mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
initial import
This commit is contained in:
Alex Shinn
commit
105c317700
5 changed files with 2342 additions and 0 deletions
128
sexp-huff.c
Normal file
128
sexp-huff.c
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
{12, 0x0C00}, /* '\x00' */
|
||||
{15, 0x0000}, /* '\x01' */
|
||||
{15, 0x4000}, /* '\x02' */
|
||||
{15, 0x2000}, /* '\x03' */
|
||||
{15, 0x6000}, /* '\x04' */
|
||||
{15, 0x0800}, /* '\x05' */
|
||||
{15, 0x4800}, /* '\x06' */
|
||||
{15, 0x2800}, /* '\x07' */
|
||||
{15, 0x6800}, /* '\x08' */
|
||||
{15, 0x1800}, /* '\x09' */
|
||||
{15, 0x5800}, /* '\x0a' */
|
||||
{15, 0x3800}, /* '\x0b' */
|
||||
{15, 0x7800}, /* '\x0c' */
|
||||
{15, 0x0100}, /* '\x0d' */
|
||||
{15, 0x4100}, /* '\x0e' */
|
||||
{15, 0x2100}, /* '\x0f' */
|
||||
{15, 0x6100}, /* '\x10' */
|
||||
{15, 0x1100}, /* '\x11' */
|
||||
{15, 0x5100}, /* '\x12' */
|
||||
{15, 0x3100}, /* '\x13' */
|
||||
{15, 0x7100}, /* '\x14' */
|
||||
{15, 0x0900}, /* '\x15' */
|
||||
{15, 0x4900}, /* '\x16' */
|
||||
{15, 0x2900}, /* '\x17' */
|
||||
{15, 0x6900}, /* '\x18' */
|
||||
{15, 0x1900}, /* '\x19' */
|
||||
{15, 0x5900}, /* '\x1a' */
|
||||
{15, 0x3900}, /* '\x1b' */
|
||||
{15, 0x7900}, /* '\x1c' */
|
||||
{15, 0x0500}, /* '\x1d' */
|
||||
{15, 0x4500}, /* '\x1e' */
|
||||
{15, 0x2500}, /* '\x1f' */
|
||||
{15, 0x6500}, /* '\x20' */
|
||||
{ 8, 0x0040}, /* '!' */
|
||||
{15, 0x1500}, /* '"' */
|
||||
{15, 0x5500}, /* '#' */
|
||||
{15, 0x3500}, /* '$' */
|
||||
{15, 0x7500}, /* '%' */
|
||||
{15, 0x0D00}, /* '&' */
|
||||
{15, 0x4D00}, /* '\'' */
|
||||
{15, 0x2D00}, /* '(' */
|
||||
{15, 0x6D00}, /* ')' */
|
||||
{11, 0x0300}, /* '*' */
|
||||
{10, 0x0180}, /* '+' */
|
||||
{15, 0x1D00}, /* ',' */
|
||||
{ 4, 0x000D}, /* '-' */
|
||||
{15, 0x5D00}, /* '.' */
|
||||
{10, 0x0380}, /* '/' */
|
||||
{15, 0x3D00}, /* '0' */
|
||||
{15, 0x7D00}, /* '1' */
|
||||
{14, 0x0080}, /* '2' */
|
||||
{14, 0x2080}, /* '3' */
|
||||
{14, 0x1080}, /* '4' */
|
||||
{14, 0x3080}, /* '5' */
|
||||
{14, 0x0880}, /* '6' */
|
||||
{14, 0x2880}, /* '7' */
|
||||
{14, 0x1880}, /* '8' */
|
||||
{14, 0x3880}, /* '9' */
|
||||
{14, 0x0480}, /* ':' */
|
||||
{14, 0x2480}, /* ';' */
|
||||
{ 7, 0x0050}, /* '<' */
|
||||
{ 7, 0x0042}, /* '=' */
|
||||
{ 7, 0x0022}, /* '>' */
|
||||
{ 5, 0x0009}, /* '?' */
|
||||
{14, 0x1480}, /* '@' */
|
||||
{14, 0x3480}, /* 'A' */
|
||||
{14, 0x0C80}, /* 'B' */
|
||||
{14, 0x2C80}, /* 'C' */
|
||||
{14, 0x1C80}, /* 'D' */
|
||||
{14, 0x3C80}, /* 'E' */
|
||||
{14, 0x0280}, /* 'F' */
|
||||
{14, 0x2280}, /* 'G' */
|
||||
{14, 0x1280}, /* 'H' */
|
||||
{14, 0x3280}, /* 'I' */
|
||||
{14, 0x0A80}, /* 'J' */
|
||||
{14, 0x2A80}, /* 'K' */
|
||||
{14, 0x1A80}, /* 'L' */
|
||||
{14, 0x3A80}, /* 'M' */
|
||||
{14, 0x0680}, /* 'N' */
|
||||
{14, 0x2680}, /* 'O' */
|
||||
{14, 0x1680}, /* 'P' */
|
||||
{14, 0x3680}, /* 'Q' */
|
||||
{14, 0x0E80}, /* 'R' */
|
||||
{14, 0x2E80}, /* 'S' */
|
||||
{14, 0x1E80}, /* 'T' */
|
||||
{14, 0x3E80}, /* 'U' */
|
||||
{14, 0x0200}, /* 'V' */
|
||||
{14, 0x2200}, /* 'W' */
|
||||
{14, 0x1200}, /* 'X' */
|
||||
{14, 0x3200}, /* 'Y' */
|
||||
{14, 0x0A00}, /* 'Z' */
|
||||
{14, 0x2A00}, /* '[' */
|
||||
{14, 0x1A00}, /* '\\' */
|
||||
{14, 0x3A00}, /* ']' */
|
||||
{14, 0x0600}, /* '^' */
|
||||
{14, 0x2600}, /* '_' */
|
||||
{14, 0x1600}, /* '`' */
|
||||
{ 3, 0x0007}, /* 'a' */
|
||||
{ 7, 0x0020}, /* 'b' */
|
||||
{ 4, 0x0004}, /* 'c' */
|
||||
{ 5, 0x001A}, /* 'd' */
|
||||
{ 4, 0x0006}, /* 'e' */
|
||||
{ 7, 0x0002}, /* 'f' */
|
||||
{ 5, 0x0011}, /* 'g' */
|
||||
{ 6, 0x0012}, /* 'h' */
|
||||
{ 4, 0x000C}, /* 'i' */
|
||||
{12, 0x0400}, /* 'j' */
|
||||
{ 8, 0x00C0}, /* 'k' */
|
||||
{ 5, 0x0018}, /* 'l' */
|
||||
{ 6, 0x0032}, /* 'm' */
|
||||
{ 4, 0x0005}, /* 'n' */
|
||||
{ 5, 0x000A}, /* 'o' */
|
||||
{ 5, 0x0001}, /* 'p' */
|
||||
{ 7, 0x0070}, /* 'q' */
|
||||
{ 3, 0x0003}, /* 'r' */
|
||||
{ 5, 0x0008}, /* 's' */
|
||||
{ 4, 0x000E}, /* 't' */
|
||||
{ 5, 0x0019}, /* 'u' */
|
||||
{ 7, 0x0062}, /* 'v' */
|
||||
{ 7, 0x0030}, /* 'w' */
|
||||
{ 7, 0x0060}, /* 'x' */
|
||||
{ 7, 0x0010}, /* 'y' */
|
||||
{11, 0x0700}, /* 'z' */
|
||||
{14, 0x3600}, /* '{' */
|
||||
{14, 0x0E00}, /* '|' */
|
||||
{14, 0x2E00}, /* '}' */
|
||||
{14, 0x1E00}, /* '~' */
|
||||
{14, 0x3E00}, /* '\x7f' */
|
||||
92
sexp-hufftabs.c
Normal file
92
sexp-hufftabs.c
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
/* auto-generated by ./symhuff.scm on Sun Feb 25 23:12:52 2007 */
|
||||
|
||||
char _huff_tab21[] = {
|
||||
'\x01', '\x00', '\x03', '\x00', '\x02', '\x00', '\x04', '\x00',
|
||||
};
|
||||
|
||||
char _huff_tab19[] = {
|
||||
'\x01', 'j', '\x01', '\x00',
|
||||
};
|
||||
|
||||
char _huff_tab20[] = {
|
||||
'\x05', '\x09', '\x07', '\x0b', '\x06', '\x0a', '\x08', '\x0c',
|
||||
};
|
||||
|
||||
char _huff_tab18[] = {
|
||||
'2', ':', '6', 'B', '4', '@', '8', 'D',
|
||||
'3', ';', '7', 'C', '5', 'A', '9', 'E',
|
||||
};
|
||||
|
||||
char _huff_tab17[] = {
|
||||
'\x0d', '\x1d', '\x15', '&', '\x11', '"', '\x19', ',',
|
||||
'\x0f', '\x1f', '\x17', '(', '\x13', '$', '\x1b', '0',
|
||||
'\x0e', '\x1e', '\x16', '\'', '\x12', '#', '\x1a', '.',
|
||||
'\x10', '\x20', '\x18', ')', '\x14', '%', '\x1c', '1',
|
||||
};
|
||||
|
||||
char _huff_tab16[] = {
|
||||
'V', '^', 'Z', '|', 'X', '`', '\\', '~',
|
||||
'W', '_', '[', '}', 'Y', '{', ']', '\x7f',
|
||||
};
|
||||
|
||||
char _huff_tab15[] = {
|
||||
'F', 'N', 'J', 'R', 'H', 'P', 'L', 'T',
|
||||
'G', 'O', 'K', 'S', 'I', 'Q', 'M', 'U',
|
||||
};
|
||||
|
||||
char _huff_tab13[] = {
|
||||
'\x00', '\x00', '\x00', '+', '\x00', '\x00', '\x00', '/',
|
||||
};
|
||||
|
||||
char _huff_tab14[] = {
|
||||
'*', 'z',
|
||||
};
|
||||
|
||||
char _huff_tab11[] = {
|
||||
'\x00', 'b', '\x00', 'x',
|
||||
};
|
||||
|
||||
char _huff_tab12[] = {
|
||||
'!', 'k',
|
||||
};
|
||||
|
||||
char _huff_tab9[] = {
|
||||
'\x00', 's', '\x00', 'l',
|
||||
};
|
||||
|
||||
char _huff_tab10[] = {
|
||||
'y', 'w', '<', 'q',
|
||||
};
|
||||
|
||||
char _huff_tab8[] = {
|
||||
'p', '?', 'g', 'u',
|
||||
};
|
||||
|
||||
char _huff_tab7[] = {
|
||||
'f', '>', '=', 'v',
|
||||
};
|
||||
|
||||
char _huff_tab5[] = {
|
||||
'\x00', 'o', '\x00', 'd',
|
||||
};
|
||||
|
||||
char _huff_tab6[] = {
|
||||
'h', 'm',
|
||||
};
|
||||
|
||||
char _huff_tab4[] = {
|
||||
'c', 'i',
|
||||
};
|
||||
|
||||
char _huff_tab3[] = {
|
||||
'n', '-',
|
||||
};
|
||||
|
||||
char _huff_tab1[] = {
|
||||
'\x00', '\x00', '\x00', 'r', '\x00', '\x00', '\x00', 'a',
|
||||
};
|
||||
|
||||
char _huff_tab2[] = {
|
||||
'e', 't',
|
||||
};
|
||||
|
||||
594
sexp-orig.c
Normal file
594
sexp-orig.c
Normal file
|
|
@ -0,0 +1,594 @@
|
|||
|
||||
/* #include <ctype.h> */
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdarg.h>
|
||||
|
||||
/* simple tagging
|
||||
* ends in 00: pointer
|
||||
* 1: fixnum
|
||||
* 010: symbol
|
||||
* 0110: char
|
||||
* 1110: other immediate object (NULL, TRUE, FALSE)
|
||||
*/
|
||||
|
||||
enum sexp_tags {
|
||||
SEXP_PAIR,
|
||||
SEXP_SYMBOL,
|
||||
SEXP_STRING,
|
||||
SEXP_VECTOR,
|
||||
};
|
||||
|
||||
/* would need a proper header for GC */
|
||||
typedef struct sexp_struct {
|
||||
char tag;
|
||||
void *data1;
|
||||
void *data2;
|
||||
} *sexp;
|
||||
|
||||
#define MAKE_IMMEDIATE(n) ((sexp) ((n<<3) + 6))
|
||||
#define SEXP_NULL MAKE_IMMEDIATE(0)
|
||||
#define SEXP_FALSE MAKE_IMMEDIATE(1)
|
||||
#define SEXP_TRUE MAKE_IMMEDIATE(2)
|
||||
#define SEXP_EOF MAKE_IMMEDIATE(3)
|
||||
#define SEXP_UNDEF MAKE_IMMEDIATE(4)
|
||||
#define SEXP_CLOSE MAKE_IMMEDIATE(5) /* internal use */
|
||||
#define SEXP_ERROR MAKE_IMMEDIATE(6)
|
||||
|
||||
#define SEXP_NULLP(x) ((x) == SEXP_NULL)
|
||||
#define SEXP_POINTERP(x) (((int) x & 3) == 0)
|
||||
#define SEXP_INTEGERP(x) (((int) x & 3) == 1)
|
||||
#define SEXP_CHARP(x) (((int) x & 7) == 2)
|
||||
|
||||
#define SEXP_PAIRP(x) (SEXP_POINTERP(x) && (x)->tag == SEXP_PAIR)
|
||||
#define SEXP_SYMBOLP(x) (SEXP_POINTERP(x) && (x)->tag == SEXP_SYMBOL)
|
||||
#define SEXP_STRINGP(x) (SEXP_POINTERP(x) && (x)->tag == SEXP_STRING)
|
||||
|
||||
#define SEXP_ALLOC(size) (malloc(size))
|
||||
#define SEXP_FREE free
|
||||
#define SEXP_NEW() ((sexp) SEXP_ALLOC(sizeof(sexp)))
|
||||
|
||||
#define make_integer(n) ((sexp) (((int) n<<2) + 1))
|
||||
#define unbox_integer(n) ((int) n>>2)
|
||||
#define make_character(n) ((sexp) (((int) n<<3) + 2))
|
||||
#define unbox_character(n) ((int) n>>3)
|
||||
|
||||
#define vector_length(x) ((int) x->data1)
|
||||
#define vector_data(x) ((sexp*) x->data2)
|
||||
|
||||
#define string_length(x) ((int) x->data1)
|
||||
#define string_data(x) ((char*) x->data2)
|
||||
|
||||
sexp cons(sexp head, sexp tail) {
|
||||
sexp pair = SEXP_NEW();
|
||||
if (! pair) return SEXP_ERROR;
|
||||
pair->tag = SEXP_PAIR;
|
||||
pair->data1 = (void*) head;
|
||||
pair->data2 = (void*) tail;
|
||||
return pair;
|
||||
}
|
||||
|
||||
sexp car(sexp obj) {
|
||||
return (SEXP_PAIRP(obj)) ? obj->data1 : SEXP_ERROR;
|
||||
}
|
||||
|
||||
sexp cdr(sexp obj) {
|
||||
return (SEXP_PAIRP(obj)) ? obj->data2 : SEXP_ERROR;
|
||||
}
|
||||
|
||||
sexp set_car(sexp obj, sexp val) {
|
||||
if (SEXP_PAIRP(obj)) {
|
||||
return obj->data1 = val;
|
||||
} else {
|
||||
return SEXP_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
sexp set_cdr(sexp obj, sexp val) {
|
||||
if (SEXP_PAIRP(obj)) {
|
||||
return obj->data2 = val;
|
||||
} else {
|
||||
return SEXP_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
sexp nreverse(sexp ls) {
|
||||
sexp a;
|
||||
sexp b;
|
||||
sexp tmp;
|
||||
|
||||
if (ls == SEXP_NULL) {
|
||||
return ls;
|
||||
} else if (! SEXP_PAIRP(ls)) {
|
||||
return SEXP_ERROR;
|
||||
} else {
|
||||
b = ls;
|
||||
a=cdr(ls);
|
||||
set_cdr(b, SEXP_NULL);
|
||||
for ( ; SEXP_PAIRP(a); ) {
|
||||
tmp = cdr(a);
|
||||
set_cdr(a, b);
|
||||
b = a;
|
||||
a = tmp;
|
||||
}
|
||||
return b;
|
||||
}
|
||||
}
|
||||
|
||||
sexp list(int count, ...) {
|
||||
sexp res = SEXP_NULL;
|
||||
sexp elt;
|
||||
int i;
|
||||
va_list ap;
|
||||
|
||||
va_start(ap, count);
|
||||
for (i=0; i<count; i++) {
|
||||
res = cons(va_arg(ap, sexp), res);
|
||||
}
|
||||
va_end(ap);
|
||||
return nreverse(res);
|
||||
}
|
||||
|
||||
int length(sexp ls) {
|
||||
sexp x;
|
||||
int res;
|
||||
for (res=0, x=ls; SEXP_PAIRP(x); res++, x=cdr(x))
|
||||
;
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp make_string(char *str) {
|
||||
sexp s = SEXP_NEW();
|
||||
if (! s) return SEXP_ERROR;
|
||||
int len = strlen(str);
|
||||
char *mystr = SEXP_ALLOC(len+1);
|
||||
if (! mystr) { SEXP_FREE(s); return SEXP_ERROR; }
|
||||
strncpy(mystr, str, len+1);
|
||||
s->tag = SEXP_STRING;
|
||||
s->data1 = (void*) len;
|
||||
s->data2 = (void*) mystr;
|
||||
return s;
|
||||
}
|
||||
|
||||
sexp intern(char *str) {
|
||||
sexp sym = SEXP_NEW();
|
||||
if (! sym) return SEXP_ERROR;
|
||||
int len = strlen(str);
|
||||
char *mystr = SEXP_ALLOC(len+1);
|
||||
if (! mystr) { SEXP_FREE(sym); return SEXP_ERROR; }
|
||||
strncpy(mystr, str, len+1);
|
||||
sym->tag = SEXP_SYMBOL;
|
||||
sym->data1 = (void*) len;
|
||||
sym->data2 = (void*) mystr;
|
||||
return sym;
|
||||
}
|
||||
|
||||
sexp make_vector(int len, sexp dflt) {
|
||||
int i;
|
||||
sexp v = SEXP_NEW();
|
||||
if (v == NULL) return SEXP_ERROR;
|
||||
sexp *x = (void*) SEXP_ALLOC(len*sizeof(sexp));
|
||||
if (x == NULL) return SEXP_ERROR;
|
||||
for (i=0; i<len; i++) {
|
||||
x[i] = dflt;
|
||||
}
|
||||
v->tag = SEXP_VECTOR;
|
||||
v->data1 = (void*) len;
|
||||
v->data2 = (void*) x;
|
||||
return v;
|
||||
}
|
||||
|
||||
sexp list_to_vector(sexp ls) {
|
||||
sexp vec = make_vector(length(ls), SEXP_FALSE);
|
||||
if (vec == SEXP_ERROR) return vec;
|
||||
sexp x;
|
||||
sexp *elts = vector_data(vec);
|
||||
int i;
|
||||
for (i=0, x=ls; SEXP_PAIRP(x); i++, x=cdr(x)) {
|
||||
elts[i] = car(x);
|
||||
}
|
||||
return vec;
|
||||
}
|
||||
|
||||
sexp vector(int count, ...) {
|
||||
sexp vec = make_vector(count, SEXP_FALSE);
|
||||
if (vec == SEXP_ERROR) return vec;
|
||||
sexp *elts = vector_data(vec);
|
||||
va_list ap;
|
||||
int i;
|
||||
|
||||
va_start(ap, count);
|
||||
for (i=0; i<count; i++) {
|
||||
elts[i] = va_arg(ap, sexp);
|
||||
}
|
||||
va_end(ap);
|
||||
return vec;
|
||||
}
|
||||
|
||||
void write_sexp (FILE *out, sexp obj) {
|
||||
int len, i;
|
||||
sexp x;
|
||||
|
||||
if (SEXP_POINTERP(obj)) {
|
||||
|
||||
switch (obj->tag) {
|
||||
case SEXP_PAIR:
|
||||
fprintf(out, "(");
|
||||
write_sexp(out, car(obj));
|
||||
for (x=cdr(obj); SEXP_PAIRP(x); x=cdr(x)) {
|
||||
fprintf(out, " ");
|
||||
write_sexp(out, car(x));
|
||||
}
|
||||
if (! SEXP_NULLP(x)) {
|
||||
fprintf(out, " . ");
|
||||
write_sexp(out, x);
|
||||
}
|
||||
fprintf(out, ")");
|
||||
break;
|
||||
case SEXP_VECTOR:
|
||||
len = vector_length(obj);
|
||||
sexp *elts = vector_data(obj);
|
||||
if (len == 0) {
|
||||
fprintf(out, "#()");
|
||||
} else {
|
||||
fprintf(out, "#(");
|
||||
write_sexp(out, elts[0]);
|
||||
for (i=1; i<len; i++) {
|
||||
fprintf(out, " ");
|
||||
write_sexp(out, elts[i]);
|
||||
}
|
||||
fprintf(out, ")");
|
||||
}
|
||||
break;
|
||||
case SEXP_STRING:
|
||||
fprintf(out, "\"");
|
||||
/* FALLTHROUGH */
|
||||
case SEXP_SYMBOL:
|
||||
fprintf(out, "%s", string_data(obj));
|
||||
if (obj->tag == SEXP_STRING) {
|
||||
fprintf(out, "\"");
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
} else if (SEXP_INTEGERP(obj)) {
|
||||
|
||||
fprintf(out, "%d", unbox_integer(obj));
|
||||
|
||||
} else if (SEXP_CHARP(obj)) {
|
||||
|
||||
if (33 <= unbox_character(obj) < 127) {
|
||||
fprintf(out, "#\\%c", unbox_character(obj));
|
||||
} else {
|
||||
fprintf(out, "#\\x%02d", unbox_character(obj));
|
||||
}
|
||||
|
||||
} else {
|
||||
|
||||
switch ((int) obj) {
|
||||
case (int) SEXP_NULL:
|
||||
fprintf(out, "()");
|
||||
break;
|
||||
case (int) SEXP_TRUE:
|
||||
fprintf(out, "#t");
|
||||
break;
|
||||
case (int) SEXP_FALSE:
|
||||
fprintf(out, "#f");
|
||||
break;
|
||||
case (int) SEXP_EOF:
|
||||
fprintf(out, "#<eof>");
|
||||
break;
|
||||
case (int) SEXP_UNDEF:
|
||||
fprintf(out, "#<undef>");
|
||||
break;
|
||||
default:
|
||||
fprintf(out, "#<error>");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void* free_sexp (sexp obj) {
|
||||
int len, i;
|
||||
sexp *elts;
|
||||
|
||||
if (SEXP_POINTERP(obj)) {
|
||||
switch (obj->tag) {
|
||||
case SEXP_PAIR:
|
||||
free_sexp(car(obj));
|
||||
free_sexp(cdr(obj));
|
||||
break;
|
||||
case SEXP_VECTOR:
|
||||
len = vector_length(obj);
|
||||
elts = vector_data(obj);
|
||||
for (i=0; i<len; i++) {
|
||||
free_sexp(elts[i]);
|
||||
}
|
||||
SEXP_FREE(elts);
|
||||
break;
|
||||
case SEXP_STRING:
|
||||
case SEXP_SYMBOL:
|
||||
free(string_data(obj));
|
||||
break;
|
||||
}
|
||||
|
||||
SEXP_FREE(obj);
|
||||
}
|
||||
}
|
||||
|
||||
enum sexp_tokens {
|
||||
TOK_OPEN_LIST,
|
||||
TOK_OPEN_VECTOR,
|
||||
TOK_CLOSE,
|
||||
TOK_START_STRING,
|
||||
TOK_SYMBOL,
|
||||
TOK_NUMBER,
|
||||
TOK_QUOTE,
|
||||
TOK_QUASIQUOTE,
|
||||
TOK_UNQUOTE,
|
||||
TOK_UNQUOTE_SPLICING,
|
||||
TOK_EOF,
|
||||
TOK_TRUE,
|
||||
TOK_FALSE,
|
||||
TOK_ERROR,
|
||||
};
|
||||
|
||||
char* read_string(FILE *in) {
|
||||
char *buf, *tmp, *res;
|
||||
char c;
|
||||
int len;
|
||||
|
||||
buf = SEXP_ALLOC(128);
|
||||
tmp = buf;
|
||||
|
||||
for (c=fgetc(in); (c != EOF) && (c != '"'); c=fgetc(in)) {
|
||||
if (c == '\\') {
|
||||
c=fgetc(in);
|
||||
switch (c) {
|
||||
case 'n':
|
||||
c = '\n';
|
||||
case 't':
|
||||
c = '\t';
|
||||
}
|
||||
*tmp++ = c;
|
||||
} else {
|
||||
*tmp++ = c;
|
||||
}
|
||||
}
|
||||
|
||||
*tmp++ = '\0';
|
||||
len = tmp - buf;
|
||||
res = SEXP_ALLOC(len);
|
||||
strncpy(res, buf, len);
|
||||
SEXP_FREE(buf);
|
||||
return res;
|
||||
}
|
||||
|
||||
char* read_symbol(FILE *in) {
|
||||
char *buf, *tmp, *res;
|
||||
char c;
|
||||
int len;
|
||||
|
||||
buf = SEXP_ALLOC(128);
|
||||
tmp = buf;
|
||||
|
||||
while (1) {
|
||||
c=fgetc(in);
|
||||
switch (c) {
|
||||
case '(': case ')': case ';': case ' ': case '\t': case '\r': case '\n':
|
||||
case '\'': case '"': case ',': case EOF:
|
||||
ungetc(c, in);
|
||||
goto done;
|
||||
break;
|
||||
}
|
||||
*tmp++ = c;
|
||||
}
|
||||
done:
|
||||
|
||||
*tmp++ = '\0';
|
||||
len = tmp - buf;
|
||||
res = SEXP_ALLOC(len);
|
||||
strncpy(res, buf, len);
|
||||
SEXP_FREE(buf);
|
||||
return res;
|
||||
}
|
||||
|
||||
int read_number(FILE *in) {
|
||||
int res = 0;
|
||||
int negativep = 0;
|
||||
char c;
|
||||
|
||||
c = fgetc(in);
|
||||
if (c == '-') {
|
||||
negativep = 1;
|
||||
} else if (isdigit(c)) {
|
||||
res = c - '0';
|
||||
}
|
||||
|
||||
for (c=fgetc(in); isdigit(c); c=fgetc(in)) {
|
||||
res = res * 10 + (c - '0');
|
||||
}
|
||||
ungetc(c, in);
|
||||
|
||||
return negativep ? -res : res;
|
||||
}
|
||||
|
||||
int read_token (FILE *in) {
|
||||
int c;
|
||||
scan_loop:
|
||||
while (isspace(c=fgetc(in)))
|
||||
;
|
||||
if (c == EOF)
|
||||
return TOK_EOF;
|
||||
switch (c) {
|
||||
case ';':
|
||||
while ((c=fgetc(in)) != '\n')
|
||||
;
|
||||
goto scan_loop;
|
||||
break;
|
||||
case '\'':
|
||||
return TOK_QUOTE;
|
||||
case '`':
|
||||
return TOK_QUASIQUOTE;
|
||||
case '"':
|
||||
return TOK_START_STRING;
|
||||
case '(':
|
||||
return TOK_OPEN_LIST;
|
||||
case ')':
|
||||
return TOK_CLOSE;
|
||||
case ',':
|
||||
c = fgetc(in);
|
||||
if (c == '@') {
|
||||
return TOK_UNQUOTE_SPLICING;
|
||||
} else {
|
||||
ungetc(c, in);
|
||||
return TOK_UNQUOTE;
|
||||
}
|
||||
case '#':
|
||||
c = fgetc(in);
|
||||
switch (c) {
|
||||
case '(':
|
||||
return TOK_OPEN_VECTOR;
|
||||
case 't':
|
||||
return TOK_TRUE;
|
||||
case 'f':
|
||||
return TOK_FALSE;
|
||||
/* case ';': */
|
||||
/* read_sexp(in); */
|
||||
/* goto scan_loop; */
|
||||
/* case 'b': */
|
||||
/* return TOK_BINARY; */
|
||||
/* case 'o': */
|
||||
/* return TOK_OCTAL; */
|
||||
/* case 'o': */
|
||||
/* return TOK_DECIMAL; */
|
||||
/* case 'x': */
|
||||
/* return TOK_HEXADECIMAL; */
|
||||
/* case 'e': */
|
||||
/* return TOK_EXACT; */
|
||||
/* case 'i': */
|
||||
/* return TOK_INEXACT; */
|
||||
default:
|
||||
return TOK_ERROR;
|
||||
}
|
||||
/* case '+': */
|
||||
/* case '-': */
|
||||
default:
|
||||
ungetc(c, in);
|
||||
return (isdigit(c) || c == '+' || c == '-') ? TOK_NUMBER : TOK_SYMBOL;
|
||||
}
|
||||
}
|
||||
|
||||
sexp read_sexp (FILE *in) {
|
||||
sexp res, tmp, tmp2;
|
||||
char *str;
|
||||
int tok = read_token(in);
|
||||
|
||||
switch (tok) {
|
||||
case TOK_EOF:
|
||||
res = SEXP_EOF;
|
||||
break;
|
||||
case TOK_TRUE:
|
||||
res = SEXP_TRUE;
|
||||
break;
|
||||
case TOK_FALSE:
|
||||
res = SEXP_FALSE;
|
||||
break;
|
||||
case TOK_QUOTE:
|
||||
res = read_sexp(in);
|
||||
res = list(2, intern("quote"), res);
|
||||
break;
|
||||
case TOK_QUASIQUOTE:
|
||||
res = read_sexp(in);
|
||||
res = list(2, intern("quasiquote"), res);
|
||||
break;
|
||||
case TOK_UNQUOTE:
|
||||
res = read_sexp(in);
|
||||
res = list(2, intern("unquote"), res);
|
||||
break;
|
||||
case TOK_UNQUOTE_SPLICING:
|
||||
res = read_sexp(in);
|
||||
res = list(2, intern("unquote-splicing"), res);
|
||||
break;
|
||||
case TOK_OPEN_LIST:
|
||||
case TOK_OPEN_VECTOR:
|
||||
res = SEXP_NULL;
|
||||
tmp = read_sexp(in);
|
||||
while ((tmp != SEXP_ERROR) && (tmp != SEXP_EOF) && (tmp != SEXP_CLOSE)) {
|
||||
if ((tok == TOK_OPEN_LIST) && SEXP_SYMBOLP(tmp)
|
||||
&& (strncmp(string_data(tmp), ".", 2) == 0)) {
|
||||
/* dotted list */
|
||||
free_sexp(tmp);
|
||||
tmp = read_sexp(in);
|
||||
if (read_token(in) != TOK_CLOSE) {
|
||||
res = SEXP_ERROR;
|
||||
} else {
|
||||
tmp2 = res;
|
||||
res = nreverse(res);
|
||||
set_cdr(tmp2, tmp);
|
||||
return res;
|
||||
}
|
||||
} else {
|
||||
res = cons(tmp, res);
|
||||
tmp = read_sexp(in);
|
||||
}
|
||||
}
|
||||
if (tmp != SEXP_CLOSE) {
|
||||
free_sexp(res);
|
||||
res = SEXP_ERROR;
|
||||
}
|
||||
res = nreverse(res);
|
||||
if (tok == TOK_OPEN_VECTOR) {
|
||||
tmp = res;
|
||||
res = list_to_vector(tmp);
|
||||
free_sexp(tmp);
|
||||
}
|
||||
break;
|
||||
case TOK_START_STRING:
|
||||
str = read_string(in);
|
||||
res = make_string(str);
|
||||
free(str);
|
||||
break;
|
||||
case TOK_SYMBOL:
|
||||
str = read_symbol(in);
|
||||
res = intern(str);
|
||||
free(str);
|
||||
break;
|
||||
case TOK_NUMBER:
|
||||
res = make_integer(read_number(in));
|
||||
break;
|
||||
case TOK_CLOSE:
|
||||
res = SEXP_CLOSE;
|
||||
break;
|
||||
case TOK_ERROR:
|
||||
default:
|
||||
res = SEXP_ERROR;
|
||||
break;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
int main (int argc, char **argv) {
|
||||
sexp obj;
|
||||
|
||||
/* sample object */
|
||||
/* write_sexp(stdout, list(6, */
|
||||
/* intern("foo"), */
|
||||
/* make_integer(2), */
|
||||
/* make_string("bar"), */
|
||||
/* make_character('d'), */
|
||||
/* vector(2, intern("baz"), intern("qux")), */
|
||||
/* SEXP_TRUE)); */
|
||||
/* fprintf(stdout, "\n"); */
|
||||
|
||||
/* rpl (repl without the eval) */
|
||||
fprintf(stdout, "> ");
|
||||
fflush(stdout);
|
||||
while ((obj = read_sexp(stdin)) != SEXP_EOF) {
|
||||
write_sexp(stdout, obj);
|
||||
fprintf(stdout, "\n> ");
|
||||
fflush(stdout);
|
||||
}
|
||||
fprintf(stdout, "\n");
|
||||
return 0;
|
||||
}
|
||||
71
sexp-unhuff.c
Normal file
71
sexp-unhuff.c
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
/* auto-generated by ./symhuff.scm on Sun Feb 25 23:12:52 2007 */
|
||||
|
||||
res = c & 7;
|
||||
c = c >> 3;
|
||||
if (res == 0) {
|
||||
res = c & 3;
|
||||
c = c >> 2;
|
||||
if (res == 0) {
|
||||
res = c & 3;
|
||||
c = c >> 2;
|
||||
if (res == 0) {
|
||||
res = c & 7;
|
||||
c = c >> 3;
|
||||
if (res == 0) {
|
||||
res = c & 3;
|
||||
c = c >> 2;
|
||||
if (res == 0) {
|
||||
res = _huff_tab21[c & 7];
|
||||
c = c >> 3;
|
||||
} else if ((res = _huff_tab19[res]) == '\x01') {
|
||||
res = _huff_tab20[c & 7];
|
||||
c = c >> 3;
|
||||
}
|
||||
} else if (res == 1) {
|
||||
res = _huff_tab18[c & 15];
|
||||
c = c >> 4;
|
||||
} else if (res == 2) {
|
||||
res = _huff_tab17[c & 31];
|
||||
c = c >> 5;
|
||||
} else if (res == 4) {
|
||||
res = _huff_tab16[c & 15];
|
||||
c = c >> 4;
|
||||
} else if (res == 5) {
|
||||
res = _huff_tab15[c & 15];
|
||||
c = c >> 4;
|
||||
} else if ((res = _huff_tab13[res]) == '\x00') {
|
||||
res = _huff_tab14[c & 1];
|
||||
c = c >> 1;
|
||||
}
|
||||
} else if ((res = _huff_tab11[res]) == '\x00') {
|
||||
res = _huff_tab12[c & 1];
|
||||
c = c >> 1;
|
||||
}
|
||||
} else if ((res = _huff_tab9[res]) == '\x00') {
|
||||
res = _huff_tab10[c & 3];
|
||||
c = c >> 2;
|
||||
}
|
||||
} else if (res == 1) {
|
||||
res = _huff_tab8[c & 3];
|
||||
c = c >> 2;
|
||||
} else if (res == 2) {
|
||||
res = c & 3;
|
||||
c = c >> 2;
|
||||
if (res == 0) {
|
||||
res = _huff_tab7[c & 3];
|
||||
c = c >> 2;
|
||||
} else if ((res = _huff_tab5[res]) == '\x00') {
|
||||
res = _huff_tab6[c & 1];
|
||||
c = c >> 1;
|
||||
}
|
||||
} else if (res == 4) {
|
||||
res = _huff_tab4[c & 1];
|
||||
c = c >> 1;
|
||||
} else if (res == 5) {
|
||||
res = _huff_tab3[c & 1];
|
||||
c = c >> 1;
|
||||
} else if ((res = _huff_tab1[res]) == '\x00') {
|
||||
res = _huff_tab2[c & 1];
|
||||
c = c >> 1;
|
||||
}
|
||||
|
||||
Loading…
Add table
Reference in a new issue