diff options
Diffstat (limited to 'builtins.c')
-rw-r--r-- | builtins.c | 166 |
1 files changed, 166 insertions, 0 deletions
@@ -35,6 +35,12 @@ BuiltinProto(builtincatch); BuiltinProto(builtinthrow); BuiltinProto(builtinsetprologflag); BuiltinProto(builtincurrentprologflag); +BuiltinProto(builtinopen); +BuiltinProto(builtinclose); +BuiltinProto(builtincurrentinput); +BuiltinProto(builtincurrentoutput); +BuiltinProto(builtinsetinput); +BuiltinProto(builtinsetoutput); int compareterms(Term *, Term *); @@ -98,6 +104,18 @@ findbuiltin(Term *goal) return builtinsetprologflag; if(Match(L"current_prolog_flag", 2)) return builtincurrentprologflag; + if(Match(L"open", 4)) + return builtinopen; + if(Match(L"close", 2)) + return builtinclose; + if(Match(L"current_input", 1)) + return builtincurrentinput; + if(Match(L"current_output", 1)) + return builtincurrentoutput; + if(Match(L"set_input", 1)) + return builtinsetinput; + if(Match(L"set_output", 1)) + return builtinsetoutput; return nil; } @@ -582,3 +600,151 @@ builtinsetprologflag(Term *database, Term *goal, Goal **goals, Choicepoint **cho return 1; } +int +builtinopen(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings) +{ + USED(database); + USED(goals); + USED(choicestack); + USED(bindings); + + Term *sourcesink = goal->children; + Term *mode = sourcesink->next; + Term *stream = mode->next; + Term *options = stream->next; + + if(sourcesink->tag == VariableTerm || mode->tag == VariableTerm || options->tag == VariableTerm) + Throw(instantiationerror()); + + if(stream->tag != VariableTerm) + Throw(typeerror(L"variable", stream)); + + if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0) + Throw(typeerror(L"empty_list", options)); + + if(mode->tag != AtomTerm) + Throw(typeerror(L"atom", mode)); + + if(sourcesink->tag != AtomTerm) + Throw(domainerror(L"source_sink", sourcesink)); + + Term *newstream; + int error = openstream(sourcesink->text, mode->text, options, &newstream); + if(error) + Throw(newstream); + else + return unify(stream, newstream, bindings); + + return 0; +} + +int +builtinclose(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings) +{ + USED(database); + USED(goals); + USED(choicestack); + USED(bindings); + + Term *stream = goal->children; + Term *options = stream->next; + + if(stream->tag == VariableTerm || options->tag == VariableTerm) + Throw(instantiationerror()); + + if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0) + Throw(typeerror(L"empty_list", options)); + + if((stream->tag != NumberTerm || stream->numbertype != NumberInt) && stream->tag != AtomTerm) + Throw(domainerror(L"stream_or_alias", stream)); + + if(!isopenstream(stream)) + Throw(existenceerror(L"stream", stream)); + + closestream(stream); + + return 1; +} + +int +builtincurrentinput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings) +{ + USED(database); + USED(goals); + USED(choicestack); + USED(bindings); + + Term *stream = goal->children; + if(stream->tag != VariableTerm && (stream->tag != NumberTerm || stream->numbertype != NumberInt)) + Throw(domainerror(L"stream", stream)); + + Term *current = currentinputstream(); + return unify(stream, current, bindings); +} + +int +builtincurrentoutput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings) +{ + USED(database); + USED(goals); + USED(choicestack); + USED(bindings); + + Term *stream = goal->children; + if(stream->tag != VariableTerm && (stream->tag != NumberTerm || stream->numbertype != NumberInt)) + Throw(domainerror(L"stream", stream)); + + Term *current = currentoutputstream(); + return unify(stream, current, bindings); +} + +int +builtinsetinput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings) +{ + USED(database); + USED(goals); + USED(choicestack); + USED(bindings); + + Term *stream = goal->children; + if(stream->tag == VariableTerm) + Throw(instantiationerror()); + + if((stream->tag != NumberTerm || stream->numbertype != NumberInt) && stream->tag != AtomTerm) + Throw(domainerror(L"stream_or_alias", stream)); + + if(!isopenstream(stream)) + Throw(existenceerror(L"stream", stream)); + + if(!isinputstream(stream)) + Throw(permissionerror(L"input", L"stream", stream)); + + setcurrentinputstream(stream); + return 1; +} + +int +builtinsetoutput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings) +{ + USED(database); + USED(goal); + USED(goals); + USED(choicestack); + USED(bindings); + + Term *stream = goal->children; + if(stream->tag == VariableTerm) + Throw(instantiationerror()); + + if((stream->tag != NumberTerm || stream->numbertype != NumberInt) && stream->tag != AtomTerm) + Throw(domainerror(L"stream_or_alias", stream)); + + if(!isopenstream(stream)) + Throw(existenceerror(L"stream", stream)); + + if(!isoutputstream(stream)) + Throw(permissionerror(L"output", L"stream", stream)); + + setcurrentoutputstream(stream); + return 1; +}
\ No newline at end of file |