Unification is normally handled using a pointer based structure representing a list. This program takes a slightly different approach and implements it using string-based lists instead.
Before defining the main unification function we have to specify a couple of auxiliary functions to handle the "lists". Firstly we need the isList function. It checks a string to report whether it can be interpreted as a list or not. The criterion is very simple: does it start and end with parentheses ? Although a more complex (and accurate) test involving counting balanced parentheses could be specified, it's not really necessary for our purposes at the moment. If it became necessary the following function could be upgraded.
<<isList function>>= FUNCTION isList% (aText AS STRING) LET isList% = (LEFT$(aText, 1) = "(" AND RIGHT$(aText, 1) = ")") END FUNCTION
Secondly we need a function to allow us to split a list into its first item and the remainder. Of course the first item may itself be a list and so here we do need to count balanced parentheses to make sure that we split the string at the right point. And that's what the WHILE/WEND loop within the following function is for. Other than that we have to ensure that the function will not get trapped in the loop if the list is malformed.
<<SplitText function>>= SUB SplitText (aFirst AS STRING, aRest AS STRING) DIM B AS INTEGER DIM J AS INTEGER DIM L AS INTEGER DIM Q AS INTEGER SELECT CASE ASC(LEFT$(aRest, 1)) CASE 40 ' ( LET B = 1 LET J = 2 LET L = LEN(aRest) WHILE J <= L AND B > 0 LET Q = ASC(MID$(aRest, J, 1)) LET B = B - (Q = 40) + (Q = 41) '( or ) LET J = J + 1 WEND CASE ELSE LET J = INSTR(aRest + " ", " ") END SELECT LET aFirst = LEFT$(aRest, J - 1) LET aRest = LTRIM$(MID$(aRest, J)) END SUB
Luckily there's no need for a list "CONSing" function. BASIC's string concatenation operator will suffice. However there is a need for a replacement function. In fact we need a specialised one which, given a list of replacements to make as its first argument, will then go ahead and make them on its second and third arguments.
<<Substitute function>>= SUB Substitute (aRepList AS STRING, aExpr1 AS STRING, aExpr2 AS STRING) DIM J AS INTEGER DIM L AS INTEGER DIM dList AS STRING DIM dItem AS STRING DIM dFrom AS STRING DIM dTo AS STRING LET dList = LTRIM$(aRepList) WHILE LEN(dList) > 0 SplitText dItem, dList LET dItem = MID$(dItem, 2, LEN(dItem) - 2) SplitText dFrom, dItem SplitText dTo, dItem LET L = LEN(dFrom) LET J = INSTR(aExpr1, dFrom) WHILE J <> 0 LET aExpr1 = LEFT$(aExpr1, J - 1) + dTo + MID$(aExpr1, J + L) LET J = INSTR(J + 1, aExpr1, dFrom) WEND LET J = INSTR(aExpr2, dFrom) WHILE J <> 0 LET aExpr2 = LEFT$(aExpr2, J - 1) + dTo + MID$(aExpr2, J + L) LET J = INSTR(J + 1, aExpr2, dFrom) WEND WEND END SUB
Now we've got the parts we need to define our Unification function. This takes the form of a divide-and-conquer algorithm which addresses five separate types of expression, dealing with four of them directly and calling itself recursively to deal with the fifth.
The first three cases are straightforward. In the first case the function has been given two identical arguments, so the result is successful unification. The second and third cases are mirror images. In each of them the function has been given a variable in one argument and some expression in the other. This leads to successful unification provided that the variable does not appear within the expression. If it doesn't then unification can be achieved by associating the variable with the expression. Otherwise unification is impossible.
The fourth case isn't quite so straightforward. It deals with the situation where both expressions are lists. In that case it is necessary to go through the two lists element by element, unifying corresponding elements. Note that unifying two elements may involve associating a variable with an expression and if that's so the variable has to be substituted wherever else it appears in the two lists. If it proves impossible to unify any two elements then it is impossible to unify the two lists.
Lastly the fifth case handles everything else. Since everything else is impossible to unify, this case just reports failure.
<<Unify function>>= SUB Unify (aThisList AS STRING, aThatList AS STRING, aEnv AS STRING) CONST FAIL = "F" DIM J AS INTEGER DIM L AS INTEGER DIM dSubst AS STRING DIM dResult AS STRING DIM dThisElem AS STRING DIM dThatElem AS STRING IF aThisList = aThatList THEN 'is already unified LET aEnv = "" ELSEIF LEFT$(aThisList, 1) = "$" THEN 'is a Variable IF INSTR(aThatList, aThisList) > 0 THEN LET aEnv = FAIL ELSE LET aEnv = "(" + aThisList + " " + aThatList + ")" END IF ELSEIF LEFT$(aThatList, 1) = "$" THEN 'is a Variable IF INSTR(aThisList, aThatList) > 0 THEN LET aEnv = FAIL ELSE LET aEnv = "(" + aThatList + " " + aThisList + ")" END IF ELSEIF isList(aThisList) AND isList(aThatList) THEN LET aThisList = MID$(aThisList, 2, LEN(aThisList) - 2) LET aThatList = MID$(aThatList, 2, LEN(aThatList) - 2) LET dSubst = "" WHILE aThisList <> aThatList AND LEN(aThisList) * LEN(aThatList) <> 0 SplitText dThisElem, aThisList SplitText dThatElem, aThatList Unify dThisElem, dThatElem, dResult IF dResult = FAIL THEN LET aEnv = dResult EXIT SUB ELSEIF dResult > "" THEN LET dSubst = dSubst + dResult Substitute dResult, aThisList, aThatList END IF WEND IF aThisList = aThatList THEN LET aEnv = dSubst ELSE LET aEnv = FAIL END IF ELSE LET aEnv = FAIL END IF END SUB
Since this is a fairly complex function it needs a comprehensive unit test. So here is a test harness with a goodly number of test cases.
<<test harness>>= DECLARE SUB Unify (aThisList AS STRING, aThatList AS STRING, aEnv AS STRING) DECLARE FUNCTION isList% (aText AS STRING) DECLARE SUB Substitute (aRepList AS STRING, aExpr1 AS STRING, aExpr2 AS STRING) DECLARE SUB SplitText (aFirst AS STRING, aRest AS STRING) DEFINT A-Z CONST FAIL = "F" CONST Tries = 100 CLS LET dStartTime! = TIMER FOR Q = 1 TO Tries RESTORE READ X$, A$, B$ WHILE LEN(X$) > 0 LET X = VAL(X$) LET C$ = A$ LET D$ = B$ LET E$ = "" Unify C$, D$, E$ LET C$ = A$ LET D$ = B$ IF E$ <> FAIL THEN Substitute E$, C$, D$ END IF PRINT "Original: ", A$, B$ PRINT "Substitutions:", E$ PRINT "Final: ", C$; IF C$ <> D$ THEN PRINT " not unified with "; D$ ELSE PRINT PRINT READ X$, A$, B$ WEND NEXT PRINT "Took"; (TIMER - dStartTime!) / (X * Tries) * 1000000!; "microseconds per unification" SYSTEM DATA 1,"(R a b)","(R a b)" DATA 2,"(R a b)","(E a b)" DATA 3,"(R $a $b)","(R ($c $d) $d)" DATA 4,"(R $a $b)","(E ($c $d) $d)" DATA 5,"(R $a $b)","(R ($c $d) d)" DATA 6,"(R $a $b)","(R ($b $d) d)" DATA 7,"(R $a $c)","(R ($b $c) $b)" DATA 8,"(R $a (b c))","(R ($b $c) $b)" DATA 9,"(R $a (d e))","(R ($b $c) $b)" DATA 10,"(R $a b)","(R ($c $d) $d)" DATA 11,"(R a b)","(R $x b)" DATA 11,"(Q (P $X $Y) (P $Y $X))","(Q $Z $Z)" DATA 12,"(P $X $Y)","(P $Y $X)" DATA 13,"(P $X $Y a)","(P $Y $X $X)" DATA 14,"(CAR ($X $Y) $X)","(CAR (1 2) $R)" DATA 15,"(CDR ($X $Y) ($Y))","(CDR (1 2) $R)" DATA 16,"(CONS ($X $Y) ($X $Y))","(CONS (1 2) $R)" DATA 17,"(A (G $X $Y))","(A (G ($Y 1) ($X 2)))" DATA 18,"(Man Fred)","(Man Fred)" DATA 19,"(f $x (t $x) $z)","(f a $y (h $w $y))" DATA "","",""