From f28544ec25ceee5fe2b783f1980cdf19caf0e977 Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Sat, 22 Jan 2022 20:34:21 +0000 Subject: Implement fgh and gh trains --- apl9.h | 11 +++++++++++ eval.c | 50 +++++++++++++++++++++++++++++++++++++++++--------- functions.c | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++- print.c | 54 ++++++++++++++++++++++++++++++++++++------------------ 4 files changed, 138 insertions(+), 28 deletions(-) diff --git a/apl9.h b/apl9.h index 8be337c..78b5c11 100644 --- a/apl9.h +++ b/apl9.h @@ -39,6 +39,7 @@ typedef enum FunctypeOp, FunctypeQuad, FunctypeHybrid, + FunctypeTrain, } functionType; typedef enum @@ -59,6 +60,7 @@ typedef enum typedef struct Array Array; typedef struct Statement Statement; typedef struct Operator Operator; +typedef struct FunctionTrain FunctionTrain; typedef struct Function Function; typedef struct Datum Datum; typedef struct Symbol Symbol; @@ -103,6 +105,12 @@ struct Operator Datum *right; }; +struct FunctionTrain +{ + int nfuncs; + Function *funcs; +}; + struct Function { functionType type; @@ -111,6 +119,7 @@ struct Function Rune *dfn; Operator operator; QuadnameDef *quad; + FunctionTrain train; }; Array *left; }; @@ -179,6 +188,7 @@ Rune *ppdatum(Datum); Rune *ppdatums(Datum *, int); Rune *pparray(Array *); Rune *ppoperator(Operator); +Rune *ppfunction(Function); /* lexer.c */ Statement *lexline(Rune *, int); @@ -219,6 +229,7 @@ void incref(Array *); /* functions.c */ Array *runfunc(Function, Array *,Array *); Array *rundfn(Rune *, Array *, Array *); +Array *runtrain(Function *, int, Array *, Array *, Array *); /* quadnames.c */ Datum quadnamedatum(QuadnameDef); diff --git a/eval.c b/eval.c index 86d0d15..f63f5e0 100644 --- a/eval.c +++ b/eval.c @@ -18,27 +18,28 @@ Datum nameis(Datum, Datum); Datum assign(Datum, Datum); Datum monadop(Datum, Datum); Datum dyadop(Datum, Datum); +Datum train(Datum, Datum); Datum *lookup(Datum); int bindingstrengths[11][11] = { /* A F H MO DO AF ( ) ← IS N */ - 6, 3, 3, 4, 0, 0, 0, 0, 0, 0, 0, /* A */ - 2, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, /* F */ - 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, /* H */ + 7, 4, 4, 5, 0, 0, 0, 0, 0, 0, 0, /* A */ + 3, 2, 5, 5, 0, 0, 0, 0, 0, 0, 0, /* F */ + 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, /* H */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */ - 5, 5, 5, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ - 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ - 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0, /* ( */ - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, /* ) */ + 6, 6, 6, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ + 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ + 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, /* ( */ + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, /* ) */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */ 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */ - 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, /* N */ + 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, /* N */ }; evalfn evalfns[11][11] = { /* A F H MO DO AF ( ) ← IS N */ strand, dyadfun, dyadfun, monadop, 0, 0, 0, 0, 0, 0, 0, /* A */ - monadfun, 0, monadop, monadop, 0, 0, 0, 0, 0, 0, 0, /* F */ + monadfun, train, monadop, monadop, 0, 0, 0, 0, 0, 0, 0, /* F */ 0, 0, 0, monadop, 0, 0, 0, 0, 0, 0, 0, /* H */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */ dyadop, dyadop, dyadop, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ @@ -287,4 +288,35 @@ dyadop(Datum left, Datum right) if(arg->tag == ArrayTag) incref(arg->array); return result; +} + +Datum +train(Datum left, Datum right) +{ + Datum result; + result.shy = 0; + result.tag = FunctionTag; + result.func.type = FunctypeTrain; + result.func.left = left.func.left; + + if(left.func.type == FunctypeTrain) + result.func = left.func; + else{ + result.func.train.nfuncs = 1; + result.func.train.funcs = malloc(sizeof(Function)); + result.func.train.funcs[0] = left.func; + } + + if(right.func.type == FunctypeTrain){ + int oldn = result.func.train.nfuncs; + result.func.train.nfuncs = oldn + right.func.train.nfuncs; + result.func.train.funcs = realloc(result.func.train.funcs, sizeof(Function) * result.func.train.nfuncs); + for(int i = 0; i < right.func.train.nfuncs; i++) + result.func.train.funcs[oldn + i] = right.func.train.funcs[i]; + }else{ + result.func.train.nfuncs++; + result.func.train.funcs = realloc(result.func.train.funcs, sizeof(Function) * result.func.train.nfuncs); + result.func.train.funcs[result.func.train.nfuncs-1] = right.func; + } + return result; } \ No newline at end of file diff --git a/functions.c b/functions.c index 09e4917..c229322 100644 --- a/functions.c +++ b/functions.c @@ -206,8 +206,12 @@ runfunc(Function f, Array *left, Array *right) throwerror(err, ENotImplemented); } return d(left, right); - }else + }else if(f.type == FunctypeTrain) + return runtrain(f.train.funcs, f.train.nfuncs, left, right, nil); + else{ + throwerror(L"runfunc for this function type", ENotImplemented); return nil; + } } Array * @@ -219,6 +223,51 @@ rundfn(Rune *code, Array *left, Array *right) return runfunc(dfn, left, right); } +Array * +runtrain(Function *funcs, int nfuncs, Array *left, Array *right, Array *acc) +{ + if(nfuncs >= 3 && acc == nil){ + Array *rtmp = runfunc(funcs[nfuncs-1], left, right); + Array *ltmp = runfunc(funcs[nfuncs-3], left, right); + Array *r = simplifyarray(rtmp); + Array *l = simplifyarray(ltmp); + Array *c = runfunc(funcs[nfuncs-2], l, r); + freearray(rtmp); + freearray(ltmp); + freearray(r); + freearray(l); + if(nfuncs == 3) + return c; + else + return runtrain(funcs, nfuncs-3, left, right, c); + }else if(nfuncs >= 2 && acc != nil){ + Array *ltmp = runfunc(funcs[nfuncs-2], left, right); + Array *l = simplifyarray(ltmp); + Array *c = runfunc(funcs[nfuncs-1], l, acc); + freearray(ltmp); + freearray(acc); + freearray(l); + if(nfuncs == 2) + return c; + else + return runtrain(funcs, nfuncs-2, left, right, c); + }else if(nfuncs == 2 && acc == nil){ + Array *rtmp = runfunc(funcs[1], left, right); + Array *r = simplifyarray(rtmp); + Array *c = runfunc(funcs[0], nil, r); + freearray(rtmp); + freearray(r); + return c; + }else if(nfuncs == 1 && acc != nil){ + Array *c = runfunc(funcs[0], nil, acc); + freearray(acc); + return c; + }else{ + throwerror(L"train combination", ENotImplemented); + return nil; + } +} + /* Monadic functions */ Array * diff --git a/print.c b/print.c index e0619a6..564956b 100644 --- a/print.c +++ b/print.c @@ -16,27 +16,11 @@ ppdatum(Datum d) Rune *result; switch(d.tag){ case ArrayTag: result = pparray(d.array); break; - case FunctionTag: - if(d.func.type == FunctypePrim) - result = runesmprint("%C", primfuncnames[d.func.code]); - else if(d.func.type == FunctypeDfn) - result = runesmprint("{%S}", d.func.dfn); - else if(d.func.type == FunctypeOp) - result = runesmprint("%S", ppoperator(d.func.operator)); - else - result = runesmprint("%S", d.func.quad->name); - break; + case FunctionTag: result = ppfunction(d.func); break; case HybridTag: result = runesmprint("%C", primhybridnames[d.func.code]); break; case MonadicOpTag: case DyadicOpTag: result = ppoperator(d.operator); break; - case BoundFunctionTag: - if(d.func.type == FunctypePrim) - result = runesmprint("%S∘%C", pparray(d.func.left), primfuncnames[d.func.code]); - else if(d.func.type == FunctypeDfn) - result = runesmprint("%S∘{%S}", pparray(d.func.left), d.func.dfn); - else - result = runesmprint("%S∘%S", pparray(d.func.left), ppoperator(d.func.operator)); - break; + case BoundFunctionTag: result = runesmprint("%S∘%S", pparray(d.func.left), ppfunction(d.func)); break; case LParTag: result = runestrdup(L"("); break; case RParTag: result = runestrdup(L")"); break; case ArrowTag: result = runestrdup(L"←"); break; @@ -207,6 +191,40 @@ ppoperator(Operator op) return res; } +Rune * +ppfunction(Function f) +{ + Rune *result; + switch(f.type){ + case FunctypePrim: + result = runesmprint("%C", primfuncnames[f.code]); + break; + case FunctypeDfn: + result = runesmprint("{%S}", f.dfn); + break; + case FunctypeOp: + result = runesmprint("%S", ppoperator(f.operator)); + break; + case FunctypeQuad: + result = runesmprint("%S", f.quad->name); + break; + case FunctypeTrain: + result = runesmprint(""); + for(int i = 0; i < f.train.nfuncs; i++){ + Rune *tmp = result; + Rune *fun = ppfunction(f.train.funcs[i]); + result = runesmprint("%S%S", tmp, fun); + free(tmp); + free(fun); + } + break; + default: + result = runesmprint("", f.type); + break; + } + return result; +} + void strdims(Rune *s, int *width, int *height) { -- cgit v1.2.3