103 lines
2.1 KiB
Perl
103 lines
2.1 KiB
Perl
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||
|
|
% Constraint Handling Rules version 2.2 %
|
||
|
|
% %
|
||
|
|
% (c) Copyright 1996-98 %
|
||
|
|
% LMU, Muenchen %
|
||
|
|
% %
|
||
|
|
% File: matching.pl %
|
||
|
|
% Author: Christian Holzbaur christian@ai.univie.ac.at %
|
||
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||
|
|
|
||
|
|
%
|
||
|
|
% Head matching for SICStus
|
||
|
|
% ch, Aug. 95
|
||
|
|
%
|
||
|
|
|
||
|
|
:- module( matching, []).
|
||
|
|
|
||
|
|
:- op( 1200, xfx, ?-).
|
||
|
|
|
||
|
|
:- use_module( library(assoc),
|
||
|
|
[
|
||
|
|
empty_assoc/1,
|
||
|
|
get_assoc/3,
|
||
|
|
put_assoc/4
|
||
|
|
]).
|
||
|
|
|
||
|
|
:- multifile
|
||
|
|
user:term_expansion/2,
|
||
|
|
user:goal_expansion/3.
|
||
|
|
|
||
|
|
:- dynamic
|
||
|
|
user:term_expansion/2,
|
||
|
|
user:goal_expansion/3.
|
||
|
|
%
|
||
|
|
user:term_expansion( ?-(M:H0,B), (M:H1 :- Body)) :- !,
|
||
|
|
functor( H0, N, A),
|
||
|
|
functor( H1, N, A),
|
||
|
|
subs( H0, H1, Code, [B]),
|
||
|
|
l2conj( Code, Body).
|
||
|
|
user:term_expansion( ?-(H0,B), (H1 :- Body)) :-
|
||
|
|
functor( H0, N, A),
|
||
|
|
functor( H1, N, A),
|
||
|
|
subs( H0, H1, Code, [B]),
|
||
|
|
l2conj( Code, Body).
|
||
|
|
|
||
|
|
%
|
||
|
|
user:goal_expansion( inline_matching(Pattern,Datum), _, Exp) :-
|
||
|
|
code( Pattern, Datum, Exp).
|
||
|
|
|
||
|
|
code( Pattern, Datum, Code) :-
|
||
|
|
subs( Pattern, Datum, L, []),
|
||
|
|
l2conj( L, Code).
|
||
|
|
|
||
|
|
%
|
||
|
|
% partial evaluation of subsumes( H0, H1)
|
||
|
|
%
|
||
|
|
subs( Pattern, Datum, L, Lt) :-
|
||
|
|
empty_assoc( Dict),
|
||
|
|
subs( Pattern, Datum, Dict,_, L, Lt).
|
||
|
|
|
||
|
|
subs( Pattern, Datum, D0,D1) --> {var(Pattern)}, !,
|
||
|
|
{var(Datum)},
|
||
|
|
( {get_assoc( Pattern, D0, _),D0=D1} -> % subsequent occ
|
||
|
|
[ Pattern == Datum ]
|
||
|
|
; % first occ
|
||
|
|
{
|
||
|
|
Pattern = Datum,
|
||
|
|
put_assoc( Pattern, D0, _, D1)
|
||
|
|
}
|
||
|
|
).
|
||
|
|
subs( Pattern, Datum, D0,D1) --> {var(Datum)}, !,
|
||
|
|
{
|
||
|
|
functor( Pattern, N, A),
|
||
|
|
functor( Skel, N, A)
|
||
|
|
},
|
||
|
|
[
|
||
|
|
nonvar( Datum),
|
||
|
|
Datum = Skel
|
||
|
|
],
|
||
|
|
subs( 1, A, Pattern, Skel, D0,D1).
|
||
|
|
subs( Pattern, Datum, D0,D1) -->
|
||
|
|
{
|
||
|
|
functor( Pattern, N, A),
|
||
|
|
functor( Datum, N, A)
|
||
|
|
},
|
||
|
|
subs( 1, A, Pattern, Datum, D0,D1).
|
||
|
|
|
||
|
|
subs( N, M, _, _, D0,D0) --> {N>M}, !.
|
||
|
|
subs( N, M, G, S, D0,D2) -->
|
||
|
|
{
|
||
|
|
arg( N, G, Ga),
|
||
|
|
arg( N, S, Sa),
|
||
|
|
N1 is N+1
|
||
|
|
},
|
||
|
|
subs( Ga, Sa, D0,D1),
|
||
|
|
subs( N1, M, G, S, D1,D2).
|
||
|
|
|
||
|
|
l2conj( [], true).
|
||
|
|
l2conj( [X|Xs], Conj) :-
|
||
|
|
( Xs = [], Conj = X
|
||
|
|
; Xs = [_|_], Conj = (X,Xc), l2conj( Xs, Xc)
|
||
|
|
).
|