<commit_before>#include "expression.h"

static void display(StObject obj, StObject port);
static bool equalp(StObject lhs, StObject rhs);

StExternalTypeInfo StExpressionTypeInfo = (StExternalTypeInfo) { "<expression>", display, equalp };

// display

static void display_body(StObject vector, StObject port)
{
    int len = ST_VECTOR_LENGTH(vector);

    if (len == 0)
    {
        return;
    }

    for (int i = 0; i < len - 1; i++) {
        St_Display(ST_VECTOR_DATA(vector)[i], port);
        St_WriteCString(" ", port);
    }
    St_Display(ST_VECTOR_DATA(vector)[len], port);
}

static void display_list(StObject vector, StObject port)
{
    St_WriteCString("(", port);
    display_body(vector, port);
    St_WriteCString(")", port);
}

static void display_let(const char *sym, struct StXLet *let, StObject port)
{
    St_WriteCString("(", port);
    St_WriteCString(sym, port);
    St_WriteCString(" (", port);
    for (size_t i = 0; i < ST_VECTOR_LENGTH(let->bindings); i++) {
        St_WriteCString("(", port);
        St_Display(ST_CAR(ST_VECTOR_DATA(let->bindings)[i]), port);
        St_WriteCString(" ", port);
        St_Display(ST_CDR(ST_VECTOR_DATA(let->bindings)[i]), port);
        St_WriteCString(")", port);
    }
    St_WriteCString(")", port);

    size_t len = ST_VECTOR_LENGTH(let->defvars);
    if (len != 0)
    {
        St_WriteCString(" ", port);
    }

    for (size_t i = 0; i < len; i++) {
        St_WriteCString("(define ", port);
        St_Display(ST_VECTOR_DATA(let->defvars)[i], port);
        St_WriteCString(" ", port);
        St_Display(ST_VECTOR_DATA(let->defvals)[i], port);
        St_WriteCString(")", port);
        if (i < len - 1)
        {
            St_WriteCString(" ", port);
        }
    }

    if (ST_VECTOR_LENGTH(let->body) != 0)
    {
        St_WriteCString(" ", port);
    }

    display_body(let->body, port);
    St_WriteCString(")", port);
}

static void display_lambda(struct StXLambda *lambda, StObject port)
{
    St_WriteCString("(lambda ", port);
    if (lambda->dotted)
    {
        size_t len = ST_VECTOR_LENGTH(lambda->vars);
        if (len == 1)
        {
            St_Display(ST_VECTOR_DATA(lambda->vars)[0], port);
        }
        else
        {
            St_WriteCString("(", port);
            for (size_t i = 0; i < len - 1; i++) {
                St_Display(ST_VECTOR_DATA(lambda->vars)[i], port);
                St_WriteCString(" ", port);
            }
            St_WriteCString(". ", port);
            St_Display(ST_VECTOR_DATA(lambda->vars)[len], port);
            St_WriteCString(")", port);
        }
    }
    else
    {
        St_WriteCString("(", port);
        display_list(lambda->vars, port);
        St_WriteCString(")", port);
    }

    size_t len = ST_VECTOR_LENGTH(lambda->defvars);
    if (len != 0)
    {
        St_WriteCString(" ", port);
    }

    for (size_t i = 0; i < len; i++) {
        St_WriteCString("(define ", port);
        St_Display(ST_VECTOR_DATA(lambda->defvars)[i], port);
        St_WriteCString(" ", port);
        St_Display(ST_VECTOR_DATA(lambda->defvals)[i], port);
        St_WriteCString(")", port);
        if (i < len - 1)
        {
            St_WriteCString(" ", port);
        }
    }

    if (ST_VECTOR_LENGTH(lambda->body) != 0)
    {
        St_WriteCString(" ", port);
    }

    display_body(lambda->body, port);
    St_WriteCString(")", port);
}

static void display(StObject obj, StObject port)
{
    StExpression xobj = ST_EXPRESSION(obj);

    switch (xobj->xtype) {
    case XVALUE:
        St_Display(xobj->value.value, port);
        break;

    case XSYMBOL:
        St_Display(xobj->symbol.symbol, port);
        break;

    case XQUOTE:
        St_WriteCString("(quote ", port);
        St_Display(xobj->quote.expr, port);
        St_WriteCString(")", port);
        break;

    case XLET:
        display_let("let", &xobj->let, port);
        break;

    case XLETSTAR:
        display_let("let*", &xobj->letstar, port);
        break;

    case XLETREC:
        display_let("letrec", &xobj->letrec, port);
        break;

    case XLETRECSTAR:
        display_let("letrec*", &xobj->letrecstar, port);
        break;

    case XLAMBDA:
        display_lambda(&xobj->lambda, port);
        break;

    case XBEGIN:
        St_WriteCString("(begin ", port);
        display_body(xobj->begin.body, port);
        St_WriteCString(")", port);
        break;

    case XIF:
        St_WriteCString("(if ", port);
        St_Display(xobj->xif.xpred, port);
        St_WriteCString(" ", port);
        St_Display(xobj->xif.xthen, port);
        if (!ST_NULLP(xobj->xif.xelse))
        {
            St_WriteCString(" ", port);
            St_Display(xobj->xif.xelse, port);
        }
        St_WriteCString(")", port);
        break;

    case XSET:
        St_WriteCString("(set! ", port);
        St_Display(xobj->set.symbol, port);
        St_WriteCString(" ", port);
        St_Display(xobj->set.value, port);
        St_WriteCString(")", port);
        break;

    case XCALLCC:
        St_WriteCString("(call/cc ", port);
        St_Display(xobj->callcc.lambda, port);
        St_WriteCString(")", port);
        break;

    case XDEFINE:
        St_WriteCString("(define ", port);
        St_Display(xobj->define.symbol, port);
        St_WriteCString(" ", port);
        St_Display(xobj->define.value, port);
        St_WriteCString(")", port);
        break;

    case XDEFINEMACRO:
        St_WriteCString("(define-macro ", port);
        St_Display(xobj->define_macro.symbol, port);
        St_WriteCString(" ", port);
        St_Display(xobj->define_macro.lambda, port);
        St_WriteCString(")", port);
        break;

    case XAND:
        St_WriteCString("(and ", port);
        display_body(xobj->and.exprs, port);
        St_WriteCString(")", port);
        break;

    case XOR:
        St_WriteCString("(or ", port);
        display_body(xobj->or.exprs, port);
        St_WriteCString(")", port);
        break;

    case XLIST:
        display_list(xobj->list.exprs, port);
        break;
    }
}

// equalp

static bool equalp(StObject lhs, StObject rhs)
{
    (void)lhs;
    (void)rhs;
    // TODO
    return false;
}

// utilities

static StExpression AllocX(StExpressionType xtype, size_t size)
{
    StExpression o = St_Alloc2(TEXTERNAL, offsetof(struct StExpressionRec, value) + size);
    o->xtype = xtype;
    return o;
}

StExpression St_MakeExpression(StExpressionType xtype)
{
    switch (xtype) {
    case XVALUE:       return AllocX(xtype, sizeof(struct StXValue));
    case XSYMBOL:      return AllocX(xtype, sizeof(struct StXSymbol));
    case XQUOTE:       return AllocX(xtype, sizeof(struct StXQuote));
    case XLET:         return AllocX(xtype, sizeof(struct StXLet));
    case XLETSTAR:     return AllocX(xtype, sizeof(struct StXLet));
    case XLETREC:      return AllocX(xtype, sizeof(struct StXLet));
    case XLETRECSTAR:  return AllocX(xtype, sizeof(struct StXLet));
    case XLAMBDA:      return AllocX(xtype, sizeof(struct StXLambda));
    case XBEGIN:       return AllocX(xtype, sizeof(struct StXBegin));
    case XIF:          return AllocX(xtype, sizeof(struct StXIf));
    case XSET:         return AllocX(xtype, sizeof(struct StXSet));
    case XCALLCC:      return AllocX(xtype, sizeof(struct StXCallCC));
    case XDEFINE:      return AllocX(xtype, sizeof(struct StXDefine));
    case XDEFINEMACRO: return AllocX(xtype, sizeof(struct StXDefineMacro));
    case XAND:         return AllocX(xtype, sizeof(struct StXList));
    case XOR:          return AllocX(xtype, sizeof(struct StXList));
    case XLIST:        return AllocX(xtype, sizeof(struct StXList));
    }
}

typedef struct
{
    void *obj;
    StObject rest;
} StXCont;

static inline StXCont cont(void *obj, StObject rest)
{
    return (StXCont) { obj, rest };
}


// parse

static StXCont parse(StObject expr);

// returns obj as vector of (sym . expr)
static StXCont parse_bindings(StObject expr)
{
    StObject h = Nil, t = Nil;

    ST_FOREACH(p, expr) {
        ST_BIND2("parse", ST_CAR(p), s, v);
        if (!ST_SYMBOLP(s))
        {
            St_Error("parse: require symbol");
        }

        StXCont sc = parse(s);
        StXCont vc = parse(v);

        ST_APPEND1(h, t, St_Cons(sc.obj, vc.obj));
    }

    return (StXCont) { St_MakeVectorFromList(h), Nil };
}

// returns obj as (vars . vals)
// vars :: vector of symbol
// vals :: vector of expr
static StXCont find_defines(StObject expr)
{
    StObject vars = Nil, vart = Nil;
    StObject vals = Nil, valt = Nil;

    if (!ST_PAIRP(expr))
    {
        goto end;
    }

    ST_FOREACH(p, expr) {
        StObject e = ST_CAR(p);
        if (!ST_PAIRP(e))
        {
            goto end;
        }

        if (ST_CAR(e) != St_Intern("define"))
        {
            goto end;
        }

        ST_BIND2("syntax error: malformed define", ST_CDR(e), s, v);

        if (!ST_SYMBOLP(s))
        {
            St_Error("syntax error: malformed define, symbol required");
        }

        StXCont sc = parse(s);
        StXCont vc = parse(v);
        ST_APPEND1(vars, vart, sc.obj);
        ST_APPEND1(vals, valt, vc.obj);
    }
end:
    return (StXCont) { St_Cons(St_MakeVectorFromList(vars), St_MakeVectorFromList(vals)), expr };
}

static StObject expand_begin(StObject expr)
{
    // TODO: implement
    return Nil;
}<commit_msg>expand_begin<commit_after>#include "expression.h"

static void display(StObject obj, StObject port);
static bool equalp(StObject lhs, StObject rhs);

StExternalTypeInfo StExpressionTypeInfo = (StExternalTypeInfo) { "<expression>", display, equalp };

// display

static void display_body(StObject vector, StObject port)
{
    int len = ST_VECTOR_LENGTH(vector);

    if (len == 0)
    {
        return;
    }

    for (int i = 0; i < len - 1; i++) {
        St_Display(ST_VECTOR_DATA(vector)[i], port);
        St_WriteCString(" ", port);
    }
    St_Display(ST_VECTOR_DATA(vector)[len], port);
}

static void display_list(StObject vector, StObject port)
{
    St_WriteCString("(", port);
    display_body(vector, port);
    St_WriteCString(")", port);
}

static void display_let(const char *sym, struct StXLet *let, StObject port)
{
    St_WriteCString("(", port);
    St_WriteCString(sym, port);
    St_WriteCString(" (", port);
    for (size_t i = 0; i < ST_VECTOR_LENGTH(let->bindings); i++) {
        St_WriteCString("(", port);
        St_Display(ST_CAR(ST_VECTOR_DATA(let->bindings)[i]), port);
        St_WriteCString(" ", port);
        St_Display(ST_CDR(ST_VECTOR_DATA(let->bindings)[i]), port);
        St_WriteCString(")", port);
    }
    St_WriteCString(")", port);

    size_t len = ST_VECTOR_LENGTH(let->defvars);
    if (len != 0)
    {
        St_WriteCString(" ", port);
    }

    for (size_t i = 0; i < len; i++) {
        St_WriteCString("(define ", port);
        St_Display(ST_VECTOR_DATA(let->defvars)[i], port);
        St_WriteCString(" ", port);
        St_Display(ST_VECTOR_DATA(let->defvals)[i], port);
        St_WriteCString(")", port);
        if (i < len - 1)
        {
            St_WriteCString(" ", port);
        }
    }

    if (ST_VECTOR_LENGTH(let->body) != 0)
    {
        St_WriteCString(" ", port);
    }

    display_body(let->body, port);
    St_WriteCString(")", port);
}

static void display_lambda(struct StXLambda *lambda, StObject port)
{
    St_WriteCString("(lambda ", port);
    if (lambda->dotted)
    {
        size_t len = ST_VECTOR_LENGTH(lambda->vars);
        if (len == 1)
        {
            St_Display(ST_VECTOR_DATA(lambda->vars)[0], port);
        }
        else
        {
            St_WriteCString("(", port);
            for (size_t i = 0; i < len - 1; i++) {
                St_Display(ST_VECTOR_DATA(lambda->vars)[i], port);
                St_WriteCString(" ", port);
            }
            St_WriteCString(". ", port);
            St_Display(ST_VECTOR_DATA(lambda->vars)[len], port);
            St_WriteCString(")", port);
        }
    }
    else
    {
        St_WriteCString("(", port);
        display_list(lambda->vars, port);
        St_WriteCString(")", port);
    }

    size_t len = ST_VECTOR_LENGTH(lambda->defvars);
    if (len != 0)
    {
        St_WriteCString(" ", port);
    }

    for (size_t i = 0; i < len; i++) {
        St_WriteCString("(define ", port);
        St_Display(ST_VECTOR_DATA(lambda->defvars)[i], port);
        St_WriteCString(" ", port);
        St_Display(ST_VECTOR_DATA(lambda->defvals)[i], port);
        St_WriteCString(")", port);
        if (i < len - 1)
        {
            St_WriteCString(" ", port);
        }
    }

    if (ST_VECTOR_LENGTH(lambda->body) != 0)
    {
        St_WriteCString(" ", port);
    }

    display_body(lambda->body, port);
    St_WriteCString(")", port);
}

static void display(StObject obj, StObject port)
{
    StExpression xobj = ST_EXPRESSION(obj);

    switch (xobj->xtype) {
    case XVALUE:
        St_Display(xobj->value.value, port);
        break;

    case XSYMBOL:
        St_Display(xobj->symbol.symbol, port);
        break;

    case XQUOTE:
        St_WriteCString("(quote ", port);
        St_Display(xobj->quote.expr, port);
        St_WriteCString(")", port);
        break;

    case XLET:
        display_let("let", &xobj->let, port);
        break;

    case XLETSTAR:
        display_let("let*", &xobj->letstar, port);
        break;

    case XLETREC:
        display_let("letrec", &xobj->letrec, port);
        break;

    case XLETRECSTAR:
        display_let("letrec*", &xobj->letrecstar, port);
        break;

    case XLAMBDA:
        display_lambda(&xobj->lambda, port);
        break;

    case XBEGIN:
        St_WriteCString("(begin ", port);
        display_body(xobj->begin.body, port);
        St_WriteCString(")", port);
        break;

    case XIF:
        St_WriteCString("(if ", port);
        St_Display(xobj->xif.xpred, port);
        St_WriteCString(" ", port);
        St_Display(xobj->xif.xthen, port);
        if (!ST_NULLP(xobj->xif.xelse))
        {
            St_WriteCString(" ", port);
            St_Display(xobj->xif.xelse, port);
        }
        St_WriteCString(")", port);
        break;

    case XSET:
        St_WriteCString("(set! ", port);
        St_Display(xobj->set.symbol, port);
        St_WriteCString(" ", port);
        St_Display(xobj->set.value, port);
        St_WriteCString(")", port);
        break;

    case XCALLCC:
        St_WriteCString("(call/cc ", port);
        St_Display(xobj->callcc.lambda, port);
        St_WriteCString(")", port);
        break;

    case XDEFINE:
        St_WriteCString("(define ", port);
        St_Display(xobj->define.symbol, port);
        St_WriteCString(" ", port);
        St_Display(xobj->define.value, port);
        St_WriteCString(")", port);
        break;

    case XDEFINEMACRO:
        St_WriteCString("(define-macro ", port);
        St_Display(xobj->define_macro.symbol, port);
        St_WriteCString(" ", port);
        St_Display(xobj->define_macro.lambda, port);
        St_WriteCString(")", port);
        break;

    case XAND:
        St_WriteCString("(and ", port);
        display_body(xobj->and.exprs, port);
        St_WriteCString(")", port);
        break;

    case XOR:
        St_WriteCString("(or ", port);
        display_body(xobj->or.exprs, port);
        St_WriteCString(")", port);
        break;

    case XLIST:
        display_list(xobj->list.exprs, port);
        break;
    }
}

// equalp

static bool equalp(StObject lhs, StObject rhs)
{
    (void)lhs;
    (void)rhs;
    // TODO
    return false;
}

// utilities

static StExpression AllocX(StExpressionType xtype, size_t size)
{
    StExpression o = St_Alloc2(TEXTERNAL, offsetof(struct StExpressionRec, value) + size);
    o->xtype = xtype;
    return o;
}

StExpression St_MakeExpression(StExpressionType xtype)
{
    switch (xtype) {
    case XVALUE:       return AllocX(xtype, sizeof(struct StXValue));
    case XSYMBOL:      return AllocX(xtype, sizeof(struct StXSymbol));
    case XQUOTE:       return AllocX(xtype, sizeof(struct StXQuote));
    case XLET:         return AllocX(xtype, sizeof(struct StXLet));
    case XLETSTAR:     return AllocX(xtype, sizeof(struct StXLet));
    case XLETREC:      return AllocX(xtype, sizeof(struct StXLet));
    case XLETRECSTAR:  return AllocX(xtype, sizeof(struct StXLet));
    case XLAMBDA:      return AllocX(xtype, sizeof(struct StXLambda));
    case XBEGIN:       return AllocX(xtype, sizeof(struct StXBegin));
    case XIF:          return AllocX(xtype, sizeof(struct StXIf));
    case XSET:         return AllocX(xtype, sizeof(struct StXSet));
    case XCALLCC:      return AllocX(xtype, sizeof(struct StXCallCC));
    case XDEFINE:      return AllocX(xtype, sizeof(struct StXDefine));
    case XDEFINEMACRO: return AllocX(xtype, sizeof(struct StXDefineMacro));
    case XAND:         return AllocX(xtype, sizeof(struct StXList));
    case XOR:          return AllocX(xtype, sizeof(struct StXList));
    case XLIST:        return AllocX(xtype, sizeof(struct StXList));
    }
}

typedef struct
{
    void *obj;
    StObject rest;
} StXCont;

static inline StXCont cont(void *obj, StObject rest)
{
    return (StXCont) { obj, rest };
}


// parse

static StXCont parse(StObject expr);

// returns obj as vector of (sym . expr)
static StXCont parse_bindings(StObject expr)
{
    StObject h = Nil, t = Nil;

    ST_FOREACH(p, expr) {
        ST_BIND2("parse", ST_CAR(p), s, v);
        if (!ST_SYMBOLP(s))
        {
            St_Error("parse: require symbol");
        }

        StXCont sc = parse(s);
        StXCont vc = parse(v);

        ST_APPEND1(h, t, St_Cons(sc.obj, vc.obj));
    }

    return (StXCont) { St_MakeVectorFromList(h), Nil };
}

// returns obj as (vars . vals)
// vars :: vector of symbol
// vals :: vector of expr
static StXCont find_defines(StObject expr)
{
    StObject vars = Nil, vart = Nil;
    StObject vals = Nil, valt = Nil;

    if (!ST_PAIRP(expr))
    {
        goto end;
    }

    ST_FOREACH(p, expr) {
        StObject e = ST_CAR(p);
        if (!ST_PAIRP(e))
        {
            goto end;
        }

        if (ST_CAR(e) != St_Intern("define"))
        {
            goto end;
        }

        ST_BIND2("syntax error: malformed define", ST_CDR(e), s, v);

        if (!ST_SYMBOLP(s))
        {
            St_Error("syntax error: malformed define, symbol required");
        }

        StXCont sc = parse(s);
        StXCont vc = parse(v);
        ST_APPEND1(vars, vart, sc.obj);
        ST_APPEND1(vals, valt, vc.obj);
    }
end:
    return (StXCont) { St_Cons(St_MakeVectorFromList(vars), St_MakeVectorFromList(vals)), expr };
}

static void expand_begin_sub(StObject expr, StObject *head, StObject *tail)
{
    if (!ST_PAIRP(expr))
    {
        ST_APPEND1(*head, *tail, expr);
        return;
    }

    ST_FOREACH(p, expr) {
        StObject e = ST_CAR(p);
        if (ST_PAIRP(e) && ST_CAR(p) == St_Intern("begin"))
        {
            expand_begin_sub(ST_CDR(expr), head, tail);
        }
        else
        {
            ST_APPEND1(*head, *tail, expr);
        }
    }
}

static StObject expand_begin(StObject expr)
{
    StObject h = Nil, t = Nil;
    expand_begin_sub(expr, &h, &t);
    return h;
}
{'fraction_non_alphanumeric': 0.13912411034339447, 'fraction_numerical': 0.0023897345316639825, 'mean_word_length': 2.4234394451360486, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 93, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3542975', 'n_tokens_mistral': 6740, 'n_tokens_neox': 6600, 'n_words': 1370}