1:- module(swap_args, [swap_args_of/5]).    2:- use_module(util(misc)).    3:- use_module(pac('expand-pac')).    4% :- expects_dialect(pac).
    5term_expansion --> pac:expand_pac.
    6:- use_module(pac(op)).    7
    8% ?- module(swap_args).
    9smash(X):- basic:smash(X).
   10
   11% ?- help(snap).
   12
   13		/***************************************
   14		*     swap arguments of a predicate    *
   15		***************************************/
   16
   17% ?- swap_args_of(f, 1, 2,` f([], [])`, X), basic:smash(X).
   18% ?- swap_args_of(f, 1, 2,` f([a,b], [[]])`, X), smash(X).
   19% ?- swap_args_of(f, 1, 2,`f(a, g(b))`, X), smash(X).
   20% ?- swap_args_of(f, 1, 2,`f([], [])`, X), smash(X).
   21% ?- swap_args_of(f, 2, 3,`f(a, b, c)`, X), smash(X).
   22% ?- swap_args_of(f, 2, 3,`f(a, b, c) + x`, X), smash(X).
   23% ?- swap_args_of(f, 2, 3,` f(a, b, c, d`, X), smash(X).
   24% ?- swap_args_of(f, 2, 10,`f(a, b, c)`, X), smash(X).
   25% ?- swap_args_of(f, 1, 2,` f([], [])`, X), smash(X).
   26
   27swap_args_of(_, I, I, X, X).
   28swap_args_of(F, I, J, X, Y):-  J < I, swap_args_of(F, J, I, X, Y).
   29swap_args_of(F, I, J, X, Y):-  atom_codes(F, F0),
   30       	append(F0, `(`, F1),
   31        once(swap_args_of(F1, I, J, Y, X, [])).
   32
   33%
   34swap_args_of(X, I, J, [A, X, NewArgs, `)` |R]) -->
   35	skip_to_args_of(X, A),
   36	full_args_rest(Args),
   37	!,
   38	{ length(Args, N),
   39		(	N >= J
   40		->   	once(swap_args_by_index(I, J, Args, Args0))
   41		;	Args0 = Args
   42		),
   43	 insert(`,`, Args0, NewArgs)
   44	},
   45	swap_args_of(X, I, J, R).
   46swap_args_of(_, _, _, X) --> is_rest(X).
   47
   48%
   49is_rest(X, X, []).
   50
   51%
   52is_prefix([C|R])-->[C], is_prefix(R).
   53is_prefix([])-->[].
   54
   55% ?- trim_left_white(`abc `, X), smash(X).
   56% ?- trim_left_white(`\tabc `, X).
   57trim_left_white --> wl("[ \t]*").
   58
   59% ?- coalgebra:show_am("(.*[^1-9a-zA-Z_])?").
   60% ?- coalgebra:show_am(".*").
   61
   62skip_to_args_of(X, A) --> w("(.*[^1-9a-zA-Z_])?", A, []),
   63	is_prefix(X).
   64
   65% ?- full_args_rest(X, `a, [])`, R).
   66full_args_rest([A|X]) --> argument(A, []),
   67	args_rest(X, []).
   68
   69%
   70args_rest(X, X) --> ")".
   71args_rest([A|X], Y) --> ",", argument(A, []),
   72	args_rest(X, Y).
   73
   74%
   75argument(X, X) --> look_ahead(`,)`).
   76argument(X, Y) --> part_of_arg(X, Z),
   77	argument(Z, Y).
   78
   79%
   80part_of_arg(X, Y) --> group(X, Y).
   81part_of_arg(X, Y) --> quoted_codes(X, Y).
   82part_of_arg([C|X], X) --> [C].
   83
   84%
   85look_ahead(L, R, R):- R = [C|_], memberchk(C, L).
   86
   87%
   88group_mark(0'[, 0']).
   89group_mark(0'(, 0')).
   90group_mark(0'{, 0'}).
   91
   92%
   93group([C|X], Y) --> [C], {group_mark(C, End)},
   94	group_rest(End, X, Y).
   95%
   96group_rest(E, [E|X], X) --> [E].
   97group_rest(E, X, Y) --> part_of_group(X, Z),
   98	group_rest(E, Z, Y).
   99%
  100part_of_group(X, X) --> look_ahead(`)]}`).
  101part_of_group(X, Y) --> group(X, Y).
  102part_of_group(X, Y) --> quoted_codes(X, Y).
  103part_of_group(X, Y) --> zero_quote_prefix(X, Y).
  104part_of_group([C|X], Y) --> [C], part_of_group(X, Y).
  105%
  106zero_quote_prefix([0'0, 0'\'|X], X) --> "0'".
  107
  108% Remark: keeping the syntax rule for not spacing for
  109% the first argument of predicate call like this:  f(a, b, c).
  110
  111% ?- swap_args_by_index(2, 3, [`a`,` b`,` c`], R).
  112% ?- swap_args_by_index(1, 2, [`a`,` b`,` c`], R).
  113% ?- swap_args_by_index(1, 2, [`a`,`b`], R), smash(R).
  114
  115swap_args_by_index(I, J, X, Y):-  D is J - I,
  116	once(scan_args(I, D, X, Y, Assocs)),
  117	edit_args(I, Assocs).
  118
  119%
  120scan_args(1, D, [A|X], [B|Y], [A-B, P-Q]):-  scan_args(D, X, Y, P-Q).
  121scan_args(N, D, [U|X], [U|Y], R):-  succ(N0, N),
  122	scan_args(N0, D, X, Y, R).
  123
  124%
  125scan_args(1, [A|X], [B|X], A-B).
  126scan_args(N, [U|X], [U|Y], R):- succ(N0, N),
  127	scan_args(N0, X, Y, R).
  128%
  129edit_args(1, [A-B0,  B-[S, A]]):- space_code(S), !,
  130	trim_left_white(B, B0).
  131edit_args(_, [A-B,  B-A]).
  132
  133% ?- quoted_codes(X, [], `'abc'`, R).
  134% ?- quoted_codes(X, [], `"abc" `, R).
  135
  136space_code(0'\s).		%'
  137%
  138escape_code(0'\\).	%'
  139%
  140quotation_code(0'\').	%'
  141quotation_code(0'\").	%'
  142quotation_code(0'\`).	%'
  143
  144quoted_codes([C|X],  Y) --> [C], {quotation_code(C)}, !,
  145	verb(C, X, Y).
  146%
  147verb(C, [C, C|X], X)	--> [C, C].
  148verb(C, [C|X], X)	--> [C].
  149verb(C, [E, C|X], X)	--> [E, C], {escape_code(E)}.
  150verb(C, [A|X], Y)	--> [A], verb(C, X, Y).
  151
  152		/*************************
  153		*     insert argument    *
  154		*************************/
  155% ?- elem_list(X, [], `abc[`, R).
  156% ?- elem_list(X, [], `abc]`, R).
  157% ?- elem_list(X, [], `abc ef)`, R).
  158% ?- elem_list(X, [], `(a,b)`, R).
  159% ?- elem_list(X, [], `(f(a),b)`, R).
  160% ?- elem_list(X, [], `f(a,b )`, []).
  161% ?- elem_list(X, [], `a(1),b)`, R).
  162% ?- elem_list(X, [], `(a(1),b)`, R).
  163% ?- elem_list(X, [], `c(a(1),b).`, R).
  164% ?- elem_list(X, [], `c(a(1),b)d(c(2), e).`, R).
  165% ?- block_elem(X, [], `{f(a)=b}`, R).
  166% ?- elem_list(X, [], `{f(a)=b}`, R).
  167% ?- elem_list(X, [], `f(a,b),`, R), collect_functors(X, S, []).
  168% ?- elem_list(X, [], `f((a,b)),`, R), collect_functors(X, S, []).
  169% ?- elem_list(X, [], `f((a)),`, R).
  170
  171elem_list(X, Y)	--> elem(X, X0), elem_list(X0, Y).
  172elem_list(X, X) --> [].
  173
  174%
  175elem(X, Y)	--> compound_elem(X, Y)
  176	|	block_elem(X, Y)
  177	|	zero_quote_code(X, Y)
  178	|	radix_number(X, Y)
  179	|	comment(X, Y)
  180	|	filler(X, Y)
  181	|	back_quote_code(X, Y)
  182	|	string(X, Y)
  183	|	w('.', X, Y).
  184
  185% ?- compound_elem(X, [], `f(1)`, R).
  186% ?- compound_elem(X, [], `f(g( 1 ),h( 2 ))`, R).
  187compound_elem([$(Functor/N, Args)|X], X) -->
  188	atom(A, []),	"(",
  189	{ atom_codes(Functor, A) },
  190	arg_list(0, N, Args, []).
  191%
  192arg_list(I, I, X, X)	--> ")", !.
  193arg_list(I, J, X, Y)	--> ",", arg_list(I, J, X, Y).
  194arg_list(I, J, [A|X], Y) --> elem_arg(A, []),
  195	{ I0 is I+1 },
  196	arg_list(I0, J, X, Y).
  197%
  198elem_arg(X, X) --> look_ahead(`,)`), !.
  199elem_arg(X, Y) --> elem(X, X0), elem_arg(X0, Y).
  200
  201% ?- atom(X, [], `abc(`, R).
  202atom(X, Y) --> wl("[a-z][_a-zA-Z0-9]*", X, Y).
  203
  204%
  205block_elem([group(Open, Close, Body)|X], X)--> [Open],
  206	{ group_mark(Open, Close) },
  207	block_content(Body, [], Close).
  208
  209%
  210block_content(X, X, Close)-->[Close].
  211block_content(X, Y, Close)--> w(",", X, X0),
  212	block_content(X0, Y, Close).
  213block_content(X, Y, Close)--> elem(X, X0),
  214	block_content(X0, Y, Close).
  215%
  216escape_code(X,  Y) --> w("\\", X, [A|Y]), [A].
  217
  218% ?- string(X, [], `"ab"`, R).
  219% ?- string(X, [], `"""ab"`, R).
  220% ?- string(X, [], `"""""ab"`, R).
  221% ?- string(X, [], `"""a""b"c`, R).
  222% ?- string(X, [], `"\"\"a\"\"b"c`, R).
  223string(X, Y) --> w("\"", X, X0),
  224		   string_content(X0, X1),
  225		   w("\"", X1, Y).
  226%
  227string_content(X, Y) -->  % keep as it is: do not contract anything.
  228		(	escape_code(X, X0)
  229		|	w("\"\"", X, X0)
  230		|	w("[^\"]", X, X0)
  231		),
  232		string_content(X0, Y).
  233string_content(X, X) --> [].
  234
  235% ?- zero_quote_code(X, [], `0'\\a`, R), smash(X).
  236zero_quote_code(X, Y) --> w("0'\\\\.", X, Y).
  237
  238% ?- radix_number(X, [], `12'a1B2C3!`, R), smash(X).
  239radix_number(X, Y)--> wl("[0-9]+'[0-9a-zA-Z]+", X, Y).
  240
  241% ?- filler(X, [], `.  .. abc(`, R).
  242filler(X, Y) --> wl("[\n\r\s\t]+", X, Y).
  243
  244% ?- comment(X, [], `% comment\t\n\n`, R), smash(X).
  245% ?- comment(X, [], `% comment\t`, R), smash(X).
  246% ?- comment(X, [], `/* comment\t\n\n end***/xyz`, R), smash(X).
  247comment(X, Y) --> line_comment(X, Y) | block_comment(X, Y).
  248
  249%
  250line_comment(X, Y) --> wl("%[^\n]*", X, X0),
  251	( w("\n", X0, Y) | end_of_line_comment(X0, Y) ).
  252%
  253end_of_line_comment(X, X, [], []).
  254
  255% ?- block_comment(X, [], `/*a/*b/*c*/def`, R).
  256% ?- block_comment(X, [], `/*(a/*b/*c)*/(def`, R).
  257block_comment(X, Y) --> w("/\\*", X, X0),
  258		w(".*", X0, X1),
  259		( w("\\*/", X1, Y)
  260		| end_of_block_comment(X1, Y)
  261		).
  262%
  263end_of_block_comment([0'*|X], X, [0'*], []).
  264end_of_block_comment(X, X, [], []).
  265
  266% ?- back_quote_code(X, [], ```a b c```, R).
  267% ?- back_quote_code(X, [], ```a ````b c```, R).
  268back_quote_code(X, Y) --> w("\`", X, X0),
  269		back_quote_code_content(X0, X1),
  270		w("\`", X1, Y).
  271%
  272back_quote_code_content(X, Y) -->  % Similarly to string/4.
  273	(	escape_code(X, X0)
  274	|	w("\`\`", X, X0)
  275	|	w("[^\`]+", X, X0)
  276	),
  277	back_quote_code_content(X0, Y).
  278back_quote_code_content(X, X) --> [].
  279
  280% ?- elem_list(X, [], `c(a(1),b) (f(a), g(b)) d(c(2), e).`, R),
  281%	collect_functors(X, Fs, []), smash(Fs).
  282
  283% ?- elem_list(X, [], `(c(a(1),b)d(c(2), e)).`, R),
  284%	collect_functors(X, Fs, []), smash(Fs).
  285collect_functors(X, Y):- collect_functors(X,  Y0, []),
  286	sort(Y0, Y).
  287%
  288collect_functors([], X, X).
  289collect_functors([A|B], X, Y):-	!, collect_functors(A, X, X0),
  290	collect_functors(B, X0, Y).
  291collect_functors($(F,Args), [F|X], Y):-!, collect_functors(Args, X, Y).
  292collect_functors(group(_,_, Body), X, Y):-!,
  293	collect_functors(Body, X, Y).
  294collect_functors(_, X, X).
  295
  296% ?- elem_list(X, [], `c(a(1),b), d(c(2), e).`, R),
  297%	edit_elem_list(swap_args:insert_last_arg, [c/2, c/1], " State", X, U),
  298%	smash(U).
  299
  300% ?- elem_list(X, [], `c(a(1),/*c(3)*/b), d(c(2), e).`, R),
  301%	edit_elem_list(swap_args:insert_last_arg, [c/2, c/1], " State", X, U),
  302%	smash(U).
  303
  304edit_elem_list(_, _, _, A, A):- atomic(A), !.
  305edit_elem_list(F, Sgn, Varname, [X|Y], [X0|Y0]):-!,
  306	edit_elem_list(F, Sgn, Varname, X, X0),
  307	edit_elem_list(F, Sgn, Varname, Y, Y0).
  308edit_elem_list(F, Sgn, Varname, X, Y):-
  309	call(F, Sgn, Varname, X, Y).
  310%
  311insert_last_arg(Sgn, Varname, $(Arity, As), Y):-
  312	maplist(edit_elem_list(swap_args:insert_last_arg, Sgn, Varname),
  313			As, Bs),
  314	insert_to_last(Sgn, Varname, Arity, Bs, Y).
  315insert_last_arg(Sgn, Varname, group(Open, Close, Body),
  316				[Open, Body0, Close]):-
  317	edit_elem_list(swap_args:insert_last_arg, Sgn, Varname,
  318		Body, Body0).
  319
  320%
  321insert_to_last(Sgn, Varname, F/N, As, [F,"(", Bs, ")"]):-
  322	(	memberchk(F/N, Sgn)
  323	->	append(As, [Varname], Cs)
  324	;	Cs = As
  325	),
  326	insert(",", Cs, Bs)