src/builtin/builtins.pl

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Builtin Predicates of Prolog Cafe
% 
% Mutsunori Banbara (banbara@kobe-u.ac.jp)
% Naoyuki Tamura (tamura@kobe-u.ac.jp)
% Kobe University
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- op(1150,  fx, (package)). 
package(_). 
:- package 'com.googlecode.prolog_cafe.builtin'.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Control constructs
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public true/0, otherwise/0.
:- public fail/0, false/0.
:- public (!)/0.
:- public (^)/2.
:- public (',')/2.
:- public (;)/2.
:- public (->)/2.
:- public call/1.

true.
otherwise.

fail :- fail.
false :- fail.

!.

(_ ^ G) :- call(G).

(P, Q) :- call(P), call(Q).

(P; _Q) :- P \= (_ -> _), call(P).
(_P; Q) :- Q \= (_ -> _), call(Q).

(IF -> THEN) :- call(IF), !, call(THEN).

(IF -> THEN; _ELSE) :- call(IF), !, call(THEN).
(_IF -> _THEN; ELSE) :- call(ELSE).

call(Term) :- 
	'$get_current_B'(Cut),
	'$meta_call'(Term, user, Cut, 0, interpret).

'$meta_call'(X, _, _, _, _) :- var(X), !, illarg(var, call(X), 1).
'$meta_call'(X, _, _, _, _) :- closure(X), !, '$call_closure'(X).
'$meta_call'(true, _, _, _, _) :- !.
'$meta_call'(_^X, P, Cut, Depth, Mode) :- !,
	'$meta_call'(X, P, Cut, Depth, Mode).
'$meta_call'(P:X, _, Cut, Depth, Mode) :- !,
	'$meta_call'(X, P, Cut, Depth, Mode).
'$meta_call'(!, _, no, _, _) :- !, illarg(context(if,cut), !, 0).
'$meta_call'(!, _, Cut, _, _) :- !, '$cut'(Cut).
'$meta_call'((X,Y), P, Cut, Depth, Mode) :- !,
	'$meta_call'(X, P, Cut, Depth, Mode),
	'$meta_call'(Y, P, Cut, Depth, Mode).
'$meta_call'((X->Y;Z), P, Cut, Depth, Mode) :- !,
	(   '$meta_call'(X, P, no, Depth, Mode) -> '$meta_call'(Y, P, Cut, Depth, Mode)
        ;   '$meta_call'(Z, P, Cut, Depth, Mode)
        ).
'$meta_call'((X->Y), P, Cut, Depth, Mode) :- !,
	(   '$meta_call'(X, P, no, Depth, Mode) -> '$meta_call'(Y, P, Cut, Depth, Mode)   ).
'$meta_call'((X;Y), P, Cut, Depth, Mode) :- !,
	(   '$meta_call'(X, P, Cut, Depth, Mode) ; '$meta_call'(Y, P, Cut, Depth, Mode)   ).
'$meta_call'(\+(X), P, _, Depth, Mode) :- !,
	\+ '$meta_call'(X, P, no, Depth, Mode).
'$meta_call'(findall(X,Y,Z), P, Cut, Depth, Mode) :- !,
	findall(X, '$meta_call'(Y, P, Cut, Depth, Mode), Z).
'$meta_call'(bagof(X,Y,Z), P, Cut, Depth, Mode) :- !,
	bagof(X, '$meta_call'(Y, P, Cut, Depth, Mode), Z).
'$meta_call'(setof(X,Y,Z), P, Cut, Depth, Mode) :- !,
	setof(X, '$meta_call'(Y, P, Cut, Depth, Mode), Z).
'$meta_call'(once(X), P, Cut, Depth, Mode) :- !,
	once('$meta_call'(X, P, Cut, Depth, Mode)).
'$meta_call'(on_exception(X,Y,Z), P, Cut, Depth, Mode) :- !,
	on_exception(X, '$meta_call'(Y, P, Cut, Depth, Mode), '$meta_call'(Z, P, Cut, Depth, Mode)).
'$meta_call'(catch(X,Y,Z), P, Cut, Depth, Mode) :- !,
	catch('$meta_call'(X, P, Cut, Depth, Mode), Y, '$meta_call'(Z, P, Cut, Depth, Mode)).
%'$meta_call'(freeze(X,Y), P, Cut, Depth, Mode) :- !, ???
%	freeze(X, '$meta_call'(Y, P, Cut, Depth, Mode)).
'$meta_call'(clause(X, Y), P, _, _, _) :- !, clause(P:X, Y).
'$meta_call'(assert(X), P, _, _, _) :- !, assertz(P:X).
'$meta_call'(assertz(X), P, _, _, _) :- !, assertz(P:X).
'$meta_call'(asserta(X), P, _, _, _) :- !, asserta(P:X).
'$meta_call'(retract(X), P, _, _, _) :- !, retract(P:X).
'$meta_call'(abolish(X), P, _, _, _) :- !, abolish(P:X).
'$meta_call'(retractall(X), P, _, _, _) :- !, retractall(P:X).
'$meta_call'(X, P, _, Depth, Mode) :- atom(P), callable(X), !,
	'$meta_call'(Mode, Depth, P, X).
'$meta_call'(X, P, _, _, _) :- 
	illarg(type(callable), call(P:X), 1).

'$meta_call'(trace, Depth, P, X) :- !, 
	functor(X, F, A),
	'$call'('com.googlecode.prolog_cafe.builtin', '$trace_goal'(X, P, F/A, Depth)).
'$meta_call'(interpret, Depth, P, X) :- 
	functor(X, F, A),
	'$call_internal'(X, P, F/A, Depth, interpret).

'$call_internal'(X, P, FA, Depth, Mode) :- 
	'$new_internal_database'(P),
	hash_contains_key(P, FA),
	!,
	'$get_current_B'(Cut),
	Depth1 is Depth + 1,
	clause(P:X, Body),
	'$meta_call'(Body, P, Cut, Depth1, Mode).
'$call_internal'(X, P, _, _, _) :- '$call'(P, X).


:- public catch/3, throw/1.
:- public on_exception/3.

catch(Goal, Catch, Recovery) :-
	on_exception(Catch, Goal, Recovery).

throw(Msg) :- raise_exception(Msg).

on_exception(Catch, Goal, Recovery) :- 
	callable(Goal), 
	!,
	'$on_exception'(Catch, Goal, Recovery).
on_exception(Catch, Goal, Recovery) :- 
	illarg(type(callable), on_exception(Catch,Goal,Recovery), 2).

'$on_exception'(_Catch, Goal, _Recovery) :-
	'$set_exception'('$none'),
	'$begin_exception'(L),
	call(Goal),
	'$end_exception'(L).
'$on_exception'(Catch, _Goal, Recovery) :-
        '$get_exception'(Msg),
        Msg \== '$none',
	'$catch_and_throw'(Msg, Catch, Recovery).

'$catch_and_throw'(Msg, Msg, Recovery) :-  !, 
        '$set_exception'('$none'),
	call(Recovery).
'$catch_and_throw'(Msg, _, _) :-  
	raise_exception(Msg).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Term unification
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public (=)/2, '$unify'/2.
:- public (\=)/2, '$not_unifiable'/2.

X = Y :- X = Y.
'$unify'(X, Y) :- '$unify'(X, Y).

X \= Y :- X \= Y.
'$not_unifiable'(X, Y) :- '$not_unifiable'(X, Y).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Type testing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public var/1, atom/1, integer/1, float/1, atomic/1, compound/1, nonvar/1, number/1.
:- public java/1, java/2, closure/1.
:- public ground/1, callable/1.

var(X) :- var(X).

atom(X) :- atom(X).

integer(X) :- integer(X).

float(X) :- float(X).

atomic(X) :- atomic(X).

nonvar(X) :- nonvar(X).

number(X) :- number(X).

java(X) :- java(X).
java(X, Y) :- java(X, Y).

closure(X) :- closure(X).

ground(X) :- ground(X).

compound(X) :- nonvar(X), functor(X, _, A), A > 0.

callable(X) :- atom(X), !.
callable(X) :- compound(X), !.
callable(X) :- closure(X).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Term comparison
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public (==)/2,  '$equality_of_term'/2.
:- public (\==)/2, '$inequality_of_term'/2.
:- public (@<)/2,  '$before'/2.
:- public (@>)/2,  '$after'/2.
:- public (@=<)/2, '$not_after'/2.
:- public (@>=)/2, '$not_before'/2.
:- public (?=)/2,  '$identical_or_cannot_unify'/2.
:- public compare/3.
% :- public sort/2.    witten in Java
% :- public keysort/2. witten in Java
% :- public merge/3.

X == Y :- X == Y.
'$equality_of_term'(X, Y) :- '$equality_of_term'(X, Y).

X \== Y :- X \== Y.
'$inequality_of_term'(X, Y) :- '$inequality_of_term'(X, Y).

X @< Y :- X @< Y.
'$before'(X, Y) :- '$before'(X, Y).

X @> Y :- X @> Y.
'$after'(X, Y) :- '$after'(X, Y).

X @=< Y :- X @=< Y.
'$not_after'(X, Y) :- '$not_after'(X, Y).

X @>= Y :- X @>= Y.
'$not_before'(X, Y) :- '$not_before'(X, Y).

?=(X, Y) :- ?=(X, Y).
'$identical_or_cannot_unify'(X, Y) :- '$identical_or_cannot_unify'(X, Y).

compare(Op, X, Y) :- '$compare0'(Op0, X, Y), '$map_compare_op'(Op0, Op).

'$map_compare_op'(Op0, Op) :- Op0 =:= 0, !, Op = (=).
'$map_compare_op'(Op0, Op) :- Op0 < 0, !, Op = (<).
'$map_compare_op'(Op0, Op) :- Op0 > 0, !, Op = (>).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Term creation and decomposition
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%:- public arg/3.     --> written in Java
%:- public functor/3. --> written in Java
:- public (=..)/2.
:- public copy_term/2.

Term =.. List :- Term =.. List.

copy_term(X, Y) :- copy_term(X, Y).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Arithmetic evaluation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public (is)/2.
:- public '$abs'/2, '$asin'/2, '$acos'/2, '$atan'/2.
:- public '$bitwise_conj'/3, '$bitwise_disj'/3, '$bitwise_exclusive_or'/3, '$bitwise_neg'/2.
:- public '$ceil'/2, '$cos'/2.
:- public '$degrees'/2.
:- public '$exp'/2.
:- public '$float'/2, '$float_integer_part'/2, '$float_fractional_part'/2, '$float_quotient'/3, '$floor'/2.
:- public '$int_quotient'/3.
:- public '$log'/2.
:- public '$max'/3, '$min'/3, '$minus'/3, '$mod'/3, '$multi'/3.
:- public '$plus'/3, '$pow'/3.
:- public '$radians'/2, '$rint'/2, '$round'/2.
:- public '$shift_left'/3, '$shift_right'/3, '$sign'/2, '$sin'/2, '$sqrt'/2.
:- public '$tan'/2, '$truncate'/2.

Z is Y :- Z is Y.

'$abs'(X, Y) :- '$abs'(X, Y).
'$asin'(X, Y) :- '$asin'(X, Y).
'$acos'(X, Y) :- '$acos'(X, Y).
'$atan'(X, Y) :- '$atan'(X, Y).
'$bitwise_conj'(X, Y, Z) :- '$bitwise_conj'(X, Y, Z).
'$bitwise_disj'(X, Y, Z) :- '$bitwise_disj'(X, Y, Z).
'$bitwise_exclusive_or'(X, Y, Z) :- '$bitwise_exclusive_or'(X, Y, Z).
'$bitwise_neg'(X, Y) :- '$bitwise_neg'(X, Y).
'$ceil'(X, Y) :- '$ceil'(X, Y).
'$cos'(X, Y) :- '$cos'(X, Y).
'$degrees'(X, Y) :- '$degrees'(X, Y).
'$exp'(X, Y) :- '$exp'(X, Y).
'$float'(X, Y) :- '$float'(X, Y).
'$float_integer_part'(X, Y) :- '$float_integer_part'(X, Y).
'$float_fractional_part'(X, Y) :- '$float_fractional_part'(X, Y).
'$float_quotient'(X, Y, Z) :- '$float_quotient'(X, Y, Z).
'$floor'(X, Y) :- '$floor'(X, Y).
'$int_quotient'(X, Y, Z) :- '$int_quotient'(X, Y, Z).
'$log'(X, Y) :- '$log'(X, Y).
'$max'(X, Y, Z) :- '$max'(X, Y, Z).
'$min'(X, Y, Z) :- '$min'(X, Y, Z).
'$minus'(X, Y, Z) :- '$minus'(X, Y, Z).
'$mod'(X, Y, Z) :- '$mod'(X, Y, Z).
'$multi'(X, Y, Z) :- '$multi'(X, Y, Z).
'$plus'(X,Y,Z) :- '$plus'(X,Y,Z).
'$pow'(X, Y, Z) :- '$pow'(X, Y, Z).
'$radians'(X, Y) :- '$radians'(X, Y).
'$rint'(X, Y) :- '$rint'(X, Y).
'$round'(X, Y) :- '$round'(X, Y).
'$shift_left'(X, Y, Z) :- '$shift_left'(X, Y, Z).
'$shift_right'(X, Y, Z) :- '$shift_right'(X, Y, Z).
'$sign'(X, Y) :- '$sign'(X, Y).
'$sin'(X, Y) :- '$sin'(X, Y).
'$sqrt'(X, Y) :- '$sqrt'(X, Y).
'$tan'(X, Y) :- '$tan'(X, Y).
'$truncate'(X, Y) :- '$truncate'(X, Y).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Arithmetic comparison
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public (=:=)/2, '$arith_equal'/2.
:- public (=\=)/2, '$arith_not_equal'/2.
:- public (<)/2, '$less_than'/2.
:- public (=<)/2, '$less_or_equal'/2.
:- public (>)/2, '$greater_than'/2.
:- public (>=)/2, '$greater_or_equal'/2.

X =:= Y :- X =:= Y.
'$arith_equal'(X, Y) :- '$arith_equal'(X, Y).

X =\= Y :- X =\= Y.
'$arith_not_equal'(X, Y) :- '$arith_not_equal'(X, Y).

X < Y :- X < Y.
'$less_than'(X, Y) :- '$less_than'(X, Y).

X =< Y :- X =< Y.
'$less_or_equal'(X, Y) :- '$less_or_equal'(X, Y).

X > Y :- X > Y.
'$greater_than'(X, Y) :- '$greater_than'(X, Y).

X >= Y :- X >= Y.
'$greater_or_equal'(X, Y) :- '$greater_or_equal'(X, Y).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Clause retrieval and information
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public clause/2.
:- public (initialization)/2.
:- public '$new_indexing_hash'/3.

clause(Head, B) :-
	'$head_to_term'(Head, H, P:PI, clause(Head,B)),
	'$new_internal_database'(P),
	'$check_procedure_permission'(P:PI, access, private_procedure, clause(Head, B)), 
	'$clause_internal'(P, PI, H, Cl, _),
	%(ground(Cl) -> Cl = (H :- B) ; copy_term(Cl, (H :- B))). ???
	copy_term(Cl, (H :- B)).

% head --> term
'$head_to_term'(H, T, Pkg:F/A, Goal) :- 
	'$head_to_term'(H, T, user, Pkg, Goal),
	functor(T, F, A).

'$head_to_term'(H, _, _, _, Goal) :- var(H), !,
	illarg(var, Goal, 1).
'$head_to_term'(P:H, T, _, Pkg, Goal) :- !,
	'$head_to_term'(H, T, P, Pkg, Goal).
'$head_to_term'(H, H, Pkg, Pkg, _) :- callable(H), atom(Pkg), !.
'$head_to_term'(_, _, _, _, Goal) :- 
	illarg(type(callable), Goal, 1).

% creates an internal database for A if no exists.
'$new_internal_database'(A) :-
	atom(A),
	'$get_hash_manager'(HM),
	'$new_internal_database'(HM, A).

'$new_internal_database'(HM, A) :-
	hash_contains_key(HM, A),
	!.
'$new_internal_database'(_, A) :-
	new_hash(_, [alias(A)]),
	'$init_internal_database'(A).

'$init_internal_database'(A) :-
	'$compiled_predicate'(A, '$init', 0),
	call(A:'$init'),
	!.
'$init_internal_database'(_).

% checks if the internal database of A exists.
'$defined_internal_database'(A) :-
	atom(A),
	'$get_hash_manager'(HM),
	hash_contains_key(HM, A).

% repeatedly finds dynamic clauses.
'$clause_internal'(P, PI, H, Cl, Ref) :-
	hash_contains_key(P, PI),
	'$get_indices'(P, PI, H, RevRefs),
	'$get_instances'(RevRefs, Cls_Refs),
	'$clause_internal0'(Cls_Refs, Cl, Ref).

'$clause_internal0'([], _, _) :- fail.
'$clause_internal0'([(Cl,Ref)], Cl, Ref) :- !.
'$clause_internal0'(L, Cl, Ref) :-
	'$builtin_member'((Cl,Ref), L).

'$get_indices'(P, PI, H, Refs) :-
	'$new_indexing_hash'(P, PI, IH),
	'$calc_indexing_key'(H, Key),
	(    hash_contains_key(IH, Key) -> hash_get(IH, Key, Refs)
             ; 
             hash_get(IH, var, Refs)
        ).

% finds the indexing hashtable for P:PI. creates it if no exist.
'$new_indexing_hash'(P, PI, IH) :-
	hash_contains_key(P, PI),
	!,
	hash_get(P, PI, IH).
'$new_indexing_hash'(P, PI, IH) :-
	new_hash(IH),
	hash_put(IH, all, []),
	hash_put(IH, var, []),
	hash_put(IH, lis, []),
	hash_put(IH, str, []),
	hash_put(P, PI, IH).

'$calc_indexing_key'(H, all) :- atom(H), !.
'$calc_indexing_key'(H, Key) :- 
	arg(1, H, A1), 
	'$calc_indexing_key0'(A1, Key).

'$calc_indexing_key0'(A1, all) :- var(A1), !.
'$calc_indexing_key0'(A1, lis) :- A1 = [_|_], !.
'$calc_indexing_key0'(A1, str) :- compound(A1), !.
'$calc_indexing_key0'(A1, Key) :- ground(A1), !, '$term_hash'(A1, Key).
'$calc_indexing_key0'(A1, Key) :- illarg(type(term), '$calc_indexing_key0'(A1,Key), 1).

% checks the permission of predicate P:F/A.
'$check_procedure_permission'(P:F/A, _Operation, _ObjType, _Goal) :- 
	hash_contains_key(P, F/A),
	!.
'$check_procedure_permission'(P:F/A, Operation, ObjType, Goal) :- 
	'$compiled_predicate_or_builtin'(P, F, A),
	!,
        illarg(permission(Operation,ObjType,P:F/A,_), Goal, _).
'$check_procedure_permission'(_, _, _, _).

% initialize internal databases of given packages.
initialization([], Goal) :- !, once(Goal).
initialization([P|Ps], Goal) :-
	'$new_internal_database'(P),
	initialization(Ps, Goal).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Clause creation and destruction
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public assert/1.
:- public assertz/1.
:- public asserta/1.
:- public retract/1.
:- public abolish/1.
:- public retractall/1.

assert(T) :-assertz(T).

assertz(T) :-
	'$term_to_clause'(T, Cl, P:PI, assertz(T)),
	'$new_internal_database'(P),
	'$check_procedure_permission'(P:PI, modify, static_procedure, assertz(T)),
	copy_term(Cl, NewCl),
	'$insert'(NewCl, Ref),
	'$update_indexing'(P, PI, Cl, Ref, 'z'),
	fail.
assertz(_).

asserta(T) :- 
	'$term_to_clause'(T, Cl, P:PI, asserta(T)),
	'$new_internal_database'(P),
	'$check_procedure_permission'(P:PI, modify, static_procedure, asserta(T)),
	copy_term(Cl, NewCl),
	'$insert'(NewCl, Ref),
	'$update_indexing'(P, PI, Cl, Ref, 'a'),
	fail.
asserta(_).

abolish(T) :- 
	'$term_to_predicateindicator'(T, P:PI, abolish(T)),
	'$new_internal_database'(P),
	'$check_procedure_permission'(P:PI, modify, static_procedure, abolish(T)),
	'$new_indexing_hash'(P, PI, IH),
	hash_get(IH, all, Refs),
	'$erase_all'(Refs),
	hash_remove(P, PI),
	fail.
abolish(_).

retract(Cl) :-
	'$clause_to_term'(Cl, T, P:PI, retract(Cl)),
	'$new_internal_database'(P),
	'$check_procedure_permission'(P:PI, access, static_procedure, retract(Cl)),
	T = (H :- _),
	'$clause_internal'(P, PI, H, Cl0, Ref),
	copy_term(Cl0, T),
	'$erase'(Ref),
	'$rehash_indexing'(P, PI, Ref).

retractall(Head) :- 
	'$head_to_term'(Head, H, P:PI, retractall(Head)),
	'$new_internal_database'(P),
	'$check_procedure_permission'(P:PI, access, static_procedure, retractall(Head)),
	'$clause_internal'(P, PI, H, Cl, Ref),
	copy_term(Cl, (H :- _)),
	'$erase'(Ref),
	'$rehash_indexing'(P, PI, Ref),
	fail.
retractall(_).

% term --> clause (for assert)
'$term_to_clause'(Cl0, Cl, Pkg:F/A, Goal) :- 
	'$term_to_clause'(Cl0, Cl, user, Pkg, Goal),
	Cl = (H :- _),
	functor(H, F, A).

'$term_to_clause'(Cl0, _, _, _, Goal) :- var(Cl0), !,
	illarg(var, Goal, 1).
'$term_to_clause'(_, _, Pkg0, _, Goal) :- var(Pkg0), !,
	illarg(var, Goal, 1).
'$term_to_clause'(P:Cl0, Cl, _, Pkg, Goal) :- !,
	'$term_to_clause'(Cl0, Cl, P, Pkg, Goal).
'$term_to_clause'(_, _, Pkg0, _, Goal) :- \+(atom(Pkg0)), !,
	illarg(type(atom), Goal, 1).
'$term_to_clause'((H0 :- B0), (H :- B), Pkg, Pkg, Goal) :- !,
	'$term_to_head'(H0, H, Pkg, Goal),
	'$term_to_body'(B0, B, Pkg, Goal).
'$term_to_clause'(H0, (H :- true), Pkg, Pkg, Goal) :-
	'$term_to_head'(H0, H, Pkg, Goal).

'$term_to_head'(H, H, _, _) :- atom(H), !.
'$term_to_head'(H, H, _, _) :- compound(H), !.
'$term_to_head'(_, _, _, Goal) :- 
	illarg(type(callable), Goal, 1).

'$term_to_body'(B0, B, Pkg, _) :- 
	'$localize_body'(B0, Pkg, B).

'$localize_body'(G, P, G1) :- var(G), !,
	'$localize_body'(call(G), P, G1).
'$localize_body'(P:G, _, G1) :- !,
	'$localize_body'(G, P, G1).
'$localize_body'((X,Y), P, (X1,Y1)) :- !,
	'$localize_body'(X, P, X1),
	'$localize_body'(Y, P, Y1).
'$localize_body'((X->Y), P, (X1->Y1)) :- !,
	'$localize_body'(X, P, X1),
	'$localize_body'(Y, P, Y1).
'$localize_body'((X;Y), P, (X1;Y1)) :- !,
	'$localize_body'(X, P, X1),
	'$localize_body'(Y, P, Y1).	
'$localize_body'(G, P, G1) :-
	functor(G, F, A),
	'$builtin_meta_predicates'(F, A, M), %???
	!,
	G  =.. [F|As],
	'$localize_args'(M, As, P, As1),
	G1 =.. [F|As1].
'$localize_body'(G, P, call(P:G)) :- var(P), !.
'$localize_body'(G, user, G) :- !.
'$localize_body'(G, _, G) :- system_predicate(G), !.
'$localize_body'(G, P, P:G).

'$localize_args'([], [], _, []) :- !.
'$localize_args'([:|Ms], [A|As], P, [P:A|As1]) :-
	(var(A) ; A \= _:_),
	!,
	'$localize_args'(Ms, As, P, As1).
'$localize_args'([_|Ms], [A|As], P, [A|As1]) :-
	'$localize_args'(Ms, As, P, As1).

'$builtin_meta_predicates'((^), 2, [?,:]).
'$builtin_meta_predicates'(call, 1, [:]).
'$builtin_meta_predicates'(once, 1, [:]).
'$builtin_meta_predicates'((\+), 1, [:]).
'$builtin_meta_predicates'(findall, 3, [?,:,?]).
'$builtin_meta_predicates'(setof, 3, [?,:,?]).
'$builtin_meta_predicates'(bagof, 3, [?,:,?]).
'$builtin_meta_predicates'(on_exception, 3, [?,:,:]).
'$builtin_meta_predicates'(catch, 3, [:,?,:]).
'$builtin_meta_predicates'(freeze, 2, [?,:]).

% clause --> term (for retract)
'$clause_to_term'(Cl, T, Pkg:F/A, Goal) :- 
	'$clause_to_term'(Cl, T, user, Pkg, Goal),
	T = (H :- _),
	functor(H, F, A).

'$clause_to_term'(Cl, _, _, _, Goal) :- var(Cl), !,
	illarg(var, Goal, 1).
'$clause_to_term'(_, _, Pkg, _, Goal) :- var(Pkg), !,
	illarg(var, Goal, 1).
'$clause_to_term'(P:Cl, T, _, Pkg, Goal) :- !,
	'$clause_to_term'(Cl, T, P, Pkg, Goal).
'$clause_to_term'(_, _, Pkg, _, Goal) :- \+(atom(Pkg)), !,
	illarg(type(atom), Goal, 1).
'$clause_to_term'((H0 :- B), (H :- B), Pkg, Pkg, Goal) :- !,
	'$head_to_term'(H0, H, _, Goal).
	%'$body_to_term'(B0, B, Goal).
'$clause_to_term'(H0, (H :- true), Pkg, Pkg, Goal) :-
	'$head_to_term'(H0, H, _, Goal).

% term --> predicate indicator (for abolish)
'$term_to_predicateindicator'(T, Pkg:PI, Goal) :- 
	'$term_to_predicateindicator'(T, PI, user, Pkg, Goal).

'$term_to_predicateindicator'(T, _, _, _, Goal) :- var(T), !,
	illarg(var, Goal, 1).
'$term_to_predicateindicator'(_, _, Pkg, _, Goal) :- var(Pkg), !,
	illarg(var, Goal, 1).
'$term_to_predicateindicator'(P:T, PI, _, Pkg, Goal) :- !,
	'$term_to_predicateindicator'(T, PI, P, Pkg, Goal).
'$term_to_predicateindicator'(T, _, _, _, Goal) :- T \= _/_, !,
	illarg(type('predicate_indicator'), Goal, 1).
'$term_to_predicateindicator'(F/_, _, _, _, Goal) :- \+ atom(F), !,
	illarg(type(atom), Goal, 1).
'$term_to_predicateindicator'(_/A, _, _, _, Goal) :- \+ integer(A), !,
	illarg(type(integer), Goal, 1).
'$term_to_predicateindicator'(T, T, Pkg, Pkg, _).

'$update_indexing'(P, PI, Cl, Ref, A_or_Z) :-
	'$new_indexing_hash'(P, PI, IH),
	'$gen_indexing_keys'(Cl, IH, Keys),
	'$update_indexing_hash'(A_or_Z, Keys, IH, Ref).

'$gen_indexing_keys'((H :- _), _, [all]) :- atom(H), !.
'$gen_indexing_keys'((H :- _), IT, Keys) :- 
	arg(1, H, A1), 
	'$gen_indexing_keys0'(A1, IT, Keys).

'$gen_indexing_keys0'(A1, IT,      Keys) :- var(A1), !, hash_keys(IT, Keys).
'$gen_indexing_keys0'(A1,  _, [all,lis]) :- A1 = [_|_], !.
'$gen_indexing_keys0'(A1,  _, [all,str]) :- compound(A1), !.
'$gen_indexing_keys0'(A1, IT, [all,Key]) :- ground(A1),  !,
	'$term_hash'(A1, Key), % get the hash code of A1
	(    hash_contains_key(IT, Key) -> true
             ;
             hash_get(IT, var, L), hash_put(IT, Key, L)
        ).
'$gen_indexing_keys0'(A1, IT, Keys) :- 
	illarg(type(term), '$gen_indexing_keys0'(A1,IT,Keys), 1).

'$update_indexing_hash'(a, Keys, IH, Ref) :- !, '$hash_addz_all'(Keys, IH, Ref).
'$update_indexing_hash'(z, Keys, IH, Ref) :- !, '$hash_adda_all'(Keys, IH, Ref).

'$hash_adda_all'([], _, _) :- !.
'$hash_adda_all'([K|Ks], H, X) :- 
	'$hash_adda'(H, K, X), 
	'$hash_adda_all'(Ks, H, X).

'$hash_addz_all'([], _, _) :- !.
'$hash_addz_all'([K|Ks], H, X) :-
	'$hash_addz'(H, K, X),
	'$hash_addz_all'(Ks, H, X).

'$erase_all'([]) :- !.
'$erase_all'([R|Rs]) :- '$erase'(R), '$erase_all'(Rs).

'$rehash_indexing'(P, PI, Ref) :-
	'$new_indexing_hash'(P, PI, IH),
	hash_keys(IH, Keys),
	'$remove_index_all'(Keys, IH, Ref).

'$remove_index_all'([], _, _) :- !.
'$remove_index_all'([K|Ks], IH, Ref) :-
	'$hash_remove_first'(IH, K, Ref),
	'$remove_index_all'(Ks, IH, Ref).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% All solutions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public findall/3.
:- public bagof/3.
:- public setof/3.

% findall/3
findall(Template, Goal, Instances) :- callable(Goal), !,
	new_hash(H),
	'$findall'(H, Template, Goal, Instances).
findall(Template, Goal, Instances) :- 
	illarg(type(callable), findall(Template,Goal,Instances), 2).

'$findall'(H, Template, Goal, _) :-
	call(Goal), 
	copy_term(Template, CT),
	'$hash_adda'(H, '$FINDALL', CT),
	fail.
'$findall'(H, _, _, Instances) :-
	hash_get(H, '$FINDALL', Vs),
	reverse(Vs, Instances).

% bagof/3 & setof/3
bagof(Template, Goal, Instances) :- callable(Goal), !,	
	'$bagof'(Template, Goal, Instances).
bagof(Template, Goal, Instances) :- 
	illarg(type(callable), bagof(Template,Goal,Instances), 2).

setof(Template, Goal, Instances) :- callable(Goal), !,	
	'$bagof'(Template, Goal, Instances0),
	sort(Instances0, Instances).
setof(Template, Goal, Instances) :- 
	illarg(type(callable), setof(Template,Goal,Instances), 2).

'$bagof'(Template, Goal, Instances) :- 
	'$free_variables_set'(Goal, Template, FV),
	%write('Goal = '), write(Goal), nl,
	%write('Free variables set = '), write(FV), nl,
	FV \== [],
	!,
	Witness =.. ['$witness'|FV],
	findall(Witness+Template, Goal, S),
	'$bagof_instances'(S, Witness, Instances0),
	Instances = Instances0.
'$bagof'(Template, Goal, Instances) :- 
	findall(Template, Goal, Instances),
	Instances \== [].

'$bagof_instances'([], _Witness, _Instances) :- fail.
'$bagof_instances'(S0, Witness, Instances) :-
	S0 = [W+T|S],
	'$variants_subset'(S, W, WT_list, T_list, S_next),
	'$bagof_instances0'(S_next, Witness, Instances, [W+T|WT_list], [T|T_list]).

'$bagof_instances0'(_, Witness, Instances, WT_list, T_list) :-
	'$unify_witness'(WT_list, Witness),
	Instances = T_list.
'$bagof_instances0'(S_next, Witness, Instances, _, _) :-
	'$bagof_instances'(S_next, Witness, Instances).

'$variants_subset'([], _W, [], [], []) :- !.
'$variants_subset'([W0+T0|S], W, [W0+T0|WT_list], [T0|T_list], S_next) :-
	'$term_variant'(W, W0),
	!,
	'$variants_subset'(S, W, WT_list, T_list, S_next).
'$variants_subset'([WT|S], W, WT_list, T_list, [WT|S_next]) :-
	'$variants_subset'(S, W, WT_list, T_list, S_next).

'$term_variant'(X, Y) :- new_hash(Hash), '$term_variant'(X, Y, Hash).

'$term_variant'(X, Y, Hash) :- var(X), !,
	(   hash_contains_key(Hash, X) ->
	    hash_get(Hash, X, V), Y == V
	    ;
	    var(Y), hash_put(Hash, X, Y)
	).
'$term_variant'(X, Y, _) :- ground(X), !,
	X == Y.
'$term_variant'(_, Y, _) :- var(Y), !,
	fail.
'$term_variant'([X|Xs], [Y|Ys], Hash) :- !,
	'$term_variant'(X, Y, Hash),
	'$term_variant'(Xs, Ys, Hash).
'$term_variant'(X, Y, Hash) :- 
	X =.. Xs,
	Y =.. Ys,
	'$term_variant'(Xs, Ys, Hash).

'$unify_witness'([], _) :- !.
'$unify_witness'([W+_|WT_list], W) :-
	'$unify_witness'(WT_list, W).

% Variable set of a term
'$variables_set'(X, Vs) :- '$variables_set'(X, [], Vs).

'$variables_set'(X, Vs, Vs      ) :- var(X), '$builtin_memq'(X, Vs), !.
'$variables_set'(X, Vs, [X|Vs]  ) :- var(X), !.
'$variables_set'(X, Vs0, Vs0    ) :- atomic(X), !.
'$variables_set'([X|Xs], Vs0, Vs) :- !, 
	'$variables_set'(X, Vs0, Vs1), 
	'$variables_set'(Xs, Vs1, Vs).
'$variables_set'(X, Vs0, Vs     ) :- 
	X =.. Xs, 
	'$variables_set'(Xs, Vs0, Vs).

'$builtin_memq'(X, [Y|_])  :- X==Y, !.
'$builtin_memq'(X, [_|Ys]) :- '$builtin_memq'(X, Ys).

% Existential variables set of a term
'$existential_variables_set'(X, Vs) :- 
	'$existential_variables_set'(X, [], Vs).

'$existential_variables_set'(X, Vs, Vs) :- var(X), !.
'$existential_variables_set'(X, Vs, Vs) :- atomic(X), !.
'$existential_variables_set'(_:X, Vs0, Vs) :- !,
	'$existential_variables_set'(X, Vs0, Vs).
%'$existential_variables_set'((X;Y), Vs0, Vs) :- !,
%	'$existential_variables_set'(X, Vs0, Vs1),
%	'$existential_variables_set'(Y, Vs1, Vs).
%'$existential_variables_set'((X->Y), Vs0, Vs) :- !,
%	'$existential_variables_set'(X, Vs0, Vs1),
%	'$existential_variables_set'(Y, Vs1, Vs).
%'$existential_variables_set'((X,Y), Vs0, Vs) :- !,	
%	'$existential_variables_set'(X, Vs0, Vs1),
%	'$existential_variables_set'(Y, Vs1, Vs).
'$existential_variables_set'(^(V,G), Vs0, Vs) :- !,
	'$variables_set'(V, Vs0, Vs1),
	'$existential_variables_set'(G, Vs1, Vs).
'$existential_variables_set'('$meta_call'(G,_,_,_,_), Vs0, Vs) :- !, %???
	'$existential_variables_set'(G, Vs0, Vs).
'$existential_variables_set'(_, Vs, Vs).

% Free variables set of a term
'$free_variables_set'(T, V, FV) :- 
	'$variables_set'(T, TV),
	'$variables_set'(V, VV),
	'$existential_variables_set'(T, VV, BV),
	'$builtin_set_diff'(TV, BV, FV),
	!.

'$builtin_set_diff'(L1, L2, L) :-
	sort(L1, SL1),
	sort(L2, SL2),
	'$builtin_set_diff0'(SL1, SL2, L).

'$builtin_set_diff0'([], _, []) :- !.
'$builtin_set_diff0'(L1, [], L1) :- !.
'$builtin_set_diff0'([X|Xs], [Y|Ys], L) :- X == Y, !,
	'$builtin_set_diff0'(Xs, Ys, L).
'$builtin_set_diff0'([X|Xs], [Y|Ys], [X|L]) :- X @< Y, !,
	'$builtin_set_diff0'(Xs, [Y|Ys], L).
'$builtin_set_diff0'([X|Xs], [Y|Ys], [Y|L]) :- 
	'$builtin_set_diff0'([X|Xs], Ys, [Y|L]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Term input/output (read)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public read/2.
:- public read_with_variables/3.
%:- public read_line/2. (written in Java)
:- dynamic '$tokens'/1. 

read(S_or_a, X) :-
	read_tokens(S_or_a, Tokens, _),
	parse_tokens(X, Tokens),
	!.

read_with_variables(S_or_a, X, Vs) :-
	read_tokens(S_or_a, Tokens, Vs),
	parse_tokens(X, Tokens),
	!.

% read_token(S_or_a, Token) reads one token from the input, 
% and unifies Token with:
%   error(Atom), 
%   end_of_file, 
%   '.', ' ', '(', ')', '[', ']', '{', '}', ',', '|', 
%   number(Integer_or_Float),
%   atom(Atom), 
%   var(Atom), 
%   string(CharCodeList)

read_token(S_or_a, Token) :-
	'$read_token0'(S_or_a, Type, Token0),
	'$read_token1'([Type], Token0, Token).

'$read_token1'([-2], T, error(T))  :- !. % error('message')
'$read_token1'("I",  T, number(T)) :- !. % number(intvalue)
'$read_token1'("D",  T, number(T)) :- !. % number(floatvalue)
'$read_token1'("A",  T, atom(T))   :- !. % atom('name')
'$read_token1'("V",  T, var(T))    :- !. % var('name')
'$read_token1'("S",  T, string(T)) :- !. % string("chars")
'$read_token1'(_,    T, T)         :- !. % others

% read_tokens(Tokens, Vs) reads tokens from the input 
% until full-stop-mark ('.') or end_of_file, 
% unifies Tokens with a list of tokens.
% Token for a variable has a form of var(Name,Variable).
% Vs is a list of Name=Variable pairs.

read_tokens(Stream, Tokens, Vs) :-
	'$read_tokens'(Stream, Tokens, Vs, []),
	!.

'$read_tokens'(Stream, Tokens, Vs, VI) :-
	read_token(Stream, Token),
	'$read_tokens1'(Stream, Token, Tokens, Vs, VI).

'$read_tokens1'(Stream, error(Message), [], _, _) :-  !,
	'$read_tokens_until_fullstop'(Stream),
	raise_exception(syntax_error(Message)),
	fail.
'$read_tokens1'(_Stream, end_of_file, [end_of_file,'.'], [], _) :- !.
'$read_tokens1'(_Stream, '.', ['.'], [], _) :- !.
'$read_tokens1'(Stream, var('_'), [var('_',V)|Tokens], ['_'=V|Vs], VI0) :- !,
	'$read_tokens'(Stream, Tokens, Vs, ['_'=V|VI0]).
'$read_tokens1'(Stream, var(Name), [var(Name,V)|Tokens], Vs, VI) :-
	'$mem_pair'(Name=V, VI), !,
	'$read_tokens'(Stream, Tokens, Vs, VI).
'$read_tokens1'(Stream, var(Name), [var(Name,V)|Tokens], [Name=V|Vs], VI0) :- !,
	'$read_tokens'(Stream, Tokens, Vs, [Name=V|VI0]).
'$read_tokens1'(Stream, Token, [Token|Tokens], Vs, VI) :-
	'$read_tokens'(Stream, Tokens, Vs, VI).

'$mem_pair'(X1=V1, [X2=V2|_]) :- X1 == X2, !, V1 = V2.
'$mem_pair'(X, [_|L]) :- '$mem_pair'(X, L).
%'$mem_pair'(X, [_|L]) :- member(X, L).

'$read_tokens_until_fullstop'(Stream) :-
	read_token(Stream, Token),
	'$read_tokens_until_fullstop'(Stream, Token).

'$read_tokens_until_fullstop'(_Stream, end_of_file) :- !.
'$read_tokens_until_fullstop'(_Stream, '.') :- !.
'$read_tokens_until_fullstop'(Stream, _) :-
	read_token(Stream, Token),
	'$read_tokens_until_fullstop'(Stream, Token).

parse_tokens(X, Tokens) :-
	retractall('$tokens'(_)),
	assertz('$tokens'(Tokens)),
	'$parse_tokens'(X, 1201, Tokens, ['.']),
	retract('$tokens'(Tokens)),
	!.

% '$parse_tokens'(X, Prec) parses the input whose precedecence =< Prec.
'$parse_tokens'(X, Prec0) -->
	'$parse_tokens_skip_spaces',
	'$parse_tokens1'(Prec0, X1, Prec1),
	!,
	'$parse_tokens_skip_spaces',
	'$parse_tokens2'(Prec0, X1, Prec1, X, _Prec),
	!.

'$parse_tokens1'(Prec0, X1, Prec1) -->
	'$parse_tokens_peep_next'(Next),
	{'$parse_tokens_is_starter'(Next)},
	!,
	'$parse_tokens_before_op'(Prec0, X1, Prec1).
'$parse_tokens1'(_, _, _) -->
	'$parse_tokens_peep_next'(Next),
	'$parse_tokens_error'([Next,cannot,start,an,expression]).

'$parse_tokens2'(Prec0, X, Prec, X, Prec) -->
	'$parse_tokens_peep_next'(Next),
	{'$parse_tokens_is_terminator'(Next)},
	{Prec =< Prec0},
	!.
'$parse_tokens2'(Prec0, X1, Prec1, X, Prec) -->
	'$parse_tokens_peep_next'(Next),
	{'$parse_tokens_is_post_in_op'(Next)},
	!,
	'$parse_tokens_post_in_ops'(Prec0, X1, Prec1, X, Prec).
'$parse_tokens2'(_, _, _, _, _) --> 
	'$parse_tokens_error'([operator,expected,after,expression]).

% '$parse_tokens_before_op'(Prec0, X, Prec)
% parses the input until infix or postfix operator,
% and returns X and Prec
'$parse_tokens_before_op'(Prec0, X, Prec) --> [' '], !,
	'$parse_tokens_before_op'(Prec0, X, Prec).
'$parse_tokens_before_op'(_, end_of_file, 0) --> [end_of_file], !.
'$parse_tokens_before_op'(_, N, 0) --> [number(N)], !.
'$parse_tokens_before_op'(_, N, 0) -->
	[atom('-')], [number(N0)], !, {N is -N0}.
'$parse_tokens_before_op'(_, V, 0) --> [var(_,V)], !.
'$parse_tokens_before_op'(_, S, 0) --> [string(S)], !.
'$parse_tokens_before_op'(_, X, 0) --> ['('], !,
	'$parse_tokens'(X, 1201),
	'$parse_tokens_expect'(')').
'$parse_tokens_before_op'(_, X, 0) --> ['{'], !,
	'$parse_tokens_skip_spaces',
	'$parse_tokens_brace'(X).
'$parse_tokens_before_op'(_, X, 0) --> ['['], !,
	'$parse_tokens_skip_spaces',
	'$parse_tokens_list'(X).
'$parse_tokens_before_op'(_, X, 0) -->
	[atom(F)], ['('],
	!,
	'$parse_tokens_skip_spaces',
	'$parse_tokens_args'(Args),
	{X =.. [F|Args]}.
'$parse_tokens_before_op'(Prec0, X, PrecOp) -->
	[atom(F)], {current_op(PrecOp,fx,F)}, {PrecOp =< Prec0},
	'$parse_tokens_skip_spaces',
	'$parse_tokens_peep_next'(Next),
	{'$parse_tokens_is_starter'(Next)},
	{\+ '$parse_tokens_is_post_in_op'(Next)},
	!,
        {Prec1 is PrecOp - 1},
        '$parse_tokens'(Arg, Prec1),
	{functor(X, F, 1)},
	{arg(1, X, Arg)}.
'$parse_tokens_before_op'(Prec0, X, PrecOp) -->
	[atom(F)], {current_op(PrecOp,fy,F)}, {PrecOp =< Prec0},
	'$parse_tokens_skip_spaces',
	'$parse_tokens_peep_next'(Next),
	{'$parse_tokens_is_starter'(Next)},
	{\+ '$parse_tokens_is_post_in_op'(Next)},
	!,
        '$parse_tokens'(Arg, PrecOp),
	{functor(X, F, 1)},
	{arg(1, X, Arg)}.
'$parse_tokens_before_op'(_, A, 0) -->
	[atom(A)].

'$parse_tokens_brace'('{}') --> ['}'], !.
'$parse_tokens_brace'(X) -->
	'$parse_tokens'(X1, 1201),
	'$parse_tokens_expect'('}'),
	{X = {X1}}.

'$parse_tokens_list'('[]') --> [']'], !.
'$parse_tokens_list'([X|Xs]) -->
	'$parse_tokens'(X, 999),
	'$parse_tokens_skip_spaces',
	'$parse_tokens_list_rest'(Xs).

'$parse_tokens_list_rest'(Xs) --> ['|'], !,
	'$parse_tokens'(Xs, 999),
	'$parse_tokens_expect'(']').
'$parse_tokens_list_rest'([X|Xs]) --> [','], !,
	'$parse_tokens'(X, 999),
	'$parse_tokens_skip_spaces',
	'$parse_tokens_list_rest'(Xs).
'$parse_tokens_list_rest'('[]') -->
	'$parse_tokens_expect'(']').

'$parse_tokens_args'('[]') --> [')'], !.
'$parse_tokens_args'([X|Xs]) -->
	'$parse_tokens'(X, 999),
	'$parse_tokens_skip_spaces',
	'$parse_tokens_args_rest'(Xs).

'$parse_tokens_args_rest'([X|Xs]) --> [','], !,
	'$parse_tokens'(X, 999),
	'$parse_tokens_skip_spaces',
	'$parse_tokens_args_rest'(Xs).
'$parse_tokens_args_rest'('[]') -->
	'$parse_tokens_expect'(')').

% '$parse_tokens_post_in_op'(Prec0, X1, Prec1, X, Prec)
% parses the input beginning from infix or postfix operator,
% and returns X and Prec
'$parse_tokens_post_in_ops'(Prec0, X1, Prec1, X, Prec) -->
	'$parse_tokens_skip_spaces',
	[Op],
	'$parse_tokens_op'(Op, Prec0, X1, Prec1, X2, Prec2),
	'$parse_tokens_post_in_ops'(Prec0, X2, Prec2, X, Prec).
'$parse_tokens_post_in_ops'(Prec0, X, Prec, X, Prec) --> 
	{Prec =< Prec0}.

'$parse_tokens_op'(',', Prec0, X1, Prec1, X, PrecOp) --> !,
	'$parse_tokens_op'(atom(','), Prec0, X1, Prec1, X, PrecOp).
'$parse_tokens_op'('|', Prec0, X1, Prec1, X, PrecOp) --> !,
	'$parse_tokens_op'(atom(';'), Prec0, X1, Prec1, X, PrecOp).
'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
	{current_op(PrecOp, xf, Op)}, {PrecOp =< Prec0},
	{Prec1 < PrecOp},
	{functor(X, Op, 1)},
	{arg(1, X, X1)}.
'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
	{current_op(PrecOp, yf, Op)}, {PrecOp =< Prec0},
	{Prec1 =< PrecOp},
	{functor(X, Op, 1)},
	{arg(1, X, X1)}.
'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
	{current_op(PrecOp, xfx, Op)}, {PrecOp =< Prec0},
	{Prec1 < PrecOp},
	{Prec2 is PrecOp - 1},
	'$parse_tokens'(X2, Prec2),
	!,
	{functor(X, Op, 2)},
	{arg(1, X, X1)},
	{arg(2, X, X2)}.
'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
	{current_op(PrecOp, xfy, Op)}, {PrecOp =< Prec0},
	{Prec1 < PrecOp},
	{Prec2 is PrecOp},
	'$parse_tokens'(X2, Prec2),
	!,
	{functor(X, Op, 2)},
	{arg(1, X, X1)},
	{arg(2, X, X2)}.
'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
	{current_op(PrecOp, yfx, Op)}, {PrecOp =< Prec0},
	{Prec1 =< PrecOp},
	{Prec2 is PrecOp - 1},
	'$parse_tokens'(X2, Prec2),
	!,
	{functor(X, Op, 2)},
	{arg(1, X, X1)},
	{arg(2, X, X2)}.

'$parse_tokens_is_starter'(end_of_file).
'$parse_tokens_is_starter'('(').
'$parse_tokens_is_starter'('[').
'$parse_tokens_is_starter'('{').
'$parse_tokens_is_starter'(number(_)).
'$parse_tokens_is_starter'(atom(_)).
'$parse_tokens_is_starter'(var(_,_)).
'$parse_tokens_is_starter'(string(_)).

'$parse_tokens_is_terminator'(')').
'$parse_tokens_is_terminator'(']').
'$parse_tokens_is_terminator'('}').
'$parse_tokens_is_terminator'('.').

'$parse_tokens_is_post_in_op'(',') :- !.
'$parse_tokens_is_post_in_op'('|') :- !.
'$parse_tokens_is_post_in_op'(atom(Op)) :-
	current_op(_, Type, Op),
	'$parse_tokens_post_in_type'(Type),
	!.

'$parse_tokens_post_in_type'(xfx).
'$parse_tokens_post_in_type'(xfy).
'$parse_tokens_post_in_type'(yfx).
'$parse_tokens_post_in_type'(xf).
'$parse_tokens_post_in_type'(yf).

'$parse_tokens_expect'(Token) -->
	'$parse_tokens_skip_spaces',
	[Token],
	!.
'$parse_tokens_expect'(Token) -->
	'$parse_tokens_error'([Token,expected]).

'$parse_tokens_skip_spaces' --> [' '], !, '$parse_tokens_skip_spaces'.
'$parse_tokens_skip_spaces' --> [].

'$parse_tokens_peep_next'(Next, S, S) :- S = [Next|_].

'$parse_tokens_error'(Message, S0, _S) :-
	clause('$tokens'(Tokens), _),
	raise_exception(syntax_error(Message, at(Tokens))),
	fail.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Term input/output (write)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public write/2.
:- public writeq/2.
:- public write_canonical/2.
:- public write_term/3.

write(S_or_a, Term) :-
	write_term(S_or_a, Term, [numbervars(true)]).

writeq(S_or_a, Term) :-
	write_term(S_or_a, Term, [quoted(true),numbervars(true)]).

write_canonical(S_or_a, Term) :-
	write_term(S_or_a, Term, [quoted(true),ignore_ops(true)]).

write_term(S_or_a, Term, Options) :-
	'$write_term'(S_or_a, Term, Options),
	fail.
write_term(_, _, _).

'$write_term'(S_or_a, Term, Options) :-
	'$write_term0'(Term, 1200, punct, _, Options, S_or_a),
	!.

'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :- 
	var(Term), 
	!,
	'$write_space_if_needed'(Type0, alpha, S_or_a),
	'$fast_write'(S_or_a, Term).
'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :- 
	java(Term), 
	!,
	'$write_space_if_needed'(Type0, alpha, S_or_a),
	'$fast_write'(S_or_a, Term).
'$write_term0'(Term, _Prec, Type0, alpha, Style, S_or_a) :-
	Term = '$VAR'(VN), integer(VN), VN >= 0,
	'$builtin_member'(numbervars(true), Style),
	!,
	'$write_space_if_needed'(Type0, alpha, S_or_a),
	'$write_VAR'(VN, S_or_a).
'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :- 
	number(Term), Term < 0, 
	!,
	'$write_space_if_needed'(Type0, symbol, S_or_a),
	'$fast_write'(S_or_a, Term).
'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :- 
	number(Term), 
	!,
	'$write_space_if_needed'(Type0, alpha, S_or_a),
	'$fast_write'(S_or_a, Term).
%'$write_term0'(Term, Prec, Type0, punct, _, S_or_a) :-
%	atom(Term), 
%	current_op(PrecOp, OpType, Term),
%	(OpType = fx ; OpType = fy),
%	PrecOp =< Prec,
%	!,
%	'$write_space_if_needed'(Type0, punct, S_or_a),
%	put_char(S_or_a, '('),
%	'$write_atom'(Term, punct, _, _, S_or_a),
%	put_char(S_or_a, ')').
'$write_term0'(Term, _Prec, Type0, Type, Style, S_or_a) :- 
	atom(Term), 
	!,
	'$write_atom'(Term, Type0, Type, Style, S_or_a).
'$write_term0'(Term, Prec, Type0, Type, Style, S_or_a) :-
	\+ '$builtin_member'(ignore_ops(true), Style),
	'$write_is_operator'(Term, Op, Args, OpType),
	!,
	'$write_term_op'(Op, OpType, Args, Prec, Type0, Type, Style, S_or_a).
'$write_term0'(Term, _Prec, Type0, punct, Style, S_or_a) :-
	Term = [_|_],
	\+ '$builtin_member'(ignore_ops(true), Style),
	!,
	'$write_space_if_needed'(Type0, punct, S_or_a),
	put_char(S_or_a, '['),
	'$write_term_list_args'(Term, punct, _, Style, S_or_a),
	put_char(S_or_a, ']').
'$write_term0'(Term, _Prec, Type0, _Type, Style, S_or_a) :-
	Term = {Term1},
	\+ '$builtin_member'(ignore_ops(true), Style),
	!,
	'$write_space_if_needed'(Type0, punct, S_or_a),
	put_char(S_or_a, '{'),
	'$write_term0'(Term1, 1200, punct, _, Style, S_or_a),
	put_char(S_or_a, '}').
'$write_term0'(Term, _Prec, Type0, punct, Style, S_or_a) :-
	Term =.. [F|Args],
	'$write_atom'(F, Type0, _, Style, S_or_a),
	put_char(S_or_a, '('),
	'$write_term_args'(Args, punct, _, Style, S_or_a),
	put_char(S_or_a, ')').

'$write_space_if_needed'(punct, _,     _     ) :- !.
'$write_space_if_needed'(X,     X,     S_or_a) :- !, put_char(S_or_a, ' ').
'$write_space_if_needed'(other, alpha, S_or_a) :- !, put_char(S_or_a, ' ').
'$write_space_if_needed'(_,     _,     _     ).

'$write_VAR'(VN, S_or_a) :- VN < 26, !,
	Letter is VN mod 26 + "A",
	put_code(S_or_a, Letter).
'$write_VAR'(VN, S_or_a) :-
	Letter is VN mod 26 + "A",
	put_code(S_or_a, Letter),
	Rest is VN//26,
	'$fast_write'(S_or_a, Rest).

'$write_atom'(Atom, Type0, Type, Style, S_or_a) :- 
	'$builtin_member'(quoted(true), Style), 
	!,
	'$atom_type'(Atom, Type), 
	'$write_space_if_needed'(Type0, Type, S_or_a),
	'$fast_writeq'(S_or_a, Atom).
'$write_atom'(Atom, Type0, Type, _, S_or_a) :-
	'$atom_type'(Atom, Type), 
	'$write_space_if_needed'(Type0, Type, S_or_a),
	'$fast_write'(S_or_a, Atom).

'$atom_type'(X, alpha ) :- '$atom_type0'(X, 0), !.
'$atom_type'(X, symbol) :- '$atom_type0'(X, 1), !.
'$atom_type'(X, punct ) :- '$atom_type0'(X, 2), !.
'$atom_type'(X, other ) :- '$atom_type0'(X, 3), !.

'$write_is_operator'(Term, Op, Args, OpType) :-
	functor(Term, Op, Arity),
	'$write_op_type'(Arity, OpType),
	current_op(_, OpType, Op),
	Term =.. [_|Args],
	!.

'$write_op_type'(1, fx).
'$write_op_type'(1, fy).
'$write_op_type'(1, xf).
'$write_op_type'(1, yf).
'$write_op_type'(2, xfx).
'$write_op_type'(2, xfy).
'$write_op_type'(2, yfx).

'$write_term_op'(Op, OpType, Args, Prec, Type0, punct, Style, S_or_a) :-
	current_op(PrecOp, OpType, Op), 
	PrecOp > Prec,
	!,
	'$write_space_if_needed'(Type0, punct, S_or_a),
	put_char(S_or_a, '('),
	'$write_term_op1'(Op, OpType, Args, PrecOp, punct, _, Style, S_or_a),
	put_char(S_or_a, ')').
'$write_term_op'(Op, OpType, Args, _Prec, Type0, Type, Style, S_or_a) :-
	current_op(PrecOp, OpType, Op),
	'$write_term_op1'(Op, OpType, Args, PrecOp, Type0, Type, Style, S_or_a).

'$write_term_op1'(Op, fx, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
	'$write_atom'(Op, Type0, Type1, Style, S_or_a),
	Prec1 is PrecOp - 1,
	'$write_term0'(A1, Prec1, Type1, Type, Style, S_or_a).
'$write_term_op1'(Op, fy, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
	'$write_atom'(Op, Type0, Type1, Style, S_or_a),
	Prec1 is PrecOp,
	'$write_term0'(A1, Prec1, Type1, Type, Style, S_or_a).
'$write_term_op1'(Op, xf, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
	Prec1 is PrecOp - 1,
	'$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
	'$write_atom'(Op, Type1, Type, Style, S_or_a).
'$write_term_op1'(Op, yf, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
	Prec1 is PrecOp,
	'$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
	'$write_atom'(Op, Type1, Type, Style, S_or_a).
'$write_term_op1'(Op, xfx, [A1,A2], PrecOp, Type0, Type, Style, S_or_a) :- !,
	Prec1 is PrecOp - 1,
	Prec2 is PrecOp - 1,
	'$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
	'$write_term_infix_op'(Op, Type1, Type2, Style, S_or_a),
	'$write_term0'(A2, Prec2, Type2, Type, Style, S_or_a).
'$write_term_op1'(Op, xfy, [A1,A2], PrecOp, Type0, Type, Style, S_or_a) :- !,
	Prec1 is PrecOp - 1,
	Prec2 is PrecOp,
	'$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
	'$write_term_infix_op'(Op, Type1, Type2, Style, S_or_a),
	'$write_term0'(A2, Prec2, Type2, Type, Style, S_or_a).
'$write_term_op1'(Op, yfx, [A1,A2], PrecOp, Type0, Type, Style, S_or_a) :- !,
	Prec1 is PrecOp,
	Prec2 is PrecOp - 1,
	'$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
	'$write_term_infix_op'(Op, Type1, Type2, Style, S_or_a),
	'$write_term0'(A2, Prec2, Type2, Type, Style, S_or_a).
	
'$write_term_infix_op'(',', Type0, punct, _, S_or_a) :- !,
	'$write_space_if_needed'(Type0, punct, S_or_a),
	put_char(S_or_a, ',').
'$write_term_infix_op'(Op, Type0, Type, Style, S_or_a) :-
	'$write_atom'(Op, Type0, Type, Style, S_or_a).

'$write_term_list_args'([A|As], Type0, Type, Style, S_or_a) :- 
	nonvar(As), As = [_|_], 
	!,
	'$write_term0'(A, 999, Type0, Type1, Style, S_or_a),
	'$write_space_if_needed'(Type1, punct, S_or_a),
	put_char(S_or_a, ','),
	'$write_term_list_args'(As, punct, Type, Style, S_or_a).

'$write_term_list_args'([A|As], Type0, Type, Style, S_or_a) :- 
	nonvar(As), As = [], 
	!,
	'$write_term0'(A, 999, Type0, Type, Style, S_or_a).

'$write_term_list_args'([A|As], Type0, Type, Style, S_or_a) :-
	'$write_term0'(A, 999, Type0, Type1, Style, S_or_a),
	'$write_space_if_needed'(Type1, punct, S_or_a),
	put_char(S_or_a, '|'),
	'$write_term0'(As, 999, punct, Type, Style, S_or_a).

'$write_term_args'([], Type, Type, _, _) :- !.
'$write_term_args'([A], Type0, Type, Style, S_or_a) :- !,
	'$write_term0'(A, 999, Type0, Type, Style, S_or_a).
'$write_term_args'([A|As], Type0, Type, Style, S_or_a) :- !,
	'$write_term0'(A, 999, Type0, Type1, Style, S_or_a),
	'$write_space_if_needed'(Type1, punct, S_or_a),
	put_char(S_or_a, ','),
	'$write_term_args'(As, punct, Type, Style, S_or_a).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Term input/output (others)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public op/3.
:- public current_op/3.
:- dynamic '$current_operator'/3.

op(Priority, Op_specifier, Operator) :-
	integer(Priority), 
	0 =<Priority, Priority =<1200,
	!,
	'$op1'(Priority, Op_specifier, Operator).
op(Priority, Op_specifier, Operator) :-
        illarg(domain(integer,0-1200), op(Priority,Op_specifier,Operator), 1).

'$op1'(Priority, Op_specifier, Operator) :- 
	nonvar(Op_specifier),
	'$op_specifier'(Op_specifier, _),
	!,
	'$op2'(Priority, Op_specifier, Operator).
'$op1'(Priority, Op_specifier, Operator) :- 
        findall(X, '$op_specifier'(X,_), Domain), 
	illarg(domain(term,Domain), op(Priority,Op_specifier,Operator), 2).

'$op2'(Priority, Op_specifier, Operator) :- 
	atom(Operator), 
	!,
	'$add_operators'([Operator], Priority, Op_specifier).
'$op2'(Priority, Op_specifier, Operator) :- 
	'$op_atom_list'(Operator, Atoms),
	!,
	'$add_operators'(Atoms, Priority, Op_specifier).
'$op2'(Priority, Op_specifier, Operator) :- 
        illarg(type(list(atom)), op(Priority,Op_specifier,Operator), 3).

'$add_operators'([], _, _) :- !.
'$add_operators'([A|As], Priority, Op_specifier) :- 
	'$add_op'(A, Priority, Op_specifier),
	'$add_operators'(As, Priority, Op_specifier).

'$add_op'(',', Priority, Op_specifier) :- !,
	illarg(permission(modify,operator,',',_), op(Priority,Op_specifier,','), 3).
'$add_op'(A, _, Op_specifier) :-
	clause('$current_operator'(_,Op_specifier0,A), _),
	'$op_specifier'(Op_specifier, Class),
	'$op_specifier'(Op_specifier0, Class0),
	Class = Class0,
	retract('$current_operator'(_,Op_specifier0,A)),
	fail.
'$add_op'(_, 0, _) :- !.
'$add_op'(A, Priority, Op_specifier) :-
	assertz('$current_operator'(Priority,Op_specifier,A)).

'$op_specifier'( fx, prefix).
'$op_specifier'( fy, prefix).
'$op_specifier'(xfx, infix).
'$op_specifier'(xfy, infix).
'$op_specifier'(yfx, infix).
'$op_specifier'( xf, postfix).
'$op_specifier'( yf, postfix).

'$op_atom_list'(X, _) :- var(X), !, fail.
'$op_atom_list'([], []) :- !.
'$op_atom_list'([X|Xs], [X|As]) :- atom(X), !,
	'$op_atom_list'(Xs, As).

current_op(Priority, Op_specifier, Operator) :-
	clause('$current_operator'(Priority,Op_specifier,Operator), _).

'$current_operator'( 1200, xfx, (:-)).
'$current_operator'( 1200, xfx, (-->)).
'$current_operator'( 1200,  fx, (:-)).
'$current_operator'( 1200,  fx, (?-)).
'$current_operator'( 1150,  fx, (package)).
'$current_operator'( 1150,  fx, (import)).
'$current_operator'( 1150,  fx, (public)).
'$current_operator'( 1150,  fx, (dynamic)).
'$current_operator'( 1150,  fx, (meta_predicate)).
'$current_operator'( 1150,  fx, (mode)).
'$current_operator'( 1150,  fx, (multifile)).
'$current_operator'( 1150,  fx, (block)).
'$current_operator'( 1100, xfy, (;)).
'$current_operator'( 1050, xfy, (->)).
'$current_operator'( 1000, xfy, (',')).
'$current_operator'(  900,  fy, (\+)).
'$current_operator'(  700, xfx, (=)).
'$current_operator'(  700, xfx, (\=)).
'$current_operator'(  700, xfx, (==)).
'$current_operator'(  700, xfx, (\==)).
'$current_operator'(  700, xfx, (@<)).
'$current_operator'(  700, xfx, (@>)).
'$current_operator'(  700, xfx, (@=<)).
'$current_operator'(  700, xfx, (@>=)).
'$current_operator'(  700, xfx, (=..)).
'$current_operator'(  700, xfx, (is)).
'$current_operator'(  700, xfx, (=:=)).
'$current_operator'(  700, xfx, (=\=)).
'$current_operator'(  700, xfx, (<)).
'$current_operator'(  700, xfx, (>)).
'$current_operator'(  700, xfx, (=<)).
'$current_operator'(  700, xfx, (>=)).
'$current_operator'(  550, xfy, (:)).
'$current_operator'(  500, yfx, (+)).
'$current_operator'(  500, yfx, (-)).
'$current_operator'(  500, yfx, (#)).
'$current_operator'(  500, yfx, (/\)).
'$current_operator'(  500, yfx, (\/)).
'$current_operator'(  500,  fx, (+)).
'$current_operator'(  400, yfx, (*)).
'$current_operator'(  400, yfx, (/)).
'$current_operator'(  400, yfx, (//)).
'$current_operator'(  400, yfx, (mod)).
'$current_operator'(  400, yfx, (rem)).
'$current_operator'(  400, yfx, (<<)).
'$current_operator'(  400, yfx, (>>)).
'$current_operator'(  300, xfx, (~)).
'$current_operator'(  200, xfx, (**)).
'$current_operator'(  200, xfy, (^)).
'$current_operator'(  200,  fy, (\)).
'$current_operator'(  200,  fy, (-)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Logic and control
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public (\+)/1.
:- public once/1.
:- public repeat/0.

\+(G) :- call(G), !, fail.
\+(_).

repeat.
repeat :- repeat.

once(G) :- call(G), !.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Atomic term processing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%:- public atom_length/2.                  written in Java
%:- public atom_concat/3.                  written in Java
:- public sub_atom/5.
%:- public atom_chars/2, atom_codes/2.     written in Java
%:- public char_code/2.                    written in Java
%:- public number_chars/2, number_codes/2. written in Java
:- public name/2.
%:- public regex_compile/2.                written in Java
%:- public regex_match/3.                  written in Java
:- public regex_matches/3.
:- public regex_matches/2.

sub_atom(Atom, Before, Length, After, Sub_atom) :-
    atom_concat(AtomL, X, Atom),
    atom_length(AtomL, Before),
    atom_concat(Sub_atom, AtomR, X),
    atom_length(Sub_atom, Length),
    atom_length(AtomR, After).

name(Constant, Chars) :-
	nonvar(Constant),
	(   number(Constant) -> number_codes(Constant, Chars)
	;   atomic(Constant) -> atom_codes(Constant, Chars)
	;   illarg(type(atomic), name(Constant,Chars), 1)
	).
name(Constant, Chars) :-
	var(Constant),
	(   number_codes(Constant0, Chars) -> Constant = Constant0
	;   atom_codes(Constant0, Chars) -> Constant = Constant0
	;   illarg(type(list(char)), name(Constant,Chars), 2)
	).

regex_matches(_, [], _) :- !, fail.
regex_matches(Pattern, List, Result) :-
	List = [_ | _],
	!,
	regex_list(Pattern, List, Result).
regex_matches(Pattern, String, Result) :-
	atom(String),
	regex_compile(Pattern, Matcher),
	regex_match(Matcher, String, Result).

regex_matches(Pattern, String) :-
	once(regex_matches(Pattern, String, _)).

regex_list(Pattern, [H | _ ], Result) :- regex_matches(Pattern, H, Result).
regex_list(Pattern, [_ | Ls], Result) :- regex_list(Pattern, Ls, Result).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Implementation defined hooks
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public set_prolog_flag/2.
:- public current_prolog_flag/2.

set_prolog_flag(Flag, Value) :- var(Flag), !, 
	illarg(var, set_prolog_flag(Flag,Value), 1).
set_prolog_flag(Flag, Value) :- var(Value), !, 
	illarg(var, set_prolog_flag(Flag,Value), 2).
set_prolog_flag(Flag, Value) :- atom(Flag), !, 
	'$set_prolog_flag0'(Flag, Value).
set_prolog_flag(Flag, Value) :- 
	illarg(type(atom), set_prolog_flag(Flag,Value), 1).

'$set_prolog_flag0'(Flag, Value) :- 
	'$prolog_impl_flag'(Flag, Mode, changeable(YN)),
	!,
	'$set_prolog_flag0'(YN, Flag, Value, Mode).
'$set_prolog_flag0'(Flag, Value) :- 
	illarg(domain(atom,prolog_flag), set_prolog_flag(Flag,Value), 1).

'$set_prolog_flag0'(no, Flag, Value, _) :- !,
        illarg(permission(modify,flag,Flag,_), set_prolog_flag(Flag,Value), _).
'$set_prolog_flag0'(_, Flag, Value, Mode) :-
	'$builtin_member'(Value, Mode),
	!,
	'$set_prolog_impl_flag'(Flag, Value).
'$set_prolog_flag0'(_, Flag, Value, _) :-
	illarg(domain(atom,flag_value), set_prolog_flag(Flag,Value), 2).

current_prolog_flag(Flag, Term) :- var(Flag), !,
	'$prolog_impl_flag'(Flag, _, _),
	'$get_prolog_impl_flag'(Flag, Term).
current_prolog_flag(Flag, Term) :- atom(Flag), !,
	(   '$prolog_impl_flag'(Flag, _, _) -> '$get_prolog_impl_flag'(Flag, Term)
        ;   illarg(domain(atom,prolog_flag), current_prolog_flag(Flag,Term), 1)
        ).
current_prolog_flag(Flag, Term) :- 
	illarg(type(atom), current_prolog_flag(Flag,Term), 1).

'$prolog_impl_flag'(debug, [on,off], changeable(yes)).
'$prolog_impl_flag'(max_arity, _, changeable(no)).

:- public halt/0.
:- public abort/0.

halt :- halt(0).
abort :- raise_exception('Execution aborted').

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% DCG
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public 'C'/3, expand_term/2.

'C'([X|S], X, S).

expand_term(Dcg, Cl) :- var(Dcg), !, Dcg = Cl.
expand_term(Dcg, Cl) :- '$dcg_expansion'(Dcg, Cl0), !, Cl0 = Cl.
expand_term(Dcg, Dcg).

'$dcg_expansion'(Dcg, Cl) :- var(Dcg), !, Dcg = Cl.
'$dcg_expansion'((Head --> B), (H1 :- G1, G2)) :-
	nonvar(Head),
	Head = (H, List),
	List = [_|_],
	!,
	'$dcg_translation_atom'(H, H1, S0, S1),
	'$dcg_translation'(B, G1, S0, S),
	'$dcg_translation'(List, G2, S1, S).
'$dcg_expansion'((H --> B), (H1 :- B1)) :-
	'$dcg_translation_atom'(H, H1, S0, S),
	'$dcg_translation'(B, B1, S0, S).

'$dcg_translation_atom'(X, phrase(X,S0,S), S0, S) :- 
	var(X),
	!.
'$dcg_translation_atom'(M:X, M:X1, S0, S) :- !,
	'$dcg_translation_atom'(X, X1, S0, S).
'$dcg_translation_atom'(X, X1, S0, S) :-
	X =.. [F|As],
	'$builtin_append'(As, [S0,S], As1),
	X1 =.. [F|As1].

'$dcg_translation'(X, Y, S0, S) :-
	'$dcg_trans'(X, Y0, T, S0, S),
	'$dcg_trans0'(Y0, Y, T, S0, S).

'$dcg_trans0'(Y, Y, T, S0, T) :- T \== S0, !.
'$dcg_trans0'(Y0, Y, T, _, S) :- '$dcg_concat'(Y0, S=T, Y).

'$dcg_concat'(X, Y, Z) :- X == true, !, Z = Y.
'$dcg_concat'(X, Y, Z) :- Y == true, !, Z = X.
'$dcg_concat'(X, Y, (X,Y)).

'$dcg_trans'(X, X1, S, S0, S) :- var(X), !,
	'$dcg_translation_atom'(X, X1, S0, S).
'$dcg_trans'(M:X, M:Y, T, S0, S) :- !,
	'$dcg_trans'(X, Y, T, S0, S).
'$dcg_trans'([], true, S0, S0, _) :- !.
'$dcg_trans'([X|Y], Z, T, S0, S) :- !,
	'$dcg_trans'(Y, Y1, T, S1, S),
	'$dcg_concat'('C'(S0,X,S1), Y1, Z).
'$dcg_trans'(\+X, (X1 -> fail; S=S0), S, S0, S) :- !,
	'$dcg_trans'(X, X1, S1, S0, S1).
'$dcg_trans'((X,Y), Z, T, S0, S) :- !,
	'$dcg_trans'(X, X1, S1, S0, S1),
	'$dcg_trans'(Y, Y1, T, S1, S),
	'$dcg_concat'(X1, Y1, Z).
'$dcg_trans'((X->Y), (X1->Y1), T, S0, S) :- !,
	'$dcg_trans'(X, X1, S1, S0, S1),
	'$dcg_trans'(Y, Y1, T, S1, S).
'$dcg_trans'((X;Y), (X1;Y1), S, S0, S) :- !,
	'$dcg_translation'(X, X1, S0, S),
	'$dcg_translation'(Y, Y1, S0, S).
'$dcg_trans'(!, !, S0, S0, _) :- !.
'$dcg_trans'({G}, call(G), S0, S0, _) :- var(G), !.
'$dcg_trans'({G}, G, S0, S0, _) :- !.
'$dcg_trans'(X, X1, S, S0, S) :-
	'$dcg_translation_atom'(X, X1, S0, S).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Hash creation and control
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public new_hash/1.
:- public hash_map/2.
:- public hash_exists/1.

new_hash(Hash) :- new_hash(Hash, []).

hash_map(H_or_a, List) :-
	hash_keys(H_or_a, Ks0),
	sort(Ks0, Ks),
	hash_map(Ks, List, H_or_a).

hash_map([], [], _) :- !.
hash_map([K|Ks], [(K,V)|Ls], H_or_a) :-
	hash_get(H_or_a, K, V),
	hash_map(Ks, Ls, H_or_a).

hash_exists(Alias) :-
  atom(Alias),
  '$get_hash_manager'(HM),
  hash_contains_key(HM, Alias).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Prolog interpreter
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- op(1170, xfx, (:-)).
:- op(1170, xfx, (-->)).
:- op(1170,  fx, (:-)).
:- op(1170,  fx, (?-)).

:- op(1150,  fx, (package)).
:- op(1150,  fx, (import)).
:- op(1150,  fx, (public)).
:- op(1150,  fx, (dynamic)).
:- op(1150,  fx, (meta_predicate)).
:- op(1150,  fx, (mode)).
:- op(1150,  fx, (multifile)).
:- op(1150,  fx, (block)).

:- public consult_stream/1.
:- dynamic '$consulted_file'/1.
:- dynamic '$consulted_import'/2.
:- dynamic '$consulted_package'/1.
:- dynamic '$consulted_predicate'/3.

%%% Read Program

consult_stream(File, In) :-
	'$consult_init'(File),
	repeat,
	    read(In, Cl),
	    '$consult_clause'(Cl),
	    Cl == end_of_file,
	    !.

'$consult_init'(File) :-
	retractall('$consulted_file'(_)),
	retractall('$consulted_package'(_)),
	retractall('$consulted_import'(File, _)),
	retract('$consulted_predicate'(P,PI,File)),
	abolish(P:PI),
	fail.
'$consult_init'(File) :-
	assertz('$consulted_file'(File)),
	assertz('$consulted_package'(user)).

'$consult_clause'(end_of_file          ) :- !.
'$consult_clause'((:- module(P,_))     ) :- !, '$assert_consulted_package'(P).
'$consult_clause'((:- package P)       ) :- !, '$assert_consulted_package'(P).
'$consult_clause'((:- import P)        ) :- !, '$assert_consulted_import'(P).
'$consult_clause'((:- dynamic _)       ) :- !.
'$consult_clause'((:- public _)        ) :- !.
'$consult_clause'((:- meta_predicate _)) :- !.
'$consult_clause'((:- mode _)          ) :- !.
'$consult_clause'((:- multifile _)     ) :- !.
'$consult_clause'((:- block _)         ) :- !.
'$consult_clause'((:- G)               ) :- !, clause('$consulted_package'(P), _), once(P:G).
'$consult_clause'(Clause0) :- 
	'$consult_preprocess'(Clause0, Clause), 
	'$consult_cls'(Clause).

'$assert_consulted_package'(P) :-
	clause('$consulted_package'(P), _),
	!.
'$assert_consulted_package'(P) :-
	retractall('$consulted_package'(_)),
	assertz('$consulted_package'(P)).

'$assert_consulted_import'(P) :-
	clause('$consulted_file'(File), _),
	assertz('$consulted_import'(File, P)).

'$consult_preprocess'(Clause0, Clause) :-
	expand_term(Clause0, Clause).

'$consult_cls'((H :- G)) :- !, '$assert_consulted_clause'((H :- G)).
'$consult_cls'(H) :- '$assert_consulted_clause'((H :- true)).

'$assert_consulted_clause'(Clause) :-
	Clause = (H :- _),
	functor(H, F, A),
	clause('$consulted_file'(File), _),
	clause('$consulted_package'(P), _),
	assertz(P:Clause),
	assertz('$consulted_predicate'(P,F/A,File)),
	!.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Misc
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- public reverse/2.
:- public length/2.
:- public numbervars/3.
:- public statistics/2.

reverse(Xs, Zs) :- reverse(Xs, [], Zs).
reverse([], Zs, Zs).
reverse([X|Xs], Tmp, Zs) :- reverse(Xs, [X|Tmp], Zs).

length(L, N) :- var(N), !, '$length'(L, 0, N).
length(L, N) :- '$length0'(L, 0, N).

'$length'([], I, I).
'$length'([_|L], I0, I) :- I1 is I0+1, '$length'(L, I1, I).

'$length0'([], I, I) :- !.
'$length0'([_|L], I0, I) :- I0 < I, I1 is I0+1, '$length0'(L, I1, I).

numbervars(X, VI, VN) :- 
	integer(VI), VI >= 0, 
	!,
	'$numbervars'(X, VI, VN).

'$numbervars'(X, VI, VN) :- var(X), !,
	X = '$VAR'(VI),	  % This structure is checked in write
	VN is VI + 1.
'$numbervars'(X, VI, VI) :- atomic(X), !.
'$numbervars'(X, VI, VI) :- java(X), !.
'$numbervars'(X, VI, VN) :-
	functor(X, _, N),
	'$numbervars_str'(1, N, X, VI, VN).

'$numbervars_str'(I, I, X, VI, VN) :- !,
	arg(I, X, A),
	'$numbervars'(A, VI, VN).
'$numbervars_str'(I, N, X, VI, VN) :-
	arg(I, X, A),
	'$numbervars'(A, VI, VN1),
	I1 is I + 1,
	'$numbervars_str'(I1, N, X, VN1, VN).

statistics(Key, Value) :- 
	nonvar(Key), 
	'$statistics_mode'(Key), 
	!,
	'$statistics'(Key, Value).
statistics(Key, Value) :- 
	findall(M, '$statistics_mode'(M), Domain),
	illarg(domain(atom,Domain), statistics(Key,Value), 1).

'$statistics_mode'(runtime).
'$statistics_mode'(trail).
'$statistics_mode'(choice).

illarg(Msg, Goal, ArgNo) :- var(Msg), !,
	illarg(var, Goal, ArgNo).
illarg(var, Goal, ArgNo) :-
	raise_exception(instantiation_error(Goal, ArgNo)).
illarg(type(Type), Goal, ArgNo) :- 
	arg(ArgNo, Goal, Arg),
	(  nonvar(Arg) -> 
	   Error = type_error(Goal,ArgNo,Type,Arg)
	;  Error = instantiation_error(Goal,ArgNo)
	),
	raise_exception(Error).
illarg(domain(Type,ExpDomain), Goal, ArgNo) :-
	arg(ArgNo, Goal, Arg),
	(  '$match_type'(Type, Arg) ->
	   Error = domain_error(Goal,ArgNo,ExpDomain,Arg)
	;  nonvar(Arg) ->
	   Error = type_error(Goal,ArgNo,Type,Arg)
	;  Error = instantiation_error(Goal,ArgNo)
	),
	raise_exception(Error).
illarg(existence(ObjType,Culprit,Message), Goal, ArgNo) :-
	raise_exception(existence_error(Goal,ArgNo,ObjType,Culprit,Message)).
illarg(permission(Operation, ObjType, Culprit, Message), Goal, _) :-
	raise_exception(permission_error(Goal,Operation,ObjType,Culprit,Message)).
illarg(representation(Flag), Goal, ArgNo) :- 
	raise_exception(representation_error(Goal,ArgNo,Flag)).
illarg(evaluation(Type), Goal, ArgNo) :- 
	raise_exception(evaluation_error(Goal,ArgNo,Type)).
illarg(syntax(Type,Culprit,Message), Goal, ArgNo) :- 
	raise_exception(syntax_error(Goal,ArgNo,Type,Culprit,Message)).
illarg(system(Message), _, _) :- 
	raise_exception(system_error(Message)).
illarg(internal(Message), _, _) :- 
	raise_exception(internal_error(Message)).
illarg(java(Exception), Goal, ArgNo) :- 
	raise_exception(java_error(Goal,ArgNo,Exception)).
illarg(Msg, _, _) :- raise_exception(Msg).

'$match_type'(term,         _).
'$match_type'(variable,     X) :- var(X).
'$match_type'(atom,         X) :- atom(X).
'$match_type'(atomic,       X) :- atomic(X).
'$match_type'(byte,         X) :- integer(X), 0 =< X, X =< 255.
'$match_type'(in_byte,      X) :- integer(X), -1 =< X, X =< 255.
'$match_type'(character,    X) :- atom(X), atom_length(X, 1).
'$match_type'(in_character, X) :- (X == 'end_of_file' ; '$match_type'(character,X)).
'$match_type'(number,       X) :- number(X).
'$match_type'(integer,      X) :- integer(X).
'$match_type'(float,        X) :- float(X).
'$match_type'(callable,     X) :- callable(X).
'$match_type'(compound,     X) :- compound(X).
'$match_type'(list,         X) :- nonvar(X), (X = [] ; X = [_|_]).
'$match_type'(java,         X) :- java(X).
'$match_type'(stream,       X) :- (java(X, 'java.io.PushbackReader') ; java(X, 'java.io.PrintWriter')).
'$match_type'(stream_or_alias, X) :- (atom(X) ; '$match_type'(stream, X)).
'$match_type'(hash,         X) :- java(X, 'com.googlecode.prolog_cafe.lang.HashtableOfTerm').
'$match_type'(hash_or_alias,X) :- (atom(X) ; '$match_type'(hash, X)).
'$match_type'(predicate_indicator, X) :- 
	nonvar(X), 
	X = P:F/A, 
	atom(P),
	atom(F),
	integer(A).
%'$match_type'(evaluable,    X).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Utilities
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'$builtin_append'([], Zs, Zs).
'$builtin_append'([X|Xs], Ys, [X|Zs]) :- '$builtin_append'(Xs, Ys, Zs).

'$builtin_member'(X, [X|_]).
'$builtin_member'(X, [_|L]) :- '$builtin_member'(X, L).	

'$member_in_reverse'(X, [_|L]) :- '$member_in_reverse'(X, L).
'$member_in_reverse'(X, [X|_]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% END