Permalink
Browse files

add sbcl ported version of OPS5

  • Loading branch information...
1 parent 51870cc commit 5092d8a5f92348fd2537a89b1dd4be2885bf121f @briangu committed Apr 4, 2011
Showing with 5,641 additions and 0 deletions.
  1. +132 −0 README
  2. +176 −0 demo/auto.ops
  3. +59 −0 demo/auto.run
  4. +196 −0 demo/ops-demo-mab.lisp
  5. +326 −0 demo/ops-demo-ttt.lisp
  6. +318 −0 demo/reactor.ops
  7. +65 −0 demo/reactor.run
  8. +215 −0 doc/lang.doc
  9. +259 −0 doc/lang.mss
  10. BIN doc/lang.ps
  11. +195 −0 ops-backup.lisp
  12. +824 −0 ops-compile.lisp
  13. +61 −0 ops-globals.lisp
  14. +57 −0 ops-init.lisp
  15. +529 −0 ops-io.lisp
  16. +705 −0 ops-main.lisp
  17. +606 −0 ops-match.lisp
  18. +646 −0 ops-rhs.lisp
  19. +160 −0 ops-util.lisp
  20. +112 −0 ops.lisp
View
@@ -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*
View
@@ -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)))
View
@@ -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
Oops, something went wrong.

0 comments on commit 5092d8a

Please sign in to comment.