diff options
Diffstat (limited to 'builtins.c')
| -rw-r--r-- | builtins.c | 83 |
1 files changed, 83 insertions, 0 deletions
@@ -66,6 +66,8 @@ BuiltinProto(builtinloadmodulefromfile); BuiltinProto(builtinflushoutput); BuiltinProto(builtinstreamproperties); BuiltinProto(builtinsetstreamposition); +BuiltinProto(builtinop); +BuiltinProto(builtincurrentops); int compareterms(Term *, Term *); @@ -187,6 +189,10 @@ findbuiltin(Term *goal) return builtinstreamproperties; if(Match(L"set_stream_position", 2)) return builtinsetstreamposition; + if(Match(L"$op", 3)) + return builtinop; + if(Match(L"current_ops", 1)) + return builtincurrentops; return nil; } @@ -1508,4 +1514,81 @@ builtinsetstreamposition(Term *goal, Binding **bindings, Module *module) reposition(s, pos->ival); return 1; +} + +int +builtinop(Term *goal, Binding **bindings, Module *module) +{ + USED(bindings); + Term *priority = goal->children; + Term *specifier = priority->next; + Term *operator = specifier->next; + + if(runestrcmp(operator->text, L",") == 0) + Throw(permissionerror(L"modify", L"operator", operator)); + + int type = 0; + if(runestrcmp(specifier->text, L"xf") == 0) + type = Xf; + else if(runestrcmp(specifier->text, L"yf") == 0) + type = Yf; + else if(runestrcmp(specifier->text, L"xfx") == 0) + type = Xfx; + else if(runestrcmp(specifier->text, L"xfy") == 0) + type = Xfy; + else if(runestrcmp(specifier->text, L"yfx") == 0) + type = Yfx; + else if(runestrcmp(specifier->text, L"fy") == 0) + type = Fy; + else if(runestrcmp(specifier->text, L"fx") == 0) + type = Fx; + + addoperator(priority->ival, type, operator->text, module); + return 1; +} + +int +builtincurrentops(Term *goal, Binding **bindings, Module *module) +{ + Term *ops = goal->children; + Term *oplist = nil; + + int level; + for(level = 0; level < PrecedenceLevels; level++){ + Operator *o; + for(o = module->operators[level]; o != nil; o = o->next){ + int type = o->type; + while(type != 0){ + Term *args = mkinteger(o->level); + if(type & Xf){ + args->next = mkatom(L"xf"); + type = type^Xf; + }else if(type & Yf){ + args->next = mkatom(L"yf"); + type = type^Yf; + }else if(type & Xfx){ + args->next = mkatom(L"xfx"); + type = type^Xfx; + }else if(type & Xfy){ + args->next = mkatom(L"xfy"); + type = type^Xfy; + }else if(type & Yfx){ + args->next = mkatom(L"yfx"); + type = type^Yfx; + }else if(type & Fx){ + args->next = mkatom(L"fx"); + type = type^Fx; + }else if(type & Fy){ + args->next = mkatom(L"fy"); + type = type^Fy; + } + args->next->next = mkatom(o->spelling); + Term *op = mkcompound(L"op", 3, args); + oplist = appendterm(oplist, op); + } + } + } + + Term *realops = mklist(oplist); + return unify(ops, realops, bindings); }
\ No newline at end of file |