Download code

Jump to: navigation, search

Back to Unification_(QBASIC)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

unify.bas

  1 REM The authors of this work have released all rights to it and placed it
  2 REM in the public domain under the Creative Commons CC0 1.0 waiver
  3 REM (http://creativecommons.org/publicdomain/zero/1.0/).
  4 REM 
  5 REM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  6 REM EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  7 REM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  8 REM IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  9 REM CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 10 REM TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 11 REM SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 12 REM 
 13 REM Retrieved from: http://en.literateprograms.org/Unification_(QBASIC)?oldid=7904
 14 
 15 DECLARE SUB Unify (aThisList AS STRING, aThatList AS STRING, aEnv AS STRING)
 16 DECLARE FUNCTION isList% (aText AS STRING)
 17 DECLARE SUB Substitute (aRepList AS STRING, aExpr1 AS STRING, aExpr2 AS STRING)
 18 DECLARE SUB SplitText (aFirst AS STRING, aRest AS STRING)
 19 
 20 DEFINT A-Z
 21 
 22 CONST FAIL = "F"
 23 CONST Tries = 100
 24 
 25 CLS
 26 LET dStartTime! = TIMER
 27 FOR Q = 1 TO Tries
 28    RESTORE
 29    READ X$, A$, B$
 30    WHILE LEN(X$) > 0
 31       LET X = VAL(X$)
 32       LET C$ = A$
 33       LET D$ = B$
 34       LET E$ = ""
 35       Unify C$, D$, E$
 36 
 37       LET C$ = A$
 38       LET D$ = B$
 39       IF E$ <> FAIL THEN
 40          Substitute E$, C$, D$
 41       END IF
 42 
 43       PRINT "Original:     ", A$, B$
 44       PRINT "Substitutions:", E$
 45       PRINT "Final:        ", C$;
 46       IF C$ <> D$ THEN PRINT " not unified with "; D$ ELSE PRINT
 47       PRINT
 48       READ X$, A$, B$
 49    WEND
 50 NEXT
 51 PRINT "Took"; (TIMER - dStartTime!) / (X * Tries) * 1000000!; "microseconds per unification"
 52 
 53 SYSTEM
 54 
 55 DATA 1,"(R a b)","(R a b)"
 56 DATA 2,"(R a b)","(E a b)"
 57 DATA 3,"(R $a $b)","(R ($c $d) $d)"
 58 DATA 4,"(R $a $b)","(E ($c $d) $d)"
 59 DATA 5,"(R $a $b)","(R ($c $d) d)"
 60 DATA 6,"(R $a $b)","(R ($b $d) d)"
 61 DATA 7,"(R $a $c)","(R ($b $c) $b)"
 62 DATA 8,"(R $a (b c))","(R ($b $c) $b)"
 63 DATA 9,"(R $a (d e))","(R ($b $c) $b)"
 64 DATA 10,"(R $a b)","(R ($c $d) $d)"
 65 DATA 11,"(R a b)","(R $x b)"
 66 DATA 11,"(Q (P $X $Y) (P $Y $X))","(Q $Z $Z)"
 67 DATA 12,"(P $X $Y)","(P $Y $X)"
 68 DATA 13,"(P $X $Y a)","(P $Y $X $X)"
 69 DATA 14,"(CAR ($X $Y) $X)","(CAR (1 2) $R)"
 70 DATA 15,"(CDR ($X $Y) ($Y))","(CDR (1 2) $R)"
 71 DATA 16,"(CONS ($X $Y) ($X $Y))","(CONS (1 2) $R)"
 72 DATA 17,"(A (G $X $Y))","(A (G ($Y 1) ($X 2)))"
 73 DATA 18,"(Man Fred)","(Man Fred)"
 74 DATA 19,"(f $x (t $x) $z)","(f a $y (h $w $y))"
 75 DATA "","",""
 76 FUNCTION isList% (aText AS STRING)
 77 
 78    LET isList% = (LEFT$(aText, 1) = "(" AND RIGHT$(aText, 1) = ")")
 79 
 80 END FUNCTION
 81 
 82 SUB SplitText (aFirst AS STRING, aRest AS STRING)
 83 
 84    DIM B AS INTEGER
 85    DIM J AS INTEGER
 86    DIM L AS INTEGER
 87    DIM Q AS INTEGER
 88 
 89    SELECT CASE ASC(LEFT$(aRest, 1))
 90    CASE 40  ' (
 91       LET B = 1
 92       LET J = 2
 93       LET L = LEN(aRest)
 94       WHILE J <= L AND B > 0
 95          LET Q = ASC(MID$(aRest, J, 1))
 96          LET B = B - (Q = 40) + (Q = 41)  '( or )
 97          LET J = J + 1
 98       WEND
 99    CASE ELSE
100       LET J = INSTR(aRest + " ", " ")
101    END SELECT
102    LET aFirst = LEFT$(aRest, J - 1)
103    LET aRest = LTRIM$(MID$(aRest, J))
104 
105 END SUB
106 SUB Substitute (aRepList AS STRING, aExpr1 AS STRING, aExpr2 AS STRING)
107 
108    DIM J AS INTEGER
109    DIM L AS INTEGER
110    DIM dList AS STRING
111    DIM dItem AS STRING
112    DIM dFrom AS STRING
113    DIM dTo AS STRING
114 
115    LET dList = LTRIM$(aRepList)
116    WHILE LEN(dList) > 0
117       SplitText dItem, dList
118       LET dItem = MID$(dItem, 2, LEN(dItem) - 2)
119       SplitText dFrom, dItem
120       SplitText dTo, dItem
121       LET L = LEN(dFrom)
122       LET J = INSTR(aExpr1, dFrom)
123       WHILE J <> 0
124          LET aExpr1 = LEFT$(aExpr1, J - 1) + dTo + MID$(aExpr1, J + L)
125          LET J = INSTR(J + 1, aExpr1, dFrom)
126       WEND
127       LET J = INSTR(aExpr2, dFrom)
128       WHILE J <> 0
129          LET aExpr2 = LEFT$(aExpr2, J - 1) + dTo + MID$(aExpr2, J + L)
130          LET J = INSTR(J + 1, aExpr2, dFrom)
131       WEND
132    WEND
133 
134 END SUB
135 SUB Unify (aThisList AS STRING, aThatList AS STRING, aEnv AS STRING)
136 
137    CONST FAIL = "F"
138 
139    DIM J AS INTEGER
140    DIM L AS INTEGER
141    DIM dSubst AS STRING
142    DIM dResult AS STRING
143    DIM dThisElem AS STRING
144    DIM dThatElem AS STRING
145 
146    IF aThisList = aThatList THEN 'is already unified
147       LET aEnv = ""
148    ELSEIF LEFT$(aThisList, 1) = "$" THEN 'is a Variable
149       IF INSTR(aThatList, aThisList) > 0 THEN
150          LET aEnv = FAIL
151       ELSE
152          LET aEnv = "(" + aThisList + " " + aThatList + ")"
153       END IF
154    ELSEIF LEFT$(aThatList, 1) = "$" THEN 'is a Variable
155       IF INSTR(aThisList, aThatList) > 0 THEN
156          LET aEnv = FAIL
157       ELSE
158          LET aEnv = "(" + aThatList + " " + aThisList + ")"
159       END IF
160    ELSEIF isList(aThisList) AND isList(aThatList) THEN
161       LET aThisList = MID$(aThisList, 2, LEN(aThisList) - 2)
162       LET aThatList = MID$(aThatList, 2, LEN(aThatList) - 2)
163       LET dSubst = ""
164       WHILE aThisList <> aThatList AND LEN(aThisList) * LEN(aThatList) <> 0
165          SplitText dThisElem, aThisList
166          SplitText dThatElem, aThatList
167          Unify dThisElem, dThatElem, dResult
168          IF dResult = FAIL THEN
169             LET aEnv = dResult
170             EXIT SUB
171          ELSEIF dResult > "" THEN
172             LET dSubst = dSubst + dResult
173             Substitute dResult, aThisList, aThatList
174          END IF
175       WEND
176       IF aThisList = aThatList THEN
177          LET aEnv = dSubst
178       ELSE
179          LET aEnv = FAIL
180       END IF
181    ELSE
182       LET aEnv = FAIL
183    END IF
184 
185 END SUB


hijacker
hijacker
hijacker
hijacker