与 STO 检测的统一
Unification with STO detection
在 ISO Prolog 中,统一仅针对 NSTO(不受发生检查)的情况定义。背后的想法是涵盖那些在程序中最常使用并且实际上被所有 Prolog 系统支持的统一案例。更具体地说,ISO/IEC 13211-1:1995 内容如下:
7.3.3 Subject to occurs-check (STO) and not subject
to occurs-check (NSTO)
A set of equations (or two terms) is "subject to occurs-
check" (STO) iff there exists a way to proceed through
the steps of the Herbrand Algorithm such that 7.3.2 g
happens.
A set of equations (or two terms) is "not subject to
occurs-check" (NSTO) iff there exists no way to proceed
through the steps of the Herbrand Algorithm such that
7.3.2 g happens.
...
这步7.3.2g写着:
g) If there is an equation of the form X = t such
that X is a variable and t is a non-variable term
which contains this variable, then exit with failure (not
unifiable, positive occurs-check).
完整的算法称为 Herbrand 算法,通常被称为 Martelli-Montanari unification algorithm - 它主要通过以 非确定性 方式重写方程组来进行.
请注意,引入了新方程式:
d) If there is an equation of the form f(a1,a2, ...aN) =
f(b1,b2, ...bN) then replace it by the set of equations
ai = bi.
这意味着具有相同函子但不同元数的两个复合项永远不会影响 STO-ness。
这种不确定性是 STO 测试难以实施的原因。毕竟,仅仅测试是否需要发生检查是不够的,但要证明对于所有可能的算法执行方式,这种情况永远不会发生。
这里用一个案例来说明情况:
?- A/B+C*D = 1/2+3*4.
统一可能从 A = 1
开始,但也可能是其他任何对,并以任何顺序继续。为确保NSTO属性,必须确保没有可能产生STO情况的路径。考虑一个对于当前实现没有问题,但仍然是 STO 的情况:
?- 1+A = 2+s(A).
Prolog 系统首先将此等式重写为:
?- 1 = 2, A = s(A).
现在,他们任选其一
1 = 2
使算法失败退出,或
A = s(A)
其中应用步骤 g 并检测到 STO-ness。
我的问题是双重的。首先,它是关于 unify_sto(X,Y)
(仅使用第 1 部分的 defined built-ins)的 ISO Prolog 中的实现,以下内容适用:
如果统一为STO,则unify_sto(X,Y)
产生错误,否则
如果unify_sto(X,Y)
成功那么X = Y
也会成功
如果unify_sto(X,Y)
失败那么X = Y
也会失败
我的第二个问题是关于在这种情况下要发出的具体错误。参见 ISO 的 error classes.
这是一个简单的开始步骤:所有成功案例都包含在 unify_with_occurs_check(X,Y)
的成功案例中。剩下要做的是区分 NSTO 故障和 STO 错误情况。那是事情开始变得困难...
在 SWI-prolog 中:
unify_sto(X,Y) :-
\+ unify_with_occurs_check(X,Y),
X = Y,
!,
writeln('Error: NSTO failure'),
fail.
unify_sto(X,Y) :-
X = Y.
给出以下结果:
[debug] ?- unify_sto(X,s(X)).
Error: NSTO failure
false.
[debug] ?- unify_sto(X,a).
X = a.
[debug] ?- unify_sto(b,a).
false.
这是我的尝试:
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, XG),
term_general(Y, YG),
\+(unify_sto1(XG,YG)),
throw(error(type_error(acyclic,unify(X,Y)),_))
).
unify_sto1(X, Y):-
unify_with_occurs_check(X,Y).
unify_sto1(X, Y):-
X\=Y.
term_general(X, Y):-
(var(X) -> Y=X ;
(atomic(X) -> Y=_ ;
(
X=..[Functor|L],
term_general1(L, NL),
Y=..[Functor|NL]
))).
term_general1([X|XTail], [Y|YTail]):-
term_general(X, Y),
term_general1(XTail, YTail).
term_general1([], []).
它首先尝试unify_with_occurs_check
,如果没有成功,则继续为每个参数构建一个更通用的术语,然后它尝试统一这样的术语并测试它是否是循环的.如果它是循环的,则抛出 非循环 类型的 type_error
。
例如:
?- unify_sto(1+A,2+s(A)).
ERROR: Unhandled exception: error(type_error(acyclic,unify(1+_G3620,2+s(_G3620))))
再次尝试:
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, Y, XG, YG),
\+(unify_sto1(XG,YG)),
throw(error(type_error(acyclic,unify(X,Y)),_))
).
unify_sto1(X, Y):-
unify_with_occurs_check(X,Y).
unify_sto1(X, Y):-
X\=Y.
term_general(X, Y, XG, YG):-
((var(X) ; var(Y)) -> (XG=X, YG=Y) ;
((
functor(X, Functor, Len),
functor(Y, Functor, Len),
X=..[_|XL],
Y=..[_|YL],
term_general1(XL, YL, NXL, NYL)
) ->
(
XG=..[Functor|NXL],
YG=..[Functor|NYL]
) ;
( XG=_, YG=_ )
)).
term_general1([X|XTail], [Y|YTail], [XG|XGTail], [YG|YGTail]):-
term_general(X, Y, XG, YG),
term_general1(XTail, YTail, XGTail, YGTail).
term_general1([], [], [], []).
它首先尝试 unify_with_occurs_check,如果没有成功,则继续构建两个更通用的术语,遍历每个术语的结构。
- 如果其中一个项是变量,则两个项都保持原样。
- 如果这两个术语是同一个原子,或者如果它们都是具有相同特征的化合物术语
functor 和 arity [*],它遍历它的参数使得更多
他们的总称。
- 否则它会为每个术语分配一个新的变量。
然后它再次尝试 unify_with_occurs_check 更一般的术语
测试非循环统一并相应地抛出错误。
[*] 复合术语中的 arity 测试是贪婪地完成的,因为 term_general1/4
将失败递归,因为 OP 声明仅使用内置link 第 1 部分中定义的谓词不包括 length/2
.。 (已编辑: 添加了两个 functor/3
调用以在调用 term_general1 之前测试仿函数 和 arity,以免尝试如果他们的数量不匹配,检查内部条款)
例如:
?- unify_sto(s(1)+A,A+s(B)).
A = s(1),
B = 1
?- unify_sto(1+A,2+s(A)).
ERROR: Type error: `acyclic' expected, found `unify(1+_G5322,2+s(_G5322))'
?- unify_sto(a(1)+X,b(1)+s(X)).
ERROR: Type error: `acyclic' expected, found `unify(a(1)+_G7068,b(1)+s(_G7068))'
编辑 2015 年 6 月 2 日:
上述解决方案对查询失败:
unify_sto(A+A,a(A)+b(A)).
是否不会产生统一错误。
这里对成对处理每个子项并在发现错误后立即产生错误的算法进行了改进:
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, Y, unify(X,Y), XG, YG),
\+unify_with_occurs_check(XG,YG),
throw(error(type_error(acyclic,unify(X,Y)),_))
).
unify_sto1(X, Y):-
unify_with_occurs_check(X,Y).
unify_sto1(X, Y):-
X\=Y.
term_general(X, Y, UnifyTerm, XG, YG):-
((var(X) ; var(Y)) -> (XG=X, YG=Y) ;
((
functor(X, Functor, Len),
functor(Y, Functor, Len),
X=..[Functor|XL],
Y=..[Functor|YL],
term_general1(XL, YL, UnifyTerm, NXL, NYL)
) ->
(
XG=..[Functor|NXL],
YG=..[Functor|NYL]
) ;
( XG=_, YG=_ )
)).
term_general1([X|XTail], [Y|YTail], UnifyTerm, [XG|XGTail], [YG|YGTail]):-
term_general(X, Y, UnifyTerm, XG, YG),
\+(unify_with_occurs_check(XG,YG))-> throw(error(type_error(acyclic,UnifyTerm),_)) ;
term_general1(XTail, YTail, UnifyTerm, XGTail, YGTail).
term_general1([], [], _, [], []).
在原始答案中产生错误结果的查询的测试用例:
?- unify_sto(A+A,a(A)+b(A)).
ERROR: Type error: `acyclic' expected, found `unify(_G6902+_G6902,a(_G6902)+b(_G6902))'
?- unify_sto(A+A, a(_)+b(A)).
ERROR: Type error: `acyclic' expected, found `unify(_G5167+_G5167,a(_G5173)+b(_G5167))'
第三次尝试。这主要是先前答案中的错误修复(已经有很多修改)。
编辑:2015 年 6 月 4 日
在创建一个更通用的术语时,如果其中一个是变量,我会按原样保留两个子术语。现在,我在这种情况下通过调用 term_general/2
.
为 "other" 子项构建了一个更通用的术语
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, Y, unify(X,Y), XG, YG),
\+unify_with_occurs_check(XG,YG),
throw(error(type_error(acyclic, unify(X,Y)),_))
).
term_general(X, Y, UnifyTerm, XG, YG):-
(var(X) -> (XG=X, term_general(Y, YG)) ;
(var(Y) -> (YG=Y, term_general(X, XG)) ;
((
functor(X, Functor, Len),
functor(Y, Functor, Len),
X=..[_|XL],
Y=..[_|YL],
term_general1(XL, YL, UnifyTerm, NXL, NYL)
) ->
(
XG=..[Functor|NXL],
YG=..[Functor|NYL]
) ;
( XG=_, YG=_ )
))).
term_general1([X|XTail], [Y|YTail], UnifyTerm, [XG|XGTail], [YG|YGTail]):-
term_general(X, Y, UnifyTerm, XG, YG),
(
\+(unify_with_occurs_check(XG,YG)) ->
throw(error(type_error(acyclic,UnifyTerm),_)) ;
term_general1(XTail, YTail, UnifyTerm, XGTail, YGTail)
).
term_general1([], [], _, [], []).
term_general(X, XG):-
(var(X) -> XG=X ;
(atomic(X) -> XG=_ ;
(
X=..[_|XL],
term_general1(XL, XG)
))).
term_general1([X|XTail], [XG|XGTail]):-
term_general(X, XG),
term_general1(XTail, XGTail).
term_general1([], _).
这里是这个问题中到目前为止提到的单元测试:
unit_tests:-
member([TermA,TermB], [[_A+_B,_C+_D], [_E+_F, 1+2],
[a(_G+1),a(1+_H)], [a(1), b(_I)],
[A+A,a(B)+b(B)], [A+A,a(B,1)+b(B)]]),
(unify_sto(TermA, TermB)->Unifies=unifies ; Unifies=does_not_unify),
writeln(test(TermA, TermB, Unifies)),
fail.
unit_tests:-
member([TermA,TermB], [[A+A,B+a(B)], [A+A,A+b(A)],
[A+A,a(_)+b(A)], [1+A,2+s(A)],
[a(1)+X,b(1)+s(X)]]),
catch(
(
(unify_sto(TermA, TermB)->true;true),
writeln(test_failed(TermA, TermB))
), E, writeln(test_ok(E))),
fail.
unit_tests.
这是我用来测试@gusbro 版本的版本。这个想法是从字面上使用 Martelli-Montanari。通过重写方程列表 [X1=Y1,X2=Y2|Etc]
,某些重写规则会立即应用 - 使用 !为承诺。对于某些规则,我不太确定,所以我将它们保留为与原始算法一样不确定。
请注意 rewrite_sto/1
将失败或产生错误。我们对成功案例不感兴趣,它是在没有任何搜索的情况下处理的。另外,请注意,可以消除导致(立即)失败的方程式!这有点不直观,但我们在这里只对查找 STO 案例感兴趣。
unify_with_sto_check(X,Y) :-
( \+ unify_with_occurs_check(X, Y)
-> rewrite_sto([X=Y]) % fails or error
; X = Y
).
rewrite_sto(Xs0) :-
select(X=Y, Xs0,Xs),
( X == Y
; nonvar(X), nonvar(Y),
functor(X,F,A),
\+ functor(Y,F,A)
; var(X), var(Y),
X = Y
),
!,
rewrite_sto(Xs).
rewrite_sto(Xs0) :-
select(X=Y, Xs0, Xs1),
nonvar(X), nonvar(Y),
functor(X,F,A),
functor(Y,F,A),
!,
X =.. [_|XArgs],
Y =.. [_|YArgs],
maplist(\Xi^Yi^(Xi=Yi)^true, XArgs, YArgs, XYs),
append(XYs,Xs1,Xs),
rewrite_sto(Xs).
rewrite_sto(Xs0) :-
select(X=Y, Xs0,Xs),
( var(X), nonvar(Y) -> unify_var_term(X, Y)
; nonvar(X), var(Y) -> unify_var_term(Y, X)
; throw(impossible)
),
rewrite_sto(Xs).
unify_var_term(V, Term) :-
( unify_with_occurs_check(V, Term) -> true
; throw(error(type_error(acyclic_term, Term), _))
).
在 ISO Prolog 中,统一仅针对 NSTO(不受发生检查)的情况定义。背后的想法是涵盖那些在程序中最常使用并且实际上被所有 Prolog 系统支持的统一案例。更具体地说,ISO/IEC 13211-1:1995 内容如下:
7.3.3 Subject to occurs-check (STO) and not subject
to occurs-check (NSTO)A set of equations (or two terms) is "subject to occurs-
check" (STO) iff there exists a way to proceed through
the steps of the Herbrand Algorithm such that 7.3.2 g
happens.A set of equations (or two terms) is "not subject to
occurs-check" (NSTO) iff there exists no way to proceed
through the steps of the Herbrand Algorithm such that
7.3.2 g happens....
这步7.3.2g写着:
g) If there is an equation of the form X = t such
that X is a variable and t is a non-variable term
which contains this variable, then exit with failure (not
unifiable, positive occurs-check).
完整的算法称为 Herbrand 算法,通常被称为 Martelli-Montanari unification algorithm - 它主要通过以 非确定性 方式重写方程组来进行.
请注意,引入了新方程式:
d) If there is an equation of the form f(a1,a2, ...aN) =
f(b1,b2, ...bN) then replace it by the set of equations
ai = bi.
这意味着具有相同函子但不同元数的两个复合项永远不会影响 STO-ness。
这种不确定性是 STO 测试难以实施的原因。毕竟,仅仅测试是否需要发生检查是不够的,但要证明对于所有可能的算法执行方式,这种情况永远不会发生。
这里用一个案例来说明情况:
?- A/B+C*D = 1/2+3*4.
统一可能从 A = 1
开始,但也可能是其他任何对,并以任何顺序继续。为确保NSTO属性,必须确保没有可能产生STO情况的路径。考虑一个对于当前实现没有问题,但仍然是 STO 的情况:
?- 1+A = 2+s(A).
Prolog 系统首先将此等式重写为:
?- 1 = 2, A = s(A).
现在,他们任选其一
1 = 2
使算法失败退出,或A = s(A)
其中应用步骤 g 并检测到 STO-ness。
我的问题是双重的。首先,它是关于 unify_sto(X,Y)
(仅使用第 1 部分的 defined built-ins)的 ISO Prolog 中的实现,以下内容适用:
如果统一为STO,则
unify_sto(X,Y)
产生错误,否则如果
unify_sto(X,Y)
成功那么X = Y
也会成功如果
unify_sto(X,Y)
失败那么X = Y
也会失败
我的第二个问题是关于在这种情况下要发出的具体错误。参见 ISO 的 error classes.
这是一个简单的开始步骤:所有成功案例都包含在 unify_with_occurs_check(X,Y)
的成功案例中。剩下要做的是区分 NSTO 故障和 STO 错误情况。那是事情开始变得困难...
在 SWI-prolog 中:
unify_sto(X,Y) :-
\+ unify_with_occurs_check(X,Y),
X = Y,
!,
writeln('Error: NSTO failure'),
fail.
unify_sto(X,Y) :-
X = Y.
给出以下结果:
[debug] ?- unify_sto(X,s(X)).
Error: NSTO failure
false.
[debug] ?- unify_sto(X,a).
X = a.
[debug] ?- unify_sto(b,a).
false.
这是我的尝试:
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, XG),
term_general(Y, YG),
\+(unify_sto1(XG,YG)),
throw(error(type_error(acyclic,unify(X,Y)),_))
).
unify_sto1(X, Y):-
unify_with_occurs_check(X,Y).
unify_sto1(X, Y):-
X\=Y.
term_general(X, Y):-
(var(X) -> Y=X ;
(atomic(X) -> Y=_ ;
(
X=..[Functor|L],
term_general1(L, NL),
Y=..[Functor|NL]
))).
term_general1([X|XTail], [Y|YTail]):-
term_general(X, Y),
term_general1(XTail, YTail).
term_general1([], []).
它首先尝试unify_with_occurs_check
,如果没有成功,则继续为每个参数构建一个更通用的术语,然后它尝试统一这样的术语并测试它是否是循环的.如果它是循环的,则抛出 非循环 类型的 type_error
。
例如:
?- unify_sto(1+A,2+s(A)).
ERROR: Unhandled exception: error(type_error(acyclic,unify(1+_G3620,2+s(_G3620))))
再次尝试:
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, Y, XG, YG),
\+(unify_sto1(XG,YG)),
throw(error(type_error(acyclic,unify(X,Y)),_))
).
unify_sto1(X, Y):-
unify_with_occurs_check(X,Y).
unify_sto1(X, Y):-
X\=Y.
term_general(X, Y, XG, YG):-
((var(X) ; var(Y)) -> (XG=X, YG=Y) ;
((
functor(X, Functor, Len),
functor(Y, Functor, Len),
X=..[_|XL],
Y=..[_|YL],
term_general1(XL, YL, NXL, NYL)
) ->
(
XG=..[Functor|NXL],
YG=..[Functor|NYL]
) ;
( XG=_, YG=_ )
)).
term_general1([X|XTail], [Y|YTail], [XG|XGTail], [YG|YGTail]):-
term_general(X, Y, XG, YG),
term_general1(XTail, YTail, XGTail, YGTail).
term_general1([], [], [], []).
它首先尝试 unify_with_occurs_check,如果没有成功,则继续构建两个更通用的术语,遍历每个术语的结构。
- 如果其中一个项是变量,则两个项都保持原样。
- 如果这两个术语是同一个原子,或者如果它们都是具有相同特征的化合物术语 functor 和 arity [*],它遍历它的参数使得更多 他们的总称。
- 否则它会为每个术语分配一个新的变量。
然后它再次尝试 unify_with_occurs_check 更一般的术语 测试非循环统一并相应地抛出错误。
[*] 复合术语中的 arity 测试是贪婪地完成的,因为 。 (已编辑: 添加了两个 term_general1/4
将失败递归,因为 OP 声明仅使用内置link 第 1 部分中定义的谓词不包括 length/2
.functor/3
调用以在调用 term_general1 之前测试仿函数 和 arity,以免尝试如果他们的数量不匹配,检查内部条款)
例如:
?- unify_sto(s(1)+A,A+s(B)).
A = s(1),
B = 1
?- unify_sto(1+A,2+s(A)).
ERROR: Type error: `acyclic' expected, found `unify(1+_G5322,2+s(_G5322))'
?- unify_sto(a(1)+X,b(1)+s(X)).
ERROR: Type error: `acyclic' expected, found `unify(a(1)+_G7068,b(1)+s(_G7068))'
编辑 2015 年 6 月 2 日:
上述解决方案对查询失败:
unify_sto(A+A,a(A)+b(A)).
是否不会产生统一错误。
这里对成对处理每个子项并在发现错误后立即产生错误的算法进行了改进:
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, Y, unify(X,Y), XG, YG),
\+unify_with_occurs_check(XG,YG),
throw(error(type_error(acyclic,unify(X,Y)),_))
).
unify_sto1(X, Y):-
unify_with_occurs_check(X,Y).
unify_sto1(X, Y):-
X\=Y.
term_general(X, Y, UnifyTerm, XG, YG):-
((var(X) ; var(Y)) -> (XG=X, YG=Y) ;
((
functor(X, Functor, Len),
functor(Y, Functor, Len),
X=..[Functor|XL],
Y=..[Functor|YL],
term_general1(XL, YL, UnifyTerm, NXL, NYL)
) ->
(
XG=..[Functor|NXL],
YG=..[Functor|NYL]
) ;
( XG=_, YG=_ )
)).
term_general1([X|XTail], [Y|YTail], UnifyTerm, [XG|XGTail], [YG|YGTail]):-
term_general(X, Y, UnifyTerm, XG, YG),
\+(unify_with_occurs_check(XG,YG))-> throw(error(type_error(acyclic,UnifyTerm),_)) ;
term_general1(XTail, YTail, UnifyTerm, XGTail, YGTail).
term_general1([], [], _, [], []).
在原始答案中产生错误结果的查询的测试用例:
?- unify_sto(A+A,a(A)+b(A)).
ERROR: Type error: `acyclic' expected, found `unify(_G6902+_G6902,a(_G6902)+b(_G6902))'
?- unify_sto(A+A, a(_)+b(A)).
ERROR: Type error: `acyclic' expected, found `unify(_G5167+_G5167,a(_G5173)+b(_G5167))'
第三次尝试。这主要是先前答案中的错误修复(已经有很多修改)。 编辑:2015 年 6 月 4 日
在创建一个更通用的术语时,如果其中一个是变量,我会按原样保留两个子术语。现在,我在这种情况下通过调用 term_general/2
.
unify_sto(X,Y):-
unify_with_occurs_check(X,Y) -> true ;
(
term_general(X, Y, unify(X,Y), XG, YG),
\+unify_with_occurs_check(XG,YG),
throw(error(type_error(acyclic, unify(X,Y)),_))
).
term_general(X, Y, UnifyTerm, XG, YG):-
(var(X) -> (XG=X, term_general(Y, YG)) ;
(var(Y) -> (YG=Y, term_general(X, XG)) ;
((
functor(X, Functor, Len),
functor(Y, Functor, Len),
X=..[_|XL],
Y=..[_|YL],
term_general1(XL, YL, UnifyTerm, NXL, NYL)
) ->
(
XG=..[Functor|NXL],
YG=..[Functor|NYL]
) ;
( XG=_, YG=_ )
))).
term_general1([X|XTail], [Y|YTail], UnifyTerm, [XG|XGTail], [YG|YGTail]):-
term_general(X, Y, UnifyTerm, XG, YG),
(
\+(unify_with_occurs_check(XG,YG)) ->
throw(error(type_error(acyclic,UnifyTerm),_)) ;
term_general1(XTail, YTail, UnifyTerm, XGTail, YGTail)
).
term_general1([], [], _, [], []).
term_general(X, XG):-
(var(X) -> XG=X ;
(atomic(X) -> XG=_ ;
(
X=..[_|XL],
term_general1(XL, XG)
))).
term_general1([X|XTail], [XG|XGTail]):-
term_general(X, XG),
term_general1(XTail, XGTail).
term_general1([], _).
这里是这个问题中到目前为止提到的单元测试:
unit_tests:-
member([TermA,TermB], [[_A+_B,_C+_D], [_E+_F, 1+2],
[a(_G+1),a(1+_H)], [a(1), b(_I)],
[A+A,a(B)+b(B)], [A+A,a(B,1)+b(B)]]),
(unify_sto(TermA, TermB)->Unifies=unifies ; Unifies=does_not_unify),
writeln(test(TermA, TermB, Unifies)),
fail.
unit_tests:-
member([TermA,TermB], [[A+A,B+a(B)], [A+A,A+b(A)],
[A+A,a(_)+b(A)], [1+A,2+s(A)],
[a(1)+X,b(1)+s(X)]]),
catch(
(
(unify_sto(TermA, TermB)->true;true),
writeln(test_failed(TermA, TermB))
), E, writeln(test_ok(E))),
fail.
unit_tests.
这是我用来测试@gusbro 版本的版本。这个想法是从字面上使用 Martelli-Montanari。通过重写方程列表 [X1=Y1,X2=Y2|Etc]
,某些重写规则会立即应用 - 使用 !为承诺。对于某些规则,我不太确定,所以我将它们保留为与原始算法一样不确定。
请注意 rewrite_sto/1
将失败或产生错误。我们对成功案例不感兴趣,它是在没有任何搜索的情况下处理的。另外,请注意,可以消除导致(立即)失败的方程式!这有点不直观,但我们在这里只对查找 STO 案例感兴趣。
unify_with_sto_check(X,Y) :-
( \+ unify_with_occurs_check(X, Y)
-> rewrite_sto([X=Y]) % fails or error
; X = Y
).
rewrite_sto(Xs0) :-
select(X=Y, Xs0,Xs),
( X == Y
; nonvar(X), nonvar(Y),
functor(X,F,A),
\+ functor(Y,F,A)
; var(X), var(Y),
X = Y
),
!,
rewrite_sto(Xs).
rewrite_sto(Xs0) :-
select(X=Y, Xs0, Xs1),
nonvar(X), nonvar(Y),
functor(X,F,A),
functor(Y,F,A),
!,
X =.. [_|XArgs],
Y =.. [_|YArgs],
maplist(\Xi^Yi^(Xi=Yi)^true, XArgs, YArgs, XYs),
append(XYs,Xs1,Xs),
rewrite_sto(Xs).
rewrite_sto(Xs0) :-
select(X=Y, Xs0,Xs),
( var(X), nonvar(Y) -> unify_var_term(X, Y)
; nonvar(X), var(Y) -> unify_var_term(Y, X)
; throw(impossible)
),
rewrite_sto(Xs).
unify_var_term(V, Term) :-
( unify_with_occurs_check(V, Term) -> true
; throw(error(type_error(acyclic_term, Term), _))
).