-
Notifications
You must be signed in to change notification settings - Fork 12
/
newblocks.CLP
31 lines (25 loc) · 839 Bytes
/
newblocks.CLP
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
; ============================================
; Author: James Anthony Ortiz
; Course: CEN4681 - Expert Systems
; Date: 10/07/2019
; File: newblocks.CLP
; ============================================
(defrule move-to-floor
(goal-stack $?gtop ?goal $?rest)
(not (stack $?stop ?goal $?rest))
?stack <- (stack $?top&:(member$ ?goal ?top) ?rest2)
=>
(retract ?stack)
(assert (stack (first$ (create$ ?top))))
(assert (stack (rest$ ?top) $?rest2))
(printout t (implode$ (first$ ?top)) " moved on top of floor" crlf))
(defrule move-correct
(declare (salience 99))
(goal-stack $?top ?block1 ?block2 $?rest)
?stack1 <- (stack ?block1 $?rest2)
?stack2 <- (stack ?block2 $?rest)
=>
(retract ?stack1 ?stack2)
(assert (stack $?rest2))
(assert (stack ?block1 ?block2 ?rest))
(printout t ?block1 " moved on top of " ?block2 crlf))