Procedural Programming

Some RHS Functions

Procedural Functions

if

(defrule continuous-check
    ?phase <- (phase check-continuous)
    =>
    (retract ?phase)
    (printout t "Continuous? ")
    (bind ?answer (read))
    (if (or (eq ?answer y) (eq ?answer yes))
        then (assert (phase continue))
        else (assert (phase halt))) )

while

;for input error checking
(defrule player-select
    (phase choose-player) ; control pattern
    =>
    (printout t "Who moves first (Computer: c "
               "Human: h)? ")
    (bind ?answer (read))
    (while (and (neq ?answer c) (neq ?answer h))
        do
        (printout t "Choose c or h only." crlf)
        (bind ?answer (read))
    (assert (player-select ?answer)) )

loop-for-count

(loop-for-count (?cnt1 2 4) do
   (loop-for-count (?cnt2 3) do
      (printout t ?cnt1 " ")
      (loop-for-count 3 do
         (printout t "."))
      (printout t " " ?cnt2 crlf)))

progn$

(progn$ (create$ 1 2 3)
   (printout t . crlf))

(progn$ (?v (create$ a b c))
   (printout t ?v-index " " ?v crlf))

break

    (break)

halt

    (halt)

(defrule continuous-check
    ?phase <- (phase check-continuous)
    =>
    (retract ?phase)
    (printout t "Continuous? ")
    (bind ?answer (read))
    (while (and (neq ?answer yes) (neq ?answer no))
        do
        (printout t "Continue? ")
        (bind ?answer (read))
    (assert (phase continue))
    (if (neq ?answer yes)
        then (halt)))

Deffunction Construct

(deffunction  hypotenuse-length (?a ?b)
   (** (+ (* ?a ?a) (* ?b ?b)) 0.5))

(deffunction  check-input (?question ?values)
   (printout t ?question " " ?values " ")
   (bind ?answer (read))
   (while (not (member$ ?answer ?values))
        (printout t ?question " " ?values " ")
        (bind ?answer (read)))

return Function

(deffunction  hypotenuse-length (?a ?b)
   (bind ?tmp (+ (* ?a ?a) (* ?b ?b)))		;local var ?tmp
   (return (** ?tmp 0.5)))

Revisiting the Sticks Program

(deffunction  check-input (?question ?values)
   (printout t ?question " " ?values " ")
   (bind ?answer (read))
   (while (not (member$ ?answer ?values))
        (printout t ?question " " ?values " ")
        (bind ?answer (read)))
   (return ?answer))

(defrule player-select
   (phase choose-player)
   =>
   (bind ?player
         (check-input
          "Who moves first (Computer: c " "Human: h)? "
          (create$ c h)))
   (assert (player-move ?player)))

Revised Sticks Program

• Complete Sticks Rule base

Wildcard Parameter

(deffunction  check-input (?question $?values)
   (printout t ?question " " ?values " ")
   (bind ?answer (read))
   (while (not (member$ ?answer ?values))
        (printout t ?question " " ?values " ")
        (bind ?answer (read)))
   (return ?answer))

(defrule player-select
   (phase choose-player)
   =>
   (bind ?player
         (check-input
          "Who moves first (Computer: c " "Human: h)? "
          c h))
   (assert (player-move ?player)))

Defglobal Construct

(defglobal ?*debug-print* = nil)

(defrule debug-example
    (data ?x)
    =>
    (printout ?*debug-print*
    "Debug-example ?x = " ?x " " crlf)

Useful Commands and Functions

• system

(defrule list-directory
    (list-directory ?dir)
    =>
    (system "dir " ?dir))

• batch

(batch "commands.bat")

• dribble-on and dribble-off

(dribble-on <file-name>)
(dribble-off)

• random and seed

(deffunction roll-die ()
   (random 1 6))

(seed 30)

• sort

(sort > 4 3 5 7 2 7)	;(2 3 4 5 7 7)

Previous Efficiency in Rule-Based Languages   Up TOC   Next Introduction to COOL : Class and Inheritance