diff options
author | Peter Mikkelsen <peter@pmikkelsen.com> | 2021-07-16 20:09:02 +0000 |
---|---|---|
committer | Peter Mikkelsen <peter@pmikkelsen.com> | 2021-07-16 20:09:02 +0000 |
commit | 3f316c5c9265618fe7095cc39c4cb10909cbe468 (patch) | |
tree | d01a693fd4f19e56a644905848b38aaef4974025 | |
parent | 8ef27e2fe652a8b29a8b57589863f2f2b45f9425 (diff) |
Implement a bit more of prolog flag predicates set_prolog_flag/2 and current_prolog_flag/2
-rw-r--r-- | builtins.c | 27 | ||||
-rw-r--r-- | dat.h | 35 | ||||
-rw-r--r-- | flags.c | 160 | ||||
-rw-r--r-- | fns.h | 3 | ||||
-rw-r--r-- | repl.pl | 6 | ||||
-rw-r--r-- | stdlib.pl | 57 |
6 files changed, 250 insertions, 38 deletions
@@ -38,7 +38,7 @@ BuiltinProto(builtinis); BuiltinProto(builtincatch); BuiltinProto(builtinthrow); BuiltinProto(builtinsetprologflag); -BuiltinProto(builtincurrentprologflag); +BuiltinProto(builtincurrentprologflags); BuiltinProto(builtinopen); BuiltinProto(builtinclose); BuiltinProto(builtincurrentinput); @@ -125,10 +125,10 @@ findbuiltin(Term *goal) return builtincatch; if(Match(L"throw", 1)) return builtinthrow; - if(Match(L"set_prolog_flag", 2)) + if(Match(L"$set_prolog_flag", 2)) return builtinsetprologflag; - if(Match(L"current_prolog_flag", 2)) - return builtincurrentprologflag; + if(Match(L"current_prolog_flags", 1)) + return builtincurrentprologflags; if(Match(L"open", 4)) return builtinopen; if(Match(L"close", 2)) @@ -605,12 +605,13 @@ builtinthrow(Term *goal, Binding **bindings, Module *module) } int -builtincurrentprologflag(Term *goal, Binding **bindings, Module *module) +builtincurrentprologflags(Term *goal, Binding **bindings, Module *module) { - USED(goal); - USED(bindings); USED(module); - return 0; + Term *flagsandvals = goal->children; + Term *list = getallflags(); + Term *realflagsandvals = mklist(list); + return unify(flagsandvals, realflagsandvals, bindings); } int @@ -621,15 +622,7 @@ builtinsetprologflag(Term *goal, Binding **bindings, Module *module) Term *key = goal->children; Term *value = key->next; - if(key->tag == VariableTerm || value->tag == VariableTerm) - Throw(instantiationerror()); - - if(key->tag != AtomTerm) - Throw(typeerror(L"atom", key)); - - Term *error = setflag(key->text, value); - if(error) - Throw(error); + setflag(key->text, value); return 1; } @@ -109,13 +109,48 @@ int debug; /* Flags */ enum { + BoundedTrue, + BoundedFalse, +}; + +enum { + IntegerRoundDown, + IntegerRoundTowardZero, +}; + +enum { + CharConversionOn, + CharConversionOff, +}; + +enum { + DebugOn, + DebugOff, +}; + +enum { + UnknownError, + UnknownFail, + UnknownWarning, +}; + +enum { DoubleQuotesChars, DoubleQuotesCodes, DoubleQuotesAtom, }; +int flagbounded; +vlong flagmaxinteger; +vlong flagmininteger; +int flagintegerroundingfunction; +int flagcharconversion; +int flagdebug; +vlong flagmaxarity; +int flagunknown; int flagdoublequotes; + /* State of the running system */ Choicepoint *choicestack; Goal *goalstack; @@ -5,36 +5,160 @@ #include "dat.h" #include "fns.h" -Term *setdoublequotes(Term *); +void setcharconversion(Term *); +void setdebug(Term *); +void setunknown(Term *); +void setdoublequotes(Term *); + +static Rune *boundedvals[] = { + [BoundedTrue] = L"true", + [BoundedFalse] = L"false" +}; + +static Rune *integerroundvals[] = { + [IntegerRoundDown] = L"down", + [IntegerRoundTowardZero] = L"toward_zero" +}; + +static Rune *charconversionvals[] = { + [CharConversionOn] = L"on", + [CharConversionOff] = L"off" +}; + +static Rune *debugvals[] = { + [DebugOn] = L"on", + [DebugOff] = L"off" +}; + +static Rune *unknownvals[] = { + [UnknownError] = L"error", + [UnknownFail] = L"fail", + [UnknownWarning] = L"warning" +}; + +static Rune *doublequotesvals[] = { + [DoubleQuotesChars] = L"chars", + [DoubleQuotesCodes] = L"codes", + [DoubleQuotesAtom] = L"atom" +}; void initflags(void) { + uvlong zero = 0; + + flagbounded = BoundedTrue; + flagmaxinteger = (~zero)>>1; + flagmininteger = flagmaxinteger+1; + flagintegerroundingfunction = IntegerRoundDown; + flagcharconversion = CharConversionOff; + flagdebug = DebugOff; + flagunknown = UnknownError; flagdoublequotes = DoubleQuotesChars; } -Term * +void setflag(Rune *flag, Term *value) { - if(runestrcmp(flag, L"double_quotes") == 0) - return setdoublequotes(value); - else - return permissionerror(L"modify", L"flag", mkatom(flag)); + if(runestrcmp(flag, L"char_conversion") == 0) + setcharconversion(value); + else if(runestrcmp(flag, L"debug") == 0) + setdebug(value); + else if(runestrcmp(flag, L"unknown") == 0) + setunknown(value); + else if(runestrcmp(flag, L"double_quotes") == 0) + setdoublequotes(value); } Term * +getallflags(void) +{ + Term *boundedval = mkatom(boundedvals[flagbounded]); + Term *maxintval = mkinteger(flagmaxinteger); + Term *minintval = mkinteger(flagmininteger); + Term *roundingval = mkatom(integerroundvals[flagintegerroundingfunction]); + Term *charconvval = mkatom(charconversionvals[flagcharconversion]); + Term *debugval = mkatom(debugvals[flagdebug]); + Term *unknownval = mkatom(unknownvals[flagunknown]); + Term *doublequotesval = mkatom(doublequotesvals[flagdoublequotes]); + + Term *boundedkey = mkatom(L"bounded"); + boundedkey->next = boundedval; + Term *maxintkey = mkatom(L"max_integer"); + maxintkey->next = maxintval; + Term *minintkey = mkatom(L"min_integer"); + minintkey->next = minintval; + Term *roundingkey = mkatom(L"integer_rounding_function"); + roundingkey->next = roundingval; + Term *charconvkey = mkatom(L"character_conversion"); + charconvkey->next = charconvval; + Term *debugkey = mkatom(L"debug"); + debugkey->next = debugval; + Term *unknownkey = mkatom(L"unknown"); + unknownkey->next = unknownval; + Term *doublequoteskey = mkatom(L"double_quotes"); + doublequoteskey->next = doublequotesval; + + Term *boundedflag = mkcompound(L"flag", 2, boundedkey); + Term *maxintflag = mkcompound(L"flag", 2, maxintkey); + Term *minintflag = mkcompound(L"flag", 2, minintkey); + Term *roundingflag = mkcompound(L"flag", 2, roundingkey); + Term *charconvflag = mkcompound(L"flag", 2, charconvkey); + Term *debugflag = mkcompound(L"flag", 2, debugkey); + Term *unknownflag = mkcompound(L"flag", 2, unknownkey); + Term *doublequotesflag = mkcompound(L"flag", 2, doublequoteskey); + + boundedflag->next = maxintflag; + maxintflag->next = minintflag; + minintflag->next = roundingflag; + roundingflag->next = charconvflag; + charconvflag->next = debugflag; + debugflag->next = unknownflag; + unknownflag->next = doublequotesflag; + + return boundedflag; +} + +void +setcharconversion(Term *value) +{ + int max = 2; + int i; + for(i = 0; i < max; i++){ + if(runestrcmp(value->text, charconversionvals[i]) == 0) + flagcharconversion = i; + } +} + +void +setdebug(Term *value) +{ + int max = 2; + int i; + for(i = 0; i < max; i++){ + if(runestrcmp(value->text, debugvals[i]) == 0) + flagdebug = i; + } +} + +void +setunknown(Term *value) +{ + int max = 3; + int i; + for(i = 0; i < max; i++){ + if(runestrcmp(value->text, unknownvals[i]) == 0) + flagunknown = i; + } +} + +void setdoublequotes(Term *value) { - if(value->tag != AtomTerm) - return typeerror(L"atom", value); - - if(runestrcmp(value->text, L"chars") == 0) - flagdoublequotes = DoubleQuotesChars; - else if(runestrcmp(value->text, L"codes") == 0) - flagdoublequotes = DoubleQuotesCodes; - else if(runestrcmp(value->text, L"atom") == 0) - flagdoublequotes = DoubleQuotesAtom; - else - return domainerror(L"flag_value", value); - return nil; + int max = 3; + int i; + for(i = 0; i < max; i++){ + if(runestrcmp(value->text, doublequotesvals[i]) == 0) + flagdoublequotes = i; + } }
\ No newline at end of file @@ -30,7 +30,8 @@ Builtin findbuiltin(Term *); /* flags.c */ void initflags(void); -Term *setflag(Rune *, Term *); +void setflag(Rune *, Term *); +Term *getallflags(void); /* error.c */ Term *instantiationerror(void); @@ -52,8 +52,10 @@ write_result([], State) :- write('true'), write_state(State). write_result([B|Bs], State) :- write_bindings([B|Bs]), write_state(State). write_bindings([]). -write_bindings([B|Bs]) :- - write(B), +write_bindings([Var = Val|Bs]) :- + write(Var), + write(' = '), + writeq(Val), ( Bs = [] -> true ; put_char(','), nl @@ -549,3 +549,60 @@ nl :- nl(S) :- put_char(S, ' '). % This should really be \n + +% flags +set_prolog_flag(Flag, Value) :- + is_nonvar(Flag), + is_nonvar(Value), + is_atom(Flag), + is_prolog_flag(Flag), + is_appropriate_flag_value(Flag, Value), + is_modifiable_flag(Flag), + '$set_prolog_flag'(Flag, Value). + +current_prolog_flag(Flag, Value) :- + is_atom_or_var(Flag), + ( atom(Flag) + -> is_prolog_flag(Flag) + ; true + ), + current_prolog_flags(FlagsAndValues), + member(flag(Flag, Value), FlagsAndValues). + +is_prolog_flag(Flag) :- + member(Flag, + [ bounded + , max_integer + , min_integer + , integer_rounding_function + , char_conversion + , debug + , max_arity + , unknown + , double_quotes]), + ! + ; domain_error(prolog_flag, Flag). + +is_modifiable_flag(Flag) :- + member(Flag, [char_conversion, debug, unknown, double_quotes]), + ! + ; permission_error(modify, flag, Flag). + +is_appropriate_flag_value(Flag, Value) :- + appropriate_flag_values(Flag, Values), + member(Value, Values), + ! + ; domain_error(flag_value, Flag + Value). + +appropriate_flag_values(bounded, [true, false]). +appropriate_flag_values(max_integer, [Val]) :- + current_prolog_flag(max_integer, Val). +appropriate_flag_values(min_integer, [Val]) :- + current_prolog_flag(min_integer, Val). +appropriate_flag_values(integer_rounding_function, [down, toward_zero]). +appropriate_flag_values(char_conversion, [on, off]). +appropriate_flag_values(debug, [on, off]). +appropriate_flag_values(max_arity, [Val]) :- + current_prolog_flag(max_arity). +appropriate_flag_values(unknown, [error, fail, warning]). +appropriate_flag_values(double_quotes, [chars, codes, atom]).
\ No newline at end of file |