#include #include #include #include "apl9.h" Rune *errormsg; typedef Datum (*evalfn)(Datum, Datum); Datum strand(Datum, Datum); Datum monadfun(Datum, Datum); Datum dyadfun(Datum, Datum); Datum lpar(Datum, Datum); Datum rpar(Datum, Datum); int bindingstrengths[12][12] = { /* A F H MO DO AF ( ) { } [ ] */ 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */ 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, /* DO */ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ 4, 4, 4, 4, 4, 4, 0, 5, 4, 4, 4, 4, /* ( */ 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */ }; evalfn evalfns[12][12] = { /* A F H MO DO AF ( ) { } [ ] */ strand, dyadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */ monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */ 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, /* DO */ monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ lpar, lpar, lpar, lpar, lpar, 0, lpar, rpar, lpar, lpar, lpar, lpar, /* ( */ 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */ }; Datum * eval(Datum *tokens, int *ntoks) { while(*ntoks > 1){ int maxlevel = 0; int offset; evalfn fn = nil; print("CURRENT: %S\n", ppdatums(tokens, *ntoks)); for(offset = (*ntoks)-1; offset >= 0; offset--){ int level; if(offset == 0) level = 0; else{ Datum left = tokens[offset-1]; Datum right = tokens[offset]; level = bindingstrengths[left.tag][right.tag]; } if(level < maxlevel){ Datum left = tokens[offset]; Datum right = tokens[offset+1]; fn = evalfns[left.tag][right.tag]; print("Reducing %S and %S\n", ppdatum(left), ppdatum(right)); break; }else if(level > maxlevel) maxlevel = level; } if(maxlevel == 0){ errormsg = L"No reduce rule. Syntax error."; *ntoks = 0; }else{ tokens[offset] = fn(tokens[offset],tokens[offset+1]); for(int i = offset+1; i < (*ntoks)-1; i++) tokens[i] = tokens[i+1]; (*ntoks)--; } } return tokens; } Datum strand(Datum left, Datum right) { print("Stranding\n"); Datum result; Array *leftarr = left.array->stranded ? left.array : fnEnclose(left.array); Array *rightarr = right.array->stranded ? right.array : fnEnclose(right.array); result.tag = ArrayTag; result.array = fnCatenateFirst(leftarr, rightarr); result.array->stranded = 1; return result; } Datum monadfun(Datum left, Datum right) { print("Monadic function application\n"); Datum result; result.tag = ArrayTag; /* TODO handle undefined functions here */ if(left.func.left) result.array = dyadfunctiondefs[left.code](left.func.left, right.array); else result.array = monadfunctiondefs[left.code](right.array); return result; } Datum dyadfun(Datum left, Datum right) { print("Applying left argument to function\n"); Datum result; result.tag = BoundFunctionTag, result.func = right.func; result.func.left = left.array; return result; } Datum lpar(Datum left, Datum right) { /* build up a parthenthesised expression */ left.expr.ntoks++; left.expr.toks = realloc(left.expr.toks, sizeof(Datum) * left.expr.ntoks); left.expr.toks[left.expr.ntoks-1] = right; print("LPAR: %S\n", ppdatums(left.expr.toks, left.expr.ntoks)); return left; } Datum rpar(Datum left, Datum right) { /* evaluate a parenthesis expression and return the result */ USED(right); print("RPAR: %S\n", ppdatums(left.expr.toks, left.expr.ntoks)); Datum *result = eval(left.expr.toks, &left.expr.ntoks); result[0].array->stranded = 0; return result[0]; /* TODO handle error if ntoks != 1 */ }