Skip to content

Commit

Permalink
add sbcl ported version of OPS5
Browse files Browse the repository at this point in the history
  • Loading branch information
@briangu
briangu committed Apr 4, 2011
1 parent 51870cc commit 5092d8a
Show file tree
Hide file tree
Showing 20 changed files with 5,641 additions and 0 deletions.
132 changes: 132 additions & 0 deletions README
View file
@@ -0,0 +1,132 @@
;;; ****************************************************************
;;; VPS2 -- Interpreter for OPS5 ***********************************
;;; ****************************************************************
;;;
;;; Ops5 is a programming language for production systems.
;;;
;;; This Common Lisp version of OPS5 is in the public domain. It is based
;;; in part on based on a Franz Lisp implementation done by Charles L. Forgy
;;; at Carnegie-Mellon University, which was placed in the public domain by
;;; the author in accordance with CMU policies. Ported to Common Lisp by
;;; George Wood and Jim Kowalski. CMU Common Lisp modifications by
;;; Dario Guise, Skef Wholey, Michael Parzen, and Dan Kuokka.
;;; Modified to work in CLtL1, CLtL2 and X3J13 compatible lisps by
;;; Mark Kantrowitz on 14-OCT-92. The auto.ops and reactor.ops demo files
;;; were provided by Michael Mauldin.
;;;
;;; This code is made available is, and without warranty of any kind by the
;;; authors or by Carnegie-Mellon University.
;;;
;;; This code has been tested in Allegro v4.1, Lucid v4.1, IBCL, and
;;; CMU CL.
;;;
;;; Source code:
;;; ops.lisp, ops-globals.lisp, ops-backup.lisp, ops-compile.lisp,
;;; ops-init.lisp, ops-io.lisp, ops-main.lisp, ops-match.lisp,
;;; ops-rhs.lisp, ops-util.lisp
;;;
;;; Demo Files:
;;; ops-demo-mab.lisp and ops-demo-ttt.lisp
;;; auto.ops and reactor.ops
;;;
;;; Documentation for OPS may be found in the OPS5 User's Manual, July 1981,
;;; by Forgy, CMU CSD.
;;;
;;; This version of OPS5 was obtained by anonymous ftp from
;;; ftp.cs.cmu.edu:/user/ai/areas/expert/systems/ops5/ops5_cl.tgz

;;; ********************************
;;; Usage **************************
;;; ********************************
;;;
;;; Before loading:
;;; Change the global variable *ops-code-directory* to refer to the
;;; directory where the OPS5 sources are kept. You may also need to
;;; change the definition of OPS-PATHNAME depending on your lisp.
;;;
;;;
;;; To use:
;;; 1. From Lisp, load the file "ops":
;;; (load "ops")
;;; 2. Go into the OPS package:
;;; (in-package "OPS")
;;; 3. To compile the OPS sources, use compile-ops:
;;; (compile-ops)
;;; 4. To load the OPS sources, use load-ops:
;;; (load-ops)
;;; Now you can load your OPS5 code or start typing in productions.
;;; If you want to load in a new set of productions, call (reset-ops)
;;; between rule sets. For a nice REP Loop, run (ops).
;;;
;;; Demos:
;;;
;;; There are two demos
;;; interactive tic-tac-toe
;;; the monkey and banana problem
;;; To run the former, just load it and call (run). For the latter,
;;; load it, enter (make start 1) and then call (run).

;;; ********************************
;;; Known Bugs *********************
;;; ********************************
;;;
;;; Loading new rule-sets clobbers the state of the interpreter. To use
;;; a new rule-set, exit lisp and restart OPS.
;;;
;;; Although this implementation has been put into its own package, only
;;; a few interfaces have been exported. You must run in the OPS package.

;;; ********************************
;;; Sample Run *********************
;;; ********************************
> (load "ops")
;;; Loading binary file "ops.hbin"
#P"/afs/andrew.cmu.edu/scs/cs/15-381/ops5v1/ops.hbin"
> (in-package "OPS")
#<Package "OPS" 40242A7E>
> (load-ops)
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-globals.hbin"
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-util.hbin"
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-backup.hbin"
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-compile.hbin"
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-main.hbin"
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-match.hbin"
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-io.hbin"
;;; Loading binary file "/afs/andrew.cmu.edu/scs/cs/15-381/ops5/ops-rhs.hbin"
NIL
> (load "../ops/auto.ops")
;;; Loading source file "../ops/auto.ops"
;;; Warning: File "../ops/auto.ops" does not begin with IN-PACKAGE. Loading into package "OPS"
******************
#P"/afs/andrew.cmu.edu/scs/cs/15-381/ops/auto.ops"
> (make ready)
NIL
> (run)


Automobile Diagnosis


Is this true: key is off [no] y

Concluding you must turn the key to start the car
*End of diagnosis*


Is this true: key is off [no]

Is this true: engine is turning [no] yes

Concluding problem is in fuel or ignition system

Is this true: headlights are dim or dead [no] q

end -- explicit halt
18 productions (108 // 200 nodes)
19 firings (42 rhs actions)
5 mean working memory size (8 maximum)
4 mean conflict set size (7 maximum)
10 mean token memory size (17 maximum)
NIL
>
;;; *EOF*
176 changes: 176 additions & 0 deletions demo/auto.ops
View file
@@ -0,0 +1,176 @@
;;; Sample OPS5 program: Automobile diagnosis
;;; Provided by Michael Mauldin, mlm@cs.cmu.edu.

(reset-ops)

(watch 0)
(strategy lex)

(literalize task
goal) ; Task name

(literalize fact
name ; Question to ask user [Y/N]
value) ; Answer to question

(p start
(ready)
-->
(Remove 1)
(make task ^goal start)
(write (crlf) (crlf) "Automobile Diagnosis" (crlf) (crlf)))

(p initialize
(task ^goal start)
-->
(modify 1 ^goal diagnose)
(make fact ^name |spark at spark plugs|)
(make fact ^name |carburetor smells like gasoline|)
(make fact ^name |fuel gauge shows empty|)
(make fact ^name |headlights are dim or dead|)
(make fact ^name |engine is turning|)
(make fact ^name |key is off|))

;;; ask-user: Ask the user about a fact

(p ask-user
(task ^goal diagnose)
(fact ^name <name> ^value nil)
-->
(write (crlf) "Is this true:" <name> "[no] ")
(bind <input> (acceptline no))
(modify 2 ^value <input>))

;;; make-yes-answer: Force a yes answer to be 'yes'

(p make-yes-answer
(task ^goal diagnose)
(fact ^value << y >>)
-->
(modify 2 ^value yes))

;;; make-no-answer: Force a no answer to be 'no'

(p make-no-answer
(task ^goal diagnose)
(fact ^value << n >>)
-->
(modify 2 ^value no))

;;; force-yes-or-no: Wipe out bad answers

(p force-yes-answer
(task ^goal diagnose)
(fact ^value {<> nil <> yes <> y <> no <> n <> q <> quit})
-->
(write (crlf) "Please answer yes or no")
(modify 2 ^value nil))

;;; quit: Quit

(p quit
(task ^goal diagnose)
(fact ^value << q quit >>)
-->
(halt))

(p key-is-off
(task ^goal diagnose)
(fact ^name |key is off| ^value yes)
-->
(bind <x> |you must turn the key to start the car|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf))
(modify 1 ^goal clean))

(p ignition-or-fuel
(task ^goal diagnose)
(fact ^name |key is off| ^value no)
(fact ^name |engine is turning| ^value yes)
-->
(bind <x> |problem is in fuel or ignition system|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf)))

(p bad-starting-system
(task ^goal diagnose)
(fact ^name |key is off| ^value no)
(fact ^name |engine is turning| ^value no)
-->
(bind <x> |problem is in starting system|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf)))

(p out-of-gas
(task ^goal diagnose)
(fact ^name |fuel gauge shows empty| ^value yes)
-->
(bind <x> |out of gas|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf))
(modify 1 ^goal clean))

(p engine-flooded
(task ^goal diagnose)
(fact ^name |problem is in fuel or ignition system| ^value yes)
(fact ^name |carburetor smells like gasoline| ^value yes)
(fact ^name |spark at spark plugs| ^value yes)
-->
(bind <x> |engine is flooded: wait 15 minutes|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf))
(modify 1 ^goal clean))

(p bad-ignition
(task ^goal diagnose)
(fact ^name |problem is in fuel or ignition system| ^value yes)
(fact ^name |headlights are dim or dead| ^value no)
(fact ^name |spark at spark plugs| ^value no)
-->
(bind <x> |you have a bad ignition system|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf))
(modify 1 ^goal clean))

(p bad-battery
(task ^goal diagnose)
(fact ^name |headlights are dim or dead| ^value yes)
-->
(bind <x> |you have a dead battery|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf))
(modify 1 ^goal clean))

(p bad-starter
(task ^goal diagnose)
(fact ^name |problem is in starting system| ^value yes)
(fact ^name |headlights are dim or dead| ^value no)
-->
(bind <x> |you have a bad starter|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf))
(modify 1 ^goal clean))

(p bad-fuel-pump
(task ^goal diagnose)
(fact ^name |problem is in fuel or ignition system| ^value yes)
(fact ^name |carburetor smells like gasoline| ^value no)
(fact ^name |fuel gauge shows empty| ^value no)
-->
(bind <x> |problem in fuel system: bad fuel pump or filter|)
(make fact ^name <x> ^value yes)
(write (crlf) "Concluding" <x> (crlf))
(modify 1 ^goal clean))

(p clean-up-old-fact
(task ^goal clean)
(fact)
-->
(Remove 2))

(p done-cleaning
(task ^goal clean)
-(fact)
-->
(modify 1 ^goal start)
(write "*End of diagnosis*" (crlf) (crlf)))
59 changes: 59 additions & 0 deletions demo/auto.run
View file
@@ -0,0 +1,59 @@
> (load "demo/auto.ops")
;;; Loading source file "demo/auto.ops"
;;; Warning: File "demo/auto.ops" does not begin with IN-PACKAGE. Loading into package "OPS"
Common Lisp OPS5 interpreter, version 14-OCT-92.
******************
#P"/afs/andrew.cmu.edu/scs/cs/15-381/ops5/demo/auto.ops"
> (make ready)
NIL
> (run)


Automobile Diagnosis


Is this true: key is off [no] yes

Concluding you must turn the key to start the car
*End of diagnosis*


Is this true: key is off [no] no

Is this true: engine is turning [no] yes

Concluding problem is in fuel or ignition system

Is this true: headlights are dim or dead [no] no

Is this true: fuel gauge shows empty [no] no

Is this true: carburetor smells like gasoline [no] yes

Is this true: spark at spark plugs [no] yes

Concluding engine is flooded: wait 15 minutes
*End of diagnosis*


Is this true: key is off [no] no

Is this true: engine is turning [no] n

Concluding problem is in starting system

Is this true: headlights are dim or dead [no] n

Concluding you have a bad starter
*End of diagnosis*


Is this true: key is off [no] q

end -- explicit halt
18 productions (108 // 200 nodes)
50 firings (101 rhs actions)
5 mean working memory size (9 maximum)
4 mean conflict set size (8 maximum)
11 mean token memory size (19 maximum)
NIL

0 comments on commit 5092d8a

Please sign in to comment.