    1/* Part of plumdrum
    2	Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL)
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(env,
   20		[	init_env//0
   21		,	key//1
   22		,	key_val//2
   23		,	ins_key//1
   24		,	ins_key//2
   25		,	get_key//2
   26		,	get_key//3
   27		,	set_key//2
   28		,	upd_key//3
   29		,	with_key//2
   30		,	del_key//1
   31		,	sel_key//2
   32		,	with_env/1
   33		,	ins_keys//1
   34		,	sel_keys//1
   35		]).   36
   37:- meta_predicate with_key(+,//,+,-), with_env(:).

Environments for stateful computations

This module provides DCG compatible rules for managing a state variable which consistists of an environment, which contains a set of key-value mappings. The predicates do a number of checks to ensure safe and consistant use. */

   47:- use_module(library(dcg_core)).   48:- use_module(library(rbtrees)).   49
   50user:goal_expansion(no_fail(K,S,G), (G -> true; check(K,S), throw(failed(G)))).
   51user:portray(t(_,_)) :- write('<rbtree/2>').

init_env// is det: Set state to empty environment.

   55init_env --> set_with(rb_empty).

key(?Key, ?Val)// is nondet: Enumerate all keys in environment.

   59key(K,S,S) :- rb_in(K,_,S).

key_val(?Key, ?Val)// is nondet: Enumerate all keys and associated values.

   63key_val(K,V,S,S) :- rb_in(K,V,S).

get_key(+Key, +Default, ?Val)// is det: Unify Val with value associated with Key or Default if not present.

   67get_key(K,V,D,S,S) :- (rb_lookup(K,V,S) -> true; V=D).

get_key(+Key, ?Val)// is det: Unify Val with value associated with Key.

   71get_key(K,V,S,S)       :- no_fail(K, S, rb_lookup(K,V,S)).

set_key(+Key, ?Val)// is det: Set value associated with Key to Val.

   75set_key(K,V,S1,S2)     :- no_fail(K, S1, rb_update(S1,K,V,S2)).

upd_key(+Key, ?Val1, ?Val2)// is det: Unify Val1 with value associated with Key and set new value to Val2.

   79upd_key(K,V1,V2,S1,S2) :- no_fail(K, S1, rb_update(S1,K,V1,V2,S2)).

del_key(+Key)// is det: Remove Key from environment.

   83del_key(K,S1,S2)       :- no_fail(K, S1, rb_delete(S1,K,S2)).

sel_key(+Key, ?Val)// is det: Remove Key from environment and unify Val with its value.

   87sel_key(K,V,S1,S2)     :- no_fail(K, S1, rb_delete(S1,K,V,S2)).

ins_key(+Key, ?Val)// is det
ins_key(+Key)// is det: Add Key to environment with given value or unbound if no value given.

   93ins_key(K,S1,S2) :- ins_key(K,_,S1,S2).
   94ins_key(K,V,S1,S2) :- 
   95	(	var(K) -> throw(instantiation_error('environment key'))
   96	;	rb_in(K,_,S1) -> throw(error(key_exists(K)))
   97	;	no_fail(K, S1, rb_insert_new(S1,K,V,S2))
   98	).

with_key(+Key, :Phrase)// is nondet: Use Phrase to compute new value of key from old.

  102with_key(K,P,S1,S2)    :- check(K,S1), rb_apply(S1,K,call_dcg(P),S2).

with_env(:Phrase) is nondet: Run phrase with initial state equal to an empty environment.

  107with_env(G) :- init_env(_,E), call_dcg(G,E,_).
  108
  109
  110check(K,S) :- 
  111	(	var(K) -> throw(instantiation_error('environment key'))
  112	;	rb_in(K,_,S) -> true
  113	;	throw(error(key_not_found(K)))
  114	).
  115
  116prolog:message(error(key_not_found(K))) -->
  117	[ 'Key (~w) not found in current environment.'-[K], nl].
  118
  119prolog:message(error(key_exists(K))) -->
  120	[ 'Key (~w) already present in current environment.'-[K], nl].
  121% alternative is to use assoc, but assoc does not allow keys to
  122% be removed.
  123%key_set(K,V,S1,S2) :- put_assoc(K,S1,V,S2).
  124%with_key(K,P,S1,S2) :- get_assoc(K,S1,V1), call_dcg(P,V1,V2), put_assoc(K,S1,V2,S2).
  125
  126
  127ins_keys([]) --> !.
  128ins_keys([(K,V)|KX]) --> ins_key(K,V), ins_keys(KX).
  129
  130sel_keys([]) --> !.
  131sel_keys([(K,V)|KX]) --> sel_key(K,V), sel_keys(KX)