Commit b0434898 authored by Niels Möller's avatar Niels Möller
Browse files

Bug fixes. Output of canonical S-expressions seems to work now.

Rev: src/sexp.c:1.2
Rev: src/sexp.h:1.3
parent d26a3a4f
......@@ -25,21 +25,36 @@
#include "sexp.h"
#include "format.h"
#include "werror.h"
#include "xalloc.h"
#include <assert.h>
#include <stdarg.h>
#define CLASS_DEFINE
#unclude "sexp.h.x"
#include "sexp.h.x"
#undef CLASS_DEFINE
struct lsh_string *do_format_sexp_string(struct sexp *s, int style)
#include "sexp.c.x"
/* CLASS:
(class
(name sexp_string)
(super sexp)
(vars
(display string)
(contents string)))
*/
static struct lsh_string *do_format_sexp_string(struct sexp *s, int style)
{
CAST(sexp_string, self, s);
switch(style)
{
SEXP_TRANSPORT:
return ssh_format("{%lfs}",
encode_base64(SEXP_FORMAT(s, SEXP_CANONICAL), 1));
case SEXP_TRANSPORT:
fatal("Internal error!\n");
case SEXP_ADVANCED:
/* Special case of canonical, so we'll fal through for now. */
case SEXP_CANONICAL:
......@@ -55,6 +70,254 @@ struct lsh_string *do_format_sexp_string(struct sexp *s, int style)
}
}
/* Consumes its args (display may be NULL) */
static struct sexp *make_sexp_string(struct lsh_string *d, struct lsh_string *c)
{
NEW(sexp_string, s);
s->super.format = do_format_sexp_string;
s->display = d;
s->contents = c;
return &s->super;
}
static struct lsh_string *do_format_sexp_tail(struct sexp_cons *c, int style)
{
if (!c)
return ssh_format(")");
switch(style)
{
case SEXP_TRANSPORT:
fatal("Internal error!\n");
case SEXP_ADVANCED:
/* Special case of canonical, so we'll fall through for now. */
case SEXP_CANONICAL:
return ssh_format("%ls %ls",
sexp_format(c->car, style),
do_format_sexp_tail(c->cdr, style));
default:
fatal("do_format_sexp_tail: Unknown output style.\n");
}
}
static struct lsh_string *do_format_sexp_cons(struct sexp *s, int style)
{
CAST(sexp_cons, self, s);
switch(style)
{
case SEXP_TRANSPORT:
fatal("Internal error!\n");
case SEXP_ADVANCED:
/* Special case of canonical, so we'll fal through for now. */
case SEXP_CANONICAL:
return ssh_format("(%ls", do_format_sexp_tail(self, style));
default:
fatal("do_format_sexp_tail: Unknown output style.\n");
}
}
struct sexp *sexp_c(struct sexp *car, struct sexp_cons *cdr)
{
NEW(sexp_cons, c);
c->super.format = do_format_sexp_cons;
c->car = car;
c->cdr = cdr;
return &c->super;
}
/* CLASS:
(class
(name sexp_vector)
(super sexp)
(vars
; FIXME: With better var-array support, this
; could use an embedded var-array instead.
(elements object object_list)))
*/
static struct lsh_string *do_format_sexp_vector(struct sexp *e, int style)
{
CAST(sexp_vector, v, e);
unsigned i;
UINT32 size;
struct lsh_string **elements = alloca(LIST_LENGTH(v->elements)
* sizeof(struct lsh_string *) );
switch(style)
{
case SEXP_TRANSPORT:
fatal("Internal error!\n");
case SEXP_ADVANCED:
/* Special case of canonical, so we'll fal through for now. */
case SEXP_CANONICAL:
{
struct lsh_string *res;
UINT8 *dst;
assert(LIST_LENGTH(v->elements));
for (i = 0, size = 0; i<LIST_LENGTH(v->elements); i++)
{
CAST_SUBTYPE(sexp, o, LIST(v->elements)[i]);
elements[i] = sexp_format(o, style);
size += elements[i]->length;
}
res = lsh_string_alloc(size + 2);
dst = res->data;
*dst++ = '(';
for (i = 0; i<LIST_LENGTH(v->elements); i++)
{
memcpy(dst, elements[i]->data, elements[i]->length);
dst += elements[i]->length;
lsh_string_free(elements[i]);
}
*dst++ = ')';
assert(dst == (res->data + res->length));
return res;
}
default:
fatal("do_format_sexp_vector: Unknown output style.\n");
}
}
struct sexp *sexp_l(unsigned n, ...)
{
va_list args;
va_start(args, n);
if (!n)
{
assert(va_arg(args, int) == -1);
va_end(args);
return NULL;
}
else
{
NEW(sexp_vector, v);
v->super.format = do_format_sexp_vector;
v->elements = make_object_listv(n, args);
va_end(args);
return &v->super;
}
}
struct sexp *sexp_a(int a)
{
return make_sexp_string(NULL, ssh_format("%la", a));
}
struct sexp *sexp_z(char *s)
{
return make_sexp_string(NULL, ssh_format("%lz", s));
}
/* mpz->atom */
struct sexp *sexp_n(mpz_t n)
{
return make_sexp_string(NULL, ssh_format("%ln", n));
}
struct sexp *sexp_sn(mpz_t n)
{
fatal("sexp_sn: Signed numbers are not supported.\n");
}
struct lsh_string *sexp_format(struct sexp *e, int style)
{
switch(style)
{
case SEXP_TRANSPORT:
return ssh_format("{%lfs}",
encode_base64(sexp_format(e, SEXP_CANONICAL), 1));
case SEXP_ADVANCED:
case SEXP_CANONICAL:
return e
? SEXP_FORMAT(e, style)
: ssh_format("()");
default:
fatal("sexp_format: Unknown output style.\n");
}
}
static void encode_base64_group(UINT32 n, UINT8 *dest)
{
static const UINT8 digits[64] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdef"
"ghijklmnopqrstuvwxyz0123456789+/";
unsigned i;
for (i = 0; i<4; i++)
{
dest[3 - i] = digits[n & 0x3f];
n >>= 6;
}
}
struct lsh_string *encode_base64(struct lsh_string *s, int free)
{
UINT32 full_groups = (s->length) / 3;
unsigned last = (s->length) % 3;
struct lsh_string *res = lsh_string_alloc( (full_groups + !!last) * 4);
UINT8 *src = s->data;
UINT8 *dst = res->data;
if (full_groups)
{
unsigned i;
/* Loop over all but the last group. */
for (i=0; i+1<full_groups; dst += 4, i++)
{
encode_base64_group( ( (*src++) << 16)
| ( (*src++) << 8)
| (*src++), dst);
}
}
switch(last)
{
case 0:
/* Finished */
break;
case 1:
encode_base64_group( (*src++) << 16, dst);
dst += 2;
*dst++ = '=';
*dst++ = '=';
break;
case 2:
encode_base64_group( ( (*src++) << 16)
| ( (*src++) << 8), dst);
dst += 3;
*dst++ = '=';
break;
default:
fatal("encode_base64: Internal error!\n");
}
assert(dst == (res->data + res->length));
if (free)
lsh_string_free(s);
return res;
}
......@@ -26,31 +26,31 @@
#ifndef LSH_SEXP_H_INCLUDED
#define LSH_SEXP_H_INCLUDED
#include "lsh_types.h"
#include "bignum.h"
#define CLASS_DECLARE
#unclude "sexp.h.x"
#include "sexp.h.x"
#undef CLASS_DECLARE
/* CLASS:
(class
(name sexp)
(vars
(format method int "int style")))
(format method "struct lsh_string *" "int style")))
*/
#define SEXP_FORMAT(e, s) ((e)->format((e), (s)))
/* CLASS:
(class
(name sexp_string)
(name sexp_cons)
(super sexp)
(vars
(display string)
(contents string)))
(car object sexp)
(cdr object sexp_cons)))
*/
/* CLASS:
/* ;; CLASS:
(class
(name sexp_atom)
(super sexp)
......@@ -58,20 +58,15 @@
(atom . int)))
*/
/* CLASS:
(class
(name "sexp_cons")
(super sexp)
(vars
(car object sexp)
(cdr object sex_cons)))
*/
/* Output styles */
#define SEXP_CANONICAL 0
#define SEXP_TRANSPORT 1
#define SEXP_EXTENDED 2
#define SEXP_ADVANCED 2
struct lsh_string *sexp_format(struct sexp *e, int style);
struct lsh_string *encode_base64(struct lsh_string *s, int free);
/* Creating sexps */
/* atom->sexp */
......@@ -99,7 +94,7 @@ int *sexp_consp(struct sexp *e);
struct sexp *sexp_car(struct sexp *e);
struct sexp *sexp_cdr(struct sexp *e);
int sexp *sexp_null_cdr(struct sexp *e);
int sexp_null_cdr(struct sexp *e);
struct lsh_string *sexp_contents(struct sexp *e);
struct lsh_string *sexp_display(struct sexp *e);
......@@ -110,15 +105,17 @@ int sexp_bignum_s(struct sexp *e, mpz_t n);
/* Parsing sexp */
/* CLASS:
/* ;;CLASS:
(class
(name sexp_handler)
(vars
(method int "struct sexp *e")))
(handler method int "struct sexp *e")))
*/
struct read_handler make_read_sexp(struct sexp_handler *h)
#if 0
struct read_handler make_read_sexp(struct sexp_handler *h);
#endif
#endif /* LSH_SEXP_H_INCLUDED */
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment