diff options
| -rw-r--r-- | apl9.h | 48 | ||||
| -rw-r--r-- | eval.c | 93 | ||||
| -rw-r--r-- | functions.c | 40 | ||||
| -rw-r--r-- | lexer.c | 10 | ||||
| -rw-r--r-- | mkfile | 1 | ||||
| -rw-r--r-- | operators.c | 64 | ||||
| -rw-r--r-- | print.c | 31 |
7 files changed, 229 insertions, 58 deletions
@@ -27,13 +27,21 @@ typedef enum typedef enum { + OperatortypeDop, + OperatortypePrim, +} operatorType; + +typedef enum +{ FunctypeDfn, FunctypePrim, + FunctypeOp, } functionType; /* Data types */ typedef struct Array Array; typedef struct Statement Statement; +typedef struct Operator Operator; typedef struct Function Function; typedef struct Datum Datum; typedef struct Symbol Symbol; @@ -61,12 +69,25 @@ struct Statement Statement *next; }; +struct Operator +{ + operatorType type; + int dyadic; + union { + int code; + Rune *dop; + }; + Datum *left; + Datum *right; +}; + struct Function { functionType type; union { int code; Rune *dfn; + Operator operator; }; Array *left; }; @@ -79,6 +100,7 @@ struct Datum Array *array; Statement stmt; Function func; + Operator operator; Symbol *symbol; }; }; @@ -98,6 +120,8 @@ struct Symtab typedef Array* (*fnmonad)(Array*); typedef Array* (*fndyad)(Array*, Array*); +typedef Array* (*opmonad)(Datum *, Array *, Array *); +typedef Array* (*opdyad)(Datum *, Datum *, Array *, Array *); /* Function prototypes for the different source files */ /* main.c */ @@ -107,6 +131,7 @@ Datum *evalline(Rune *); Rune *ppdatum(Datum); Rune *ppdatums(Datum *, int); Rune *pparray(Array *); +Rune *ppoperator(Operator); /* lexer.c */ Statement *lexline(Rune *); @@ -133,7 +158,10 @@ Array *allocarray(int, int, int); void freearray(Array *); void incref(Array *); -/* Monadic functions from functions.h */ +/* functions.c */ +Array *runfunc(Function, Array *,Array *); + +/* Monadic functions from function.c */ Array *fnSame(Array *); Array *fnTally(Array *); Array *fnEnclose(Array *); @@ -142,7 +170,7 @@ Array *fnIndexGenerator(Array *); Array *fnRavel(Array *); Array *fnShape(Array *); -/* Dyadic functions from functions.h */ +/* Dyadic functions from function.c */ Array *fnPlus(Array *, Array *); Array *fnMinus(Array *, Array *); Array *fnTimes(Array *, Array *); @@ -154,16 +182,22 @@ Array *fnRight(Array *, Array *); Array *fnCatenateFirst(Array *, Array *); Array *fnReshape(Array *, Array *); +/* Monadic operators from operators.c */ +Array *opSwitch(Datum *, Array *, Array *); +Array *opOver(Datum *, Datum *, Array *, Array *); + /* Global variables */ extern int traceeval; /* eval.c */ extern Rune *errormsg; /* eval.c */ extern int datasizes[]; /* array.c */ -extern Rune primfuncnames[]; /* function.c */ -extern Rune primmonopnames[]; /* lexer.c */ -extern Rune primdyadopnames[]; /* lexer.c */ +extern Rune primfuncnames[]; /* functions.c */ +extern Rune primmonopnames[]; /* operators.c */ +extern Rune primdyadopnames[]; /* operators.c */ extern Rune primhybridnames[]; /* lexer.c */ -extern fnmonad monadfunctiondefs[]; /* function.c */ -extern fndyad dyadfunctiondefs[]; /* function.c */ +extern fnmonad monadfunctiondefs[]; /* functions.c */ +extern fndyad dyadfunctiondefs[]; /* functions.c */ +extern opmonad monadoperatordefs[]; /* operators.c */ +extern opdyad dyadoperatordefs[]; /* operators.c */ extern Symtab *globalsymtab; /* symbol.c */ extern Symtab *currentsymtab; /* symbol.c */ extern int alloccounts; /* memory.c */
\ No newline at end of file @@ -17,32 +17,34 @@ Datum dyadfun(Datum, Datum); Datum parens(Datum, Datum); Datum nameis(Datum, Datum); Datum assign(Datum, Datum); +Datum monadop(Datum, Datum); +Datum dyadop(Datum, Datum); Datum *lookup(Datum); int bindingstrengths[13][13] = { /* A F H MO DO AF ( ) [ ] ← IS N */ - 4, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */ - 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */ + 6, 3, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */ + 2, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */ + 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ + 5, 5, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ - 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, /* ( */ - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, /* ) */ + 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, /* ( */ + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, /* ) */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */ 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, /* N */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, /* N */ }; evalfn evalfns[13][13] = { /* A F H MO DO AF ( ) [ ] ← IS N */ - strand, dyadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */ - monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */ + strand, dyadfun, 0, monadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */ + monadfun, 0, 0, monadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */ + 0, 0, 0, monadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ + dyadop, dyadop, dyadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ 0, 0, 0, 0, 0, 0, 0, parens, 0, 0, 0, 0, 0, /* ( */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */ @@ -164,38 +166,7 @@ monadfun(Datum left, Datum right) Datum result; result.tag = ArrayTag; result.shy = 0; - - if(left.func.type == FunctypeDfn){ - Symtab *tmpsymtab = currentsymtab; - currentsymtab = newsymtab(); - if(left.func.left){ - Symbol *alpha = getsym(currentsymtab, L"⍺"); - alpha->value.tag = ArrayTag; - alpha->value.array = left.func.left; - /* no need to increment refs, since it was done on binding the arg */ - alpha->undefined = 0; - } - - Symbol *omega = getsym(currentsymtab, L"⍵"); - omega->value = right; - omega->undefined = 0; - incref(right.array); - - Datum *dfnres = evalline(left.func.dfn); - freesymtab(currentsymtab); - currentsymtab = tmpsymtab; - return *dfnres; /* TODO what if the evaluation failed */ - }else{ - /* TODO handle undefined functions here */ - if(left.func.left) - result.array = dyadfunctiondefs[left.func.code](left.func.left, right.array); - else - result.array = monadfunctiondefs[left.func.code](right.array); - } - - if(left.func.left) - freearray(left.func.left); - + result.array = runfunc(left.func, left.func.left, right.array); return result; } @@ -250,4 +221,40 @@ assign(Datum left, Datum right) } right.shy = 1; return right; +} + +Datum +monadop(Datum left, Datum right) +{ + traceprint("Applying left argument to operator\n"); + Datum *arg = malloc(sizeof(Datum)); + *arg = left; + + Datum result; + result.shy = 0; + result.tag = FunctionTag, + result.func.type = FunctypeOp; + result.func.operator = right.operator; + result.func.operator.left = arg; + result.func.left = nil; + if(arg->tag == ArrayTag) + incref(arg->array); + return result; +} + +Datum +dyadop(Datum left, Datum right) +{ + traceprint("Applying right argument to operator\n"); + Datum *arg = malloc(sizeof(Datum)); + *arg = right; + + Datum result; + result.shy = 0; + result.tag = MonadicOpTag, + result.operator = left.operator; + result.operator.right = arg; + if(arg->tag == ArrayTag) + incref(arg->array); + return result; }
\ No newline at end of file diff --git a/functions.c b/functions.c index db9fe01..636c195 100644 --- a/functions.c +++ b/functions.c @@ -116,6 +116,46 @@ fndyad dyadfunctiondefs[] = { 0, /* ⍕ */ }; +/* Runner function */ +Array * +runfunc(Function f, Array *left, Array *right) +{ + if(f.type == FunctypeDfn){ + Symtab *tmpsymtab = currentsymtab; + currentsymtab = newsymtab(); + + if(left){ + Symbol *alpha = getsym(currentsymtab, L"⍺"); + alpha->value.tag = ArrayTag; + alpha->value.array = left; + alpha->undefined = 0; + incref(left); + } + + Symbol *omega = getsym(currentsymtab, L"⍵"); + omega->value.tag = ArrayTag; + omega->value.array = right; + omega->undefined = 0; + incref(right); + + Datum *dfnres = evalline(f.dfn); + freesymtab(currentsymtab); + currentsymtab = tmpsymtab; + return (*dfnres).array; /* TODO what if the evaluation failed */ + }else if(f.type == FunctypePrim){ + if(left) + return dyadfunctiondefs[f.code](left, right); + else + return monadfunctiondefs[f.code](right); + }else{ + /* TODO assumes prim op, not dop */ + if(f.operator.dyadic) + return dyadoperatordefs[f.operator.code](f.operator.left, f.operator.right, left, right); + else + return monadoperatordefs[f.operator.code](f.operator.left, left, right); + } +} + /* Monadic functions */ Array * @@ -4,8 +4,6 @@ #include "apl9.h" -Rune primmonopnames[] = L"¨⍨⌸⌶&"; -Rune primdyadopnames[] = L"⍣.∘⍤⍥@⍠⌺"; Rune primhybridnames[] = L"/\⌿⍀"; Statement * @@ -77,11 +75,15 @@ lexline(Rune *line) offset++; }else if(p = runestrchr(primmonopnames, line[offset])){ stmt->toks[stmt->ntoks].tag = MonadicOpTag; - stmt->toks[stmt->ntoks].func.code = p-primmonopnames; + stmt->toks[stmt->ntoks].operator.type = OperatortypePrim; + stmt->toks[stmt->ntoks].operator.dyadic = 0; + stmt->toks[stmt->ntoks].operator.code = p-primmonopnames; offset++; }else if(p = runestrchr(primdyadopnames, line[offset])){ stmt->toks[stmt->ntoks].tag = DyadicOpTag; - stmt->toks[stmt->ntoks].func.code = p-primdyadopnames; + stmt->toks[stmt->ntoks].operator.type = OperatortypePrim; + stmt->toks[stmt->ntoks].operator.dyadic = 1; + stmt->toks[stmt->ntoks].operator.code = p-primdyadopnames; offset++; }else if(isdigitrune(line[offset])){ char buf[64]; @@ -10,6 +10,7 @@ OFILES=\ functions.$O\ symbol.$O\ memory.$O\ + operators.$O\ HFILES=\ apl9.h\ diff --git a/operators.c b/operators.c new file mode 100644 index 0000000..ba999bd --- /dev/null +++ b/operators.c @@ -0,0 +1,64 @@ +#include <u.h> +#include <libc.h> +#include <bio.h> + +#include "apl9.h" + +Rune primmonopnames[] = L"¨⍨⌸⌶&"; +Rune primdyadopnames[] = L"⍣.∘⍤⍥@⍠⌺"; + +opmonad monadoperatordefs[] = { + 0, /* ¨ */ + opSwitch, /* ⍨ */ + 0, /* ⌸ */ + 0, /* ⌶ */ + 0, /* & */ +}; + +opdyad dyadoperatordefs[] = { + 0, /* ⍣ */ + 0, /* . */ + 0, /* ∘ */ + 0, /* ⍤ */ + opOver, /* ⍥ */ + 0, /* @ */ + 0, /* ⍠ */ + 0, /* ⌺ */ +}; + +/* Monadic operators */ +Array * +opSwitch(Datum *lefto, Array *left, Array *right) +{ + if(lefto->tag == ArrayTag){ + incref(lefto->array); + return lefto->array; + }else if(lefto->tag == FunctionTag){ + if(left) + return runfunc(lefto->func, right, left); + else + return runfunc(lefto->func, right, right); + }else + return nil; +} + +/* Dyadic operators */ +Array * +opOver(Datum *lefto, Datum *righto, Array *left, Array *right) +{ + if(lefto->tag != FunctionTag || righto->tag != FunctionTag) + return nil; + if(left){ + Array *r = runfunc(righto->func, nil, right); + Array *l = runfunc(righto->func, nil, left); + Array *res = runfunc(lefto->func, l, r); + freearray(r); + freearray(l); + return res; + }else{ + Array *tmp = runfunc(righto->func, nil, right); + Array *res = runfunc(lefto->func, nil, tmp); + freearray(tmp); + return res; + } +}
\ No newline at end of file @@ -13,17 +13,21 @@ ppdatum(Datum d) case FunctionTag: if(d.func.type == FunctypePrim) result = runesmprint("%C", primfuncnames[d.func.code]); - else + else if(d.func.type == FunctypeDfn) result = runesmprint("{%S}", d.func.dfn); + else + result = runesmprint("%S", ppoperator(d.func.operator)); break; case HybridTag: result = runesmprint("%C", primhybridnames[d.func.code]); break; - case MonadicOpTag: result = runesmprint("%C", primmonopnames[d.func.code]); break; - case DyadicOpTag: result = runesmprint("%C", primdyadopnames[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 + 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 LParTag: result = runestrdup(L"("); break; case RParTag: result = runestrdup(L")"); break; @@ -90,4 +94,23 @@ pparray(Array *a) } } return res; +} + +Rune * +ppoperator(Operator op) +{ + Rune *left = op.left ? ppdatum(*op.left) : runestrdup(L""); + Rune *right = op.right ? ppdatum(*op.right) : runestrdup(L""); + Rune *res; + if(op.type == OperatortypeDop) + res = runesmprint("(%S{%S}%S)", left, op.dop, right); + else{ + res = runesmprint("(%S%C%S)", + left, + op.dyadic ? primdyadopnames[op.code] : primmonopnames[op.code], + right); + } + free(left); + free(right); + return res; }
\ No newline at end of file |