-
Notifications
You must be signed in to change notification settings - Fork 1
/
logic.lso
143 lines (143 loc) · 10.4 KB
/
logic.lso
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
(letrec(letrec(lambda(kb)(append(quote(Logic LispKit interpreter: type end
to finish))(interact kb(quote(patience))(quote((quote 50)))(quote NotDefined
)(quote NIL))))(comment quote((Logic LispKit interpreter, Geraint Jones,
PRG Oxford)(Last changed 11 November from the text of)(LispKit interpreter,
Geraint Jones, PRG Oxford)(Last changed 8 November 1982)))(interact lambda
(kb globaln globalv it database)(letrec(cons(chr(quote 13))(cons(quote >
)line))(line if(eq tag(quote exit))(quote(Exit logic interpreter))(if(eq
tag(quote message))(append message(interact(tail kb)newglobaln newglobalv
it newdatabase))(if(eq tag(quote evaluation))(append(print expression)(
interact(tail kb)globaln globalv expression database))(if(eq tag(quote restore
))(interact(append file(let(if(eq(head t)(quote >))(tail t)t)(t tail kb
)))globaln globalv it database)(cons(quote Error)(interact(tail kb)globaln
globalv it database))))))(tag head result)(message head(tail result))(expression
head(tail result))(file tail result)(newglobaln head(tail(tail result))
)(newglobalv head(tail(tail(tail result))))(newdatabase head(tail(tail(
tail(tail result)))))(result loop(head kb)globaln globalv it database)(
print letrec(lambda(s)(first patience(flatten s)))(first lambda(n l)(if
(eq l(quote NIL))(quote NIL)(if(eq n(quote 0))(let(cons stop(cons stop(
cons stop(quote NIL))))(stop chr(quote 46)))(cons(head l)(first(sub n(quote
1))(tail l))))))(patience evaluate(quote patience)globaln globalv it database
)(flatten lambda(s)(letrec(if(isfunction s)(quote(**function**))(if(isvariable
s)(subscript(tail s)(quote NIL))(if(atom s)(cons s(quote NIL))(cons open
(append(flatten(head s))t)))))(t if(eq(head r)(quote NIL))(cons close(quote
NIL))(if(eq(head r)open)(tail r)(cons point(append r(cons close(quote NIL
))))))(r flatten(tail s))(subscript lambda(v s)(if(atom v)(cons v s)(subscript
(tail v)(cons colon(cons(head v)s)))))(open chr(quote 40))(close chr(quote
41))(point chr(quote 46))(colon chr(quote 58)))))))(loop lambda(command
globaln globalv it database)(letrec(if(atom command)(if(eq command(quote
end))exit(if(eq command(quote save))(save(cons(quote database)globaln)globaln
globalv database)(if(eq command(quote vars))(message globaln globaln globalv
database)(if(eq command(quote new))(message(quote(new database))globaln
globalv(quote NIL))(evaluation expression)))))(if(eq keyword(quote def)
)(if(eq name(quote Error))error(if(atom name)(message(cons name(quote(defined
)))(cons name globaln)(cons value globalv)database)error))(if(eq keyword
(quote cancel))(if(member name globaln)(message(cons name(quote(cancelled
)))(remove name globaln globaln)(remove name globaln globalv)database)error
)(if(eq keyword(quote save))(save(tail command)globaln globalv database
)(if(eq keyword(quote restore))(restore(tail command))(if(if(eq keyword
(quote fact))(quote T)(eq keyword(quote forall)))(message(quote(asserted
))globaln globalv(cons command database))(evaluation expression)))))))(
keyword head command)(name head'(tail' command))(value head'(tail'(tail'
command)))(expression evaluate command globaln globalv it database)(remove
lambda(a t l)(if(eq a(head t))(tail l)(cons(head l)(remove a(tail t)(tail
l)))))(exit cons(quote exit)(quote NIL))(message lambda(m n v d)(cons(quote
message)(cons m(cons n(cons v(cons d(quote NIL)))))))(evaluation lambda
(e)(cons(quote evaluation)(cons e(quote NIL))))(error message(quote(Error
))globaln globalv)(save lambda(l globaln globalv database)(letrec(message
(cons(cons(quote restore)(deflist l globaln globalv(if(member(quote database
)l)database(quote NIL))))(quote NIL))globaln globalv database)(deflist lambda
(l n v d)(if(eq n(quote NIL))d(deflist l(tail n)(tail v)(if(member(head
n)l)(cons(cons(quote def)(cons(head n)(cons(head v)(quote NIL))))d)d)))
)))(restore lambda(f)(cons(quote restore)f))))(evaluate letrec(lambda(e
globaln globalv it database)(letrec(eval e n v)(n cons(cons(quote it)(cons
(quote database)globaln))(quote NIL))(v cons(cons it(cons(assemble database
)(listeval globalv n v)))(quote NIL))))(eval lambda(e n v)(letrec(if(atom
e)(associate e n v)(if(eq keyword(quote quote))text1(if(eq keyword(quote
atom))(if(atom argument1)(quote T)(isvariable argument1))(if(eq keyword
(quote head))(if(indivisible argument1)(quote Error)(head argument1))(if
(eq keyword(quote tail))(if(indivisible argument1)(quote Error)(tail argument1
))(if(eq keyword(quote cons))(cons(if(reserved argument1)(quote Error)argument1
)argument2)(if(eq keyword(quote eq))(equal argument1 argument2)(if(eq keyword
(quote leq))(leq argument1 argument2)(if(eq keyword(quote add))(add argument1
argument2)(if(eq keyword(quote sub))(sub argument1 argument2)(if(eq keyword
(quote mul))(mul argument1 argument2)(if(eq keyword(quote div))(if(eq argument2
(quote 0))(quote Error)(div argument1 argument2))(if(eq keyword(quote rem
))(if(eq argument2(quote 0))(quote Error)(rem argument1 argument2))(if(
eq keyword(quote if))(if argument1 argument2 argument3)(if(eq keyword(quote
lambda))(makefunction text1 text2 n v)(if(eq keyword(quote let))(let(eval
text1 newn newv)(newn cons(names definitions)n)(newv cons(listeval(values
definitions)n v)v))(if(eq keyword(quote letrec))(letrec(eval text1 newn
newv)(newn cons(names definitions)n)(newv cons(listeval(values definitions
)newn newv)v))(if(eq keyword(quote chr))(chr argument1)(if(eq keyword(quote
all))(solve text1(tail' texts)(associate(quote database)n v))(if(eq keyword
(quote logic))(letrec(eval text1 newn newv)(newn cons(quote(database))n
)(newv cons(cons(dbappend(assemble(tail' texts))(associate(quote database
)n v))(quote NIL))v)(dbappend lambda(n o)(if(eq n(quote NIL))o(if(atom n
)(quote NIL)(cons(head n)(dbappend(tail n)o))))))(letrec(if(isfunction applicand
)(eval body newn newv)(quote Error))(body tail(head function))(newn cons
(head(head function))(head(tail function)))(newv cons arguments(tail(tail
function)))(function tail applicand)(applicand eval(head e)n v)))))))))
)))))))))))))(keyword head e)(arguments listeval texts n v)(argument1 head'
arguments)(argument2 head'(tail' arguments))(argument3 head'(tail'(tail'
arguments)))(definitions assoclist'(tail' texts))(texts tail e)(text1 head'
texts)(text2 head'(tail' texts))))(listeval let(lambda(l n v)(map(e n v
)l))(e lambda(n v)(lambda(x)(eval x n v))))(associate letrec(lambda(a n
v)(if(eq n(quote NIL))(quote NotDefined)(if(member a(head n))(locate a(
head n)(head v))(associate a(tail n)(tail v)))))(locate lambda(a n v)(if
(atom v)(quote Error)(if(eq a(head n))(head v)(locate a(tail n)(tail v)
)))))(names let(lambda(d)(map v d))(v lambda(b)(head b)))(values let(lambda
(d)(map v d))(v lambda(b)(tail b)))(indivisible lambda(c)(if(atom c)(quote
T)(if(isfunction c)(quote T)(isvariable c))))(solve letrec(lambda(variables
constraints database)(realise variables(loop(quote 1)(cons(cons(setvars
(quote 0)(markvars variables constraints))(quote NIL))(quote NIL))database
)))(realise letrec(lambda(variables environments)(map(instantiate(map sub0
variables))environments))(sub0 lambda(v)(subscript(quote 0)(makevariable
v)))(instantiate lambda(v)(lambda(e)(instance v e)))(instance lambda(v e
)(if(isvariable v)(if(defined v e)(instance(associate v e)e)v)(if(atom v
)v(cons(instance(head v)e)(instance(tail v)e))))))(loop lambda(level waiting
database)(letrec(if(eq waiting(quote NIL))(quote NIL)(append solved(loop
(add(quote 1)level)resubmitted database)))(solved head deduction)(resubmitted
tail deduction)(deduction deduce waiting(setvars level database))))(deduce
lambda(waiting database)(letrec(if(eq waiting(quote NIL))(quote(NIL))(cons
solved resubmitted))(solved if(eq constraints(quote NIL))(cons environment
solved')solved')(resubmitted if(eq constraints(quote NIL))resubmitted'(
append(resolve constraints environment database)resubmitted'))(constraints
head(head waiting))(environment tail(head waiting))(solved' head rest)(
resubmitted' tail rest)(rest deduce(tail waiting)database)))(resolve lambda
(constraints environment database)(letrec(if(eq database(quote NIL))(quote
NIL)(if(eq unification(quote impossible))rest(cons(cons relaxation unification
)rest)))(unification unify(head constraints)(head clause)environment)(relaxation
append(tail clause)(tail constraints))(clause head database)(rest resolve
constraints environment(tail database))))(unify lambda(a b substitution
)(letrec(if(equal a' b')substitution(if(isvariable a')(bind a' b' substitution
)(if(isvariable b')(bind b' a' substitution)(if(if(atom a')(quote T)(atom
b'))(quote impossible)(if(eq unifyheads(quote impossible))(quote impossible
)unifytails)))))(a' associate a substitution)(b' associate b substitution
)(unifyheads unify(head a')(head b')substitution)(unifytails unify(tail
a')(tail b')unifyheads)))(defined lambda(v e)(if(eq e(quote NIL))(quote
F)(if(equal v(head(head e)))(quote T)(defined v(tail e)))))(associate letrec
(lambda(v e)(if(defined v e)(associate(immediate v e)e)v))(immediate lambda
(v e)(if(equal v(head(head e)))(tail(head e))(immediate v(tail e)))))(bind
lambda(n v e)(cons(cons n v)e))(setvars lambda(i e)(if(isvariable e)(subscript
i e)(if(atom e)e(cons(setvars i(head e))(setvars i(tail e))))))(subscript
lambda(i v)(makevariable(cons i(tail v)))))(assemble lambda(d)(letrec(if
(atom d)(quote NIL)(if(atom clause)rest(if(eq keyword(quote fact))(cons
(tail clause)rest)(if(eq keyword(quote forall))(cons(markvars(head(tail
clause))(tail(tail clause)))rest)rest))))(clause head d)(keyword head clause
)(rest assemble(tail d))))(markvars lambda(v e)(if(atom e)(if(member e v
)(makevariable e)e)(cons(markvars v(head e))(markvars v(tail e)))))))(append
lambda(a b)(if(atom a)b(cons(head a)(append(tail a)b))))(member lambda(
a l)(if(atom l)(quote F)(if(eq a(head l))(quote T)(member a(tail l)))))
(equal lambda(a b)(if(eq a b)(quote T)(if(if(atom a)(quote T)(atom b))(
quote F)(if(equal(head a)(head b))(equal(tail a)(tail b))(quote F)))))(
map lambda(f l)(if(atom l)l(cons(f(head l))(map f(tail l)))))(head' lambda
(c)(if(atom c)(quote Error)(head c)))(tail' lambda(c)(if(atom c)(quote Error
)(tail c)))(assoclist' lambda(l)(if(atom l)(quote NIL)(if(atom(head l))
(assoclist'(tail l))(if(atom(head(head l)))(cons(head l)(assoclist'(tail
l)))(assoclist'(tail l))))))(isvariable lambda(v)(if(atom v)(quote F)(eq
(head v)(quote VariableTag))))(makevariable lambda(v)(cons(quote VariableTag
)v))(isfunction lambda(f)(if(atom f)(quote F)(eq(head f)(quote FunctionTag
))))(makefunction lambda(formals body n v)(cons(quote FunctionTag)(cons
(cons formals body)(cons n v))))(reserved lambda(a)(if(eq a(quote FunctionTag
))(quote T)(eq a(quote VariableTag)))))