1 {------------------------------------------------------------------------------
    2                                    MATCHING
    3 
    4 This module provides a `match' function which implements the famous unification
    5 algorithm. It takes a pair of `patterns', ie structures with variables in them,
    6 matches them against each other, and extracts information about the values
    7 which variables must have in order for the match to be successful. For example,
    8 if `X has stripes' is matched against `Y has Z' then the match is successful,
    9 and the information X=Y and Z=stripes is gleaned. The information about
   10 variables is stored using the `Environment' type; a table which maps variable
   11 names to phrases. The exports from this module are the `Environment' type and
   12 the `match' function.
   13 ------------------------------------------------------------------------------}
   14 
   15 module Match where
   16 import Result
   17 import Table
   18 import Knowledge
   19 
   20 -- The `Environment' type stores information about variables. The `subst'
   21 -- function is used whenever a phrase contains variables about which
   22 -- information may be known. The variables in the phrase are (recursively)
   23 -- substituted by their values in the given environment.
   24 
   25 type Environment = Table String Phrase
   26 
   27 subst env (Term x ps) = Term x [subst env p | p<-ps]
   28 subst env (Var x) =
   29    if fails lookup then (Var x) else subst env (answer lookup) where
   30    lookup = find env x
   31 
   32 -- The `match' function substitutes any known information about the variables
   33 -- in its argument patterns before comparing them with `compear'.  The
   34 -- `matchList' function deals with a list of pairs of patterns which need to be
   35 -- matched. The information gleaned from each pair is used in matching the
   36 -- next, and the final result contains all the information.
   37 
   38 match env p1 p2 = compear env (subst env p1) (subst env p2)
   39 
   40 matchList env [] = success env
   41 matchList env ((p1,p2):pairs) =
   42    if fails res then res else matchList (answer res) pairs where
   43    res = match env p1 p2
   44 
   45 -- The `compear' function is the heart of the algorithm. It compares two
   46 -- phrases and updates the given environment accordingly. For normal terms, it
   47 -- compares the joining words. If these are equal, then it compares
   48 -- corresponding pairs of subphrases. If one or other of the phrases is a
   49 -- variable, then it makes a suitable entry in the environment.
   50 
   51 compear env (Term x1 ps1) (Term x2 ps2)
   52    | x1 == x2  = matchList env (zip ps1 ps2)
   53    | otherwise = failure "no match"
   54 compear env (Var x) (Var y)
   55    | x /= y    = success (update env x (Var y))
   56    | otherwise = success env
   57 compear env (Var x) p
   58    | not (occurs (Var x) p)  =  success (update env x p)
   59    | otherwise = failure "occurs check failed"
   60 compear env p (Var x) =
   61    compear env (Var x) p
   62 
   63 -- The `occurs' check makes sure that a variable does not itself occur in the
   64 -- phrase which it is being set equal to. For example, if X were being set
   65 -- equal to `the animal eats X', then there would be no solution for X,
   66 -- indicating some sort of logical error.
   67 
   68 occurs v (Term x ps) = or [occurs v p | p<-ps]
   69 occurs (Var y) (Var x) = y == x
   70 occurs p (Var x) = False