better way to define prolog flag.

packages/chr

@@ -1 +1 @@
-Subproject commit c325e4564bb8d4e32c27f2061df85f13d315974e
+Subproject commit f6a79007615bf46dc79712c41d61289834f28ba3

packages/jpl

@@ -1 +1 @@
-Subproject commit a2d2f03107eecd45462cd61a678035132cf06326
+Subproject commit eb6d27251c2548c25e6d37fff2a27a014caaa7aa

pl/directives.yap

@@ -151,7 +151,7 @@
 
 
 yap_flag(V,Out) :-
-	'$user_defined_flag'(V,_),
+	'$user_defined_flag'(V,_,_,_),
 	(nonvar(V) ->
 	 !
 	;
@@ -1032,17 +1032,11 @@ set_prolog_flag(F,V) :-
 	var(V), !,
 	'$do_error'(instantiation_error,set_prolog_flag(F,V)).
 set_prolog_flag(F, Val) :-
-	recorded('$dialect',swi,_),
+	prolog:'$user_defined_flag'(F,_,_,_), !,
-	prolog:'$user_defined_flag'(F,_), !,
 	yap_flag(F, Val).
 set_prolog_flag(F,V) :-
 	\+ atom(F), !,
 	'$do_error'(type_error(atom,F),set_prolog_flag(F,V)).
-set_prolog_flag(F,V) :-
-	recorded('$dialect',swi,_),
-	\+ yap_flag(F,_),
-	user_defined_flag(F),
-	fail.
 set_prolog_flag(F,V) :-
 	yap_flag(F,V).
 
@@ -1067,49 +1061,103 @@ source_mode(Old,New) :-
 source :- '$set_yap_flags'(11,1).
 no_source :- '$set_yap_flags'(11,0).
 
-%
+create_prolog_flag(Name, Value) :-
-% allow users to define their own directives.
+	create_prolog_flag(Name, Value, []).
-%
-user_defined_directive(Dir,_) :-
-	'$directive'(Dir), !.
-user_defined_directive(Dir,Action) :-
-	functor(Dir,Na,Ar),
-	functor(NDir,Na,Ar),
-	'$current_module'(M, prolog),
-	assert_static('$directive'(NDir)),
-	assert_static(('$exec_directive'(Dir, _, _) :- Action)),
-	'$current_module'(_, M).
 
-%
+create_prolog_flag(Name, Value, Options) :-
-% allow users to define their own flags.
+	'$check_flag_name'(Name, create_prolog_flag(Name, Value, Options)),
-%
+	'$check_flag_options'(Options, Domain, RW, create_prolog_flag(Name, Value, Options)),
-user_defined_flag(Atom) :- var(Atom), !,
+	'$check_flag_value'(Value, Domain, create_prolog_flag(Name, Value, Options)),
-	'$do_error'(instantiation_error,user_defined_flag(Atom)).
+	retractall(prolog:'$user_defined_flag'(Name,_,_,_)),
-user_defined_flag(Atom) :-
+	assert(prolog:'$user_defined_flag'(Name,Domain,RW,Value)).
-	'$user_defined_flag'(Atom,_), !.
-user_defined_flag(Atom) :-
-	yap_flag(Atom, _), !,
-	'$do_error'(domain_error(user_defined_prolog_flag,Atom),user_defined_flag(Atom)).
-user_defined_flag(Atom) :-
-	assert(prolog:'$user_defined_flag'(Atom,[])).
 
-'$enumerate_user_flag'(V, Out) :-
+'$check_flag_name'(V, G) :-
-	'$user_defined_flag'(V, Out).
+	var(V),
+	'$do_error'(instantiation_error,G).
+'$check_flag_name'(Name, _) :-
+	atom(Name), !.
+'$check_flag_name'(Name, G) :-
+	'$do_error'(type_error(atom),G).
+	
+'$check_flag_options'(O, _, _, G) :-
+	var(O),
+	'$do_error'(instantiation_error,G).
+'$check_flag_options'([], term, read_write, _) :- !.
+'$check_flag_options'([O1|Os], Domain, RW, G) :- !,
+	'$check_flag_optionsl'([O1|Os], Domain, RW, G).
+'$check_flag_options'(O, _, _, G) :-
+	'$do_error'(type_error(list),G).
+
+
+'$check_flag_optionsl'([], term, read_write, G).
+'$check_flag_optionsl'([V|Os], Domain, RW, G) :-
+	var(V),
+	'$do_error'(instantiation_error,G).
+'$check_flag_optionsl'([type(Type)|Os], Domain, RW, G) :- !,
+	'$check_flag_type'(Type, Domain, G),
+	'$check_flag_optionsl'(Os, _, RW, G).
+'$check_flag_optionsl'([access(Access)|Os], Domain, RW, G) :- !,
+	'$check_flag_access'(Access, RW, G),
+	'$check_flag_optionsl'(Os, Domain, _, G).
+'$check_flag_optionsl'(Os, Domain, RW, G) :-
+	'$do_error'(domain_error(create_prolog_flag,Os),G).
+
+'$check_flag_type'(V, _, G) :-
+	var(V),
+	'$do_error'(instantiation_error,G).
+'$check_flag_type'(boolean, boolean, _) :- !.
+'$check_flag_type'(integer, integer, _) :- !.
+'$check_flag_type'(float, float, _) :- !.
+'$check_flag_type'(atom, atom, _) :- !.
+'$check_flag_type'(term, term, _) :- !.
+'$check_flag_type'(Atom, _, G) :-
+	'$do_error'(domain_error(create_prolog_flag_option(type),Atom),G).
+
+'$check_flag_access'(V, _, G) :-
+	var(V),
+	'$do_error'(instantiation_error,G).
+'$check_flag_access'(read_write, read_write, _) :- !.
+'$check_flag_access'(read_only, read_only, _) :- !.
+'$check_flag_type'(Atom, _, G) :-
+	'$do_error'(domain_error(create_prolog_flag_option(access),Atom),G).
 
 '$user_flag_value'(F, Val) :-
 	var(Val), !,
-	'$user_defined_flag'(F,Val).
+	'$user_defined_flag'(F,_,_,Val).
-'$user_flag_value'(F, Val) :-
-	recorded('$dialect',swi,_), !,
-	retractall(prolog:'$user_defined_flag'(F,_)),
-	assert(prolog:'$user_defined_flag'(Atom,Val)).
 '$user_flag_value'(F, Val) :-
 	atomic(Val), !,
-	retractall(prolog:'$user_defined_flag'(F,_)),
+	prolog:'$user_defined_flag'(F,Domain,RW,V0),
-	assert(prolog:'$user_defined_flag'(Atom,Val)).
+	(
+	 Val == V0
+	->
+	 true
+	;
+	 RW = read_only
+	->
+	 '$do_error'(permission_error(modify,flag,F),yap_flag(F,Val))
+	;
+	  '$check_flag_value'(Val, Domain, yap_flag(F,Val)),
+	  retractall(prolog:'$user_defined_flag'(F,_,_,_)),
+	  assert(prolog:'$user_defined_flag'(F,Domain,RW,Val))
+	).
 '$user_flag_value'(F, Val) :-
 	'$do_error'(type_error(atomic,Val),yap_flag(F,Val)).
 
+'$check_flag_value'(Value, _, G) :-
+	\+ ground(Value), !,
+	'$do_error'(instantiation_error,G).
+'$check_flag_value'(_, term, _) :- !.
+'$check_flag_value'(Value, atom, _) :-
+	atom(Value), !.
+'$check_flag_value'(Value, integer, _) :-
+	integer(Value), !.
+'$check_flag_value'(Value, float, _) :-
+	float(Value), !.
+'$check_flag_value'(true, boolean, _) :- !.
+'$check_flag_value'(false, boolean, _) :- !.
+'$check_flag_value'(Value, Domain, G) :-
+	'$do_error'(domain_error(Domain,Value),G).
+
 '$expects_dialect'(swi) :-
 	eraseall('$dialect'),
 	recorda('$dialect',swi,_),

pl/init.yap

@@ -84,7 +84,7 @@ lists:append([H|T], L, [H|R]) :-
 	 'yapor.yap',
          'udi.yap'].
 
-:- dynamic prolog:'$user_defined_flag'/2.
+:- dynamic prolog:'$user_defined_flag'/4.
 
 :- multifile prolog:debug_action_hook/1.