ref: 3f316c5c9265618fe7095cc39c4cb10909cbe468
parent: 8ef27e2fe652a8b29a8b57589863f2f2b45f9425
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Fri Jul 16 16:09:02 EDT 2021
Implement a bit more of prolog flag predicates set_prolog_flag/2 and current_prolog_flag/2
--- a/builtins.c
+++ b/builtins.c
@@ -38,7 +38,7 @@
BuiltinProto(builtincatch);
BuiltinProto(builtinthrow);
BuiltinProto(builtinsetprologflag);
-BuiltinProto(builtincurrentprologflag);
+BuiltinProto(builtincurrentprologflags);
BuiltinProto(builtinopen);
BuiltinProto(builtinclose);
BuiltinProto(builtincurrentinput);
@@ -125,10 +125,10 @@
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 @@
}
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 @@
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;
}
--- a/dat.h
+++ b/dat.h
@@ -109,12 +109,47 @@
/* 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;
--- a/flags.c
+++ b/flags.c
@@ -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 *
-setdoublequotes(Term *value)
+getallflags(void)
{- if(value->tag != AtomTerm)
- return typeerror(L"atom", value);
+ 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]);
- 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;
+ 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)
+{+ 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
--- a/fns.h
+++ b/fns.h
@@ -30,7 +30,8 @@
/* flags.c */
void initflags(void);
-Term *setflag(Rune *, Term *);
+void setflag(Rune *, Term *);
+Term *getallflags(void);
/* error.c */
Term *instantiationerror(void);
--- a/repl.pl
+++ b/repl.pl
@@ -52,8 +52,10 @@
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--- a/stdlib.pl
+++ b/stdlib.pl
@@ -549,3 +549,60 @@
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