home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
ckermit.zip
/
rulebase
< prev
next >
Wrap
Lisp/Scheme
|
2004-05-14
|
3KB
|
122 lines
# From: "Dat Nguyen" <thucdat@hotmail.com>
# Subject: Rule-based Programming
# Date: Thu, 13 May 2004 13:49:06 -0400
#
# A typical rule-based problem is car repair. A demonstrative
# implementation in C-Kermit is shown here:
#
define say { echo \%1 }
define addFact {
local \%i
for \%i 1 \v(argc)-1 1 {
asg FactDatabase \m(FactDatabase)\&_[\%i]|
incr FactNumber
}
# showFact
}
define removeFact {
local \%i
for \%i 1 \v(argc)-1 1 {
asg FactDatabase \freplace(\m(FactDatabase),|\&_[\%i]|,|)
decr FactNumber
}
# showFact
}
define anyFact {
(FactNumber)
}
define hasFact {
(\find(\%1,\m(FactDatabase)))
}
define removeAllFact {
asg FactDatabase |
(setq FactNumber 0)
}
define showFact {
show mac FactDatabase
show mac FactNumber
}
define addGoal {
local \%i
for \%i 1 \v(argc)-1 1 {
asg GoalDatabase \m(GoalDatabase)\&_[\%i]|
incr GoalNumber
}
# showGoal
}
define removeGoal {
local \%i
for \%i 1 \v(argc)-1 1 {
asg GoalDatabase \freplace(\m(GoalDatabase),|\&_[\%i]|,|)
decr GoalNumber
}
# showGoal
}
define allGoalDone {
(! GoalNumber)
}
define hasGoal {
(\find(\%1,\m(GoalDatabase)))
}
define removeAllGoal {
asg GoalDatabase |
(setq GoalNumber 0)
}
define showGoal {
show mac GoalDatabase
show mac GoalNumber
}
define fireRule {
local \&e[] \%n \%i fired
asg \%n \fsplit(\%1,&e,{ })
while true {
for \%i 1 \%n 1 {
if define \m(\&e[\%i]) {
asg fired \fexec(\&e[\%i])
# if rule was fired, reevaluate all rules
if fired {
echo {\&e[\%i] was *fired*}
break
}
}
}
if not fired break # no rule was fired
if = 1 \fexec(allGoalDone) break # all goals achieved
}
echo
echo {That's all there is}
echo
}
define rule_sample {
(if (hasGoal 'Goal_xxx)
(if (hasFact 'Fact_yyy)
(if (not (hasGoal 'Goal_zzz))
(.
(removeGoal 'Goal_xxx) # Goal achieved
(removeFact 'Fact_yyy) # Fact changed
(addGoal 'Fact_www) # New goal
(addFact 'Fact_yyy) # New fact
(1)
)
(0)
)
(0)
)
(0)
)
}