1/*
    2	DCG Term Expansion
    3	
    4	Modified translation of DCGs:
    5	Prolog Code inside {..} and Terminals are wrapped in 'P'/3 resp. 'T'/3 predicates. 
    6	
    7	Usage: 
    8	Since a term-expansion doesn't work beyond module boundaries, 
    9	this has to be initialised in a Module which reaches the DCG.
   10	
   11	term_expansion(R, R0) :-
   12		dcg_hashexp:dcg_expansion(R, R0).
   13*/
   14:- module(dcg_hashexp,
   15	[
   16		dcg_expansion/2,
   17		'P'/3,
   18		'T'/3
   19	]).   20
   21/*
   22	Load modified version SWI module '$dcg'.
   23	dcg_hashexp relies on this
   24*/
   25:- use_module(dcg_hashswi).   26:- use_module(dcg_hashlib).   27
   28/*
   29	Modified DCG Expansion
   30	
   31	Terminals and {..} fragments are replaced. 
   32*/
   33dcg_expansion((H --> B), (H0 :- B1)) :-
   34	exp(B, B0),
   35	dcg_translate_rule_((H --> B0), (H0 :- B1)).
   36
   37/*
   38	Expand grammar bodies
   39	
   40	Recognising Terminals:
   41	[..] -> 'T'([..])
   42	
   43	Recognising {..} Prolog Code:
   44	{..} -> 'P'(..)
   45	
   46	Recognising Strings:
   47	".." -> 'T'([.,.])
   48	
   49	This doesn't change the codes behaviour, 
   50	but makes it possible to identify these fragmens later on.
   51	
   52	Future Work:
   53	- changes behaviour of cut (!) (since 'P' is opaque for the cut..)
   54*/
   55exp({A}, 'P'(A)).
   56exp(A, 'T'(A0)) :-
   57	string(A),
   58	string_chars(A, A0).
   59exp(A, 'T'(A)) :-
   60	is_list(A).
   61exp(A, A) :-
   62	A \= {_},
   63	A \= (_,_),
   64	\+is_list(A). 
   65exp((A,B), (A0, B0)) :-
   66	exp(A, A0),
   67	exp(B, B0).	
   68
   69/*
   70	Wrapper for {...} (Plain Prolog code)
   71	
   72	Goals are checked using safe_goal/1, allows for white-listed built-in predicates
   73*/
   74'P'(Prolog, In, Rest) :-
   75	safe_goal(Prolog),
   76	call(Prolog),
   77	In = Rest.
   78
   79/*
   80	Wrapper for Terminals
   81*/
   82'T'(Terminal, In, Rest) :- 
   83	append(Terminal, Rest, In)