[
  {
    "path": ".gitignore",
    "content": ".DS_Store\n.byebug_history\n\n# from splitting chapters\ndocs/paradigmsofartificialintelligenceprogramming.md\ndocs/copyright.md\ndocs/dedication.md\ndocs/index.md\ndocs/paradigmsofartificialintelligenceprogramming.md\ndocs/tableofcontents.md"
  },
  {
    "path": "LICENSE",
    "content": "MIT License\n\nCopyright (c) 2018 Peter Norvig\n\nPermission is hereby granted, free of charge, to any person obtaining a copy\nof this software and associated documentation files (the \"Software\"), to deal\nin the Software without restriction, including without limitation the rights\nto use, copy, modify, merge, publish, distribute, sublicense, and/or sell\ncopies of the Software, and to permit persons to whom the Software is\nfurnished to do so, subject to the following conditions:\n\nThe above copyright notice and this permission notice shall be included in all\ncopies or substantial portions of the Software.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\nIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\nFITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\nAUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER\nLIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,\nOUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE\nSOFTWARE.\n"
  },
  {
    "path": "PAIP-safari.md",
    "content": "# Paradigms of Artificial Intelligence Programming\n{:.book_title}\n\n## Case Studies in Common Lisp\n{:.book_subtitle}\n\nFirst Edition\n\nPeter Norvig\n!!!(p) {:.titleauthor}\n\n![logo](images/logo.jpg)\n\n\n\n# Table of Contents\n{:.fmtitle}\n\n[Cover image](Cover.xhtml)\n\n[Title page](B9780080571157500303.xhtml)\n\n[Copyright page](B9780080571157500315.xhtml)\n\n[Dedication](B9780080571157500327.xhtml)\n\n[Preface](B9780080571157500261.xhtml)\n\n[Why Lisp?\nWhy Common Lisp?](B9780080571157500261.xhtml#s0015)\n\n[Outline of the Book](B9780080571157500261.xhtml#s0020)\n\n[How to Use This Book](B9780080571157500261.xhtml#s0025)\n\n[Supplementary Texts and Reference Books](B9780080571157500261.xhtml#s0030)\n\n[A Note on Exercises](B9780080571157500261.xhtml#s0035)\n\n[Acknowledgments](B9780080571157500261.xhtml#s0010)\n\n[Part I: Introduction to Common Lisp](parti.xhtml)\n\n[Chapter 1: Introduction to Lisp](B9780080571157500017.xhtml)\n\n[1.1 Symbolic Computation](B9780080571157500017.xhtml#s0010)\n\n[1.2 Variables](B9780080571157500017.xhtml#s0015)\n\n[1.3 Special Forms](B9780080571157500017.xhtml#s0020)\n\n[1.4 Lists](B9780080571157500017.xhtml#s0025)\n\n[1.5 Defining New Functions](B9780080571157500017.xhtml#s0030)\n\n[1.6 Using Functions](B9780080571157500017.xhtml#s0035)\n\n[1.7 Higher-Order Functions](B9780080571157500017.xhtml#s0040)\n\n[1.8 Other Data Types](B9780080571157500017.xhtml#s0045)\n\n[1.9 Summary: The Lisp Evaluation Rule](B9780080571157500017.xhtml#s0050)\n\n[1.10 What Makes Lisp Different?](B9780080571157500017.xhtml#s0055)\n\n[1.11 Exercises](B9780080571157500017.xhtml#s1060)\n\n[1.12 Answers](B9780080571157500017.xhtml#s0060)\n\n[Chapter 2: A Simple Lisp Program](B9780080571157500029.xhtml)\n\n[2.1 A Grammar for a Subset of English](B9780080571157500029.xhtml#s0010)\n\n[2.2 A Straightforward Solution](B9780080571157500029.xhtml#s0015)\n\n[2.3 A Rule-Based Solution](B9780080571157500029.xhtml#s0020)\n\n[2.4 Two Paths to Follow](B9780080571157500029.xhtml#s0025)\n\n[2.5 Changing the Grammar without Changing the Program](B9780080571157500029.xhtml#s0030)\n\n[2.6 Using the Same Data for Several Programs](B9780080571157500029.xhtml#s0035)\n\n[2.7 Exercises](B9780080571157500029.xhtml#s0040)\n\n[2.8 Answers](B9780080571157500029.xhtml#s0045)\n\n[Chapter 3: Overview of Lisp](B9780080571157500030.xhtml)\n\n[3.1 A Guide to Lisp Style](B9780080571157500030.xhtml#s0010)\n\n[3.2 Special Forms](B9780080571157500030.xhtml#s0015)\n\n[3.3 Functions on Lists](B9780080571157500030.xhtml#s0065)\n\n[3.4 Equality and Internal Representation](B9780080571157500030.xhtml#s0070)\n\n[3.5 Functions on Sequences](B9780080571157500030.xhtml#s0075)\n\n[3.6 Functions for Maintaining Tables](B9780080571157500030.xhtml#s0080)\n\n[3.7 Functions on Trees](B9780080571157500030.xhtml#s0085)\n\n[3.8 Functions on Numbers](B9780080571157500030.xhtml#s0090)\n\n[3.9 Functions on Sets](B9780080571157500030.xhtml#s0095)\n\n[3.10 Destructive Functions](B9780080571157500030.xhtml#s0100)\n\n[3.11 Overview of Data Types](B9780080571157500030.xhtml#s0105)\n\n[3.12 Input/Output](B9780080571157500030.xhtml#s0110)\n\n[3.13 Debugging Tools](B9780080571157500030.xhtml#s0115)\n\n[3.14 Antibugging Tools](B9780080571157500030.xhtml#s0120)\n\n[3.15 Evaluation](B9780080571157500030.xhtml#s0135)\n\n[3.16 Closures](B9780080571157500030.xhtml#s0140)\n\n[3.17 Special Variables](B9780080571157500030.xhtml#s0145)\n\n[3.18 Multiple Values](B9780080571157500030.xhtml#s0150)\n\n[3.19 More about Parameters](B9780080571157500030.xhtml#s0155)\n\n[3.20 The Rest of Lisp](B9780080571157500030.xhtml#s0160)\n\n[3.21 Exercises](B9780080571157500030.xhtml#s0165)\n\n[3.22 Answers](B9780080571157500030.xhtml#s0170)\n\n[Part II: Early AI Programs](partii.xhtml)\n\n[Chapter 4: GPS: The General Problem Solver](B9780080571157500042.xhtml)\n\n[4.1 Stage 1: Description](B9780080571157500042.xhtml#s0010)\n\n[4.2 Stage 2: Specification](B9780080571157500042.xhtml#s0015)\n\n[4.3 Stage 3: Implementation](B9780080571157500042.xhtml#s0020)\n\n[4.4 Stage 4: Test](B9780080571157500042.xhtml#s0025)\n\n[4.5 Stage 5: Analysis, or \"We Lied about the G\"](B9780080571157500042.xhtml#s0030)\n\n[4.6 The Running Around the Block Problem](B9780080571157500042.xhtml#s0035)\n\n[4.7 The Clobbered Sibling Goal Problem](B9780080571157500042.xhtml#s0040)\n\n[4.8 The Leaping before You Look Problem](B9780080571157500042.xhtml#s0045)\n\n[4.9 The Recursive Subgoal Problem](B9780080571157500042.xhtml#s0050)\n\n[4.10 The Lack of Intermediate Information Problem](B9780080571157500042.xhtml#s0055)\n\n[4.11 GPS Version 2: A More General Problem Solver](B9780080571157500042.xhtml#s0060)\n\n[4.12 The New Domain Problem: Monkey and Bananas](B9780080571157500042.xhtml#s0065)\n\n[4.13 The Maze Searching Domain](B9780080571157500042.xhtml#s0070)\n\n[4.14 The Blocks World Domain](B9780080571157500042.xhtml#s0075)\n\n[4.15 Stage 5 Repeated: Analysis of Version 2](B9780080571157500042.xhtml#s0090)\n\n[4.16 The Not Looking after You Don't Leap Problem](B9780080571157500042.xhtml#s0095)\n\n[4.17 The Lack of Descriptive Power Problem](B9780080571157500042.xhtml#s0100)\n\n[4.18 The Perfect Information Problem](B9780080571157500042.xhtml#s0105)\n\n[4.19 The Interacting Goals Problem](B9780080571157500042.xhtml#s0110)\n\n[4.20 The End of GPS](B9780080571157500042.xhtml#s0115)\n\n[4.21 History and References](B9780080571157500042.xhtml#s0120)\n\n[4.22 Exercises](B9780080571157500042.xhtml#s0125)\n\n[4.23 Answers](B9780080571157500042.xhtml#s0130)\n\n[Chapter 5: Eliza: Dialog with a Machine](B9780080571157500054.xhtml)\n\n[5.1 Describing and Specifying ELIZA !!!(span) {:.smallcaps}](B9780080571157500054.xhtml#s0010)\n\n[5.2 Pattern Matching](B9780080571157500054.xhtml#s0015)\n\n[5.3 Segment Pattern Matching](B9780080571157500054.xhtml#s0020)\n\n[5.4 The ELIZA !!!(span) {:.smallcaps} Program: A Rule-Based Translator](B9780080571157500054.xhtml#s0025)\n\n[5.5 History and References](B9780080571157500054.xhtml#s0030)\n\n[5.6 Exercises](B9780080571157500054.xhtml#s0035)\n\n[5.7 Answers](B9780080571157500054.xhtml#s0040)\n\n[Chapter 6: Building Software Tools](B9780080571157500066.xhtml)\n\n[6.1 An Interactive Interpreter Tool](B9780080571157500066.xhtml#s0010)\n\n[6.2 A Pattern-Matching Tool](B9780080571157500066.xhtml#s0015)\n\n[6.3 A Rule-Based Translator Tool](B9780080571157500066.xhtml#s0020)\n\n[6.4 A Set of Searching Tools](B9780080571157500066.xhtml#s0025)\n\n[6.5 GPS as Search](B9780080571157500066.xhtml#s0060)\n\n[6.6 History and References](B9780080571157500066.xhtml#s0065)\n\n[6.7 Exercises](B9780080571157500066.xhtml#s0070)\n\n[6.8 Answers](B9780080571157500066.xhtml#s0075)\n\n[Chapter 7: STUDENT !!!(span) {:.smallcaps} : Solving Algebra Word Problems](B9780080571157500078.xhtml)\n\n[7.1 Translating English into Equations](B9780080571157500078.xhtml#s0010)\n\n[7.2 Solving Algebraic Equations](B9780080571157500078.xhtml#s0015)\n\n[7.3 Examples](B9780080571157500078.xhtml#s0020)\n\n[7.4 History and References](B9780080571157500078.xhtml#s0025)\n\n[7.5 Exercises](B9780080571157500078.xhtml#s0030)\n\n[7.6 Answers](B9780080571157500078.xhtml#s0035)\n\n[Chapter 8: Symbolic Mathematics: A Simplification Program](B978008057115750008X.xhtml)\n\n[8.1 Converting Infix to Prefix Notation](B978008057115750008X.xhtml#s0010)\n\n[8.2 Simplification Rules](B978008057115750008X.xhtml#s0015)\n\n[8.3 Associativity and Commutativity](B978008057115750008X.xhtml#s0020)\n\n[8.4 Logs, Trig, and Differentiation](B978008057115750008X.xhtml#s0025)\n\n[8.5 Limits of Rule-Based Approaches](B978008057115750008X.xhtml#s0030)\n\n[8.6 Integration](B978008057115750008X.xhtml#s0035)\n\n[8.7 History and References](B978008057115750008X.xhtml#s0040)\n\n[8.8 Exercises](B978008057115750008X.xhtml#s0045)\n\n[Part III: Tools and Techniques](partiii.xhtml)\n\n[Chapter 9: Efficiency Issues](B9780080571157500091.xhtml)\n\n[9.1 Caching Results of Previous Computations: Memoization](B9780080571157500091.xhtml#s0010)\n\n[9.2 Compiling One Language into Another](B9780080571157500091.xhtml#s0015)\n\n[9.3 Delaying Computation](B9780080571157500091.xhtml#s0020)\n\n[9.4 Indexing Data](B9780080571157500091.xhtml#s0025)\n\n[9.5 Instrumentation: Deciding What to Optimize](B9780080571157500091.xhtml#s0030)\n\n[9.6 A Case Study in Efficiency: The SIMPLIFY Program](B9780080571157500091.xhtml#s0035)\n\n[9.7 History and References](B9780080571157500091.xhtml#s0070)\n\n[9.8 Exercises](B9780080571157500091.xhtml#s0075)\n\n[9.9 Answers](B9780080571157500091.xhtml#s0080)\n\n[Chapter 10: Low-Level Efficiency Issues](B9780080571157500108.xhtml)\n\n[10.1 Use Declarations](B9780080571157500108.xhtml#s0010)\n\n[10.2 Avoid Generic Functions](B9780080571157500108.xhtml#s0015)\n\n[10.3 Avoid Complex Argument Lists](B9780080571157500108.xhtml#s0020)\n\n[10.4 Avoid Unnecessary Consing](B9780080571157500108.xhtml#s0025)\n\n[10.5 Use the Right Data Structures](B9780080571157500108.xhtml#s0030)\n\n[10.6 Exercises](B9780080571157500108.xhtml#s0035)\n\n[10.7 Answers](B9780080571157500108.xhtml#s0040)\n\n[Chapter 11: Logic Programming](B978008057115750011X.xhtml)\n\n[11.1 Idea 1: A Uniform Data Base](B978008057115750011X.xhtml#s0010)\n\n[11.2 Idea 2: Unification of Logic Variables](B978008057115750011X.xhtml#s0015)\n\n[11.3 Idea 3: Automatic Backtracking](B978008057115750011X.xhtml#s0025)\n\n[11.4 The Zebra Puzzle](B978008057115750011X.xhtml#s0040)\n\n[11.5 The Synergy of Backtracking and Unification](B978008057115750011X.xhtml#s0045)\n\n[11.6 Destructive Unification](B978008057115750011X.xhtml#s0050)\n\n[11.7 Prolog in Prolog](B978008057115750011X.xhtml#s0055)\n\n[11.8 Prolog Compared to Lisp](B978008057115750011X.xhtml#s0060)\n\n[11.9 History and References](B978008057115750011X.xhtml#s0065)\n\n[11.10 Exercises](B978008057115750011X.xhtml#s0070)\n\n[11.11 Answers](B978008057115750011X.xhtml#s0075)\n\n[Chapter 12: Compiling Logic Programs](B9780080571157500121.xhtml)\n\n[12.1 A Prolog Compiler](B9780080571157500121.xhtml#s0010)\n\n[12.2 Fixing the Errors in the Compiler](B9780080571157500121.xhtml#s0015)\n\n[12.3 Improving the Compiler](B9780080571157500121.xhtml#s0020)\n\n[12.4 Improving the Compilation of Unification](B9780080571157500121.xhtml#s0025)\n\n[12.5 Further Improvements to Unification](B9780080571157500121.xhtml#s0030)\n\n[12.6 The User Interface to the Compiler](B9780080571157500121.xhtml#s0035)\n\n[12.7 Benchmarking the Compiler](B9780080571157500121.xhtml#s0040)\n\n[12.8 Adding More Primitives](B9780080571157500121.xhtml#s0045)\n\n[12.9 The Cut](B9780080571157500121.xhtml#s0050)\n\n[12.10 \"Real\" Prolog](B9780080571157500121.xhtml#s0055)\n\n[12.11 History and References](B9780080571157500121.xhtml#s0060)\n\n[12.12 Exercises](B9780080571157500121.xhtml#s0065)\n\n[12.13 Answers](B9780080571157500121.xhtml#s0070)\n\n[Chapter 13: Object-Oriented Programming](B9780080571157500133.xhtml)\n\n[13.1 Object-Oriented Programming](B9780080571157500133.xhtml#s0010)\n\n[13.2 Objects](B9780080571157500133.xhtml#s0015)\n\n[13.3 Generic Functions](B9780080571157500133.xhtml#s0020)\n\n[13.4 Classes](B9780080571157500133.xhtml#s0025)\n\n[13.5 Delegation](B9780080571157500133.xhtml#s0030)\n\n[13.6 Inheritance](B9780080571157500133.xhtml#s0035)\n\n[13.7 CLOS: The Common Lisp Object System](B9780080571157500133.xhtml#s0040)\n\n[13.8 A CLOS Example: Searching Tools](B9780080571157500133.xhtml#s0045)\n\n[13.9 Is CLOS Object-Oriented?](B9780080571157500133.xhtml#s0060)\n\n[13.10 Advantages of Object-Oriented Programming](B9780080571157500133.xhtml#s0065)\n\n[13.11 History and References](B9780080571157500133.xhtml#s0070)\n\n[13.12 Exercises](B9780080571157500133.xhtml#s0075)\n\n[Chapter 14: Knowledge Representation and Reasoning](B9780080571157500145.xhtml)\n\n[14.1 A Taxonomy of Representation Languages](B9780080571157500145.xhtml#s0010)\n\n[14.2 Predicate Calculus and its Problems](B9780080571157500145.xhtml#s0015)\n\n[14.3 A Logical Language: Prolog](B9780080571157500145.xhtml#s0020)\n\n[14.4 Problems with Prolog's Expressiveness](B9780080571157500145.xhtml#s0025)\n\n[14.5 Problems with Predicate Calculus's Expressiveness](B9780080571157500145.xhtml#s0030)\n\n[14.6 Problems with Completeness](B9780080571157500145.xhtml#s0035)\n\n[14.7 Problems with Efficiency: Indexing](B9780080571157500145.xhtml#s0040)\n\n[14.8 A Solution to the Indexing Problem](B9780080571157500145.xhtml#s0045)\n\n[14.9 A Solution to the Completeness Problem](B9780080571157500145.xhtml#s0050)\n\n[14.10 Solutions to the Expressiveness Problems](B9780080571157500145.xhtml#s0055)\n\n[14.11 History and References](B9780080571157500145.xhtml#s0085)\n\n[14.12 Exercises](B9780080571157500145.xhtml#s0090)\n\n[14.13 Answers](B9780080571157500145.xhtml#s0095)\n\n[Part IV: Advanced AI Programs](partiv.xhtml)\n\n[Chapter 15: Symbolic Mathematics with Canonical Forms](B9780080571157500157.xhtml)\n\n[15.1 A Canonical Form for Polynomials](B9780080571157500157.xhtml#s0010)\n\n[15.2 Differentiating Polynomials](B9780080571157500157.xhtml#s0015)\n\n[15.3 Converting between Infix and Prefix](B9780080571157500157.xhtml#s0020)\n\n[15.4 Benchmarking the Polynomial Simplifier](B9780080571157500157.xhtml#s0025)\n\n[15.5 A Canonical Form for Rational Expressions](B9780080571157500157.xhtml#s0030)\n\n[15.6 Extending Rational Expressions](B9780080571157500157.xhtml#s0035)\n\n[15.7 History and References](B9780080571157500157.xhtml#s0040)\n\n[15.8 Exercises](B9780080571157500157.xhtml#s0045)\n\n[15.9 Answers](B9780080571157500157.xhtml#s0050)\n\n[Chapter 16: Expert Systems](B9780080571157500169.xhtml)\n\n[16.1 Dealing with Uncertainty](B9780080571157500169.xhtml#s0010)\n\n[16.2 Caching Derived Facts](B9780080571157500169.xhtml#s0015)\n\n[16.3 Asking Questions](B9780080571157500169.xhtml#s0020)\n\n[16.4 Contexts Instead of Variables](B9780080571157500169.xhtml#s0025)\n\n[16.5 Backward-Chaining Revisited](B9780080571157500169.xhtml#s0030)\n\n[16.6 Interacting with the Expert](B9780080571157500169.xhtml#s0035)\n\n[16.7 Interacting with the Client](B9780080571157500169.xhtml#s0040)\n\n[16.8 MYCIN !!!(span) {:.smallcaps} , A Medical Expert System](B9780080571157500169.xhtml#s0045)\n\n[16.9 Alternatives to Certainty Factors](B9780080571157500169.xhtml#s0050)\n\n[16.10 History and References](B9780080571157500169.xhtml#s0055)\n\n[16.11 Exercises](B9780080571157500169.xhtml#s0060)\n\n[16.12 Answers](B9780080571157500169.xhtml#s0065)\n\n[Chapter 17: Line-Diagram Labeling by Constraint Satisfaction](B9780080571157500170.xhtml)\n\n[17.1 The Line-Labeling Problem](B9780080571157500170.xhtml#s0010)\n\n[17.2 Combining Constraints and Searching](B9780080571157500170.xhtml#s0015)\n\n[17.3 Labeling Diagrams](B9780080571157500170.xhtml#s0020)\n\n[17.4 Checking Diagrams for Errors](B9780080571157500170.xhtml#s0025)\n\n[17.5 History and References](B9780080571157500170.xhtml#s0030)\n\n[17.6 Exercises](B9780080571157500170.xhtml#s0035)\n\n[Chapter 18: Search and the Game of Othello](B9780080571157500182.xhtml)\n\n[18.1 The Rules of the Game](B9780080571157500182.xhtml#s0010)\n\n[18.2 Representation Choices](B9780080571157500182.xhtml#s0015)\n\n[18.3 Evaluating Positions](B9780080571157500182.xhtml#s0020)\n\n[18.4 Searching Ahead: Minimax](B9780080571157500182.xhtml#s0025)\n\n[18.5 Smarter Searching: Alpha-Beta Search](B9780080571157500182.xhtml#s0030)\n\n[18.6 An Analysis of Some Games](B9780080571157500182.xhtml#s0035)\n\n[18.7 The Tournament Version of Othello](B9780080571157500182.xhtml#s0040)\n\n[18.8 Playing a Series of Games](B9780080571157500182.xhtml#s0045)\n\n[18.9 More Efficient Searching](B9780080571157500182.xhtml#s0050)\n\n[18.10 It Pays to Precycle](B9780080571157500182.xhtml#s0055)\n\n[18.11 Killer Moves](B9780080571157500182.xhtml#s0060)\n\n[18.12 Championship Programs: Iago and Bill](B9780080571157500182.xhtml#s0065)\n\n[18.13 Other Techniques](B9780080571157500182.xhtml#s0085)\n\n[18.14 History and References](B9780080571157500182.xhtml#s0135)\n\n[18.15 Exercises](B9780080571157500182.xhtml#s0140)\n\n[18.16 Answers](B9780080571157500182.xhtml#s0145)\n\n[Chapter 19: Introduction to Natural Language](B9780080571157500194.xhtml)\n\n[19.1 Parsing with a Phrase-Structure Grammar](B9780080571157500194.xhtml#s0010)\n\n[19.2 Extending the Grammar and Recognizing Ambiguity](B9780080571157500194.xhtml#s0015)\n\n[19.3 More Efficient Parsing](B9780080571157500194.xhtml#s0020)\n\n[19.4 The Unknown-Word Problem](B9780080571157500194.xhtml#s0025)\n\n[19.5 Parsing into a Semantic Representation](B9780080571157500194.xhtml#s0030)\n\n[19.6 Parsing with Preferences](B9780080571157500194.xhtml#s0035)\n\n[19.7 The Problem with Context-Free Phrase-Structure Rules](B9780080571157500194.xhtml#s0040)\n\n[19.8 History and References](B9780080571157500194.xhtml#s0045)\n\n[19.9 Exercises](B9780080571157500194.xhtml#s0050)\n\n[19.10 Answers](B9780080571157500194.xhtml#s0055)\n\n[Chapter 20: Unification Grammars](B9780080571157500200.xhtml)\n\n[20.1 Parsing as Deduction](B9780080571157500200.xhtml#s0010)\n\n[20.2 Definite Clause Grammars](B9780080571157500200.xhtml#s0015)\n\n[20.3 A Simple Grammar in DCG Format](B9780080571157500200.xhtml#s0020)\n\n[20.4 A DCG Grammar with Quantifiers](B9780080571157500200.xhtml#s0025)\n\n[20.5 Preserving Quantifier Scope Ambiguity](B9780080571157500200.xhtml#s0030)\n\n[20.6 Long-Distance Dependencies](B9780080571157500200.xhtml#s0035)\n\n[20.7 Augmenting DCG Rules](B9780080571157500200.xhtml#s0040)\n\n[20.8 History and References](B9780080571157500200.xhtml#s0045)\n\n[20.9 Exercises](B9780080571157500200.xhtml#s0050)\n\n[20.10 Answers](B9780080571157500200.xhtml#s0055)\n\n[Chapter 21: A Grammar of English](B9780080571157500212.xhtml)\n\n[21.1 Noun Phrases](B9780080571157500212.xhtml#s0010)\n\n[21.2 Modifiers](B9780080571157500212.xhtml#s0015)\n\n[21.3 Noun Modifiers](B9780080571157500212.xhtml#s0020)\n\n[21.4 Determiners](B9780080571157500212.xhtml#s0025)\n\n[21.5 Verb Phrases](B9780080571157500212.xhtml#s0030)\n\n[21.6 Adverbs](B9780080571157500212.xhtml#s0035)\n\n[21.7 Clauses](B9780080571157500212.xhtml#s0040)\n\n[21.8 Sentences](B9780080571157500212.xhtml#s0045)\n\n[21.9 XPs](B9780080571157500212.xhtml#s0050)\n\n[21.10 Word Categories](B9780080571157500212.xhtml#s0055)\n\n[21.11 The Lexicon](B9780080571157500212.xhtml#s0060)\n\n[21.12 Supporting the Lexicon](B9780080571157500212.xhtml#s0115)\n\n[21.13 Other Primitives](B9780080571157500212.xhtml#s0120)\n\n[21.14 Examples](B9780080571157500212.xhtml#s0125)\n\n[21.15 History and References](B9780080571157500212.xhtml#s0130)\n\n[21.16 Exercises](B9780080571157500212.xhtml#s0135)\n\n[Part V: The Rest of Lisp](partv.xhtml)\n\n[Chapter 22: Scheme: An Uncommon Lisp](B9780080571157500224.xhtml)\n\n[22.1 A Scheme Interpreter](B9780080571157500224.xhtml#s0010)\n\n[22.2 Syntactic Extension with Macros](B9780080571157500224.xhtml#s0015)\n\n[22.3 A Properly Tail-Recursive Interpreter](B9780080571157500224.xhtml#s0020)\n\n[22.4 Throw, Catch, and Call/cc](B9780080571157500224.xhtml#s0025)\n\n[22.5 An Interpreter Supporting Call/cc](B9780080571157500224.xhtml#s0030)\n\n[22.6 History and References](B9780080571157500224.xhtml#s0035)\n\n[22.7 Exercises](B9780080571157500224.xhtml#s0040)\n\n[22.8 Answers](B9780080571157500224.xhtml#s0045)\n\n[Chapter 23: Compiling Lisp](B9780080571157500236.xhtml)\n\n[23.1 A Properly Tail-Recursive Lisp Compiler](B9780080571157500236.xhtml#s0010)\n\n[23.2 Introducing Call/cc](B9780080571157500236.xhtml#s0015)\n\n[23.3 The Abstract Machine](B9780080571157500236.xhtml#s0020)\n\n[23.4 A Peephole Optimizer](B9780080571157500236.xhtml#s0025)\n\n[23.5 Languages with Different Lexical Conventions](B9780080571157500236.xhtml#s0030)\n\n[23.6 History and References](B9780080571157500236.xhtml#s0035)\n\n[23.7 Exercises](B9780080571157500236.xhtml#s0040)\n\n[23.8 Answers](B9780080571157500236.xhtml#s0045)\n\n[Chapter 24: ANSI Common Lisp](B9780080571157500248.xhtml)\n\n[24.1 Packages](B9780080571157500248.xhtml#s0010)\n\n[24.2 Conditions and Error Handling](B9780080571157500248.xhtml#s0020)\n\n[24.3 Pretty Printing](B9780080571157500248.xhtml#s0035)\n\n[24.4 Series](B9780080571157500248.xhtml#s0040)\n\n[24.5 The Loop Macro](B9780080571157500248.xhtml#s0045)\n\n[24.6 Sequence Functions](B9780080571157500248.xhtml#s0090)\n\n[24.7 Exercises](B9780080571157500248.xhtml#s0115)\n\n[24.8 Answers](B9780080571157500248.xhtml#s0120)\n\n[Chapter 25: Troubleshooting](B978008057115750025X.xhtml)\n\n[25.1 Nothing Happens](B978008057115750025X.xhtml#s0010)\n\n[25.2 Change to Variable Has No Effect](B978008057115750025X.xhtml#s0015)\n\n[25.3 Change to Function Has No Effect](B978008057115750025X.xhtml#s0020)\n\n[25.4 Values Change \"by Themselves\"](B978008057115750025X.xhtml#s0025)\n\n[25.5 Built-In Functions Don't Find Elements](B978008057115750025X.xhtml#s0030)\n\n[25.6 Multiple Values Are Lost](B978008057115750025X.xhtml#s0035)\n\n[25.7 Declarations Are Ignored](B978008057115750025X.xhtml#s0040)\n\n[25.8 My Lisp Does the Wrong Thing](B978008057115750025X.xhtml#s0045)\n\n[25.9 How to Find the Function You Want](B978008057115750025X.xhtml#s0050)\n\n[25.10 Syntax of LOOP](B978008057115750025X.xhtml#s0055)\n\n[25.11 Syntax of COND](B978008057115750025X.xhtml#s0060)\n\n[25.12 Syntax of CASE](B978008057115750025X.xhtml#s0065)\n\n[25.13 Syntax of LET and LET*](B978008057115750025X.xhtml#s0070)\n\n[25.14 Problems with Macros](B978008057115750025X.xhtml#s0075)\n\n[25.15 A Style Guide to Lisp](B978008057115750025X.xhtml#s0080)\n\n[25.16 Dealing with Files, Packages, and Systems](B978008057115750025X.xhtml#s0110)\n\n[25.17 Portability Problems](B978008057115750025X.xhtml#s0115)\n\n[25.18 Exercises](B978008057115750025X.xhtml#s0120)\n\n[25.19 Answers](B978008057115750025X.xhtml#s0125)\n\n[Appendix: Obtaining the Code in this Book](B9780080571157500273.xhtml)\n\n[FTP: The File Transfer Protocol](B9780080571157500273.xhtml#s0010)\n\n[Available Software](B9780080571157500273.xhtml#s0015)\n\n[Bibliography](B9780080571157500285.xhtml)\n\n[Index](B9780080571157500297_1.xhtml)\n\n\n\n# Copyright\n{:#cop0005}\n{:.fmtitle}\n\nSponsoring Editor *Michael B.\nMorgan*\n!!!(p) {:.copyright-top}\n\nProduction Manager *Yonie Overton*\n!!!(p) {:.copyright}\n\nCover Designer *Sandra Popovich*\n!!!(p) {:.copyright}\n\nText Design/Composition *SuperScript Typography*\n!!!(p) {:.copyright}\n\nCopyeditor *Barbara Beidler Kendrick*\n!!!(p) {:.copyright}\n\nProofreaders *Lynn Meinhardt, Sharilyn Hovind, Gary Morris*\n!!!(p) {:.copyright}\n\nPrinter *Malloy Lithographing*\n!!!(p) {:.copyright}\n\nMorgan Kaufmann Publishers, Inc.\n!!!(p) {:.copyright-top}\n\n*Editorial and Sales Office:*\n!!!(p) {:.copyright}\n\n340 Pine Street, Sixth Floor\n!!!(p) {:.copyright}\n\nSan Francisco, CA 94104-3205\n!!!(p) {:.copyright}\n\nUSA\n!!!(p) {:.copyright}\n\n*Telephone* 415/392-2665\n!!!(p) {:.copyright}\n\n*Facsimile* 415/982-2665\n!!!(p) {:.copyright}\n\n*Internet*[mkp@mkp.com](mailto:mkp@mkp.com)\n!!!(p) {:.copyright}\n\n*Web site*[http://mkp.com](http://mkp.com)\n!!!(p) {:.copyright}\n\n@ 1992 Morgan Kaufmann Publishers, Inc.\n!!!(p) {:.copyright-top}\n\nAll rights reserved\n!!!(p) {:.copyright}\n\nPrinted in the United States of America\n!!!(p) {:.copyright}\n\n03 02 01 8 7 6\n!!!(p) {:.copyright-top}\n\nNo part of this publication may be reproduced, stored in a retrieval system, or transmitted in any form or by any means-electronic, photocopying, recording, or otherwise-without the prior written permission of the publisher.\n!!!(p) {:.copyright-top}\n\nLibrary of Congress Cataloging-in-Publication Data\n!!!(p) {:.copyright-top}\n\nNorvig, Peter.\n!!!(p) {:.copyright-top}\n\nParadigms of artificial intelligence programming: case studies in common Lisp / Peter Norvig.\n!!!(p) {:.copyright}\n\np. cm.\n!!!(p) {:.copyright}\n\nIncludes bibliographical references and index.\n!!!(p) {:.copyright}\n\nISBN 1-55860-191-0:\n!!!(p) {:.copyright}\n\n1.\nElectronic digital computers-Programming.\n2.\nCOMMON LISP (Computer program language) 3.\nArtificial intelligence. I.\nTitle.\n!!!(p) {:.copyright}\n\nQA76.6.N687 1991\n!!!(p) {:.copyright}\n\n006.3-dc20    91-39187\n!!!(p) {:.copyright}\n\nCIP\n!!!(p) {:.copyright}\n\n\n\n# Dedication\n{:#ded0005}\n{:.fmtitle}\n\n*To my family*...\n!!!(p) {:.dedication}\n\n\n\n# Preface\n{:#pre0005}\n{:.fmtitle}\n\n> **paradigm***n***1** an example or pattern; *esp* an outstandingly clear or typical example.\n\n> -*Longman's Dictionary of the English Language*, 1984\n\nThis book is concerned with three related topics: the field of artificial intelligence, or AI; the skill of computer programming; and the programming language Common Lisp.\nCareful readers of this book can expect to come away with an appreciation of the major questions and techniques of AI, an understanding of some important AI programs, and an ability to read, modify, and create programs using Common Lisp.\nThe examples in this book are designed to be clear examples of good programming style-paradigms of programming.\nThey are also paradigms of AI research-historically significant programs that use widely applicable techniques to solve important problems.\n\nJust as a liberal arts education includes a course in \"the great books\" of a culture, so this book is, at one level, a course in \"the great programs\" that define the AI culture.[1](#fn0010)\n\nAt another level, this book is a highly technical compendium of the knowledge you will need to progress from being an intermediate Lisp programmer to being an expert.\nParts I and II are designed to help the novice get up to speed, but the complete beginner may have a hard time even with this material.\nFortunately, there are at least five good texts available for the beginner; see page xiii for my recommendations.\n\nAll too often, the teaching of computer programming consists of explaining the syntax of the chosen language, showing the student a 10-line program, and then asking the student to write programs.\nIn this book, we take the approach that the best way to learn to write is to read (and conversely, a good way to improve reading skills is to write).\nAfter the briefest of introductions to Lisp, we start right off with complex programs and ask the reader to understand and make small modifications to these programs.\n\nThe premise of this book is that you can only write something useful and interesting when you both understand what makes good writing and have something interesting to say.\nThis holds for writing programs as well as for writing prose.\nAs Kernighan and Plauger put it on the cover of *Software Tools in Pascal:*\n\n> Good programming is not learned from generalities, but by seeing how significant programs can be made clean, easy to read, easy to maintain and modify, human-engineered, efficient, and reliable, by the application of common sense and good programming practices.\nCareful study and imitation of good programs leads to better writing.\n\nThe proud craftsman is often tempted to display only the finished work, without any indication of the false starts and mistakes that are an unfortunate but unavoidable part of the creative process.\nUnfortunately, this reluctance to unveil the process is a barrier to learning; a student of mathematics who sees a beautiful 10-line proof in a textbook can marvel at its conciseness but does not learn how to construct such a proof.\nThis book attempts to show the complete programming process, \"warts and all.\" Each chapter starts with a simple version of a program, one that works on some examples but fails on others.\nEach chapter shows how these failures can be analyzed to build increasingly sophisticated versions of the basic program.\nThus, the reader can not only appreciate the final result but also see how to learn from mistakes and refine an initially incomplete design.\nFurthermore, the reader who finds a particular chapter is becoming too difficult can skip to the next chapter, having gained some appreciation of the problem area, and without being overwhelmed by the details.\n\nThis book presents a body of knowledge loosely known as \"AI programming techniques,\" but it must be recognized that there are no clear-cut boundaries on this body of knowledge.\nTo be sure, no one can be a good AI programmer without first being a good programmer.\nThus, this book presents topics (especially in parts III and V) that are not AI per se, but are essential background for any AI practitioner.\n\n## Why Lisp? Why Common Lisp?\n{:#s0015}\n{:.h1hd}\n\nLisp is one of the oldest programming languages still in widespread use today.\nThere have been many versions of Lisp, each sharing basic features but differing in detail.\nIn this book we use the version called Common Lisp, which is the most widely accepted standard.\nLisp has been chosen for three reasons.\n!!!(p) {:.para_fl}\n\nFirst, Lisp is the most popular language for AI programming, particularly in the United States.\nIf you're going to learn a language, it might as well be one with a growing literature, rather than a dead tongue.\n\nSecond, Lisp makes it easy to capture relevant generalizations in defining new objects.\nIn particular, Lisp makes it easy to define new languages especially targeted to the problem at hand.\nThis is especially handy in AI applications, which often manipulate complex information that is most easily represented in some novel form.\nLisp is one of the few languages that allows full flexibility in defining and manipulating programs as well as data.\nAll programming languages, by definition, provide a means of defining programs, but many other languages limit the ways in which a program can be used, or limit the range of programs that can be defined, or require the programmer to explicitly state irrelevant details.\n\nThird, Lisp makes it very easy to develop a working program fast.\nLisp programs are concise and are uncluttered by low-level detail.\nCommon Lisp offers an unusually large number of useful predefined objects, including over 700 functions.\nThe programming environment (such as debugging tools, incremental compilers, integrated editors, and interfaces to window systems) that surround Lisp systems are usually very good.\nAnd the dynamic, interactive nature of Lisp makes it easy to experiment and change a program while it is being developed.\n\nIt must be mentioned that in Europe and Japan, Prolog has been as popular as Lisp for AI work.\nProlog shares most of Lisp's advantages in terms of flexibility and conciseness.\nRecently, Lisp has gained popularity worldwide, and Prolog is becoming more well known in the United States.\nAs a result, the average AI worker today is likely to be bilingual.\nThis book presents the key ideas behind Prolog in [chapters 11](B978008057115750011X.xhtml) and [12](B9780080571157500121.xhtml), and uses these ideas in subsequent chapters, particularly [20](B9780080571157500200.xhtml) and [21](B9780080571157500212.xhtml).\n\nThe dialect of Lisp known as Scheme is also gaining in popularity, but primarily for teaching and experimenting with programming language design and techniques, and not so much for writing large AI programs.\nScheme is presented in [chapters 22](B9780080571157500224.xhtml) and [23](B9780080571157500236.xhtml).\nOther dialects of Lisp such as Franz Lisp, MacLisp, InterLisp, ZetaLisp, and Standard Lisp are now considered obsolete.\nThe only new dialect of Lisp to be proposed recently is EuLisp, the European Lisp.\nA few dialects of Lisp live on as embedded extension languages.\nFor example, the Gnu Emacs text editor uses elisp, and the AutoCad computer-aided design package uses AutoLisp, a derivative of Xlisp.\nIn the future, it is likely that Scheme will become a popular extension language, since it is small but powerful and has an officially sanctioned standard definition.\n\nThere is a myth that Lisp (and Prolog) are \"special-purpose\" languages, while languages like Pascal and C are \"general purpose.\" Actually, just the reverse is true.\nPascal and C are special-purpose languages for manipulating the registers and memory of a von Neumann-style computer.\nThe majority of their syntax is devoted to arithmetic and Boolean expressions, and while they provide some facilities for forming data structures, they have poor mechanisms for procedural abstraction or control abstraction.\nIn addition, they are designed for the state-oriented style of programming: computing a result by changing the value of variables through assignment statements.\n\nLisp, on the other hand, has no special syntax for arithmetic.\nAddition and multiplication are no more or less basic than list operations like appending, or string operations like converting to upper case.\nBut Lisp provides all you will need for programming in general: defining data structures, functions, and the means for combining them.\n\nThe assignment-dominated, state-oriented style of programming is possible in Lisp, but in addition object-oriented, rule-based, and functional styles are all supported within Lisp.\nThis flexibility derives from two key features of Lisp: First, Lisp has a powerful *macro* facility, which can be used to extend the basic language.\nWhen new styles of programming were invented, other languages died out; Lisp simply incorporated the new styles by defining some new macros.\nThe macro facility is possible because Lisp programs are composed of a simple data structure: the list.\nIn the early days, when Lisp was interpreted, most manipulation of programs was done through this data structure.\nNowadays, Lisp is more often compiled than interpreted, and programmers rely more on Lisp's second great flexible feature: the *function*.\nOf course, other languages have functions, but Lisp is rare in allowing the creation of new functions while a program is running.\n\nLisp's flexibility allows it to adapt as programming styles change, but more importantly, Lisp can adapt to your particular programming problem.\nIn other languages you fit your problem to the language; with Lisp you extend the language to fit your problem.\n\nBecause of its flexibility, Lisp has been succesful as a high-level language user for rapid prototyping in areas such as AI, graphics, and interfaces.\nLisp has also been the dominant language for exploratory programming, where the problems are so complex that no clear solution is available at the start of the project.\nMuch of AI falls under this heading.\n\nThe size of Common Lisp can be either an advantage or a disadvantage, depending on your outlook.\nIn [David Touretzky's (1989)](B9780080571157500285.xhtml#bb1240) fine book for beginning programmers, the emphasis is on simplicity.\nHe chooses to write some programs slightly less concisely, rather than introduce an esoteric new feature (he cites `pushnew` as an example).\nThat approach is entirely appropriate for beginners, but this book goes well past the level of beginner.\nThis means exposing the reader to new features of the language whenever they are appropriate.\nMost of the time, new features are described as they are introduced, but sometimes explaining the details of a low-level function would detract from the explanation of the workings of a program.\nIn accepting the privilege of being treated as an \"adult,\" the reader also accepts a responsibility-to look up unfamiliar terms in an appropriate reference source.\n\n## Outline of the Book\n{:#s0020}\n{:.h1hd}\n\nThis book is organized into five parts.\n!!!(p) {:.para_fl}\n\n**[Part I](parti.xhtml)** introduces the Common Lisp programming language.\n\n[Chapter 1](B9780080571157500017.xhtml) gives a quick introduction by way of small examples that demonstrate the novel features of Lisp.\nIt can be safely skipped or skimmed by the experienced programmer.\n\n[Chapter 2](B9780080571157500029.xhtml) is a more extended example showing how the Lisp primitives can be put together to form a program.\nIt should be studied carefully by the novice, and even the experienced programmer will want to look through it to get a feel for my programming style.\n\n[Chapter 3](B9780080571157500030.xhtml) provides an overview of the Lisp primitives.\nIt can be skimmed on first reading and used as a reference whenever an unfamiliar function is mentioned in the text.\n\n[Part I](parti.xhtml) has been kept intentionally brief, so that there is more room for presenting actual AI programs.\nUnfortunately, that means that another text or reference book (or online help) may be needed to clarify some of the more esoteric features of the language.\nMy recommendations for texts are on page xiii.\n\nThe reader may also want to refer to [chapter 25](B978008057115750025X.xhtml), which offers some debugging and troubleshooting hints.\n\n**[Part II](partii.xhtml)** covers four early AI programs that all use rule-based pattern-matching techniques.\nBy starting with relatively simple versions of the programs and then improving them and moving on to more complex programs, the reader is able to gradually acquire increasingly advanced programming skills.\n\n[Chapter 4](B9780080571157500042.xhtml) presents a reconstruction of GPS !!!(span) {:.smallcaps} , the General Problem Solver.\nThe implementation follows the STRIPS !!!(span) {:.smallcaps} approach.\n\n[Chapter 5](B9780080571157500054.xhtml) describes ELIZA !!!(span) {:.smallcaps} , a program that mimics human dialogue.\nThis is followed by a chapter that generalizes some of the techniques used in GPS !!!(span) {:.smallcaps} and ELIZA !!!(span) {:.smallcaps} and makes them available as tools for use in subsequent programs.\n\n[Chapter 7](B9780080571157500078.xhtml) covers STUDENT !!!(span) {:.smallcaps} , a program that solves high-school-level algebra word problems.\n\n[Chapter 8](B978008057115750008X.xhtml) develops a small subset of the MACSYMA !!!(span) {:.smallcaps} program for doing symbolic algebra, including differential and integral calculus.\nIt may be skipped by those who shy away from heavy mathematics.\n\n**[Part III](partiii.xhtml)** detours from AI for a moment to present some general tools for more efficient programming.\nThe reader who masters the material in this part can be considered an advanced Lisp programmer.\n\n[Chapter 9](B9780080571157500091.xhtml) is a detailed study of efficiency techniques, concentrating on caching, indexing, compilation, and delaying computation.\n[Chapter 10](B9780080571157500108.xhtml) covers lower-level efficiency issues such as using declarations, avoiding garbage generation, and choosing the right data structure.\n\n[Chapter 11](B978008057115750011X.xhtml) presents the Prolog language.\nThe aim is two-fold: to show how to write an interpreter for another language, and to introduce the important features of Prolog, so that they can be used where appropriate.\n[Chapter 12](B9780080571157500121.xhtml) shows how a compiler for Prolog can be 20 to 200 times faster than the interpreter.\n\n[Chapter 13](B9780080571157500133.xhtml) introduces object-oriented programming in general, then explores the Common Lisp Object System (CLOS).\n\n[Chapter 14](B9780080571157500145.xhtml) discusses the advantages and limitations of both logic-oriented and object-oriented programming, and develops a knowledge representation formalism using all the techniques of [part III](partiii.xhtml).\n\n**[Part IV](partiv.xhtml)** covers some advanced AI programs.\n\n[Chapter 15](B9780080571157500157.xhtml) uses the techniques of [part III](partiii.xhtml) to come up with a much more efficient implementation of MACSYMA !!!(span) {:.smallcaps} . It uses the idea of a canonical form, and replaces the very general rewrite rule approach with a series of more specific functions.\n\n[Chapter 16](B9780080571157500169.xhtml) covers the EMYCIN !!!(span) {:.smallcaps} expert system shell, a backward chaining rule-based system based on certainty factors.\nThe MYCIN !!!(span) {:.smallcaps} medical expert system is also covered briefly.\n\n[Chapter 17](B9780080571157500170.xhtml) covers the Waltz line-labeling algorithm for polyhedra (using Huffman-Clowes labels).\nDifferent approaches to constraint propagation and backtracking are discussed.\n\n[Chapter 18](B9780080571157500182.xhtml) presents a program that plays an excellent game of Othello.\nThe technique used, alpha-beta searching, is appropriate to a wide variety of two-person games.\n\n[Chapter 19](B9780080571157500194.xhtml) is an introduction to natural language processing.\nIt covers context-free grammar, top-down and bottom-up parsing, chart parsing, and some semantic interpretation and preferences.\n\n[Chapter 20](B9780080571157500200.xhtml) extends the linguistic coverage of the previous chapter and introduces logic grammars, using the Prolog compiler developed in [chapter 11](B978008057115750011X.xhtml).\n\n[Chapter 21](B9780080571157500212.xhtml) is a fairly comprehensive grammar of English using the logic grammar formalism.\nThe problems of going from a simple idea to a realistic, comprehensive program are discussed.\n\n**[Part V](partv.xhtml)** includes material that is peripheral to AI but important for any serious Lisp programmer.\n\n[Chapter 22](B9780080571157500224.xhtml) presents the Scheme dialect of Lisp.\nA simple Scheme interpreter is developed, then a properly tail-recursive interpreter, then an interpreter that explicitly manipulates continuations and supports `call/cc`.\n[Chapter 23](B9780080571157500236.xhtml) presents a Scheme compiler.\n\n[Chapter 24](B9780080571157500248.xhtml) presents the features that are unique to American National Standards Institute (ANSI) Common Lisp.\nThis includes the `loop` macro, as well as error handling, pretty printing, series and sequences, and the package facility.\n\n[Chapter 25](B978008057115750025X.xhtml) is a guide to troubleshooting and debugging Lisp programs.\n\nThe bibliography lists over 200 sources, and there is a comprehensive index.\nIn addition, the appendix provides a directory of publicly available Lisp programs.\n\n## How to Use This Book\n{:#s0025}\n{:.h1hd}\n\nThe intended audience for this book is broad: anyone who wants to become an advanced Lisp programmer, and anyone who wants to be an advanced AI practitioner.\nThere are several recommended paths through the book:\n!!!(p) {:.para_fl}\n\n*  *In an Introductory AI Course:* Concentrate on parts I and II, and at least one example from [part IV](partiv.xhtml).\n\n*  *In an Advanced AI Programming Course:* Concentrate on parts I, II and IV, skipping chapters that are of less interest and adding as much of [part III](partiii.xhtml) as time permits.\n\n*  *In an Advanced Programming Languages Course:* Concentrate on parts I and V, with selections from [part III](partiii.xhtml).\nCover [chapters 11](B978008057115750011X.xhtml) and [13](B9780080571157500133.xhtml) if similar material is not presented with another text.\n\n*  *For the Professional Lisp Programmer:* Read as much of the book as possible, and refer back to it often.\n[Part III](partiii.xhtml) and [chapter 25](B978008057115750025X.xhtml) are particularly important.\n\n## Supplementary Texts and Reference Books\n{:#s0030}\n{:.h1hd}\n\nThe definitive reference source is Steele's *Common Lisp the Language*.\nFrom 1984 to 1990, this unambiguously defined the language Common Lisp.\nHowever, in 1990 the picture became more complicated by the publication of *Common Lisp the Language*, 2d edition.\nThis book, also by Steele, contains the recommendations of ANSI subcommittee X3J13, whose charter is to define a standard for Lisp.\nThese recommendations include many minor changes and clarifications, as well as brand new material on object-oriented programming, error condition handling, and the loop macro.\nThe new material doubles the size of the book from 465 to 1029 pages.\n!!!(p) {:.para_fl}\n\nUntil the ANSI recommendations are formally accepted, Common Lisp users are in the unfortunate situation of having two distinct and incompatible standards: \"original\" Common Lisp and ANSI Common Lisp.\nMost of the code in this book is compliant with both standards.\nThe most significant use of an ANSI function is the `loop` macro.\nThe ANSI `map-into`, `complement`, and `reduce` functions are also used, although rarely.\nDefinitions for all these functions are included, so even those using an \"original\" Common Lisp system can still run all the code in the book.\n\nWhile *Common Lisp the Language* is the definitive standard, it is sometimes terse and can be difficult for a beginner.\n*Common Lisp: the Reference*, published by Franz Inc., offers complete coverage of the language with many helpful examples.\n*Common LISPcraft*, by Robert Wilensky, and *Artificial Intelligence Programming*, by Charniak et al., also include brief summaries of the Common Lisp functions.\nThey are not as comprehensive, but that can be a blessing, because it can lead the reader more directly to the functions that are important (at least in the eyes of the author).\n\nIt is a good idea to read this book with a computer at hand, to try out the examples and experiment with examples of your own.\nA computer is also handy because Lisp is self-documenting, through the functions `apropos`, `describe`, and `documentation`.\nMany implementations also provide more extensive documentation through some kind of 'help' command or menu.\n\nThe five introductory Lisp textbooks I recommend are listed below.\nThe first is more elementary than the others.\n\n*  *Common Lisp: A Gentle Introduction to Symbolic Computation* by David Touretzky.\nMost appropriate for beginners, including those who are not computer scientists.\n\n*  *A Programmer's Guide to Common Lisp* by Deborah G.\nTatar.\nAppropriate for those with experience in another programming language, but none in Lisp.\n\n*  *Common LISPcraft* by Robert Wilensky.\nMore comprehensive and faster paced, but still useful as an introduction as well as a reference.\n\n*  *Common Lisp* by Wade L.\nHennessey.\nSomewhat hit-and-miss in terms of the topics it covers, but with an enlightened discussion of implementation and efficiency issues that do not appear in the other texts.\n\n*  *LISP* (3d edition) by Patrick H.\nWinston and Bertold Horn.\nCovers the most ground in terms of programming advice, but not as comprehensive as a reference.\nMay be difficult for beginners.\nIncludes some AI examples.\n\nWhile it may be distracting for the beginner to be continually looking at some reference source, the alternative-to have this book explain every new function in complete detail as it is introduced-would be even more distracting.\nIt would interrupt the description of the AI programs, which is what this book is all about.\n\nThere are a few texts that show how to write AI programs and tools, but none that go into the depth of this book.\nNevertheless, the expert AI programmer will want to be familiar with all the following texts, listed in rough order of increasing sophistication:\n\n*  *LISP* (3d edition).\n(See above.)\n\n*  *Programming Paradigms in Lisp* by Rajeev Sangal.\nPresents the different styles of programming that Lisp accommodates, illustrating them with some useful AI tools.\n\n*  *Programming for Artificial Intelligence* by Wolfgang Kreutzer and Bruce McKenzie.\nCovers some of the basics of rule-based and pattern-matching systems well, but covers Lisp, Prolog, and Smalltalk, and thus has no time left for details in any of the languages.\n\n*  *Artificial Intelligence Programming* (2d edition) by Eugene Charniak, Christopher Riesbeck, Drew McDermott, and James Meehan.\nContains 150 pages of Lisp overview, followed by an advanced discussion of AI tools, but no actual AI programs.\n\n*  *AI in Practice: Examples in Pop-11* by Allan Ramsey and Rosalind Barrett.\nAdvanced, high-quality implementations of five AI programs, unfortunately using a language that has not gained popularity.\n\nThe current text combines the virtues of the last two entries: it presents both actual AI programs and the tools necessary to build them.\nFurthermore, the presentation is in an incremental fashion, with simple versions presented first for clarity, followed by more sophisticated versions for completeness.\n\n## A Note on Exercises\n{:#s0035}\n{:.h1hd}\n\nSample exercises are provided throughout.\nReaders can test their level of understanding by faithfully doing the exercises.\nThe exercises are graded on the scale [s], [m], [h], [d], which can be interpreted either as a level of difficulty or as an expected time it will take to do the exercise:\n!!!(p) {:.para_fl}\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Code | Difficulty | Time to Do |\n| [s] | Simple | Seconds |\n| [m] | Medium | Minutes |\n| [h] | Hard | Hours |\n| [d] | Difficult | Days |\n\nThe time to do the exercise is measured from the point that the concepts have been well understood.\nIf the reader is unclear on the underlying concepts, it might take hours of review to understand a [m] problem.\nAnswers to the exercises can be found in a separate section at the end of each chapter.\n\n## Acknowledgments\n{:#s0010}\n{:.h1hd}\n\nA great many people contributed to this book.\nFirst of all I would like to thank my students at USC and Berkeley, as well as James Martin's students at Colorado and Michael Pazzani's students at Irvine, who course-tested earlier versions of this book.\nUseful suggestions, corrections, and additions were made by:\n!!!(p) {:.para_fl}\n\nNina Amenta (Berkeley), Ray S.\nBabcock and John Paxton (Montana State), Bryan A.\nBentz (BBN), Mary P.\nBoelk (Johnson Controls), Michael Braverman (Berkeley), R.\nChandrasekar and M.\nSasikumar (National Centre for Software Technology, Bombay), Mike Clancy (Berkeley), Michael Covington (Georgia), Bruce D'Ambrosio (Oregon State), Piew Datta (Irvine), Shawn Dettrey (USC), J.\nA.\nDurieux (AI Engineering BV, Amsterdam), Joseph Faletti (ETS), Paul Fuqua (Texas Instruments), Robert Goldman (Tulane), Marty Hall (Johns Hopkins), Marti Hearst (Berkeley), Jim Hendler (Maryland), Phil Laird (NASA), Raymond Lang (Tulane), David D.\nLoeffler (MCC), George Luger (New Mexico), Rob MacLachlan (CMU), Barry Margolin (Thinking Machines), James Mayfield (UMBC), Sanjay Manchandi (Arizona), Robert McCartney (Connecticut), James Meehan (DEC), Andrew L.\nRessler, Robert S.\nRist (University of Technology, Sydney), Paul Snively (Apple), Peter Van Roy (Berkeley), David Gumby Wallace (Cygnus), and Jeff Wu (Colorado).\n\nSam Dooley and Eric Wefald both wrote Othello-playing programs without which I would not have written [chapter 18](B9780080571157500182.xhtml).\nEric also showed me Aristotle's quotes on means-ends analysis.\nTragically, Eric died in August 1989.\nHe is sorely missed by his friends and colleagues.\nRichard Fateman made suggestions for [chapter 8](B978008057115750008X.xhtml), convinced me to write [chapter 15](B9780080571157500157.xhtml), and, with help from Peter Klier, wrote a substantial program from which I adapted some code for that chapter.\nCharley Cox (Franz Inc.), Jamie Zawinski (Lucid Inc.), and Paul Fuqua (Texas Instruments) explained the inner workings of their respective companies' compilers.\nMike Harrison, Paul Hilfinger, Marc Luria, Ethan Munson, and Stephan Slade helped with LA !!!(span) {:.smallcaps} TE !!!(span) {:.smallcaps} X.\nNarciso Jarimillo tested all the code and separated it into the files that are available to the reader (see page 897).\n\nDuring the writing of this book I was supported by a grant from the Defense Advanced Research Projects Agency (DoD), Arpa Order No.\n4871, monitored by Space and Naval Warfare Systems Command under Contract N00039-84-C-0089.\nSpecial thanks to DARPA and to Robert Wilensky and the rest of my colleagues and students at Berkeley for providing a stimulating environment for research, programming, and writing.\n\nFinally, thanks to Mike Morgan and Yonie Overton for overseeing the production of the book and encouraging me to finish on time.\n\n----------------------\n\n[1](#xfn0010) This does not imply that the programs chosen are the best of all AI programs-just that they are representative.\n!!!(p) {:.ftnote1}\n\nPart I\nIntroduction to Common Lisp\n!!!(p) {:.parttitle}\n\n# Chapter 1\n## Introduction to Lisp\n{:.chaptitle}\n\n> You think you know when you learn, are more sure when you can write, even more when you can teach, but certain when you can program.\n\n> -Alan Perlis\n\n> Yale University computer scientist\n\nThis chapter is for people with little or no experience in Lisp.\nReaders who feel confident in their Lisp programming ability can quickly skim the chapter or skip it entirely.\nThis chapter necessarily moves quickly, so those with little programming experience, or any reader who finds this chapter tough going, should seek out a supplementary introductory text.\nMy recommendations are in the preface.\n\nComputers allow one to carry out computations.\nA word processing program deals with words while a calculator deals with numbers, but the principles are the same.\nIn both cases, you provide the input (words or numbers) and specify the operations (such as deleting a word or adding two numbers) to yield a result (a completed document or calculation).\n\nWe will refer to anything that can be represented in the memory of a computer as a *computational object,* or just an *object.* So, words, paragraphs, and numbers can be objects.\nAnd because the operations (deleting and adding) must be represented somewhere in the computer's memory, they are objects, too.\n\nNormally, the distinction between a computer \"user\" and a computer \"programmer\" is that the user provides new input, or data (words or numbers), while the programmer defines new *operations*, or programs, as well as new *types* of data.\nEvery new object, be it datum or operation, must be defined in terms of previously defined objects.\nThe bad news is that it can be quite tedious to get these definitions right.\nThe good news is that each new object can in turn be used in the definition of future objects.\nThus, even complex programs can be built out of smaller, simpler objects.\nThis book covers a number of typical AI problems, showing how each problem can be broken down into manageable pieces, and also how each piece can be described in the programming language Common Lisp.\nIdeally, readers will learn enough through studying these examples to attack new AI problems with style, grace, and success.\n\nLet's consider a simple example of a computation: finding the sum of two numbers, let's say 2 and 2.\nIf we had a calculator handy, we would type \"2 + 2 =\" and see the answer displayed.\nOn a calculator using reverse Polish notation, we would have to type \"22+\" to see the same answer.\nIn Lisp, as with the calculator, the user carries out an interactive dialog with the computer by typing in an expression and seeing the computer print the value of that expression.\nThis interactive mode is different from many other programming languages that only offer a batch mode, wherein an entire program is compiled and run before any output can be seen.\n\nWe start up a pocket calculator by flipping the on/off switch.\nThe Lisp program must also be started, but the details vary from one computer to another, so I can't explain how your Lisp will work.\nAssuming we have managed to start up Lisp, we are likely to see a *prompt* of some kind.\nOn my computer, Lisp types \"`>`\" to indicate it is ready to accept the next computation.\nSo we are faced with a screen that looks like this:\n\n```lisp\n  >\n```\n\nWe may now type in our computation and see the result displayed.\nIt turns out that the Lisp convention for arithemtic expressions is slightly different: a computation consists of a parenthesized list with the operation name first, followed by any number of operands, or arguments.\nThis is called *prefix notation.*\n\n```lisp\n  >(+ 2 2)\n  4\n  >\n```\n\nWe see that Lisp has printed the answer, 4, and then another prompt, >, to indicate it is ready for the next computation.\nThroughout this book, all Lisp expressions will be displayed in `typewriter` font.\nText on the same line as the \">\" prompt is input typed by the user, and text following it is output printed by the computer.\nUsually, input that is typed by the programmer will be in `lowercase` letters, while output that is printed back by the computer will be in `UPPERCASE` letters.\nOf course, with symbols like + and 4 there is no difference.\n\nTo save space on the page, the output will sometimes be shown on the same line as the input, separated by an arrow (=>), which can be read as \"evaluates to,\" and can also be thought of as standing for the return or enter key that the user presses to complete the input:\n\n```lisp\n  > (+ 2 2) => 4\n```\n\nOne advantage of parenthesized prefix notation is that the parentheses clearly mark the beginning and end of an expression.\nIf we want, we can give + more than two arguments, and it will still add them all:\n\n```lisp\n  > (+ 1 2 3 4 5 6 7 8 9 10) => 55\n```\n\nThis time we try (9000 + 900 + 90 + 9) - (5000 + 500 + 50 + 5):\n\n```lisp\n  > (- (+ 9000 900 90 9) (+ 5000 500 50 5)) => 4444\n```\n\nThis example shows that expressions can be nested.\nThe arguments to the - function are parenthesized lists, while the arguments to each `+` are atoms.\nThe Lisp notation may look unusual compared to standard mathematical notation, but there are advantages to this notation; since Lisp expressions can consist of a function followed by any number of arguments, we don't have to keep repeating the `\"+.\"` More important than the notation is the rule for evaluation.\nIn Lisp, lists are evaluated by first evaluating all the arguments, then applying the function to the arguments, thereby Computing the result.\nThis rule is much simpler than the rule for evaluating normal mathematical expressions, where there are many conventions to remember, such as doing multiplications and divisions before sums and differences.\nWe will see below that the actual Lisp evaluation rule is a little more complicated, but not much.\n\nSometimes programmers who are familiar with other languages have preconceptions that make it difficult for them to learn Lisp.\nFor them, three points are worth stressing here.\nFirst, many other languages make a distinction between statements and expressions.\nAn expression, like `2 + 2`, has a value, but a statement, like `x = 2 + 2`, does not.\nStatements have effects, but they do not return values.\nIn Lisp, there is no such distinction: every expression returns a value.\nIt is true that some expressions have effects, but even those expressions also return values.\n\nSecond, the lexical rules for Lisp are much simpler than the rules for other languages.\nIn particular, there are fewer punctuation characters: only parentheses, quote marks (single, double, and backward), spaces, and the comma serve to separate symbols from each other.\nThus, while the statement `y=a*x+3` is analyzed as seven separate tokens in other languages, in Lisp it would be treated as a single symbol.\nTo get a list of tokens, we would have to insert spaces: `(y = a * x + 3)`.[1](#fn0010)\n\nThird, while many languages use semicolons to delimit statements, Lisp has no need of semicolons, since expressions are delimited by parentheses.\nLisp chooses to use semicolons for another purpose-to mark the beginning of a comment, which lasts until the end of the line:\n\n```lisp\n  >(+ 2 2) ; this is a comment\n  4\n```\n\n## 1.1 Symbolic Computation\n{:#s0010}\n{:.h1hd}\n\nAll we've done so far is manipulate numbers in the same way a simple pocket calculator would.\nLisp is more useful than a calculator for two main reasons.\nFirst, it allows us to manipulate objects other than numbers, and second, it allows us to define new objects that might be useful in subsequent computations.\nWe will examine these two important properties in turn.\n\nBesides numbers, Lisp can represent characters (letters), strings of characters, and arbitrary symbols, where we are free to interpret these symbols as referring to things outside the world of mathematics.\nLisp can also build nonatomic objects by combining several objects into a list.\nThis capability is fundamental and well supported in the language; in fact, the name Lisp is short for LISt Processing.\n\nHere's an example of a computation on lists:\n\n```lisp\n  > (append '(Pat Kim) '(Robin Sandy)) => (PAT KIM ROBIN SANDY)\n```\n\nThis expression appends together two lists of names.\nThe rule for evaluating this expression is the same as the rule for numeric calculations: apply the function (in this case append) to the value of the arguments.\n\nThe unusual part is the quote mark `(')`, which serves to block the evaluation of the following expression, returning it literally.\nIf we just had the expression (`Pat Kim),` it would be evaluated by considering `Pat` as a function and applying it to the value of the expression `Kim.` This is not what we had in mind.\nThe quote mark instructs Lisp to treat the list as a piece of data rather than as a function call:\n\n```lisp\n  >'(Pat Kim) (PAT KIM)\n```\n\nIn other computer languages (and in English), quotes usually come in pairs: one to mark the beginning, and one to mark the end.\nIn Lisp, a single quote is used to mark the beginning of an expression.\nSince we always know how long a single expression is-either to the end of an atom or to the matching parenthesis of a list-we don't need an explicit punctuation mark to tell us where the expression ends.\nQuotes can be used on lists, as in `'(Pat Kim)`, on symbols as in `'Robin`, and in fact on anything else.\nHere are some examples:\n\n```lisp\n  > 'John => JOHN\n  > '(John Q Public) => (JOHN Q PUBLIC)\n  > '2 => 2\n  > 2 => 2\n  > '(+ 2 2) => (+ 2 2)\n  > (+ 2 2) 4\n  > John => *Error: JOHN is not a bound variable*\n  > (John Q Public) => *Error: JOHN is not a function*\n```\n\nNote that `'2` evaluates to `2` because it is a quoted expression, and `2` evaluates to `2` because numbers evaluate to themselves.\nSame result, different reason.\nIn contrast, '`John` evaluates to `John` because it is a quoted expression, but evaluating `John` leads to an error, because evaluating a symbol means getting the value of the symbol, and no value has been assigned to `John.`\n\nSymbolic computations can be nested and even mixed with numeric computations.\nThe following expression builds a list of names in a slightly different way than we saw before, using the built-in function `list`.\nWe then see how to find the number of elements in the list, using the built-in function `length:`\n\n```lisp\n  > (append '(Pat Kim) (list '(John Q Public) 'Sandy))\n  (PAT KIM (JOHN Q PUBLIC) SANDY)\n  > (length (append '(Pat Kim) (list '(John Q Public) 'Sandy)))\n  4\n```\n\nThere are four important points to make about symbols:\n\n*  First, it is important to remember that Lisp does not attach any external significance to the objects it manipulates.\nFor example, we naturally think of (`Robin Sandy`) as a list of two first names, and (`John Q Public`) as a list of one person's first name, middle initial, and last name.\nLisp has no such preconceptions.\nTo Lisp, both `Robin` and `xyzzy` are perfectly good symbols.\n\n*  Second, to do the computations above, we had to know that `append, length`, and + are defined functions in Common Lisp.\nLearning a language involves remembering vocabulary items (or knowing where to look them up) as well as learning the basic rules for forming expressions and determining what they mean.\nCommon Lisp provides over 700 built-in functions.\nAt some point the reader should flip through a reference text to see what's there, but most of the important functions are presented in part I of this book.\n\n*  Third, note that symbols in Common Lisp are not case sensitive.\nBy that I mean that the inputs `John, john,` and `jOhN` all refer to the same symbol, which is normally printed as `JOHN.`[2](#fn0015)\n\n*  Fourth, note that a wide variety of characters are allowed in symbols: numbers, letters, and other punctuation marks like `'+'` or `'!'` The exact rules for what constitues a symbol are a little complicated, but the normal convention is to use symbols consisting mostly of letters, with words separated by a dash `(-)`, and perhaps with a number at the end.\nSome programmers are more liberal in naming variables, and include characters like `'?!$/<=>'`.\nFor example, a function to convert dollars to yen might be named with the symbol `$ - to -yen` or `$ ->yen` in Lisp, while one would use something like `DollarsToYen, dollars_to_yen` or `dol2yen` in Pascal or C.\nThere are a few exceptions to these naming conventions, which will be dealt with as they come up.\n\n## 1.2 Variables\n{:#s0015}\n{:.h1hd}\n\nWe have seen some of the basics of symbolic computation.\nNow we move on to perhaps the most important characteristic of a programming language: the ability to define new objects in terms of other s, and to name these objects for future use.\nHere symbols again play an important role-they are used to name variables.\nA variable can take on a value, which can be any Lisp object.\nOne way to give a value to a variable is with setf :\n\n```lisp\n  > (setf p '(John Q Public)) => (JOHN Q PUBLIC)\n  > p => (JOHN Q PUBLIC)\n  > (setf x 10) => 10\n  > (+ x x) => 20\n  > (+ x (length p)) => 13\n```\n\nAfter assigning the value (`John Q Public`) to the variable named `p`, we can refer to the value with the name `p`.\nSimilarly, after assigning a value to the variable named `x`, we can refer to both `x` and `p`.\n\nSymbols are also used to name functions in Common Lisp.\nEvery symbol can be used as the name of a variable or a function, or both, although it is rare (and potentially confusing) to have symbols name both.\nFor example, `append` and `length` are symbols that name functions but have no values as variables, and `pi` does not name a function but is a variable whose value is 3.1415926535897936 (or thereabout).\n\n## 1.3 Special Forms\n{:#s0020}\n{:.h1hd}\n\nThe careful reader will note that `setf` violates the evaluation rule.\nWe said earlier that functions like `+`, - and `append` work by first evaluating all their arguments and then applying the function to the result.\nBut `setf` doesn't follow that rule, because `setf` is not a function at all.\nRather, it is part of the basic syntax of Lisp.\nBesides the syntax of atoms and function calls, Lisp has a small number of syntactic expressions.\nThey are known as *special forms.* They serve the same purpose as statements in other programming languages, and indeed have some of the same syntactic markers, such as `if` and `loop`.\nThere are two main differences between Lisp's syntax and other languages.\nFirst, Lisp's syntactic forms are always lists in which the first element is one of a small number of privileged symbols.\n`setf` is one of these symbols, so (`setf x 10`) is a special form.\nSecond, special forms are expressions that return a value.\nThis is in contrast to statements in most languages, which have an effect but do not return a value.\n\nIn evaluating an to expression like `(setf x (+ 1 2)`), we set the variable named by the symbol `x` to the value of `(+ 1 2)`, which is `3`.\nIf `setf` were a normal function, we would evaluate both the symbol `x` and the expression `(+ 1 2)` and do something with these two values, which is not what we want at all.\n`setf` is called a special form because it does something special: if it did not exist, it would be impossible to write a function that assigns a value to a variable.\nThe philosophy of Lisp is to provide a small number of special forms to do the things that could not otherwise be done, and then to expect the user to write everthing else as functions.\n\nThe term *special form* is used confusingly to refer both to symbols like `setf` and expressions that start with them, like `(setf x 3)`.\nIn the book *Common LISPcraft,* Wilensky resolves the ambiguity by calling `setf` a *special function,* and reserving the term *special form* for (`setf x 3`).\nThis terminology implies that `setf` is just another function, but a special one in that its first argument is not evaluated.\nSuch a view made sense in the days when Lisp was primarily an interpreted language.\nThe modem view is that `setf` should not be considered some kind of abnormal function but rather a marker of special syntax that will be handled specially by the compiler.\nThus, the special form `(setf x (+ 2 1))` should be considered the equivalent of `x = 2 + 1` in `C`.\nWhen there is risk of confusion, we will call `setf` a *special form operator* and `(setf x 3)` a *special form expression.*\n\nIt turns out that the quote mark is just an abbreviation for another special form.\nThe expression '*x* is equivalent to `(quote *x*)`, a special form expression that evaluates to *x.* The special form operators used in this chapter are:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `defun` | define function |\n| `defparameter` | define special variable |\n| `setf` | set variable or field to new value |\n| `let` | bind local variable(s) |\n| `case` | choose one of several alternatives |\n| `if` | do one thing or another, depending on a test |\n| `function (#')` | refer to a function |\n| `quote (')` | introduce constant data |\n\n## 1.4 Lists\n{:#s0025}\n{:.h1hd}\n\nSo far we have seen two functions that operate on lists: `append` and l`ength.` Since lists are important, let's look at some more list processing functions:\n\n```lisp\n  > p => (JOHN Q PUBLIC)\n  > (first p) JOHN\n  > (rest p) => (Q PUBLIC)\n  > (second p) => Q\n  > (third p) => PUBLIC\n  > (fourth p) => NIL\n  > (length p) => 3\n```\n\nThe functions `first, second, third,` and `fourth` are aptly named: `first` returns the first element of a list, `second` gives you the second element, and so on.\nThe function `rest` is not as obvious; its name stands for \"the rest of the list after the first element.\" The symbol `nil` and the form `()` are completely synonymous; they are both representations of the empty list.\n`nil` is also used to denote the \"false\" value in Lisp.\nThus, `(fourth p)` is `nil` because there is no fourth element of `p.` Note that lists need not be composed only of atoms, but can contain sublists as elements:\n\n```lisp\n  > (setf x '((1st element) 2 (element 3) ((4)) 5))\n  > ((1ST ELEMENT) 2 (ELEMENT 3) ((4)) 5)\n  > (length x) => 5\n  > (first x) => (1ST ELEMENT)\n  > (second x) => 2\n  > (third x) => (ELEMENT 3)\n  > (fourth x) => ((4))\n  > (first (fourth x)) => (4)\n  > (first (first (fourth x))) => 4\n  > (fifth x) => 5\n  > (first x) => (1ST ELEMENT)\n  > (second (first x)) => ELEMENT\n```\n\nSo far we have seen how to access parts of lists.\nIt is also possible to build up new lists, as these examples show:\n\n```lisp\n  > p => (JOHN Q PUBLIC)\n  > (cons 'Mr p) => (MR JOHN Q PUBLIC)\n  > (cons (first p) (rest p)) => (JOHN Q PUBLIC)\n  > (setf town (list 'Anytown 'USA)) => (ANYTOWN USA)\n  > (list p 'of town 'may 'have 'already 'won!) =>\n  ((JOHN Q PUBLIC) OF (ANYTOWN USA) MAY HAVE ALREADY WON!)\n  > (append p '(of) town '(may have already won!)) =>\n  (JOHN Q PUBLIC OF ANYTOWN USA MAY HAVE ALREADY WON!)\n  > p => (JOHN Q PUBLIC)\n```\n\nThe function cons stands for \"construct.\" It takes as arguments an element and a list,[3](#fn0020) and constructs a new list whose first is the element and whose rest is the original list.\n`list` takes any number of elements as arguments and returns a new list containing those elements in order.\nWe've already seen `append,` which is similar to `list`; it takes as arguments any number of lists and appends them all together, formingone biglist.\nThus, the arguments to `append` must be lists, while the arguments to `list` may be lists or atoms.\nIt is important to note that these functions create new lists; they don't modify old ones.\nWhen we say `(append p q`), the effect is to create a brand new list that starts with the same elements that were in `p.\np` itself remains unchanged.\n\nNow let's move away from abstract functions on lists, and consider a simple problem: given a person's name in the form of a list, how might we extract the family name?\nFor `(JOHN Q PUBLIC)` wecouldjust use the function `third`, but that wouldn't work for someone with no middle name.\nThere is a function called `last` in Common Lisp; perhaps that would work.\nWe can experiment:\n\n```lisp\n  > (last p) => (PUBLIC)\n  > (first (last p)) => PUBLIC\n```\n\nIt turns out that `last` perversely returns a list of the last element, rather than the last element itself.[4](#fn0025) Thus we need to combine `first` and `last` to pick out the actual last element.\nWe would like to be able to save the work we've done, and give it a proper description, like `last-name`.\nWe could use `setf` to save the last name of `p`, but that wouldn't help determine any other last name.\nInstead we want to define a new function that computes the last name of *any* name that is represented as a list.\nThe next section does just that.\n\n## 1.5 Defining New Functions\n{:#s0030}\n{:.h1hd}\n\nThe special form `defun` stands for \"define function.\" It is used here to define a new function called `last-name`:\n\n```lisp\n  (defun last-name (name)\n     \"Select the last name from a name represented as a list.\"\n     (first (last name)))\n```\n\nWe give our new function the name `last-name.` It has a *parameter list* consisting of a single parameter: (`name`).\nThis means that the function takes one argument, which we will refer to as `name.` It also has a *documentation string* that states what the function does.\nThis is not used in any computation, but documentation strings are crucial tools for debugging and understanding large systems.\nThe body of the definition is `(first (last name))`, which is what we used before to pick out the last name of `p`.\nThe difference is that here we want to pick out the last name of any `name,` not just of the particular name `p`.\n\nIn general, a function definition takes the following form (where the documentation string is optional, and all other parts are required):\n\n  `(defun`*function-name* (*parameter...*)\n\n     \"*documentation string*\"\n\n     *function-body...*)\n\nThe function name must be a symbol, the parameters are usually symbols (with some complications to be explained later), and the function body consists of one or more expressions that are evaluated when the function is called.\nThe last expression is returned as the value of the function call.\n\nOnce we have defined `last-name,` we can use it just like any other Lisp function:\n\n```lisp\n  > (last-name p) => PUBLIC\n  > (last-name '(Rear Admiral Grace Murray Hopper)) => HOPPER\n  > (last-name '(Rex Morgan MD)) => MD\n  > (last-name '(Spot)) => SPOT\n  > (last-name '(Aristotle)) => ARISTOTLE\n```\n\nThe last three examples point out an inherent limitation of the programming enterprise.\nWhenwesay `(defun last-name...)` we are not really defining what it means for a person to have a last name; we are just defining an operation on a representation of names in terms of lists.\nOur intuitions-that MD is a title, Spot is the first name of a dog, and Aristotle lived before the concept of last name was invented-are not represented in this operation.\nHowever, we could always change the definition of `last-name` to incorporate these problematic cases.\n\nWe can also define the function `first-name.` Even though the definition is trivial (it is the same as the function `first),` it is still good practice to define `first-name` explicitly.\nThen we canuse the function `first-name` when we are dealing with names, and `first` when we are dealing with arbitrary lists.\nThe computer will perform the same operation in each case, but we as programmers (and readers of programs) will be less confused.\nAnother advanatge of defining specific functions like `first-name` is that if we decide to change the representation of names we will only have to change the definition of `first-name.` This is a much easier task than hunting through a large program and changing the uses of `first` that refer to names, while leaving other uses alone.\n\n```lisp\n  (defun first-name (name)\n     \"Select the first name from a name represented as a list.\"\n     (first name))\n  > p => (JOHN Q PUBLIC)\n  > (first-name p) => JOHN\n  > (first-name '(Wilma Flintstone)) => WILMA\n  > (setf names '((John Q Public) (Malcolm X)\n                               (Admiral Grace Murray Hopper) (Spot)\n                               (Aristotle) (A A Milne) (Z Z Top)\n                               (Sir Larry Olivier) (Miss Scarlet))) =>\n  ((JOHN Q PUBLIC) (MALCOLM X) (ADMIRAL GRACE MURRAY HOPPER)\n    (SPOT) (ARISTOTLE) (A A MILNE) (Z Z TOP) (SIR LARRY OLIVIER)\n    (MISS SCARLET))\n  > (first-name (first names)) => JOHN\n```\n\nIn the last expression we used the function `first` to pick out the first element in a list of names, and then the function `first-name` to pick out the first name of that element.\nWe could also have said `(first (first names))` or even `(first (first-name names))` and still have gotten `JOHN,` but we would not be accurately representing what is being considered a name and what is being considered a list of names.\n\n## 1.6 Using Functions\n{:#s0035}\n{:.h1hd}\n\nOne good thing about defining a list of names, as we did above, is that it makes it easier to test our functions.\nConsider the followingexpression, which can be used to test the `last-name` function:\n\n```lisp\n  > (mapcar #'last-name names)\n  (PUBLIC X HOPPER SPOT ARISTOTLE MILNE TOP OLIVIER SCARLET)\n```\n\nThe funny `#'` notation maps from the name of a function to the function itself.\nThis is analogous to `'x` notation.\nThe built-in function mapca r is passed two arguments, a function and a list.\nIt returns a list built by calling the function on every element of the input list.\nIn other words, the `mapcar` call above is equivalent to:\n\n```lisp\n  (list (last-name (first names))\n            (1ast-name (second names))\n            (last-name (third names))\n             ...)\n```\n\n`mapcar's` name cornes from the fact that it \"maps\" the function across each of the arguments.\nThe `car` part of the name refers to the Lisp function `car`, an old name for `first`.\n`cdr` is the old name for `rest`.\nThe names stand for \"contents of the address register\" and \"contents of the decrement register,\" the instructions that were used in the first implementation of Lisp on the IBM 704.\nI'm sure you'll agree that `first` and `rest` are much better names, and they will be used instead of `car` and `cdr` whenever we are talking about lists.\nHowever, we will continue to use `car` and `cdr` on occasion when we are considering a pair of values that are not considered as a list.\nBeware that some programmers still use `car` and `cdr` for lists as well.\n\nHere are some more examples of `mapcar`:\n\n```lisp\n  > (mapcar #'- '(1 2 3 4)) => (-l -2 -3 -4)\n  > (mapcar #'+ '(1 2 3 4) '(10 20 30 40)) => (11 22 33 44)\n```\n\nThis last example shows that `mapcar` can be passed three arguments, in which case the first argument should be a binary function, which will be applied to corresponding elements of the other two lists.\nIn general, `mapcar` expects an *n*-ary function as its first argument, followed by *n* lists.\nIt first applies the function to the argument list obtained by collecting the first element of each list.\nThen it applies the function to the second element of each list, and so on, until one of the lists is exhausted.\nIt returns a list of all the function values it has computed.\n\nNow that we understand `mapcar`, let's use it to test the `first-name` function:\n\n```lisp\n  > (mapcar #'first-name names)\n  (JOHN MALCOLM ADMIRAL SPOT ARISTOTLE A Z SIR MISS)\n```\n\nWe might be disappointed with these results.\nSuppose we wanted a version of `first-name` which ignored titles like Admiral and Miss, and got to the \"real\" first name.\nWe could proceed as follows:\n\n```lisp\n  (defparameter *titles*\n     '(Mr Mrs Miss Ms Sir Madam Dr Admiral Major General)\n     \"A list of titles that can appear at the start of a name.\")\n```\n\nWe've introduced another new special form, `defparameter,` which defines a parameter-a variable that does not change over the course of a computation, but that might change when we think of new things to add (like the French Mme or the military Lt.).\nThe `defparameter` form both gives a value to the variable and makes it possible to use the variable in subsequent function definitions.\nIn this example we have exercised the option of providing a documentation string that describes the variable.\nIt is a widely used convention among Lisp programmers to mark special variables by spelling their names with asterisks on either end.\nThis is just a convention; in Lisp, the asterisk is just another character that has no particular meaning.\n\nWe next give a new definition for `first-name`, which supersedes the previous definition.[5](#fn0030) This definition says that if the first word of the name is a member of the list of titles, then we want to ignore that word and return the `first-name` of the rest of the words in the name.\nOtherwise, we use the first word, just as before.\nAnother built-in function, `member`, tests to see if its first argument is an element of the list passed as the second argument.\n\nThe special form `if` has the form `(if *test then-part else-part*)`.\nThere are many special forms for performing conditional tests in Lisp; `if` is the most appropriate for this example.\nAn `if` form is evaluated by first evaluating the *test* expression.\nIf it is true, the *then-part* is evaluated and returned as the value of the `if` form; otherwise the *else-part* is evaluated and returned.\nWhile some languages insist that the value of a conditional test must be either `true` or `false`, Lisp is much more forgiving.\nThe test may legally evaluate to any value at all.\nOnly the value `nil` is considered false; all other values are considered true.\nIn the definition of `first-name` below, the function `member` will return a non-nil (hence true) value if the first element of the name is in the list of titles, and will return `nil` (hence false) if it is not.\nAlthough all non-nil values are considered true, by convention the constant `t` is usually used to represent truth.\n\n```lisp\n  (defun first-name (name)\n     \"Select the first name from a name represented as a list.\"\n     (if (member (first name) *titles*)\n            (first-name (rest name))\n            (first name)))\n```\n\nWhen we map the new `first-name` over the list of names, the results are more encouraging.\nIn addition, the function gets the \"right\" result for `'(Madam Major General Paul a Jones)` by dropping off titles one at a time.\n\n```lisp\n  > (mapcar #'first-name names)\n  (JOHN MALCOLM GRACE SPOT ARISTOTLE A Z LARRY SCARLET)\n  > (first-name '(Madam Major General Paul a Jones))\n  PAULA\n```\n\nWe can see how this works by *tracing* the execution of `first-name`, and seeing the values passed to and returned from the function.\nThe special forms trace and untrace are used for this purpose.\n\n```lisp\n  > (trace first-name)\n  (FIRST-NAME)\n  > (first-name '(John Q Public))\n  (1 ENTER FIRST-NAME: (JOHN Q PUBLIC))\n  (1 EXIT FIRST-NAME: JOHN)\n  JOHN\n```\n\nWhen `first-name` is called, the definition is entered with the single argument, `name,` taking on the value `(JOHN Q PUBLIC)`.\nThe value returned is `JOHN`.\nTrace prints two lines indicating entry and exit from the function, and then Lisp, as usual, prints the final result, `JOHN`.\n\nThe next example is more complicated.\nThe function `first-name` is used four times.\nFirst, itis entered with `name` boundto `(Madam Major General Paula Jones).` The first element of this list is `Madam,` and since this is a member of the list of titles, the result is computed by calling `first-name` again on the rest of the name-`(Major General Paula Jones).` This process repeats two more times, and we finally enter fi`rst-name` with name bound to (`Paul a Jones`).\nSince `Paula` is not a title, it becomes the result of this call to fi`rst-name,` and thus the result of all four calls, as trace shows.\nOnce we are happy with the workings of first`-name,` the special form `untrace` turns off tracing.\n\n```lisp\n  > (first-name '(Madam Major General Paula Jones)) =>\n  (1 ENTER FIRST-NAME: (MADAM MAJOR GENERAL PAULA JONES))\n    (2 ENTER FIRST-NAME: (MAJOR GENERAL PAULA JONES))\n      (3 ENTER FIRST-NAME: (GENERAL PAULA JONES))\n        (4 ENTER FIRST-NAME: (PAULA JONES))\n        (4 EXIT FIRST-NAME: PAULA)\n      (3 EXIT FIRST-NAME: PAULA)\n    (2 EXIT FIRST-NAME: PAULA)\n  (1 EXIT FIRST-NAME: PAULA)\n  PAULA\n  > (untrace first-name) => (FIRST-NAME)\n  > (first-name '(Mr Blue Jeans)) => BLUE\n```\n\nThe function `first-name` is said to be *recursive* because its definition includes a call to itself.\nProgrammers who are new to the concept of recursion sometimes find it mysterious.\nBut recursive functions are really no different from nonrecursive ones.\nAny function is required to return the correct value for the given input(s).\nAnother way to look at this requirement is to break it into two parts: a function must return a value, and it must not return any incorrect values.\nThis two-part requirement is equivalent to the first one, but it makes it easier to think about and design function definitions.\n\nNext I show an abstract description of the `first-name` problem, to emphasize the design of the function and the fact that recursive solutions are not tied to Lisp in any way:\n\n```lisp\n  function first-name(name):\n    if *the first element of name is a title*\n       then *do something complicated to get the first-name*\n       else *return the first element of the name*\n```\n\nThis breaks up the problem into two cases.\nIn the second case, we return an answer, and it is in fact the correct answer.\nWe have not yet specified what to do in the first case.\nBut we do know that it has something to do with the rest of the name after the first element, and that what we want is to extract the first name out of those elements.\nThe leap of faith is to go ahead and use `first-name`, even though it has not been fully defined yet:\n\n```lisp\n  function first-name(name):\n    if *the first element of name is a title*\n       then *return the* first-name *of the rest of the name*\n       else *return the first element of the name*\n```\n\nNow the first case in `first-name` is recursive, and the second case remains unchanged.\nWe already agreed that the second case returns the correct answer, and the first case only returns what `first-name` returns.\nSo `first-name` as a whole can only return correct answers.\nThus, we're halfway to showing that the function is correct; the other half is to show that it eventually returns some answer.\nBut every recursive call chops off the first element and looks at the rest, so for an *n*-element list there can be at most *n* recursive calls.\nThis completes the demonstration that the function is correct.\nProgrammers who learn to think this way find recursion to be a valuable tool rather than a confusing mystery.\n\n## 1.7 Higher-Order Functions\n{:#s0040}\n{:.h1hd}\n\nFunctions in Lisp can not only be \"called,\" or applied to arguments, they can also be manipulated just like any other kind of object.\nA function that takes another function as an argument is called a *higher-order function.*`mapcar` is an example.\nTo demonstrate the higher-order-function style of programming, we will define a new function called `mappend.` It takes two arguments, a function and a list.\n`mappend` maps the function over each element of the list and appends together all the results.\nThe first definition follows immediately from the description and the fact that the function `appl`y can be used to apply a function to a list of arguments.\n\n```lisp\n  (defun mappend (fn the-list)\n     \"Apply fn to each element of list and append the results.\"\n     (apply #'append (mapcar fn the-list)))\n```\n\nNow we experiment a little to see how `appl`y and `mappend` work.\nThe first example applies the addition function to a list of four numbers.\n\n```lisp\n  > (apply #'+ '(1 2 3 4)) => 10\n```\n\nThe next example applies append to a list of two arguments, where each argument is a list.\nIf the arguments were not lists, it would be an error.\n\n```lisp\n  > (apply #'append '((1 2 3) (a b c))) => (l 2 3 A B C)\n```\n\nNow we define a new function, `self-and-double`, and apply it to a variety of arguments.\n\n```lisp\n  > (defun self-and-double (x) (list x (+ x x)))\n  > (self-and-double 3) => (3 6)\n  > (apply #' self-and-double ' (3)) => (3 6)\n```\n\nIf we had tried to apply `self-and-double` to a list of more than one argument, or to a list that did not contain a number, it would be an error, just as it would be an error to evaluate `(self-and-double 3 4`) or `(self-and-double 'Kim`).\nNow let's return to the mapping functions:\n\n```lisp\n  > (mapcar #'self-and-double '(1 10 300)) => ((1 2) (10 20) (300 600))\n  > (mappend #'self-and-double '(1 10 300)) => (1 2 10 20 300 600)\n```\n\nWhen `mapcar` is passed a function and a list of three arguments, it always returns a list of three values.\nEach value is the result of calling the function on the respective argument.\nIn contrast, when `mappend` is called, it returns one big list, which is equal to all the values that `mapcar` would generate appended together.\nIt would be an error to call `mappend` with a function that didn't return lists, because `append` expects to see lists as its arguments.\n\nNow consider the following problem: given a list of elements, return a list consisting of all the numbers in the original list and the negation of those numbers.\nFor example, given the list `(testing 1 2 3 test`), return `(1 -1 2 -2 3 -3`).\nThis problem can be solved very easily using `mappend` as a component:\n\n```lisp\n  (defun numbers-and-negations (input)\n     \"Given a list, return only the numbers and their negations.\"\n     (mappend #' number-and-negation input))\n  (defun number-and-negation (x)\n     \"If x is a number, return a list of x and -x.\"\n     (if (numberp x)\n            (list x (- x))\n             nil))\n  > (numbers-and-negations '(testing 1 2 3 test)) => (1 -1 2 -2 3 -3)\n```\n\nThe alternate definition of `mappend` shown in the following doesn't make use of `mapcar;` instead it builds up the list one element at a time:\n\n```lisp\n  (defun mappend (fn the-list)\n     \"Apply fn to each element of list and append the results.\"\n     (if (null the-list)\n             nil\n             (append (funcall fn (first the-list))\n                           (mappend fn (rest the-list)))))\n```\n\n`funcall` is similar to `apply;` it too takes a function as its first argument and applies the function to a list of arguments, but in the case of `funcall`, the arguments are listed separately:\n\n```lisp\n  > (funcall #'+ 2 3) => 5\n  > (apply #' + '(2 3)) => 5\n  > (funcall #' + '(2 3)) => *Error: (2 3) is not a number.*\n```\n\nThese are equivalent to `(+ 2 3), (+ 2 3)`,and`(+ '(2 3))`, respectively.\n\nSo far, every function we have used has been either predefined in Common Lisp or introduced with a `defun`, which pairs a function with a name.\nIt is also possible to introduce a function without giving it a name, using the special syntax `lambda`.\n\nThe name *lambda* cornes from the mathematician Alonzo Church's notation for functions (Church 1941).\nLisp usually prefers expressive names over terse Greek letters, but lambda is an exception.\nA better name would be `make-function`.\nLambda derives from the notation in Russell and Whitehead's *Principia Mathematica,* which used a caret over bound variables: x^x+x !!!(span) {:.hiddenClass} ![si1_e](images/B9780080571157500017/si1_e.gif).\nChurch wanted a one-dimensional string, so he moved the caret in front: x^x+x !!!(span) {:.hiddenClass} ![si2_e](images/B9780080571157500017/si2_e.gif).\nThe caret looked funny with nothing below it, so Church switched to the closest thing, an uppercase lambda, &Lambda;*x*(*x + x*).\nThe &Lambda; was easily confused with other symbols, so eventually the lowercase lambda was substituted: *&lambda;x*(*x + x*).\nJohn McCarthy was a student of Church's at Princeton, so when McCarthy invented Lisp in 1958, he adopted the lambda notation.\nThere were no Greek letters on the keypunches of that era, so McCarthy used (`lambda (x) (+ x x)`), and it has survived to this day.\nIn general, the form of a lambda expression is\n\n```lisp\n  (lambda (*parameters...*) *body...*)\n```\n\nA lambda expression is just a nonatomic *name* for a function, just as `append` is an atomic name for a built-in function.\nAs such, it is appropriate for use in the first position of a function call, but if we want to get at the actual function, rather than its name, we still have to use the `#'` notation.\nFor example:\n\n```lisp\n  > ((lambda (x) (+ x 2)) 4) => 6\n  *>* (funcall #'(lambda (x) (+ x 2)) 4) => 6\n```\n\nTo understand the distinction we have to be clear on how expressions are evaluated in Lisp.\nThe normal rule for evaluation states that symbols are evaluated by looking up the value of the variable that the symbol refers to.\nSo the `x` in `(+ x 2)` is evaluated by looking up the value of the variable named `x`.\nA list is evaluated in one of two ways.\nIf the first element of the list is a special form opera tor, then the list is evaluated according to the syntax rule for that special form.\nOtherwise, the list represents a function call.\nThe first element is evaluated in a unique way, as a function.\nThis means it can either be a symbol or a lambda expression.\nIn either case, the function named by the first element is applied to the values of the remaining elements in the list.\nThese values are determined by the normal evaluation rules.\nIf we want to refer to a function in a position other than the first element of a function call, we have to use the `#'` notation.\nOtherwise, the expressions will be evaluated by the normal evaluation rule, and will not be treated as functions.\nFor example:\n\n```lisp\n  > append => *Error: APPEND is not a bound variable*\n  > (lambda (x) (+ x 2)) => *Error: LAMBDA is not a function*\n```\n\nHere are some more examples of the correct use of functions:\n\n```lisp\n  >(mapcar #'(lambda (x) (+ x x))\n                 '(1 2 3 4 5)) =>\n  (2 4 6 8 10)\n  > (mappend #'(lambda (l) (list l (reverse l)))\n                   ((1 2 3) (a b c))) =>\n  ((1 2 3) (3 2 1) (A B C) (C B A))\n```\n\nProgrammers who are used to other languages sometimes fail to see the point of lambda expressions.\nThere are two reasons why lambda expressions are very useful.\n\nFirst, it can be messy to clutter up a program with superfluous names.\nJust as it is clearer to write `(a+b)*(c+d)` rather than to invent variable names like `temp1` and `temp2` to hold `a+b` and `c+d`, so it can be clearer to define a function as a lambda expression rather than inventing a name for it.\n\nSecond, and more importantly, lambda expressions make it possible to create new functions at run time.\nThis is a powerful technique that is not possible in most programming languages.\nThese run-time functions, known as *closures,* will be covered in [section 3.16](B9780080571157500030.xhtml#s0085).\n\n## 1.8 Other Data Types\n{:#s0045}\n{:.h1hd}\n\nSo far we have seen just four kinds of Lisp objects: numbers, symbols, lists, and functions.\nLisp actually defines about 25 different types of objects: vectors, arrays, structures, characters, streams, hash tables, and others.\nAt this point we will introduce one more, the string.\nAs you can see in the following, strings, like numbers, evaluate to themselves.\nStrings are used mainly for printing out messages, while symbols are used for their relationships to other objects, and to name variables.\nThe printed representation of a string has a double quote mark `(\")` at each end.\n\n```lisp\n  > \"a string\" => \"a string\"\n  > (length \"a string\") => 8\n  > (length \"\") => 0\n```\n\n## 1.9 Summary: The Lisp Evaluation Rule\n{:#s0050}\n{:.h1hd}\n\nWe can now summarize the evaluation rule for Lisp.\n\n*  Every expression is either a *list* or an *atom.*\n\n*  Every list to be evaluated is either a *special form expression* or a *function application*.\n\n*  A *special form expression* is def ined to be a list whose first element is a special form operator.\nThe expression is evaluated according to the operator's idiosyncratic evaluation rule.\nFor example, the evaluation rule for setf is to evaluate the second argument according to the normal evaluation rule, set the first argument to that value, and return the value as the result.\nThe rule for `defun` is to define a new function, and return the name of the function.\nThe rule for quote is to return the first argument unevaluated.\nThe notation `'*x*` is actually an abbreviation for the special form expression `(quote *x*)`.\nSimilarly, the notation `*#*'*f*` is an abbreviation for the special form expression `(function *f*)`.\n\n```lisp\n'John = (quote John) => JOHN\n(setf p 'John) => JOHN\ndefun twice (x) (+ x x)) => TWICE\n(if (= 2 3) (error) (+ 5 6)) => 11\n```\n\n*  A *function application* is evaluated by first evaluating the arguments (the rest of the list) and then finding the function named by the first element of the list and applying it to the list of evaluated arguments.\n\n```lisp\n(+ 2 3) => 5\n(- (+ 90 9) (+ 50 5 (length '(Pat Kim)))) => 42\n```\n\nNote that if `'(Pat Kim)` did not have the quote, it would betreated as a function application of the function `pat` to the value of the variable `kim.`\n\n*  Every atom is either a *symbol* or a *nonsymbol.*\n\n*  A *symbol* evaluates to the most recent value that has been assigned to the variable named by that symbol.\nSymbols are composed of letters, and possibly digits and, rarely, punctuation characters.\nTo avoid confusion, we will use symbols composed mostly of the letters `a-z` and the `'-'` character, with a few exceptions.[6](#fn0035)\n\n```lisp\nnames\np\n*print-pretty*\n```\n\n*  A *nonsymbol atom* evaluates to itself.\nFor now, numbers and strings are the only such non-symbol atoms we know of.\nNumbers are composed of digits, and possibly a decimal point and sign.\nThere are also provisions for scientific notation, rational and complex numbers, and numbers with different bases, but we won't describe the details here.\nStrings are delimited by double quote marks on both sides.\n\n```lisp\n42 => 42\n- 273.15 => -273.15\n\"a string\" => \"a string\"\n```\n\nThere are some minor details of Common Lisp that complicate the evaluation rules, but this definition will suffice for now.\n\nOne complication that causes confusion for beginning Lispers is the difference between *reading* and *evaluating* an expression.\nBeginners often imagine that when they type an expression, such as\n\n```lisp\n  > (+ (* 3 4) (* 5 6))\n```\n\nthe Lisp system first reads the (`+`, then fetches the addition function, then reads `(* 3 4)` and computes `12`, then reads `(* 5 6)` and computes 30, and finally computes 42.\nIn fact, what actually happens is that the system first reads the entire expression, the list `(+ (* 3 4) (* 5 6))`.\nOnly after it has been read does the system begin to evaluate it.\nThis evaluation can be done by an interpreter that looks at the list directly, or it can be done by a compiler that translates the list into machine language instructions and then executes those instructions.\n\nWe can see now that it was a little imprecise to say, \"Numbers are composed of digits, and possibly a decimal point and sign.\" It would be more precise to say that the printed representation of a number, as expected by the function read and as produced by the function print, is composed of digits, and possibly a decimal point and sign.\nThe internal representation of a number varies from one computer to another, but you can be sure that it will be a bit pattern in a particular memory location, and it will no longer contain the original characters used to represent the number in decimal notation.\nSimilarly, it is the printed representation of a string that is surrounded by double quote marks; the internal representation is a memory location marking the beginning of a vector of characters.\n\nBeginners who fail to grasp the distinction between reading and evaluating may have a good model of what expressions evaluate to, but they usually have a terrible model of the efficiency of evaluating expressions.\nOne student used only one-letter variable names, because he felt that it would be faster for the computer to look up a one-letter name than a multiletter name.\nWhile it may be true that shorter names can save a microsecond at read time, this makes no difference at all at evaluation time.\nEvery variable, regardless of its name, is just a memory location, and the time to access the location does not depend on the name of the variable.\n\n## 1.10 What Makes Lisp Different?\n{:#s0055}\n{:.h1hd}\n\nWhat is it that sets Lisp apart from other languages?\nWhy is it a good language for AI applications?\nThere are at least eight important factors:\n\n*  Built-in Support for Lists\n\n*  Automatic Storage Management\n\n*  Dynamic Typing\n\n*  First-Class Functions\n\n*  Uniform Syntax\n\n*  Interactive Environment\n\n*  Extensibility\n\n*  History\n\nIn sum, these factors allow a programmer to delay making decisions.\nIn the example dealing with names, we were able to use the built-in list functions to construct and manipulate names without making a lot of explicit decisions about their representation.\nIf we decided to change the representation, it would be easy to go back and alter parts of the program, leaving other parts unchanged.\n\nThis ability to delay decisions-or more accurately, to make temporary, nonbinding decisions-is usually a good thing, because it means that irrelevant details can be ignored.\nThere are also some negative points of delaying decisions.\nFirst, the less we tell the compiler, the greater the chance that it may have to produce inefficient code.\nSecond, the less we tell the compiler, the less chance it has of noticing inconsistencies and warning us.\nErrors may not be detected until the program is run.\nLet's consider each factor in more depth, weighing the advantages and disadvantages:\n\n*  *Built-in Support for Lists.* The list is a very versatile data structure, and while lists can be implemented in any language, Lisp makes it easy to use them.\nMany AI applications involve lists of constantly changing size, making fixed-length data structures like vectors harder to use.\nEarly versions of Lisp used lists as their only aggregate data structure.\nCommon Lisp provides other types as well, because lists are not always the most efficient choice.\n\n*  *Automatic Storage Management.* The Lisp programmer needn't keep track of memory allocation; it is all done automatically.\nThis frees the programmer of a lot of effort, and makes it easy to use the functional style of programming.\nOther languages present programmers with a choice.\nVariables can be allocated on the stack, meaning that they are created when a procedure is entered, and disappear when the procedure is done.\nThis is an efficient use of storage, but it rules out functions that return complex values.\nThe other choice is for the programmer to explicitly allocate and free storage.\nThis makes the functional style possible but can lead to errors.\n\nFor example, consider the trivial problem of Computing the expression *a*x (b + c), where *a*, *b*, and *c* are numbers.\nThe code is trivial in any language; here it is in Pascal and in Lisp:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `/* Pascal */` | `;;; Lisp` |\n| `a * (b + c)` | `(* a (+ b c))` |\n\nThe only difference is that Pascal uses infix notation and Lisp uses prefix.\nNow consider Computing *a*x (b + c) when *a*, *b*, and *c* are matrices.\nAssume we have procedures for matrix multiplication and addition.\nIn Lisp the form is exactly the same; only the names of the functions are changed.\nIn Pascal we have the choice of approaches mentioned before.\nWe could declare temporary variables to hold intermediate results on the stack, and replace the functional expression with a series of procedure calls:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `/* Pascal */` | `;;; Lisp` |\n| `var temp, result: matrix;` | |\n| `add(b,c,temp);` | `(mult a (add b c))` |\n| `mult(a,temp,result);` | |\n| `return(result);` | |\n\nThe other choice is to write Pascal functions that allocate new matrices on the heap.\nThen one can write nice functional expressions like `mult(a,add(b,c))` even in Pascal.\nHowever, in practice it rarely works this nicely, because of the need to manage storage explicitly:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `/* Pascal */` | `;;; Lisp` |\n| `var a,b,c,x,y: matrix;` | |\n| `x := add(b.c);` | `(mult a (add b c))` |\n| `y := mult(a,x);` | |\n| `free(x);` | |\n| `return(y);` | |\n\nIn general, deciding which structures to free is a difficult task for the Pascal programmer.\nIf the programmer misses some, then the program may run out of memory.\nWorse, if the programmer frees a structure that is still being used, then strange errors can occur when that piece of memory is reallocated.\nLisp automatically allocates and frees structures, so these two types of errors can *never* occur.\n\n*  *Dynamic Typing.* Lisp programmers don't have to provide type declarations, because the language keeps track of the type of each object at run time, rather than figuring out all types at compile time.\nThis makes Lisp programs shorter and hence faster to develop, and it also means that functions can often be extended to work for objects to which they were not originally intended to apply.\nIn Pascal, we can write a procedure to sort an array of 100 integers, but we can't use that same procedure to sort 200 integers, or 100 strings.\nIn Lisp, one `sort` fits all.\nOne way to appreciate this kind of flexibility is to see how hard it is to achieve in other languages.\nIt is impossible in Pascal; in fact, the language Modula was invented primarily to fix this problem in Pascal.\nThe language Ada was designed to allow flexible generic functions, and a book by [Musser and Stepanov (1989)](B9780080571157500285.xhtml#bb0885) describes an Ada package that gives some of the functionality of Common Lisp's sequence functions.\nBut the Ada solution is less than ideal: it takes a 264-page book to duplicate only part of the functionality of the 20-page chapter 14 from [Steele (1990)](B9780080571157500285.xhtml#bb1160), and Musser and Stepanov went through five Ada compilers before they found one that would correctly compile their package.\nAlso, their package is considerably less powerful, since it does not handle vectors or optional keyword parameters.\nIn Common Lisp, all this functionality cornes for free, and it is easy to add more.\nOn the other hand, dynamic typing means that some errors will go undetected until run time.\nThe great advantage of strongly typed languages is that they are able to give error messages at compile time.\nThe great frustration with strongly typed languages is that they are only able to warn about a small class of errors.\nThey can tell you that you are mistakenly passing a string to a function that expects an integer, but they can't tell you that you are passing an odd number to a function that expects an even number.\n\n*  *First-Class Functions.* A *first-class* object is one that can be used anywhere and can be manipulated in the same ways as any other kind of object.\nIn Pascal or C, for example, functions can be passed as arguments to other functions, but they are not first-class, because it is not possible to create new functions while the program is running, nor is it possible to create an anonymous function without giving it a name.\nIn Lisp we can do both those things using `lambda`.\nThis is explained in [section 3.16](B9780080571157500030.xhtml#s0085), [page 92](B9780080571157500030.xhtml#p92).\n\n*  *Uniform Syntax.* The syntax of Lisp programs is simple.\nThis makes the language easy to learn, and very little time is wasted correcting typos.\nIn addition, it is easy to write programs that manipulate other programs or define whole new languages-a very powerful technique.\nThe simple syntax also makes it easy for text editing programs to parse Lisp.\nYour editor program should be able to indent expressions automatically and to show matching parentheses.\nThis is harder to do for languages with complex syntax.\nOn the other hand, some people object to all the parentheses.\nThere are two answers to this objection.\nFirst, consider the alternative: in a language with \"conventional\" syntax, Lisp's parentheses pairs would be replaced either by an implicit operator precedence rule (in the case of arithmetic and logical expressions) or by a `begin/end` pair (in the case of control structures).\nBut neither of these is necessarily an advantage.\nImplicit precedence is notoriously error-prone, and `begin/end` pairs clutter up the page without adding any content.\nMany languages are moving away from `begin/end: C` uses { and }, which are equivalent to parentheses, and several modem functional languages (such as Haskell) use horizontal blank space, with no explicit grouping at all.\nSecond, many Lisp programmers *have* considered the alternative.\nThere have been a number of preprocessors that translate from \"conventional\" syntax into Lisp.\nNone of these has caught on.\nIt is not that Lisp programmers find it *tolerable* to use all those parentheses, rather, they find it *advantageous.* With a little experience, you may too.\nIt is also important that the syntax of Lisp data is the same as the syntax of programs.\nObviously, this makes it easy to convert data to program.\nLess obvious is the time saved by having universal functions to handle input and output.\nThe Lisp functions `read` and `print` will automatically handle any list, structure, string, or number.\nThis makes it trivial to test individual functions while developing your program.\nIn a traditional language like C or Pascal, you would have to write special-purpose functions to read and print each data type you wanted to debug, as well as a special-purpose driver to call the routines.\nBecause this is time-consuming and error-prone, the temptation is to avoid testing altogether.\nThus, Lisp encourages better-tested programs, and makes it easier to develop them faster.\n\n*  *Interactive Environment.* Traditionally, a programmer would write a complete program, compile it, correct any errors detected by the compiler, and then run and debug it.\nThis is known as the *batch* mode of interaction.\nFor long programs, waiting for the compiler occupied a large portion of the debugging time.\nIn Lisp one normally writes a few small functions at a time, getting feedback from the Lisp system after evaluating each one.\nThis is known as an *interactive* environment.\nWhen it cornes time to make a change, only the changed functions need to be recompiled, so the wait is much shorter.\nIn addition, the Lisp programmer can debug by typing in arbitrary expressions at any time.\nThis is a big improvement over editing the program to introduce print statements and recompiling.\nNotice that the distinction between *interactive* and a *batch* languages is separate from the distinction between *interpreted* and *compiled* languages.\nIt has often been stated, incorrectly, that Lisp has an advantage by virtue of being an interpreted language.\nActually, experienced Common Lisp programmers tend to use the compiler almost exclusively.\nThe important point is interaction, not interpretation.\nThe idea of an interactive environment is such a good one that even traditional languages like C and Pascal are starting to offer interactive versions, so this is not an exclusive advantage of Lisp.\nHowever, Lisp still provides much better access to the interactive features.\nA C interpreter may allow the programmer to type in an expression and have it evaluated immediately, but it will not allow the programmer to write a program that, say, goes through the symbol table and finds all the user-defined functions and prints information on them.\nIn C-even interpreted C-the symbol table is just a Cheshire-cat-like invention of the interpreter's imagination that disappears when the program is run.\nIn Lisp, the symbol table is a first-class object[7](#fn0040) that can be accessed and modified with functions like `read, intern` and `do-symbols`.\nCommon Lisp offers an unusually rich set of useful tools, including over 700 built-in functions (ANSI Common Lisp has over 900).\nThus, writing a new program involves more gathering of existing pieces of code and less writing of new code from scratch.\nIn addition to the standard functions, Common Lisp implementations usually provide extensions for interacting with the editor, debugger, and window system.\n\n*  *Extensibility*.\nWhen Lisp was invented in 1958, nobody could have foreseen the advances in programming theory and language design that have taken place in the last thirty years.\nOther early languages have been discarded, replaced by ones based on newer ideas.\nHowever, Lisp has been able to survive, because it has been able to adapt.\nBecause Lisp is extensible, it has been changed to incorporate the newest features as they become popular.\nThe easiest way to extend the language is with macros.\nWhen so-called structured programming constructs such as *case* and *if-then-else* arose, they were incorporated into Lisp as macros.\nBut the flexibility of Lisp goes beyond adding individual constructs.\nBrand new styles of programming can easily be implemented.\nMany AI applications are based on the idea of *rule-based* programming.\nAnother new style is *object-oriented* programming, which has been incorporated with the Common Lisp Object System (CLOS),[8](#fn0045) a set of macros, functions, and data types that have been integrated into ANSI Common Lisp.\n\nTo show how far Lisp has come, here's the only sample program given in the *Lisp/MTS Programmer's Guide* ([Hafner and Wilcox 1974](B9780080571157500285.xhtml#bb0505)):\n\n```lisp\n  (PROG (LIST DEPTH TEMP RESTLIST)\n  (SETQ RESTLIST (LIST (CONS (READ) O)))\n  A (COND\n  ((NOT RESTLIST) (RETURN 'DONE))\n  (T (SETQ LIST (UNCONS (UNCONS RESTLIST\n         RESTLIST) DEPTH))\n  (COND ((ATOM LIST)\n  (MAPC 'PRIN1 (LIST '\"ATOM:\" LIST '\",\" 'DEPTH DEPTH))\n  (TERPRI))\n  (T (SETQ TEMP (UNCONS LIST LIST))\n  (COND (LIST\n  (SETQ RESTLIST (CONS(CONS LIST DEPTH) RESTLIST))))\n  (SETQ RESTLIST (CONS (CONS TEMP\n         (ADD1 DEPTH)) RESTLIST))\n  ))))\n  ))))(GO A))\n```\n\nNote the use of the now-deprecated goto `(GO)` statement, and the lack of consistent indexation conventions.\nThe manual also gives a recursive version of the same program:\n\n```lisp\n  (PROG NIL (\n  (LABEL ATOMPRINT (LAMBDA (RESTLIST)\n  (COND ((NOT RESTLIST) (RETURN 'DONE))\n  ((ATOM (CAAR RESTLIST)) (MAPC 'PRIN1\n         (LIST '\"ATOM:\" (CAAR RESTLIST)\n               '\",\" DEPTH (CDAR RESTLIST)))\n  (TERPRI)\n  (ATOMPRINT (CDR RESTLIST)))\n  ( T (ATOMPRINT (GRAFT\n  (LIST (CONS (CAAAR RESTLIST) (ADD1 (CDAR RESTLIST))))\n  (AND (CDAAR RESTLIST) (LIST (CONS (CDAAR RESTLIST)\n          (CDAR RESTLIST))))\n                    (CDR RESTLIST)))))))\n  (LIST (CONS (READ) 0))))\n```\n\nBoth versions are very difficult to read.\nWith our modem insight (and text editors that automatically indent), a much simpler program is possible:\n\n```lisp\n  (defun atomprint (exp &optional (depth 0))\n     \"Print each atom in exp, along with its depth of nesting.\"\n     (if (atom exp)\n            (format t \"~&ATOM: ~ a, DEPTH ~ d\" exp depth)\n            (dolist (element exp)\n               (atomprint element (+ depth 1)))))\n```\n\n## 1.11 Exercises\n{:#s1060}\n{:.h1hd}\n\n  **Exercise 1.1 [m]** Define a version of `last-name` that handles \"Rex Morgan MD,\" \"Morton Downey, Jr.,\" and whatever other cases you can think of.\n\n  **Exercise 1.2 [m]** Write a function to exponentiate, or raise a number to an integer power.\nFor example: `(power 3 2) = 32 = 9`.\n\n  **Exercise 1.3 [m]** Write a function that counts the number of atoms in an expression.\nFor example: `(count-atoms '(a (b) c)) = 3`.\nNotice that there is something of an ambiguity in this: should (`a nil c`) count as three atoms, or as two, because it is equivalent to (`a () c`)?\n\n  **Exercise 1.4 [m]** Write a function that counts the number of times an expression occurs anywhere within another expression.\nExample: `(count-anywhere 'a '(a ((a) b) a)) => 3.`\n\n  **Exercise 1.5 [m]** Write a function to compute the dot product of two sequences of numbers, represented as lists.\nThe dot product is computed by multiplying corresponding elements and then adding up the resulting products.\nExample:\n\n```lisp\n(dot-product '(10 20) '(3 4)) = 10 x 3 + 20 x 4 = 110\n```\n\n## 1.12 Answers\n{:#s0060}\n{:.h1hd}\n\n**Answer 1.2**\n\n```lisp\n  (defun power (x n)\n     \"Power raises x to the nth power. N must be an integer >= 0.\n     This executes in log n time, because of the check for even n.\"\n    (cond ((= n 0) 1)\n               ((evenp n) (expt (power x (/ n 2)) 2))\n               (t (* x (power x (- n 1))))))\n```\n\n**Answer 1.3**\n\n```lisp\n  (defun count-atoms (exp)\n     \"Return the total number of non-nil atoms in the expression.\"\n     (cond ((null exp) 0)\n               ((atom exp) 1)\n               (t (+ (count-atoms (first exp))\n                          (count-atoms (rest exp))))))\n  (defun count-all-atoms (exp &optional (if-null 1))\n     \"Return the total number of atoms in the expression,\n     counting nil as an atom only in non-tail position.\"\n     (cond ((null exp) if-null)\n                ((atom exp) 1)\n                (t (+ (count-all-atoms (first exp) 1)\n                           (count-all-atoms (rest exp) 0)))))\n```\n\n**Answer 1.4**\n\n```lisp\n  (defun count-anywhere (item tree)\n     \"Count the times item appears anywhere within tree.\"\n     (cond ((eql item tree) 1)\n                ((atom tree) 0)\n                (t (+ (count-anywhere item (first tree))\n                           (count-anywhere item (rest tree))))))\n```\n\n**Answer 1.5** Here are three versions:\n\n```lisp\n  (defun dot-product (a b)\n     \"Compute the mathematical dot product of two vectors.\"\n     (if (or (null a) (null b))\n             0\n             (+ (* (first a) (first b))\n                  (dot-product (rest a) (rest b)))))\n  (defun dot-product (a b)\n     \"Compute the mathematical dot product of two vectors.\"\n     (let ((sum 0))\n         (dotimes (i (length a))\n            (incf sum (* (elt a i) (elt b i))))\n         sum))\n  (defun dot-product (a b)\n     \"Compute the mathematical dot product of two vectors.\"\n     (apply #'+ (mapcar #'* a b)))\n```\n\n----------------------\n\n[1](#xfn0010) This list of symbols is not a legal Lisp assignaient statement, but it is a Lisp data object.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) The variable `*print-case*` controls how symbols will be printed.\nBy default, the value of this variable is :`upcase`, but it can be changed to :`downcaseor :capitalize`.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0020) Later we will see what happens when the second argument is not a list.\n!!!(p) {:.ftnote1}\n\n[4](#xfn0025) In ANSI Common Lisp, `last` is defined to return a list of the last *n* elements, where n defaultstoi.\nThus `(last p) = (last p 1) = (PUBLIC)`,and `(last p 2) = (Q PUBLIC)`.\nThis may make the definition of last seem less perverse.\n!!!(p) {:.ftnote1}\n\n[5](#xfn0030) Just as we can change the value of a variable, we can also change the value of a function in Lisp.\nIt is not necessary to recompile everything when a change is made, as it would be in other languages.\n!!!(p) {:.ftnote1}\n\n[6](#xfn0035) For example, symbols that denote so-called *special* variables usually begin and end in asterisks.\nAlso, note that I did not hesitate to use the symbol `won !` on page 11.\n!!!(p) {:.ftnote1}\n\n[7](#xfn0040) Actually, there can be several symbol tables.\nThey are known as *packages* in Common Lisp.\n!!!(p) {:.ftnote1}\n\n[8](#xfn0045) Pronounced \"see-loss.\" An alternate pronunciation, \"klaus,\" seems to be losing favor.\n!!!(p) {:.ftnote1}\n\n# Chapter 2\n## A Simple Lisp Program\n{:.chaptitle}\n\n> *Certum quod factum.*\n\n> (One is certain of only what one builds.)\n\n> - Giovanni Battista Vico (1668-1744)\n\n> Italian royal historiographer\n\nYou will never become proficient in a foreign language by studying vocabulary lists.\nRather, you must hear and speak (or read and write) the language to gain proficiency.\nThe same is true for learning computer languages.\n\nThis chapter shows how to combine the basic functions and special forms of Lisp into a complete program.\nIf you can learn how to do that, then acquiring the remaining vocabulary of Lisp (as outlined in [chapter 3](B9780080571157500030.xhtml)) will be easy.\n\n## 2.1 A Grammar for a Subset of English\n{:#s0010}\n{:.h1hd}\n\nThe program we will develop in this chapter generates random English sentences.\nHere is a simple grammar for a tiny portion of English:\n\n  *Sentence*=> *Noun-Phrase + Verb-Phrase*\n\n  *Noun-Phrase*=> *Article + Noun*\n\n  *Verb-Phrase*=> *Verb + Noun-Phrase*\n\n  *Article*=> *the, a,...*\n\n  *Noun*=> *man, ball, woman, table...*\n\n  *Verb*=> *hit, took, saw, liked...*\n\nTo be technical, this description is called a *context-free phrase-structure grammar*, and the underlying paradigm is called *generative syntax*.\nThe idea is that anywhere we want a sentence, we can generate a noun phrase followed by a verb phrase.\nAnywhere a noun phrase has been specified, we generate instead an article followed by a noun.\nAnywhere an article has been specified, we generate either \"the,\" \"a,\" or some other article.\nThe formalism is \"context-free\" because the rules apply anywhere regardless of the surrounding words, and the approach is \"generative\" because the rules as a whole define the complete set of sentences in a language (and by contrast the set of nonsentences as well).\nIn the following we show the derivation of a single sentence using the rules:\n\n  To get a *Sentence*, append a *Noun-Phrase* and a *Verb-Phrase*\n\n     To get a *Noun-Phrase*, append an *Article* and a *Noun*\n\n          Choose \"*the*\" for the *Article*\n\n          Choose \"*man*\" for the *Noun*\n\n     The resulting *Noun-Phrase* is \"*the man*\"\n\n     To get a *Verb-Phrase*, append a *Verb* and a *Noun-Phrase*\n\n          Choose \"*hit*\" for the *Verb*\n\n        To get a *Noun-Phrase*, append an *Article* and a *Noun*\n\n          Choose \"*the*\" for the *Article*\n\n          Choose \"*ball*\" for the *Noun*\n\n       The resulting *Noun-Phrase* is \"*the ball*\"\n\n     The resulting *Verb-Phrase* is \"*hit the ball*\"\n\n  The resulting *Sentence* is \"*The man hit the ball*\"\n\n## 2.2 A Straightforward Solution\n{:#s0015}\n{:.h1hd}\n\nWe will develop a program that generates random sentences from a phrase-structure grammar.\nThe most straightforward approach is to represent each grammar rule by a separate Lisp function:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(defun sentence ()` | `(append (noun-phrase) (verb-phrase)))` |\n| `(defun noun-phrase ()` | `(append (Article) (Noun)))` |\n| `(defun verb-phrase ()` | `(append (Verb) (noun-phrase)))` |\n| `(defun Article ()` | `(one-of '(the a)))` |\n| `(defun Noun ()` | `(one-of '(man ball woman table)))` |\n| `(defun Verb ()` | `(one-of '(hit took saw liked)))` |\n\nEach of these function definitions has an empty parameter list, `()`.\nThat means the functions take no arguments.\nThis is unusual because, strictly speaking, a function with no arguments would always return the same thing, so we would use a constant instead.\nHowever, these functions make use of the `random` function (as we will see shortly), and thus can return different results even with no arguments.\nThus, they are not functions in the mathematical sense, but they are still called functions in Lisp, because they return a value.\n\nAll that remains now is to define the function `one-of`.\nIt takes a list of possible choices as an argument, chooses one of these at random, and returns a one-element list of the element chosen.\nThis last part is so that all functions in the grammar will return a list of words.\nThat way, we can freely apply `append` to any category.\n\n```lisp\n  (defun one-of (set)\n     \"Pick one element of set, and make a list of it.\"\n     (list (random-elt set)))\n  (defun random-elt (choices)\n     \"Choose an element from a list at random.\"\n     (elt choices (random (length choices))))\n```\n\nThere are two new functions here, `elt` and `random.``elt` picks an element out of a list.\nThe first argument is the list, and the second is the position in the list.\nThe confusing part is that the positions start at 0, so `(elt choices 0)` is the first element of the list, and `(elt choices 1)` is the second.\nThink of the position numbers as telling you how far away you are from the front.\nThe expression `(random n)` returns an integer from 0 to n-1, so that `(random 4)` would return either 0,1,2, or 3.\n\nNow we can test the program by generating a few random sentences, along with a noun phrase and a verb phrase:\n\n```lisp\n  > (sentence)`=> `(THE WOMAN HIT THE BALL)\n  > (sentence)`=> `(THE WOMAN HIT THE MAN)\n  > (sentence)`=> `(THE BALL SAW THE WOMAN)\n  > (sentence)`=> `(THE BALL SAW THE TABLE)\n  > (noun-phrase)`=> `(THE MAN)\n  > (verb-phrase)`=> `(LIKED THE WOMAN)\n  > (trace sentence noun-phrase verb-phrase article noun verb) =>` `(SENTENCE NOUN-PHRASE VERB-PHRASE ARTICLE NOUN VERB)\n```\n\n  `> (sentence)`=>\n\n```lisp\n (1 ENTER SENTENCE)\n   (1 ENTER NOUN-PHRASE)\n     (1 ENTER ARTICLE)\n     (1 EXIT ARTICLE: (THE))\n     (1 ENTER NOUN)\n     (1 EXIT NOUN: (MAN))\n   (1 EXIT NOUN-PHRASE: (THE MAN))\n   (1 ENTER VERB-PHRASE)\n      (1 ENTER VERB)\n      (1 EXIT VERB: (HIT))\n      (1 ENTER NOUN-PHRASE)\n        (1 ENTER ARTICLE)\n        (1 EXIT ARTICLE: (THE))\n        (1 ENTER NOUN)\n        (1 EXIT NOUN: (BALL))\n      (1 EXIT NOUN-PHRASE: (THE BALL))\n    (1 EXIT VERB-PHRASE: (HIT THE BALL))\n  (1 EXIT SENTENCE: (THE MAN HIT THE BALL))\n  (THE MAN HIT THE BALL)\n```\n\nThe program works fine, and the trace looks just like the sample derivation above, but the Lisp definitions are a bit harder to read than the original grammar rules.\nThis problem will be compounded as we consider more complex rules.\nSuppose we wanted to allow noun phrases to be modified by an indefinite number of adjectives and an indefinite number of prepositional phrases.\nIn grammatical notation, we might have the following rules:\n\n  *Noun-Phrase*=> *Article + Adj* + Noun + PP**\n\n  *Adj**=> *!!!(char) Ø, Adj + Adj**\n\n  *PP**=> *!!!(char) Ø, PP + PP**\n\n  *PP*=> *Prep + Noun-Phrase*\n\n  *Adj*=> *big, little, blue, green*,...\n\n  *Prep*=> *to, in, by, with*,...\n\nIn this notation, !!!(char) Ø indicates a choice of nothing at all, a comma indicates a choice of several alternatives, and the asterisk is nothing special-as in Lisp, it's just part of the name of a symbol.\nHowever, the convention used here is that names ending in an asterisk denote zero or more repetitions of the underlying name.\nThat is, *PP** denotes zero or more repetitions of *PP*.\nThis is known as \"Kleene star\" notation (pronounced \"clean-E\") after the mathematician Stephen Cole Kleene.[1](#fn0010)\n\nThe problem is that the rules for *Adj** and *PP** contain choices that we would have to represent as some kind of conditional in Lisp.\nFor example:\n\n```lisp\n  (defun Adj* ()\n     (if (= (random 2) 0)\n             nil\n             (append (Adj) (Adj*))))\n  (defun PP* ()\n     (if (random-elt '(t nil))\n             (append (PP) (PP*))\n             nil))\n  (defun noun-phrase () (append (Article) (Adj*) (Noun) (PP*)))\n  (defun PP () (append (Prep) (noun-phrase)))\n  (defun Adj () (one-of '(big little blue green adiabatic)))\n  (defun Prep () (one-of '(to in by with on)))\n```\n\nI've chosen two different implementations for `Adj*` and `PP*`; either approach would work in either function.\nWe have to be careful, though; here are two approaches that would not work:\n\n```lisp\n  (defun Adj* ()\n     \"Warning - incorrect definition of Adjectives.\"\n     (one-of '(nil (append (Adj) (Adj*)))))\n  (defun Adj* ()\n     \"Warning - incorrect definition of Adjectives.\"\n     (one-of (list nil (append (Adj) (Adj*)))))\n```\n\nThe first definition is wrong because it could return the literal expression `((append (Adj) (Adj*)))` rather than a list of words as expected.\nThe second definition would cause infinite recursion, because Computing the value of `(Adj*)` always involves a recursive call to `(Adj*)`.\nThe point is that what started out as simple functions are now becoming quite complex.\nTo understand them, we need to know many Lisp conventions-`defun, (), case, if`, `quote`, and the rules for order of evaluation-when ideally the implementation of a grammar rule should use only *linguistic* conventions.\nIf we wanted to develop a larger grammar, the problem could get worse, because the rule-writer might have to depend more and more on Lisp.\n\n## 2.3 A Rule-Based Solution\n{:#s0020}\n{:.h1hd}\n\nAn alternative implementation of this program would concentrate on making it easy to write grammar rules and would worry later about how they will be processed.\nLet's look again at the original grammar rules:\n\n  *Sentence*=> *Noun-Phrase + Verb-Phrase*\n\n  *Noun-Phrase*=> *Article + Noun*\n\n  *Verb-Phrase*=> *Verb + Noun-Phrase*\n\n  *Article*=> *the, a,...*\n\n  *Noun*=> *man, ball, woman, table ...*\n\n  *Verb*=> *hit, took, saw, liked...*\n\nEach rule consists of an arrow with a symbol on the left-hand side and something on the right-hand side.\nThe complication is that there can be two kinds of right-hand sides: a concatenated list of symbols, as in \"*Noun-Phrase => Article+Noun*,\" or a list of alternate words, as in \"*Noun => man, ball,...*\" We can account for these possibilities by deciding that every rule will have a list of possibilities on the right-hand side, and that a concatenated list, *for example \"Article+Noun,\"* will be represented as a Lisp list, *for example*\"(`Article Noun`)\".\nThe list of rules can then be represented as follows:\n\n```lisp\n  (defparameter *simple-grammar*\n     '((sentence -> (noun-phrase verb-phrase))\n       (noun-phrase -> (Article Noun))\n       (verb-phrase -> (Verb noun-phrase))\n       (Article -> the a)\n       (Noun -> man ball woman table)\n       (Verb -> hit took saw liked))\n     \"A grammar for a trivial subset of English.\")\n  (defvar *grammar* *simple-grammar*\n     \"The grammar used by generate. Initially, this is\n     *simple-grammar*, but we can switch to other grammars.\")\n```\n\nNote that the Lisp version of the rules closely mimics the original version.\nIn particular, I include the symbol \"->\", even though it serves no real purpose; it is purely decorative.\n\nThe special forms `defvar` and `defparameter` both introduce special variables and assign a value to them; the difference is that a *variable*, like `*grammar*,` is routinely changed during the course of running the program.\nA *parameter*, like `*simple-grammar*`, on the other hand, will normally stay constant.\nA change to a parameter is considered a change *to* the program, not a change *by* the program.\n\nOnce the list of rules has been defined, it can be used to find the possible rewrites of a given category symbol.\nThe function `assoc` is designed for just this sort of task.\nIt takes two arguments, a \"key\" and a list of lists, and returns the first element of the list of lists that starts with the key.\nIf there is none, it returns `nil`.\nHere is an example:\n\n```lisp\n  > (assoc 'noun *grammar*)`=> `(NOUN -> MAN BALL WOMAN TABLE)\n```\n\nAlthough rules are quite simply implemented as lists, it is a good idea to impose a layer of abstraction by defining functions to operate on the rules.\nWe will need three functions: one to get the right-hand side of a rule, one for the left-hand side, and one to look up all the possible rewrites (right-hand sides) for a category.\n\n```lisp\n  (defun rule-lhs (rule)\n     \"The left-hand side of a rule.\"\n     (first rule))\n  (defun rule-rhs (rule)\n     \"The right-hand side of a rule.\"\n     (rest (rest rule)))\n  (defun rewrites (category)\n     \"Return a list of the possible rewrites for this category.\"\n     (rule-rhs (assoc category *grammar*)))\n```\n\nDefining these functions will make it easier to read the programs that use them, and it also makes changing the representation of rules easier, should we ever decide to do so.\n\nWe are now ready to address the main problem: defining a function that will generate sentences (or noun phrases, or any other category).\nWe will call this function `generate.` It will have to contend with three cases: (1) In the simplest case, `generate` is passed a symbol that has a set of rewrite rules associated with it.\nWe choose one of those at random, and then generate from that.\n(2) If the symbol has no possible rewrite rules, it must be a terminal symbol-a word, rather than a grammatical category-and we want to leave it alone.\nActually, we return the list of the input word, because, as in the previous program, we want all results to be lists of words.\n(3) In some cases, when the symbol has rewrites, we will pick one that is a list of symbols, and try to generate from that.\nThus, `generate` must also accept a list as input, in which case it should generate each element of the list, and then append them all together.\nIn the following, the first clause in `generate` handles this case, while the second clause handles (1) and the third handles (2).\nNote that we used the `mappend` function from [section 1.7](B9780080571157500017.xhtml#s0040) ([page 18](B9780080571157500017.xhtml#p18)).\n\n```lisp\n  (defun generate (phrase)\n     \"Generate a random sentence or phrase\"\n     (cond ((listp phrase)\n                 (mappend #'generate phrase))\n                 ((rewrites phrase)\n                  (generate (random-elt (rewrites phrase))))\n                 (t (list phrase))))\n```\n\nLike many of the programs in this book, this function is short, but dense with information: the craft of programming includes knowing what *not* to write, as well as what to write.\n\nThis style of programming is called *data-driven* programming, because the data (the list of rewrites associated with a category) drives what the program does next.\nIt is a natural and easy-to-use style in Lisp, leading to concise and extensible programs, because it is always possible to add a new piece of data with a new association without having to modify the original program.\n\nHere are some examples of generate in use:\n\n```lisp\n  > (generate 'sentence)`=> `(THE TABLE SAW THE BALL)\n  > (generate 'sentence)`=> `(THE WOMAN HIT A TABLE)\n  > (generate 'noun-phrase)`=> `(THE MAN)\n  > (generate 'verb-phrase)`=> `(TOOK A TABLE)\n```\n\nThere are many possible ways to write `generate`.\nThe following version uses `if` instead of `cond`:\n\n```lisp\n  (defun generate (phrase)\n     \"Generate a random sentence or phrase\"\n     (if (listp phrase)\n             (mappend #'generate phrase)\n             (let ((choices (rewrites phrase)))\n               (if (null choices)\n                       (list phrase)\n                       (generate (random-elt choices))))))\n```\n\nThis version uses the special form `let`, which introduces a new variable (in this case, `choices`) and also binds the variable to a value.\nIn this case, introducing the variable saves us from calling the function `rewrites twice`, as was done in the `cond` version of `generate`.\nThe general form of a `let` form is:\n\n  `(let` ((*var value*)...)\n\n    * body-containing-vars*)\n\n`let` is the most common way of introducing variables that are not parameters of functions.\nOne must resist the temptation to use a variable without introducing it:\n\n```lisp\n  (defun generate (phrase)\n   (setf choices ...) ;; wrong!\n   ... choices ...)\n```\n\nThis is wrong because the symbol `choices` now refers to a special or global variable, one that may be shared or changed by other functions.\nThus, the function generate is not reliable, because there is no guarantee that `choices` will retain the same value from the time it is set to the time it is referenced again.\nWith `let` we introduce a brand new variable that nobody else can access; therefore it is guaranteed to maintain the proper value.\n\n**Exercise 2.1 [m]** Write a version of `generate` that uses `cond` but avoids calling `rewrites twice`.\n\n**Exercise 2.2 [m]** Write a version of `generate` that explicitly differentiates between terminal symbols (those with no rewrite rules) and nonterminal symbols.\n\n## 2.4 Two Paths to Follow\n{:#s0025}\n{:.h1hd}\n\nThe two versions of the preceding program represent two alternate approaches that come up time and time again in developing programs: (1) Use the most straightforward mapping of the problem description directly into Lisp code.\n(2) Use the most natural notation available to solve the problem, and then worry about writing an interpreter for that notation.\n\nApproach (2) involves an extra step, and thus is more work for small problems.\nHowever, programs that use this approach are often easier to modify and expand.\nThis is especially true in a domain where there is a lot of data to account for.\nThe grammar of natural language is one such domain-in fact, most AI problems fit this description.\nThe idea behind approach (2) is to work with the problem as much as possible in its own terms, and to minimize the part of the solution that is written directly in Lisp.\n\nFortunately, it is very easy in Lisp to design new notations-in effect, new programming languages.\nThus, Lisp encourages the construction of more robust programs.\nThroughout this book, we will be aware of the two approaches.\nThe reader may notice that in most cases, we choose the second.\n\n## 2.5 Changing the Grammar without Changing the Program\n{:#s0030}\n{:.h1hd}\n\nWe show the utility of approach (2) by defining a new grammar that includes adjectives, prepositional phrases, proper names, and pronouns.\nWe can then apply the `generate` function without modification to this new grammar.\n\n```lisp\n  (defparameter *bigger-grammar*\n     '((sentence -> (noun-phrase verb-phrase))\n         (noun-phrase -> (Article Adj* Noun PP*) (Name) (Pronoun))\n         (verb-phrase -> (Verb noun-phrase PP*))\n         (PP* -> () (PP PP*))\n         (Adj* -> () (Adj Adj*))\n         (PP -> (Prep noun-phrase))\n         (Prep -> to in by with on)\n         (Adj -> big little blue green adiabatic)\n         (Article -> the a)\n         (Name -> Pat Kim Lee Terry Robin)\n         (Noun -> man ball woman table)\n         (Verb -> hit took saw liked)\n         (Pronoun -> he she it these those that)))\n  (setf *grammar* *bigger-grammar*)\n  > (generate 'sentence)\n  (A TABLE ON A TABLE IN THE BLUE ADIABATIC MAN SAW ROBIN\n  WITH A LITTLE WOMAN)\n  > (generate 'sentence)\n  (TERRY SAW A ADIABATIC TABLE ON THE GREEN BALL BY THAT WITH KIM IN THESE BY A GREEN WOMAN BY A LITTLE ADIABATIC TABLE IN ROBIN ON LEE)\n  > (generate 'sentence)\n  (THE GREEN TABLE HIT IT WITH HE)\n```\n\nNotice the problem with case agreement for pronouns: the program generated \"with he,\" although \"with him\" is the proper grammatical form.\nAlso, it is clear that the program does not distinguish sensible from silly output.\n\n## 2.6 Using the Same Data for Several Programs\n{:#s0035}\n{:.h1hd}\n\nAnother advantage of representing information in a declarative form-as rules or facts rather than as Lisp functions-is that it can be easier to use the information for multiple purposes.\nSuppose we wanted a function that would generate not just the list of words in a sentence but a representation of the complete syntax of a sentence.\nFor example, instead of the list `(a woman took a ball)`, we want to get the nested list:\n\n```lisp\n  (SENTENCE (NOUN-PHRASE (ARTICLE A) (NOUN WOMAN))\n                     (VERB-PHRASE (VERB TOOK)\n                                               (NOUN-PHRASE (ARTICLE A) (NOUN BALL))))\n```\n\nThis corresponds to the tree that linguists draw as in [figure 2.1](#f0010).\n\n![f02-01-9780080571157](images/B9780080571157500029/f02-01-9780080571157.jpg)     \nFigure 2.1:\n!!!(span) {:.fignum}\nSentence Parse Tree\nUsing the \"straightforward functions\" approach we would be stuck; we'd have to rewrite every function to generate the additional structure.\nWith the \"new notation\" approach we could keep the grammar as it is and just write one new function: a version of `generate` that produces nested lists.\nThe two changes are to `cons` the category onto the front of each rewrite, and then not to `append` together the results but rather just list them with `mapcar`:\n\n```lisp\n  (defun generate-tree (phrase)\n     \"Generate a random sentence or phrase,\n     with a complete parse tree.\"\n     (cond ((listp phrase)\n                  (mapcar #'generate-tree phrase))\n                 ((rewrites phrase)\n                  (cons phrase\n                             (generate-tree (random-elt (rewrites phrase)))))\n                 (t (list phrase))))\n```\n\nHere are some examples:\n\n```lisp\n  > (generate-tree 'Sentence)\n  (SENTENCE (NOUN-PHRASE (ARTICLE A)\n                                               (ADJ*)\n                                               (NOUN WOMAN)\n                                               (PP*))\n       (VERB-PHRASE (VERB HIT)\n                                               (NOUN-PHRASE (PRONOUN HE))\n                                               (PP*)))\n  > (generate-tree 'Sentence)\n  (SENTENCE (NOUN-PHRASE (ARTICLE A)\n                                               (NOUN WOMAN))\n                    (VERB-PHRASE (VERB TOOK)\n                                               (NOUN-PHRASE (ARTICLE A) (NOUN BALL))))\n```\n\nAs another example of the one-data/multiple-program approach, we can develop a function to generate all possible rewrites of a phrase.\nThe function `generate-all` returns a list of phrases rather than just one, and we define an auxiliary function, `combine-all`, to manage the combination of results.\nAlso, there are four cases instead of three, because we have to check for nil explicitly.\nStill, the complete program is quite simple:\n\n```lisp\n  (defun generate-all (phrase)\n     \"Generate a list of all possible expansions of this phrase.\"\n     (cond ((null phrase) (list nil))\n                 ((listp phrase)\n                  (combine-all (generate-all (first phrase))\n                                            (generate-all (rest phrase))))\n                 ((rewrites phrase)\n                  (mappend #'generate-all (rewrites phrase)))\n                 (t (list (list phrase)))))\n  (defun combine-all (xlist ylist)\n     \"Return a list of lists formed by appending a y to an x.\n     E.g., (combine-all '((a) (b)) '((1) (2)))\n      -> ((A 1) (B 1) (A 2) (B 2)).\"\n     (mappend #'(lambda (y)\n                             (mapcar #'(lambda (x) (append x y)) xlist))\n                       ylist))\n```\n\nWe can now use `generate-all` to test our original little grammar.\nNote that a serious drawback of `generate-all` is that it can't deal with recursive grammar rules like 'Adj* => Adj + Adj*' that appear in `*bigger-grammar*,` since these lead to an infinite number of outputs.\nBut it works fine for finite languages, like the language generated by *si`mple-grammar*:`\n\n```lisp\n  > (generate-all 'Article)\n  ((THE) (A))\n  > (generate-all 'Noun)\n  ((MAN) (BALL) (WOMAN) (TABLE))\n  > (generate-all 'noun-phrase)\n  ((A MAN) (A BALL) (A WOMAN) (A TABLE)\n  (THE MAN) (THE BALL) (THE WOMAN) (THE TABLE))\n  > (length (generate-all 'sentence))\n  256\n```\n\nThere are 256 sentences because every sentence in this language has the form Article- Noun-Verb-Article-Noun, and there are two articles, four nouns and four verbs (2 x 4 x 4 x 2 x 4 = 256).\n\n## 2.7 Exercises\n{:#s0040}\n{:.h1hd}\n\n**Exercise 2.3 [h]** Write a trivial grammar for some other language.\nThis can be a natural language other than English, or perhaps a subset of a computer language.\n\n**Exercise 2.4 [m]** One way of describing `combine-all` is that it calculates the cross-product of the function `append` on the argument lists.\nWrite the higher-order function `cross-product`, and define `combine-all` in terms of it.\n\nThe moral is to make your code as general as possible, because you never know what you may want to do with it next.\n\n## 2.8 Answers\n{:#s0045}\n{:.h1hd}\n\n**Answer 2.1**\n\n```lisp\n  (defun generate (phrase)\n     \"Generate a random sentence or phrase\"\n     (let ((choices nil))\n       (cond ((listp phrase)\n                    (mappend #'generate phrase))\n                   ((setf choices (rewrites phrase))\n                    (generate (random-elt choices)))\n                   (t (list phrase)))))\n```\n\n**Answer 2.2**\n\n```lisp\n  (defun generate (phrase)\n     \"Generate a random sentence or phrase\"\n     (cond ((listp phrase)\n                    (mappend #'generate phrase))\n                   ((non-terminal-p phrase)\n                     (generate (random-elt (rewrites phrase))))\n                   (t (list phrase))))\n  (defun non-terminal-p (category)\n     \"True if this is a category in the grammar.\"\n     (not (null (rewrites category))))\n```\n\n**Answer 2.4**\n\n```lisp\n  (defun cross-product (fn xlist ylist)\n     \"Return a list of all (fn x y) values.\"\n     (mappend #'(lambda (y)\n                               (mapcar #'(lambda (x) (funcall fn x y))\n                                       xlist))\n                     ylist))\n  (defun combine-all (xlist ylist)\n     \"Return a list of lists formed by appending a y to an x\"\n     (cross-product #'append xlist ylist))\n```\n\nNow we can use the `cross-product` in other ways as well:\n\n```lisp\n  > (cross-product #'+ '(1 2 3) '(10 20 30))\n  (11 12 13\n   21 22 23\n   31 32 33)\n  > (cross-product #'list '(a b c d e f g h)\n                          '(1 2 3 4 5 6 7 8))\n  ((A 1) (B 1) (C 1) (D 1) (E 1) (F 1) (G 1) (H 1)\n   (A 2) (B 2) (C 2) (D 2) (E 2) (F 2) (G 2) (H 2)\n   (A 3) (B 3) (C 3) (D 3) (E 3) (F 3) (G 3) (H 3)\n   (A 4) (B 4) (C 4) (D 4) (E 4) (F 4) (G 4) (H 4)\n   (A 5) (B 5) (C 5) (D 5) (E 5) (F 5) (G 5) (H 5)\n   (A 6) (B 6) (C 6) (D 6) (E 6) (F 6) (G 6) (H 6)\n   (A 7) (B 7) (C 7) (D 7) (E 7) (F 7) (G 7) (H 7)\n   (A 8) (B 8) (C 8) (D 8) (E 8) (F 8) (G 8) (H 8))\n```\n\n----------------------\n\n[1](#xfn0010) We will soon see \"Kleene plus\" notation, wherein *PP+* denotes one or more repetition of *PP*.\n!!!(p) {:.ftnote1}\n\n# Chapter 3\n## Overview of Lisp\n{:.chaptitle}\n\n> No doubt about it.\nCommon Lisp is a *big* language.\n\n> -Guy L.\nSteele, Jr.\n\n> Foreword to Koschman 1990\n\nThis chapter briefly covers the most important special forms and functions in Lisp.\nIt can be safely skipped or skimmed by the experienced Common Lisp programmer but is required reading for the novice Lisp programmer, or one who is new to the Common Lisp dialect.\n\nThis chapter can be used as a reference source, but the definitive reference is Steele's *Common Lisp the Language*, 2d edition, which should be consulted whenever there is any confusion.\nSince that book is 25 times longer than this chapter, it is clear that we can only touch on the important highlights here.\nMore detailed coverage is given later in this book as each feature is used in a real program.\n\n## 3.1 A Guide to Lisp Style\n{:#s0010}\n{:.h1hd}\n\nThe beginning Common Lisp programmer is often overwhelmed by the number of options that the language provides.\nIn this chapter we show fourteen different way s to find the length of a list.\nHow is the programmer to choose between them?\nOne answer is by reading examples of good programs-as illustrated in this book-and copying that style.\nIn general, there are six maxims that every programmer should follow:\n\n*  Be specific.\n\n*  Use abstractions.\n\n*  Be concise.\n\n*  Use the provided tools.\n\n*  Don't be obscure.\n\n*  Be consistent.\n\nThese require some explanation.\n\nUsing the most specific form possible makes it easier for your reader to understand your intent.\nFor example, the conditional special form `when` is more specific than `if`.\nThe reader who sees a `when` knows to look for only one thing: the clause to consider when the test is true.\nThe reader who sees an `if` can rightfully expect two clauses: one for when the test is true, and one for when it is false.\nEven though it is possible to use `if` when there is only one clause, it is preferable to use `when,` because `when` is more specific.\n\nOne important way of being specific is using abstractions.\nLisp provides very general data structures, such as lists and arrays.\nThese can be used to implement specific data structures that your program will use, but you should not make the mistake of invoking primitive functions directly.\nIf you define a list of names:\n\n```lisp\n(defvar *names* '((Robert E. Lee) ...))\n```\n\nthen you should also define functions to get at the components of each name.\nTo get at `Lee`,use `(last-name (first *names*)),not (caddar *names*)`.\n\nOften the maxims are in concord.\nFor example, if your code is trying to find an element in a list, you should use `find` (or maybe `find- if`), not `loop` or `do.\nfind` is more specific than the general constructs `loop` or `do,` it is an abstraction, it is more concise, it is a built-in tool, and it is simple to understand.\n\nSometimes, however, the maxims are in conflict, and experience will tell you which one to prefer.\nConsider the following two ways of placing a new key/value pair on an association list:[1](#fn0010)\n\n```lisp\n(push (cons key val) a-list)\n(setf a-list (acons key val a-list))\n```\n\nThe first is more concise.\nBut the second is more specific, as it uses the `acons` function, which is designed specifically for association lists.\nThe decision between them probably hinges on obscurity: those who find `acons` to be a familiar function would prefer the second, and those who find it obscure would prefer the first.\n\nA similar choice arises in the question of setting a variable to a value.\nSome prefer (`setq x val`) because it is most specific; others use (`setq x val`), feeling that it is more consistent to use a single form, `setf`, for all updating.\nWhichever choice you make on such issues, remember the sixth maxim: be consistent.\n\n## 3.2 Special Forms\n{:#s0015}\n{:.h1hd}\n\nAs noted in [chapter 1](B9780080571157500017.xhtml), \"special form\" is the term used to refer both to Common Lisp's syntactic constructs and the reserved words that mark these constructs.\nThe most commonly used special forms are:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| definitions | conditional | variables | iteration | other |\n| `defun` | `and` | `let` | `do` | `declare` |\n| `defstruct` | `case` | `let*` | `do*` | `function` |\n| `defvar` | `cond` | `pop` | `dolist` | `progn` |\n| `defparameter` | `if` | `push` | `dotimes` | `quote` |\n| `defconstant` | `or` | `setf` | `loop` | `return` |\n| `defmacro` | `unless` | `incf` | | `trace` |\n| `labels` | `when` | `decf` | | `untrace` |\n\n![t0010](images/B9780080571157500030/t0010.png)\n\nTo be precise, only `declare, function, if, labels, let, let*, progn` and `quote` are true special forms.\nThe others are actually defined as macros that expand into calls to more primitive special forms and functions.\nThere is no real difference to the programmer, and Common Lisp implementations are free to implement macros as special forms and vice versa, so for simplicity we will continue to use \"special form\" as a blanket term for both true special forms and built-in macros.\n\n### Special Forms for Definitions\n{:#s0020}\n{:.h2hd}\n\nIn this section we survey the special forms that can be used to introduce new global functions, macros, variables, and structures.\nWe have already seen the `defun` form for defining functions; the `defmacro` form is similar and is covered on [page 66](#p66).\n\n`(defun`*function-name* (*parameter...*) *\"optional documentation\" body...*)\n\n`(defmacro`*macro-name* (*parameter...*) *\"optional documentation\" body...*)\n\nThere are three forms for introducing special variables.\n`defvar` defines a special variable and can optionally be used to supply an initial value and a documentation string.\nThe initial value is evaluated and assigned only if the variable does not yet have any value, `defparameter` is similar, except that the value is required, and it will be used to change any existing value, `defconstant` is used to declare that a symbol will always stand for a particular value.\n\n`(defvar`*variable-name initial-value \"optional documentation\"* )\n\n`(defparameter`*variable-name value \"optional documentation\"*)\n\n`(defconstant`*variable-name value \"optional documentation\"*)\n\nAll the `def` - forms define global objects.\nIt is also possible to define local variables with `let`, and to define local functions with `labels`, as we shall see.\n\nMost programming languages provide a way to group related data together into a structure.\nCommon Lisp is no exception.\nThe `defstruct` special form defines a structure type (known as a *record* type in Pascal) and automatically defines functions to get at components of the structure.\nThe general syntax is:\n\n`(defstruct`*structure-name \"optional documentation\" slot...*)\n\nAs an example, we could define a structure for names:\n\n```lisp\n(defstruct name\n  first\n  (middle nil)\n  last)\n```\n\nThis automatically defines the constructor function `make-name,` the recognizer predicate `name-p,` and the accessor functions `name-first, name-middle` and `name-last.` The `(middle nil)` means that each new name built by `make-name` will have a middle name of `nil` by default.\nHere we create, access, and modify a structure:\n\n`> (setf b (make-name :first 'Barney :last 'Rubble))`=>\n\n```lisp\n#S(NAME : FIRST BARNEY :LAST RUBBLE)\n> (name-first b)` => `BARNEY\n> (name-middle b)` => `NIL\n> (name-last b)` => `RUBBLE\n> (name-p b)` => `T\n> (name-p 'Barney)  =>  NIL   ; *only the results of make-name are names*\n> (setf (name-middle b) 'Q)` => `Q\n> b  =>  #S(NAME : FIRST BARNEY : MIDDLE Q :LAST RUBBLE)\n```\n\nThe printed representation of a structure starts with a #S and is followed by a list consisting of the type of the structure and alternating pairs of slot names and values.\nDo not let this representation fool you: it is a convenient way of printing the structure, but it is not an accurate picture of the way structures are represented internally.\nStructures are actually implemented much like vectors.\nFor the `name` structure, the type would be in the zero element of the vector, the first name in the first element, middle in the second, and last in the third.\nThis means structures are more efficient than lists: they take up less space, and any element can be accessed in a single step.\nIn a list, it takes *n* steps to access the *n*th element.\n\nThere are options that give more control over the structure itself and the individual slots.\nThey will be covered later as they come up.\n\n### Special Forms for Conditionals\n{:#s0025}\n{:.h2hd}\n\nWe have seen the special form `if,` which has the form (`if`*test then-part else-part*), where either the *then-part* or the *else-part* is the value, depending on the success of the *test.* Remember that only `nil` counts as false; all other values are considered true for the purpose of conditionals.\nHowever, the constant `t` is the conventional value used to denote truth (unless there is a good reason for using some other value).\n\nThere are actually quite a few special forms for doing conditional evaluation.\nTechnically, `if` is defined as a special form, while the other conditionals are macros, so in some sense `if` is supposed to be the most basic.\nSome programmers prefer to use `if` for most of their conditionals; others prefer `cond` because it has been around the longest and is versatile (if not particularly pretty).\nFinally, some programmers opt for a style more like English prose, and freely use `when, unless, if,` and all the others.\n\nThe following table shows how each conditional can be expressed in terms of `if` and `cond`.\nActually, these translations are not quite right, because `or, case`, and `cond` take care not to evaluate any expression more than once, while the translations with `if` can lead to multiple evaluation of some expressions.\nThe table also has translations to `cond.` The syntax of `cond` is a series of *cond-clauses,* each consisting of a test expression followed by any number of *result* expressions:\n\n```lisp\n(cond (*test result...*)\n      (*test result...*)\n      *...*)\n```\n\n`cond` goes through the cond-clauses one at a time, evaluating each test expression.\nAs soon as a test expression evaluates non-nil, the result expressions for that clause are each evaluated, and the last expression in the clause is the value of the whole `cond.` In particular, if a cond-clause consists of just a test and no result expressions, then the value of the `cond` is the test expression itself, if it is non-nil.\nIf all of the test expressions evaluate to nil, then nil is returned as the value of the `cond.` A common idiom is to make the last cond-clause be ( t *result...*).\n\nThe forms `when` and `unless` operate like a single `cond` clause.\nBoth forms consist of a test followed by any number of consequents, which are evaluated if the test is satisfied-that is, if the test is true for `when` or false for `unless.`\n\nThe `and` form tests whether every one of a list of conditions is true, and `or` tests whether any one is true.\nBoth evaluate the arguments left to right, and stop as soon as the final result can be determined.\nHere is a table of equivalences:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| **conditional** | `if`**form** | `cond`**form** |\n| `(when`*test abc*) | `(if`*test*`(progn`*a bc*)) | `(cond` (*test a b c*)) |\n| `(unless`*test x y*) | `(if (not *test*) (progn`*xy*)) | `(cond ((not`*test*) *x y*)) |\n| `(and`*abc*) | `(if`*a*`(if`*b c*)) | `(cond` (*a*`(cond` (*bc*)))) |\n| `(or`*abc*) | `(if`*a a*`(if`*b b c*)) | `(cond (a)` (*b*) (*c*)) |\n| `(*case*`*a* (*b c*) `*(t x*))` | `(if (eql`*a *b*) *c x*) | `(cond ((eql`*a *b*)*c*) (*tx*)) |\n\nIt is considered poor style to use `and` and `or` for anything other than testing a logical condition, `when, unless,` and `if` can all be used for taking conditional action.\nFor example:\n\n```lisp\n(and (> n 100)\n    (princ \"N is large.\"))    ; Bad style!\n(or (<= n 100)\n    (princ \"N is large.\"))    ; Even worse style!\n(cond ((> n 100)        ; OK, but not MY preference\n      (princ \"N is large.\"))\n(when (> n 100)\n  (princ \"N is large.\"))    ; Good style.\n```\n\nWhen the main purpose is to return a value rather than take action, `cond` and `if` (with explicit `nil` in the else case) are preferred over when and `unless`, which implicitly return `nil` in the else case, `when` and `unless` are preferred when there is only one possibility, `if` (or, for some people, `cond)` when there are two, and `cond` when there are more than two:\n\n```lisp\n(defun tax-bracket (income)\n  \"Determine what percent tax should be paid for this income.\"\n  (cond ((< income 10000.00) 0.00)\n     ((< income 30000.00) 0.20)\n     ((< income 50000.00) 0.25)\n     ((< income 70000.00) 0.30)\n     (t             .35)))\n```\n\nIf there are several tests comparing an expression to constants, then case is appropriate.\nA case form looks like:\n\n`  (case`*expression*\n\n      (*match result*...)...)\n\nThe *expression* is evaluated and compared to each successive *match*.\nAs soon as one is `eql`, the *result* expressions are evaluated and the last one is returned.\nNote that the *match* expressions are *not* evaluated.\nIf a *match* expression is a list, then case tests if the *expression* is `eql` to any member of the list.\nIf a *match* expression is the symbol `otherwise` (or the symbol `t),` then it matches anything.\n(It only makes sense for this `otherwise` clause to be the last one.)\n\nThere is also another special form, `typecase,` which compares the type of an expression against several possibilities and, like `case`, chooses the first clause that matches.\nIn addition, the special forms `ecase` and `etypecase` are just like `case` and `typecase` except that they signal an error if there is no match.\nYou can think of the `e` as standing for either \"exhaustive\" or \"error.\" The forms `ccase` and `ctypecase` also signal errors, but they can be continuable errors (as opposed to fatal errors): the user is offered the chance to change the expression to something that satisfies one of the matches.\nHere are some examples of case forms and their cond equivalents:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(case x` | `(cond` |\n|   `(1 10)` |   `((eql x 1) 10)` |\n|   `(2 20))` |   `((eql x 2) 20))` |\n| `(typecase x` | `(cond` |\n|   `(number (abs x))` |   `((typep x 'number) (abs x))` |\n|   `(list (length x)))` |   `((typep x 'list) (length x)))` |\n| `(ecase x` | `(cond` |\n|   `(1 10)` |   `((eql x 1) 10)` |\n|   `(2 20))` |   `((eql x 2) 20)` |\n| |   `(t (error \"no valid case\")))` |\n| `(etypecase x` | `(cond` |\n|   `(number (abs x))` |   `((typep x 'number) (abs x))` |\n|   `(list (length x)))` |   `((typep x 'list) (length x))` |\n| |   `(t (error \"no valid typecase\")))` |\n\n### Special Forms for Dealing with Variables and Places\n{:#s0030}\n{:.h2hd}\n\nThe special form `setf` is used to assign a new value to a variable or *place*, much as an assignment statement with = or : = is used in other languages.\nA place, or *generalized variable* is a name for a location that can have a value stored in it.\nHere is a table of corresponding assignment forms in Lisp and Pascal:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `;; Lisp` | `/* Pascal */` |\n| `(setf x 0)` | `x := 0;` |\n| `(setf (aref A i j) 0)` | `A[i,j] := 0;` |\n| `(setf (rest list) nil)` | `list^.rest := nil;` |\n| `(setf (name-middle b) 'Q)` | `b\\middle := \"Q\";` |\n\n`setf` can be used to set a component of a structure as well as to set a variable.\nIn languages like Pascal, the expressions that can appear on the left-hand side of an assignment statement are limited by the syntax of the language.\nIn Lisp, the user can extend the expressions that are allowed in a `setf` form using the special forms `defsetf` or `define-setf-method`.\nThese are introduced on [pages 514](B9780080571157500157.xhtml#p514) and [884](B978008057115750025X.xhtml#p884) respectively.\n\nThere are also some built-in functions that modify places.\nFor example, (`rplacd list nil`) has the same effect as (`setf` (`rest list`) `nil`), except that it returns `list` instead of `nil`.\nMost Common Lisp programmers prefer to use the `setf` forms rather than the specialized functions.\n\nIf you only want to set a variable, the special form `setq` can be used instead.\nIn this book I choose to use `setf` throughout, opting for consistency over specificity.\n\nThe discussion in this section makes it seem that variables (and slots of structures) are assigned new values all the time.\nActually, many Lisp programs do no assignments whatsoever.\nIt is very common to use Lisp in a functional style where new variables may be introduced, but once a new variable is established, it never changes.\nOne way to introduce a new variable is as a parameter of a function.\nIt is also possible to introduce local variables using the special form `let`.\nFollowing are the general `let` form, along with an example.\nEach variable is bound to the corresponding value, and then the body is evaluated:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| (let ((*variable value*)...)  *body*...) | `    (let ((x 40)`        `(y (+ 1 1)))`   `(+ x y))` => `42` |\n\nDefining a local variable with a `let` form is really no different from defining parameters to an anonymous function.\nThe former is equivalent to:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| ((lambda (*variable*... )    *body*... ) *value*...) | `   ((lambda (x y)`       `(+ x y))` `40` `(+ 1 1))` |\n\nFirst, all the values are evaluated.\nThen they are bound to the variables (the parameters of the lambda expression), and finally the body is evaluated, using those bindings.\n\nThe special form `let`* is appropriate when you want to use one of the newly introduced variables in a subsequent *value* computation.\nFor example:\n\n```lisp\n(let* ((x 6)\n   (y (* x x)))\n(+ x y))` => `42\n```\n\nWe could not have used `let` here, because then the variable `x` would be unbound during the computation of `y`'s value.\n\n**Exercise 3.1 [m]** Show a `lambda` expression that is equivalent to the above `let`* expression.\nYou may need more than one `lambda.`\n\nBecause lists are so important to Lisp, there are special forms for adding and deleting elements from the front of a list-in other words, for treating a list as a stack.\nIf `list` is the name of a location that holds a list, then (`push`*x*`list`) will change `list` to have *x* as its first element, and (`pop list`) will return the first element and, as a side-effect, change `list` to no longer contain the first element.\n`push` and `pop` are equivalent to the following expressions:\n\n```lisp\n(push x list)` = `(setf list (cons x list))\n(pop list)`  = `(let ((result (first list)))\n                          (setf list (rest list))\n                          result)\n```\n\nJust as a list can be used to accumulate elements, a running sum can be used to accumulate numbers.\nLisp provides two more special forms, `incf` and `decf`, that can be used to increment or decrement a sum.\nFor both forms the first argument must be a location (a variable or other `setf`-able form) and the second argument, which is optional, is the number to increment or decrement by.\nFor those who know C, (`incf x`) is equivalent to `++x`, and (`incf x 2`) is equivalent to `x+=2`.\nIn Lisp the equivalence is:\n\n```lisp\n(incf x)` = `(incf x 1)` = `(setf x (+ x 1))\n(decf x)` = `(decf x 1)` = `(setf x (- x 1))\n```\n\nWhen the location is a complex form rather than a variable, Lisp is careful to expand into code that does not evaluate any subform more than once.\nThis holds for `push`, `pop`, `incf,` and `decf`.\nIn the following example, we have a list of players and want to decide which player has the highest score, and thus has won the game.\nThe structure `player` has slots for the player's score and number of wins, and the function `determine` - `winner` increments the winning player's `wins` field.\nThe expansion of the `incf` form binds a temporary variable so that the sort is not done twice.\n\n```lisp\n(defstruct player (score 0) (wins 0))\n(defun determine-winner (players)\n   \"Increment the WINS for the player with highest score.\"\n   (incf (player-wins (first (sort players #'>\n                  :key #'player-score)))))\n=\n(defun determine-winner (players)\n   \"Increment the WINS for the player with highest score.\"\n   (let ((temp (first (sort players #'> :key #'player-score))))\n      (setf (player-wins temp) (+ (player-wins temp) 1))))\n```\n\n### Functions and Special Forms for Repetition\n{:#s0035}\n{:.h2hd}\n\nMany languages have a small number of reserved words for forming iterative loops.\nFor example, Pascal has `while, repeat,` and `for` statements.\nIn contrast, Common Lisp has an almost bewildering range of possibilities, as summarized below:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `dolist` | loop over elements of a list |\n| `dotimes` | loop over successive integers |\n| `do, do*` | general loop, sparse syntax |\n| `loop` | general loop, verbose syntax |\n| `mapc, mapcar` | loop over elements of lists(s) |\n| `some, every` | loop over list until condition |\n| `find, reduce,`*etc.* | more specific looping functions |\n| *recursion* | general repetition |\n\nTo explain each possibility we will present versions of the function `length`, which returns the number of elements in a list.\nFirst, the special form `dolist` can be used to iterate over the elements of a list.\nThe syntax is:\n\n`(dolist (`*variable list optional-result*) *body...*)\n\nThis means that the body is executed once for each element of the list, with *variable* bound to the first element, then the second element, and so on.\nAt the end, `dolist` evaluates and returns the *optional-result* expression, or nil if there is no result expression.\n\nBelow is a version of `length` using `dolist`.\nThe `let` form introduces a new variable, `len`, which is initially bound to zero.\nThe `dolist` form then executes the body once for each element of the list, with the body incrementing `len` by one each time.\nThis use is unusual in that the loop iteration variable, `element`, is not used in the body.\n\n```lisp\n(defun lengthl (list)\n (let (len 0))       ;start with LEN=0\n  (dolist (element list) ;and on each iteration\n   (incf len))        ; increment LEN by 1\n  len))           ;and return LEN\n```\n\nIt is also possible to use the optional result of `dolist`, as shown below.\nWhile many programmers use this style, I find that it is too easy to lose track of the result, and so I prefer to place the result last explictly.\n\n```lisp\n(defun lengthl.1 (list)        ;alternate version:\n (let ((len 0))         ;(not my preference)\n  (dolist (element list len) ;uses len as result here\n   (incf len))))\n```\n\nThe function `mapc` performs much the same operation as the special form `dolist`.\nIn the simplest case, `mapc` takes two arguments, the first a function, the second a list.\nIt applies the function to each element of the list.\nHere is `length` using `mapc`:\n\n```lisp\n(defun length2 (list)\n (let ((len 0))        ;start with LEN=0\n  (mapc #'(lambda (element) ;and on each iteration\n        (incf len))   ; increment LEN by 1\n     list)\n  len)) ;and return LEN\n```\n\nThere are seven different mapping functions, of which the most useful are `mapc` and `mapcar`.\n`mapcar` executes the same function calls as `mapc,` but then returns the results in a list.\n\nThere is also a `dotimes` form, which has the syntax:\n\n(`dotimes` (*variable number optional-result*) *body...*)\n\nand executes the body with *variable* bound first to zero, then one, all the way up to *number*-1 (for a total of *number* times).\nOf course, `dotimes` is not appropriate for implementing `length`, since we don't know the number of iterations ahead of time.\n\nThere are two very general looping forms, `do` and `loop`.\nThe syntax of `do` is as follows:\n\n(`do` ((*variable initial next*)*...*)\n\n   (*exit-test result*)\n\n *body...*)\n\nEach *variable* is initially bound to the *initial* value.\nIf *exit-test* is true, then *result* is returned.\nOtherwise, the body is executed and each *variable* is set to the corresponding *next* value and *exit-test* is tried again.\nThe loop repeats until *exit-test* is true.\nIf a *next* value is omitted, then the corresponding variable is not updated each time through the loop.\nRather, it is treated as if it had been bound with a `let` form.\n\nHereis `length` implemented with `do`, using two variables, `len` to count the number of elements, and `l` to go down the list.\nThis is often referred to as *cdr-ing down a list,* because on each operation we apply the function `cdr` to the list.\n(Actually, here we have used the more mnemonic name `rest` instead of `cdr`.) Note that the `do loop` has no body!\nAll the computation is done in the variable initialization and stepping, and in the end test.\n\n```lisp\n(defun length3 (list)\n (do ((len 0 (+ len 1))  ;start with LEN=0, increment\n   (1 list (rest 1)))   ;... on each iteration\n   ((null 1) len)))    ;(until the end of the list)\n```\n\nI find the `do` form a little confusing, because it does not clearly say that we are looping through a list.\nTo see that it is indeed iterating over the list requires looking at both the variable `l` and the end test.\nWorse, there is no variable that stands for the current element of the list; we would need to say (`first l`) to get at it.\nBoth `dolist` and `mapc` take care of stepping, end testing, and variable naming automatically.\nThey are examples of the \"be specific\" principle.\nBecause it is so unspecific, `do` will not be used much in this book.\nHowever, many good programmers use it, so it is important to know how to read `do loops`, even if you decide never to write one.\n\nThe syntax of `loop` is an entire language by itself, and a decidedly non-Lisp-like language it is.\nRather than list all the possibilities for `loop`, we will just give examples here, and refer the reader to *Common Lisp the Language*, 2d edition, or chapter 24.5 for more details.\nHere are three versions of `length` using `loop`:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(defun length4 (list)` | |\n|  `(loop for element in list` | `;go through each element` |\n| `  count t))` | `; counting each one` |\n| `(defun length5 (list)` | |\n| ` (loop for element in list` | `;go through each element` |\n| `  summing 1))` | `; adding 1 each time` |\n| `(defun length6 (list)` | |\n| ` (loop with len = 0` | `;start with LEN=0` |\n| `  until (null list)` | `;and (until end of list)` |\n| `  for element = (pop list)` | `;on each iteration` |\n| `  do (incf len)` | `; increment LEN by 1` |\n| `  finally (return len)))` | `;and return LEN` |\n\nEvery programmer learns that there are certain kinds of loops that are used again and again.\nThese are often called *programming idioms* or *cliches.* An example is going through the elements of a list or array and doing some operation to each element.\nIn most languages, these idioms do not have an explicit syntactic marker.\nInstead, they are implemented with a general loop construct, and it is up to the reader of the program to recognize what the programmer is doing.\n\nLisp is unusual in that it provides ways to explicitly encapsulate such idioms, and refer to them with explicit syntactic and functional forms.\n`dolist` and `dotimes` are two examples of this-they both follow the \"be specific\" principle.\nMost programmers prefer to use a `dolist` rather than an equivalent `do,` because it cries out \"this loop iterates over the elements of a list.\" Of course, the corresponding `do` form also says the same thing-but it takes more work for the reader to discover this.\n\nIn addition to special forms like `dolist` and `dotimes,` there are quite a few functions that are designed to handle common idioms.\nTwo examples are `count-if,` which counts the number of elements of a sequence that satisfy a predicate, and `position-if,` which returns the index of an element satisfying a predicate.\nBoth can be used to implement `length.` In `length7` below, `count - if` gives the number of elements in `list` that satisfy the predicate `true.` Since `true` is defined to be always true, this gives the length of the list.\n\n```lisp\n(defun length7 (list)\n (count-if #'true list))\n(defun true (x) t)\n```\n\nIn `length8,` the function `position` - `if` finds the position of an element that satisfies the predicate true, starting from the end of the list.\nThis will be the very last element of the list, and since indexing is zero-based, we add one to get the length.\nAdmittedly, this is not the most straightforward implementation of `length.`\n\n```lisp\n(defun length8 (list)\n (if (null list)\n   0\n   (+ 1 (position-if #'true list :from-end t))))\n```\n\nA partial table of functions that implement looping idioms is given below.\nThese functions are designed to be flexible enough to handle almost all operations on sequences.\nThe flexibility cornes in three forms.\nFirst, functions like mapcar can apply to an arbitrary number of lists, not just one:\n\n```lisp\n> (mapcar #'- '(1 2 3))` => `(-1 -2 -3)\n> (mapcar #'+ '(1 2) '(10 20)) => (11 22)\n> (mapcar #'+ '(1 2) '(10 20) '(100 200)) => (111 222)\n```\n\nSecond, many of the functions accept keywords that allow the user to vary the test for comparing elements, or to only consider part of the sequence.\n\n```lisp\n> (remove 1 '(1 2 3 2 1 0 -1))` => `(2 3 2 0-1)\n> (remove 1 '(1 2 3 2 1 0 -1) :key #'abs)` => `(2 3 2 0)\n> (remove 1 '(1 2 3 2 1 0 -1) :test #'<)` => `(110 -1)\n> (remove 1 '(123210-1) : start 4)` => `(1 2 3 2 0 -1)\n```\n\nThird, some have corresponding functions ending in -`if` or -`if`-not that take a predicate rather than an element to match against:\n\n```lisp\n> (remove-if #'oddp '(1 2 3 2 1 0 -1))` => `(2 2 0)\n> (remove-if-not #'oddp '(1 2 3 2 1 0 -1))` => `(1 3 1 -1)\n> (find-if #'evenp '(1 2 3 2 1 0 -1))` => `2\n```\n\nThe following two tables assume these two values:\n\n```lisp\n(setf x '(a b c))\n(setf y '(1 2 3))\n```\n\nThe first table lists functions that work on any number of lists but do not accept keywords:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(every #' oddp y)` | => `nil` | test if every element satisfies a predicate |\n| `(some #' oddp y)` | => `t` | test if some element satisfies predicate |\n| `(mapcar #'- y)` | => `(-1-2-3)` | apply function to each element and return result |\n| `(mapc #'print y)` | *prints*`1 2 3` | perform operation on each element |\n\nThe second table lists functions that have `-if` and `-if-not` versions and also accept keyword arguments:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(member 2 y)` | =>`(2 3)` | see if element is in list |\n| `(count 'b x)` | => 1 | count the number of matching elements |\n| (`delete` 1 `y)` | => `(2 3)` | omit matching elements |\n| `(find 2 y)` | => `2` | find first element that matches |\n| `(position 'a x)` | => 0 | find index of element in sequence |\n| `(reduce #'+ y)` | => `6` | apply function to succesive elements |\n| `(remove 2 y)` | => (1 `3)` | like `delete`, but makes a new copy |\n| `(substitute 4 2 y)` | => `(1 4 3)` | replace elements with new ones |\n\n### Repetition through Recursion\n{:#s0040}\n{:.h2hd}\n\nLisp has gained a reputation as a \"recursive\" language, meaning that Lisp encourages programmers to write functions that call themselves.\nAs we have seen above, there is a dizzying number of functions and special forms for writing loops in Common Lisp, but it is also true that many programs handle repetition through recursion rather than with a syntactic loop.\n\nOne simple definition of `length` is \"the empty list has length 0, and any other list has a length which is one more than the length of the rest of the list (after the first element).\" This translates directly into a recursive function:\n\n```lisp\n(defun length9 (list)\n (if (null list)\n   0\n   (+ 1 (length9 (rest list)))))\n```\n\nThis version of `length` arises naturally from the recursive definition of a list: \"a list is either the empty list or an element consed onto another list.\" In general, most recursive functions derive from the recursive nature of the data they are operating on.\nSome kinds of data, like binary trees, are hard to deal with in anything but a recursive fashion.\nOthers, like lists and integers, can be defined either recursively (leading to recursive functions) or as a sequence (leading to iterative functions).\nIn this book, I tend to use the \"list-as-sequence\" view rather than the \"list-as-first-and- rest\" view.\nThe reason is that defining a list as a first and a rest is an arbitrary and artificial distinction that is based on the implementation of lists that Lisp happens to use.\nBut there are many other ways to decompose a list.\nWe could break it into the last element and all-but-the-last elements, for example, or the first half and the second half.\nThe \"list-as-sequence\" view makes no such artificial distinction.\nIt treats all elements identically.\n\nOne objection to the use of recursive functions is that they are inefficient, because the compiler has to allocate memory for each recursive call.\nThis may be true for the function `1ength9`, but it is not necessarily true for all recursive calls.\nConsider the following definition:\n\n```lisp\n(defun length10 (list)\n (length10-aux list 0))\n(defun length10-aux (sublist len-so-far)\n (if (null sublist)\n   len-so-far\n   (length10-aux (rest sublist) (+ 1 len-so-far))))\n```\n\n`length10` uses `length10` - `aux` as an auxiliary function, passing it 0 as the length of the list so far.\n`length10`-`aux` then goes down the list to the end, adding 1 for each element.\nThe invariant relation is that the length of the sublist plus `1en - so - far` always equals the length of the original list.\nThus, when the sublist is nil, then `1en-so-far` is the length of the original list.\nVariables like `1en - so - far` that keep track of partial results are called *accumulators.* Other examples of functions that use accumulators include `flatten - all` on page 329; `one - unknown` on page 237; the Prolog predicates discussed on page 686; and `anonymous-variables-in` on pages 400 and 433, which uses two accumulators.\n\nThe important difference between `length9` and `length10` is *when* the addition is done.\nIn `length9`, the function calls itself, then returns, and then adds 1.\nIn `length10`-`aux`, the function adds 1, then calls itself, then returns.\nThere are no pending operations to do after the recursive call returns, so the compiler is free to release any memory allocated for the original call before making the recursive call.\n`length10`-`aux` is called a *tail-recursive* function, because the recursive call appears as the last thing the function does (the tail).\nMany compilers will optimize tail-recursive calls, although not all do.\n([Chapter 22](B9780080571157500224.xhtml) treats tail-recursion in more detail, and points out that Scheme compilers guarantee that tail-recursive calls will be optimized.)\n\nSome find it ugly to introduce 1 `length10`- `aux`.\nFor them, there are two alternatives.\nFirst, we could combine 1 `length10` and 1 `length10`-`aux` into a single function with an optional parameter:\n\n```lisp\n(defun length11 (list &optional (len-so-far 0))\n (if (null list)\n   len-so-far\n   (length11 (rest list) (+ 1 len-so-far))))\n```\n\nSecond, we could introduce a *local* function inside the definition of the main function.\nThis is done with the special form `labels`:\n\n```lisp\n(defun length12 (the-list)\n (labels\n  ((length13 (list len-so-far)\n   (if (null list)\n    len-so-far\n    (length13 (rest list) (+ 1 len-so-far)))))\n  (length13 the-list 0)))\n```\n\nIn general, a `1abels` form (or the similar `flet` form) can be used to introduce one or more local functions.\nIt has the following syntax:\n\n```lisp\n(labels\n```\n\n ((*function-name* (*parameter...*) *function-body*)*...*)\n\n *body-of-labels)*\n\n### Other Special Forms\n{:#s0045}\n{:.h2hd}\n\nA few more special forms do not fit neatly into any category.\nWe have already seen the two special forms for creating constants and functions, `quote` and `function.` These are so common that they have abbreviations: 'x for `(quote x`) and `#'f` for `(function f).`\n\nThe special form `progn` can be used to evaluate a sequence of forms and return the value of the last one:\n\n```lisp\n(progn (setf x 0) (setf x (+ x 1)) x)` => `1\n```\n\n`progn` is the equivalent of a `begin`... `end` block in other languages, but it is used very infrequently in Lisp.\nThere are two reasons for this.\nFirst, programs written in a functional style never need a sequence of actions, because they don't have side effects.\nSecond, even when side effects are used, many special forms allow for a body which is a sequence-an implicit `progn.` I can only think of three places where a `progn` is justified.\nFirst, to implement side effects in a branch of a two-branched conditional, one could use either an `if` with a `progn,` or a cond:\n\n```lisp\n(if (> x 100) (cond ((> x 100)\n   (progn (print \"too big\")              (print \"too big\")\n       (setf x 100)) (setf x 100))\n   x) (t x))\n```\n\nIf the conditional had only one branch, then `when` or `unless` should be used, since they allow an implicit `progn`.\nIf there are more than two branches, then `cond` should be used.\n\nSecond, `progn` is sometimes needed in macros that expand into more than one top-level form, as in the `defun*` macro on page 326, [section 10.3](B9780080571157500108.xhtml#s0020).\nThird, a progn is sometimes needed in an `unwind-protect`, an advanced macro.\nAn example of this is the `with-resource` macro on [page 338](B9780080571157500108.xhtml#p338), [section 10.4](B9780080571157500108.xhtml#s0025).\n\nThe forms `trace` and `untrace` are used to control debugging information about entry and exit to a function:\n\n```lisp\n> (trace length9)` => `(LENGTH9)\n```\n\n`> (length9 '(a b c))`=>\n\n```lisp\n(1 ENTER LENGTH9: (ABC))\n (2 ENTER LENGTH9: (B C))\n  (3 ENTER LENGTH9: (C))\n   (4 ENTER LENGTH9: NIL)\n   (4 EXIT LENGTH9: 0)\n  (3 EXIT LENGTH9: 1)\n (2 EXIT LENGTH9: 2)\n(1 EXIT LENGTH9: 3)\n3\n> (untrace length9) => (LENGTH9)\n> (length9 '(a b c))` => `3\n```\n\nFinally, the special form `return` can be used to break out of a block of code.\nBlocks are set up by the special form `block`, or by the looping forms `(do, do*, dolist, dotimes`, or `loop`).\nFor example, the following function computes the product of a list of numbers, but if any number is zero, then the whole product must be zero, so we immediately return zero from the `dolist` loop.\nNote that this returns from the `dolist` only, not from the function itself (although in this case, the value returned by `dolist` becomes the value returned by the function, because it is the last expression in the function).\nI have used uppercase letters in `RETURN` to emphasize the fact that it is an unusual step to exit from a loop.\n\n```lisp\n(defun product (numbers)\n  \"Multiply all the numbers together to compute their product.\"\n  (let ((prod 1))\n    (dolist (n numbers prod)\n     (if (= n 0)\n      (RETURN 0)\n      (setf prod (* n prod))))))\n```\n\n### Macros\n{:#s0050}\n{:.h2hd}\n\nThe preceding discussion has been somewhat cavalier with the term \"special form.\" Actually, some of these special forms are really *macros*, forms that the compiler expands into some other code.\nCommon Lisp provides a number of built-in macros and allows the user to extend the language by defining new macros.\n(There is no way for the user to define new special forms, however.)\n\nMacros are defined with the special form `defmacro`.\nSuppose we wanted to define a macro, `while`, that would act like the `while` loop statement of Pascal.\nWriting a macro is a four-step process:\n\n*  Decide if the macro is really necessary.\n\n*  Write down the syntax of the macro.\n\n*  Figure out what the macro should expand into.\n\n*  Use `defmacro` to implement the syntax/expansion correspondence.\n\nThe first step in writing a macro is to recognize that every time you write one, you are defining a new language that is just like Lisp except for your new macro.\nThe programmer who thinks that way will rightfully be extremely frugal in defining macros.\n(Besides, when someone asks, \"What did you get done today?\" it sounds more impressive to say \"I defined a new language and wrote a compiler for it\" than to say \"I just hacked up a couple of macros.\") Introducing a macro puts much more memory strain on the reader of your program than does introducing a function, variable or data type, so it should not be taken lightly.\nIntroduce macros only when there is a clear need, and when the macro fits in well with your existing system.\nAs C.A.R.\nHoare put it, \"One thing the language designer should not do is to include untried ideas of his own.\"\n\nThe next step is to decide what code the macro should expand into.\nIt is a good idea to follow established Lisp conventions for macro syntax whenever possible.\nLook at the looping macros `(dolist, dotimes, do-symbols),` the defining macros `(defun, defvar, defparameter, defstruct),` or the the I/O macros `(with-open-file, with-open-stream, with-input-from-string),` for example.\nIf you follow the naming and syntax conventions for one of these instead of inventing your own conventions, you'll be doing the reader of your program a favor.\nFor `while,` a good syntax is:\n\n(`while`*test body...*)\n\nThe third step is to write the code that you want a macro call to expand into:\n\n```lisp\n(loop\n  (unless`*test*`(return nil))\n```\n\n  *body*)\n\nThe final step is to write the definition of the macro, using `defmacro.\nA defmacro` form is similar to a `defun` in that it has a parameter list, optional documentation string, and body.\nThere are a few differences in what is allowed in the parameter list, which will be covered later.\nHere is a definition of the macro `while`, which takes a test and a body, and builds up the `loop` code shown previously:\n\n```lisp\n(defmacro while (test &rest body)\n  \"Repeat body while test is true.\"\n  (list* 'loop\n  (list 'unless test '(return nil))\n      body))\n```\n\n(The function `list`* is like `list`, except that the last argument is appended onto the end of the list of the other arguments.) We can see what this macro expands into by using `macroexpand`, and see how it runs by typing in an example:\n\n```lisp\n> (macroexpand-1 '(while (< i 10)\n        (print (* i i))\n```\n\n        `(setf i (+ i 1))))`=>\n\n```lisp\n(LOOP (UNLESS (< I 10) (RETURN NIL))\n   (PRINT (* I I))\n   (SETF I (+ I 1)))\n> (setf i 7) =>7\n> (while (< i 10)\n  (print (* i i))\n  (setf i (+ i 1)))\n49\n64\n81\nNIL\n```\n\n[Section 24.6](B9780080571157500248.xhtml) (page 853) describes a more complicated macro and some details on the pitfalls of writing complicated macros (page 855).\n\n### Backquote Notation\n{:#s0060}\n{:.h2hd}\n\nThe hardest part about defining `while` is building the code that is the expansion of the macro.\nIt would be nice if there was a more immediate way of building code.\nThe following version of `while` following attempts to do just that.\nIt defines the local variable `code` to be a template for the code we want, and then substitutes the real values of the variables test and body for the placeholders in the code.\nThis is done with the function `subst`; (`subst`*new old tree*) substitutes *new* for each occurrence of *old* anywhere within *tree.*\n\n```lisp\n(defmacro while (test &rest body)\n \"Repeat body while test is true.\"\n (let ((code '(loop (unless test (return nil)) . body)))\n   (subst test 'test (subst body 'body code))))\n```\n\nThe need to build up code (and noncode data) from components is so frequent that there is a special notation for it, the *backquote* notation.\nThe backquote character `\"'\"` is similar to the quote character `\"'\"`.\nA backquote indicates that what follows is *mostly* a literal expression but may contain some components that are to be evaluated.\nAnything marked by a leading comma `\",\"` is evaluated and inserted into the structure, and anything marked with a leading `\",@\"` must evaluate to a list that is spliced into the structure: each element of the list is inserted, without the top-level parentheses.\nThe notation is covered in more detail in [section 23.5](B9780080571157500236.xhtml#s0030).\nHere we use the combination of backquote and comma to rewrite `while`:\n\n```lisp\n(defmacro while (test &rest body)\n \"Repeat body while test is true.\"\n '(loop (unless ,test (return nil))\n     ,@body))\n```\n\nHere are some more examples of backquote.\nNote that at the end of a list, `\",@\"` has the same effect as `\".\"` followed by `\",\"`.\nIn the middle of a list, only `\",@\"`is a possibility.\n\n```lisp\n> (setf testl '(a test)) => (A TEST)\n> '(this is ,test1) => (THIS IS (A TEST))\n> '(this is ,@test1) => (THIS IS A TEST)\n> '(this is . ,test1) => (THIS IS A TEST)\n> '(this is ,@test1 -- this is only ,@testl) =>\n(THIS IS A TEST -- THIS IS ONLY A TEST)\n```\n\nThis completes the section on special forms and macros.\nThe remaining sections of this chapter give an overview of the important built-in functions in Common Lisp.\n\n## 3.3 Functions on Lists\n{:#s0065}\n{:.h1hd}\n\nFor the sake of example, assume we have the following assignments:\n\n```lisp\n(setf x '(a b c))\n(setf y '(1 2 3))\n```\n\nThe most important functions on lists are summarized here.\nThe more complicated ones are explained more thoroughly when they are used.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(first x)` | => `a` | first element of a list |\n| `(second x)` | `=> b` | second element of a list |\n| `(third x)` | => `c` | third element of a list |\n| `(nth 0 x)` | => `a` | nth element of a list, `0`-based |\n| `(rest x)` | => `(b c)` | ail but the first element |\n| `(car x)` | => `a` | another name for the first element of a list |\n| `(cdr x)` | => `(b c)` | another name for all but the first element |\n| `(last x)` | => `(c)` | last cons cell in a list |\n| `(length x)` | => 3 | number of elements in a list |\n| `(reverse x)` | => `(c b a)` | puts list in reverse order |\n| `(cons 0 y)` | => `(0 1 2 3)` | add to front of list |\n| `(append x y)` | => `(a b c 1 2 3)` | append together elements |\n| `(list x y)` | => `((a b c) (1 2 3))` | make a new list |\n| `(list* 1 2 x)` | => `(1 2 a b` c) | append last argument to others |\n| `(null nil)` | => `T` | predicate is true of the empty list |\n| `(null x)` | => `nil` | ... and false for everything else |\n| `(listp x)` | => `T` | predicate is true of any list, including `nil` |\n| `(listp 3)` | => `nil` | ... and is false for nonlists |\n| `(consp x)` | => `t` | predicate is true of non-nil lists |\n| `(consp nil)` | => `nil` | ... and false for atoms, including `nil` |\n| `(equal x x)` | => `t` | true for lists that look the same |\n| `(equal x y)` | `nil` | ... and false for lists that look different |\n| `(sort y #'>)` | => `(3 2 1)` | sort a list according to a comparison function |\n| `(subseq x 1 2)` | => `(B)` | subsequence with given start and end points |\n\nWe said that (`cons`*a b*) builds a longer list by adding element *a* to the front of list *b,* but what if *b* is not a list?\nThis is not an error; the result is an object *x* such that (`first`*x*) => *a* (`rest`*x*) => *b,* and where *x* prints as (*a* . *b*).\nThis is known as *dotted pair* notation.\nIf *b* is a list, then the usual list notation is used for output rather than the dotted pair notation.\nBut either notation can be used for input.\n\nSo far we have been thinking of lists as sequences, using phrases like \"a list of three elements.\" The list is a convenient abstraction, but the actual implementation of lists relies on lower-level building blocks called *cons cells.* A cons cell is a data structure with two fields: a first and a rest.\nWhat we have been calling \"a list of three elements\" can also be seen as a single cons cell, whose first field points to the first element and whose rest field points to another cons cell that is a cons cell representing a list of two elements.\nThis second cons cell has a rest field that is a third cons cell, one whose rest field is nil.\nAll proper lists have a last cons cell whose rest field is nil.\n[Figure 3.1](#f0010) shows the cons cell notation for the three-element list (`one two three`), as well as for the result of (`cons 'one 'two`).\n\n![f03-01-9780080571157](images/B9780080571157500030/f03-01-9780080571157.jpg)     \nFigure 3.1\n!!!(span) {:.fignum}\nCons Cell Diagrams\n**Exercise 3.2 [s]** The function cons can be seen as a special case of one of the other functions listed previously.\nWhich one?\n\n**Exercise 3.3 [m]** Write a function that will print an expression in dotted pair notation.\nUse the built-in function `princ` to print each component of the expression.\n\n**Exercise 3.4 [m]** Write a function that, like the regular `print` function, will print an expression in dotted pair notation when necessary but will use normal list notation when possible.\n\n## 3.4 Equality and Internal Representation\n{:#s0070}\n{:.h1hd}\n\nIn Lisp there are five major equality predicates, because not all objects are created equally equal.\nThe numeric equality predicate, =, tests if two numbers are the same.\nIt is an error to apply = to non-numbers.\nThe other equality predicates operate on any kind of object, but to understand the difference between them, we need to understand some of the internals of Lisp.\n\nWhen Lisp reads a symbol in two different places, the result is guaranteed to be the exact same symbol.\nThe Lisp system maintains a symbol table that the function read uses to map between characters and symbols.\nBut when a list is read (or built) in two different places, the results are *not* identically the same, even though the corresponding elements may be.\nThis is because `read` calls `cons` to build up the list, and each call to `cons` returns a new cons cell.\n[Figure 3.2](#f0015) shows two lists, `x` and `Y`, which are both equal to (`one two`), but which are composed of different cons cells, and hence are not identical.\n[Figure 3.3](#f0020) shows that the expression (`rest x`) does not generate new cons cells, but rather shares structure with `x`, and that the expression (`cons ' zero x`) generates exactly one new cons cell, whose rest is `x`.\n\n![f03-02-9780080571157](images/B9780080571157500030/f03-02-9780080571157.jpg)     \nFigure 3.2\n!!!(span) {:.fignum}\nEqual But Nonidentical Lists\n![f03-03-9780080571157](images/B9780080571157500030/f03-03-9780080571157.jpg)     \nFigure 3.3\n!!!(span) {:.fignum}\nParts of Lists\nWhen two mathematically equal numbers are read (or computed) in two places, they may or may not be the same, depending on what the designers of your implementation felt was more efficient.\nIn most systems, two equal fixnums will be identical, but equal numbers of other types will not (except possibly short floats).\nCommon Lisp provides four equality predicates of increasing generality.\nAll four begin with the letters `eq`, with more letters meaning the predicate considers more objects to be equal.\nThe simplest predicate is `eq`, which tests for the exact same object.\nNext, `eql` tests for objects that are either `eq` or are equivalent numbers.\n`equal` tests for objects that are either `eql` or are lists or strings with `eql` elements.\nFinally, `equalp` is like `equal` except it also matches upper- and lowercase characters and numbers of different types.\nThe following table summarizes the results of applying each of the four predicates to various values of *x* and `y`.\nThe ? value means that the result depends on your implementation: two integers that are `eql` may or may not be `eq`.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| *x* | *y* | `eq` | `eql` | `equal` | `equalp` |\n| `'X` | `'x` | `T` | `T` | `T` | `T` |\n| `'0` | `'0` | `?` | `T` | `T` | `T` |\n| `'(x)` | `'(x)` | `nil` | `nil` | `T` | `T` |\n| `'\"xy\"` | `'\"xy\"` | `nil` | `nil` | `T` | `T` |\n| `'\"Xy\"` | `'\"xY\"` | `nil` | `nil` | `nil` | `T` |\n| `'0` | `'0.0` | `nil` | `nil` | `nil` | `T` |\n| `'0` | `'1` | `nil` | `nil` | `nil` | `nil` |\n\n![t0065](images/B9780080571157500030/t0065.png)\n\nIn addition, there are specialized equality predicates such as =, `tree-equal, char-equal,` and `string-equal,` which compare numbers, trees, characters, and strings, respectively.\n\n## 3.5 Functions on Sequences\n{:#s0075}\n{:.h1hd}\n\nCommon Lisp is in a transitional position halfway between the Lisps of the past and the Lisps of the future.\nNowhere is that more apparent than in the sequence functions.\nThe earliest Lisps dealt only with symbols, numbers, and lists, and provided list functions like `append` and `length.` More modem Lisps added support for vectors, strings, and other data types, and introduced the term *sequence* to refer to both vectors and lists.\n(A vector is a one-dimensional array.\nIt can be represented more compactly than a list, because there is no need to store the rest pointers.\nIt is also more efficient to get at the nth element of a vector, because there is no need to follow a chain of pointers.) Modem Lisps also support strings that are vectors of characters, and hence also a subtype of sequence.\n\nWith the new data types came the problem of naming functions that operated on them.\nIn some cases, Common Lisp chose to extend an old function: `length` can apply to vectors as well as lists.\nIn other cases, the old names were reserved for the list functions, and new names were invented for generic sequence functions.\nFor example, `append` and `mapcar` only work on lists, but `concatenate` and `map` work on any kind of sequence.\nIn still other cases, new functions were invented for specific data types.\nFor example, there are seven functions to pick the nth element out of a sequence.\nThe most general is `elt`, which works on any kind of sequence, but there are specific functions for lists, arrays, strings, bit vectors, simple bit vectors, and simple vectors.\nConfusingly, `nth` is the only one that takes the index as the first argument:\n\n`(nth`*n list*) (`elt`*sequence n*) `(aref`*array n*) `(char`*string n*) (`bit`*bit vector n*) `(sbit`*simple-bit vector n)* `(svref`*simple-vector n)*\n\nThe most important sequence functions are listed elsewhere in this chapter, depending on their particular purpose.\n\n## 3.6 Functions for Maintaining Tables\n{:#s0080}\n{:.h1hd}\n\nLisp lists can be used to represent a one-dimensional sequence of objects.\nBecause they are so versatile, they have been put to other purposes, such as representing tables of information.\nThe *association list* is a type of list used to implement tables.\nAn association list is a list of dotted pairs, where each pair consists of a *key* and a *value.* Together, the list of pairs form a table: given a key, we can retrieve the corresponding value from the table, or verify that there is no such key stored in the table.\nHere's an example for looking up the names of states by their two-letter abbreviation.\nThe function `assoc` is used.\nIt returns the key/value pair (if there is one).\nTo get the value, we just take the `cdr` of the result returned by `assoc`.\n\n```lisp\n(setf state-table` `'((AL . Alabama) (AK . Alaska) (AZ . Arizona) (AR . Arkansas)))` `> (assoc 'AK state-table)` => `(AK . ALASKA)` `> (cdr (assoc 'AK state-table))` => `ALASKA` `> (assoc 'TX state-table)` => `NIL\n```\n\nIf we want to search the table by value rather than by key, we can use rassoc:\n\n```lisp\n  > (rassoc 'Arizona table)` => `(AZ . ARIZONA)` `> (car (rassoc 'Arizona table))` => `AZ\n```\n\nManaging a table with `assoc` is simple, but there is one drawback: we have to search through the whole list one element at a time.\nIf the list is very long, this may take a while.\n\nAnother way to manage tables is with *hash tables.* These are designed to handle large amounts of data efficiently but have a degree of overhead that can make them inappropriate for small tables.\nThe function `gethash` works much like `get-`it takes two arguments, a key and a table.\nThe table itself is initialized with a call to `make-hash-table` and modified with a `setf` of `gethash:`\n\n```lisp\n(setf table (make-hash-table))` `(setf (gethash 'AL table) 'Alabama)` `(setf (gethash 'AK table) 'Alaska)` `(setf (gethash 'AZ table) 'Arizona)` `(setf (gethash 'AR table) 'Arkansas)\n```\n\nHere we retrieve values from the table:\n\n```lisp\n> (gethash 'AK table)` => `ALASKA` `> (gethash 'TX table)` => `NIL\n```\n\nThe function `remhash` removes a key/value pair from a hash table, `clrhash` removes all pairs, and `maphash` can be used to map over the key/value pairs.\nThe keys to hash tables are not restricted; they can be any Lisp object.\nThere are many more details on the implementation of hash tables in Common Lisp, and an extensive literature on their theory.\n\nA third way to represent table is with *property lists.* A property list is a list of alternating key/value pairs.\nProperty lists (sometimes called p-lists or plists) and association lists (sometimes called a-lists or alists) are similar:\n\n`a-list:` ((*key*1*.\nval*1`)` (*key*2*.\nval*`2) ... (`*keyn . valn*)) `p-list: (`*key*1*val*1*key*2*val*2*... keyn valn*)\n\nGiven this representation, there is little to choose between a-lists and p-lists.\nThey are slightly different permutations of the same information.\nThe difference is in how they are normally used.\nEvery symbol has a property list associated with it.\nThat means we can associate a property/value pair directly with a symbol.\nMost programs use only a few different properties but have many instances of property/value pairs for each property.\nThus, each symbol's p-list will likely be short.\nIn our example, we are only interested in one property: the state associated with each abbreviation.\nThat means that the property lists will be very short indeed: one property for each abbreviation, instead of a list of 50 pairs in the association list implementation.\n\nProperty values are retrieved with the function get, which takes two arguments: the first is a symbol for which we are seeking information, and the second is the property of that symbol that we are interested in.\nget returns the value of that property, if one has been stored.\nProperty/value pairs can be stored under a symbol with a setf form.\nA table would be built as follows:\n\n```lisp\n(setf (get 'AL 'state) 'Alabama)` `(setf (get 'AK 'state) 'Alaska)` `(setf (get 'AZ 'state) 'Arizona)` `(setf (get 'AR 'state) 'Arkansas)\n```\n\nNow we can retrieve values with get:\n\n```lisp\n> (get 'AK 'state) => ALASKA` `> (get 'TX 'state) => NIL\n```\n\nThis will be faster because we can go immediately from a symbol to its lone property value, regardless of the number of symbols that have properties.\nHowever, if a given symbol has more than one property, then we still have to search linearly through the property list.\nAs Abraham Lincoln might have said, you can make some of the table lookups faster some of the time, but you can't make all the table lookups faster all of the time.\nNotice that there is no equivalent of rassoc using property lists; if you want to get from a state to its abbreviation, you could store the abbreviation under a property of the state, but that would be a separate `setf` form, as in:\n\n```lisp\n(setf (get 'Arizona 'abbrev) 'AZ)\n```\n\nIn fact, when source, property, and value are all symbols, there are quite a few possibilities for how to use properties.\nWe could have mimicked the a-list approach, and listed all the properties under a single symbol, using setf on the function `symbol-plist` (which gives a symbol's complete property list):\n\n```lisp\n(setf (symbol-plist 'state-table)`     `'(AL Alabama AK Alaska AZ Arizona AR Arkansas))` `> (get 'state-table 'AL) => ALASKA` `> (get 'state-table 'Alaska) => NIL\n```\n\nProperty lists have a long history in Lisp, but they are falling out of favor as new alternatives such as hash tables are introduced.\nThere are two main reasons why property lists are avoided.\nFirst, because symbols and their property lists are global, it is easy to get conflicts when trying to put together two programs that use property lists.\nIf two programs use the same property for different purposes, they cannot be used together.\nEven if two programs use *different* properties on the same symbols, they will slow each other down.\nSecond, property lists are messy.\nThere is no way to remove quickly every element of a table implemented with property lists.\nIn contrast, this can be done trivially with `clrhash` on hash tables, or by setting an association list to nil.\n\n## 3.7 Functions on Trees\n{:#s0085}\n{:.h1hd}\n\nMany Common Lisp functions treat the expression `((a b) ((c)) (d e))` as a sequence of three elements, but there are a few functions that treat it as a tree with five non-null leaves.\nThe function `copy` - `tree` creates a copy of a tree, and `tree` - `equal` tests if two trees are equal by traversing cons cells, but not other complex data like vectors or strings.\nIn that respect, `tree-equal` is similar to `equal`, but `tree-equal` is more powerful because it allows a : `test keyword`:\n\n```lisp\n> (setf tree '((a b) ((c)) (d e)))` `> (tree-equal tree (copy-tree tree))` => `T` `(defun same-shape-tree (a b)`  `\"Are two trees the same except for the leaves?\"`  `(tree-equal a b :test #'true))` `(defun true (&rest ignore) t)` `> (same-shape-tree tree '((1 2) ((3)) (4 5)))` => `T` `> (same-shape-tree tree '((1 2) (3) (4 5)))` => `NIL\n```\n\n[Figure 3.4](#f0025) shows the tree `((a b) ((c)) (d e))`asa cons cell diagram.\n\n![f03-04-9780080571157](images/B9780080571157500030/f03-04-9780080571157.jpg)     \nFigure 3.4\n!!!(span) {:.fignum}\nCons Cell Diagram of a Tree\nThere are also two functions for substituting a new expression for an old one anywhere within a tree.\n`subst` substitutes a single value for another, while `sublis` takes a list of substitutions in the form of an association list of (*old . new*) pairs.\nNote that the order of old and new in the a-list for `sublis` is reversed from the order of arguments to `subst`.\nThe name `sublis` is uncharacteristically short and confusing; abetter name would be `subst-list`.\n\n```lisp\n> (subst 'new 'old '(old ((very old))) (NEW ((VERY NEW)))` `> (sublis '((old . new)) '(old ((very old))))` => `(NEW ((VERY NEW)))` `> (subst 'new 'old 'old) => 'NEW`  `(defun english->french (words)`   `(subiis '((are . va) (book . libre) (friend . ami)`      `(hello . bonjour) (how . comment) (my . mon)`      `(red . rouge) (you . tu))`     `words))`  `> (english->french '(hello my friend - how are you today?))` =>   `(BONJOUR MON AMI - COMMENT VA TU TODAY?)\n```\n\n## 3.8 Functions on Numbers\n{:#s0090}\n{:.h1hd}\n\nThe most commonly used functions on numbers are listed here.\nThere are quite a few other numeric functions that have been omitted.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(+ 4 2)` | => 6 | add |\n| `(- 4 2)` | => `2` | subtract |\n| `(* 4 2)` | => 8 | multiply |\n| `(/ 4 2)` | => `2` | divide |\n| (> 100 99) | => `t` | greater than (also > =, greater than or equal to) |\n| (= 100 100) | => `t` | equal (also /=, not equal) |\n| (< 99 100) | => `t` | less than (also < =, less than or equal to) |\n| `(random` 100) | `=> 42` | random integer from 0 to 99 |\n| `(expt 4 2)` | => 16 | exponentiation (also exp, *ex* and 1 og) |\n| `(sin pi)` | => 0.0 | sine function (also `cos`, `tan,` etc.) |\n| `(asin` 0) | => 0.0 | arcsine or sin- 1 function (also `acos, atan`, etc.) |\n| `(min 2 3 4)` | => `2` | minimum (also `max`) |\n| `(abs -3)` | => `3` | absolute value |\n| `(sqrt 4)` | => `2` | square root |\n| `(round 4.1)` | => `4` | round off (also `truncate, floor, ceiling`) |\n| `(rem 11 5)` | => 1 | remainder (also `mod`) |\n\n## 3.9 Functions on Sets\n{:#s0095}\n{:.h1hd}\n\nOne of the important uses of lists is to represent sets.\nCommon Lisp provides functions that treat lists in just that way.\nFor example, to see what elements the sets *r* = {*a, c, d*} and *s* = {*c, d, e*} have in common, we could use:\n\n```lisp\n> (setf r '(a b c d))` => `(A B C D)` `> (setf s '(c d e))` => `(C D E)` `> (intersection r s)` => `(C D)\n```\n\nThis implementation returned (`C D`) as the answer, but another might return (`D C`).\nThey are equivalent sets, so either is valid, and your program should not depend on the order of elements in the result . Here are the main functions on sets:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(intersection r s)` | => (c `d)` | find common elements of two sets |\n| `(union r s`) | => `(a b c d e)` | find all elements in either of two sets |\n| `(set-difference r s)` | => `(a b)` | find elements in one but not other set |\n| `(member 'd r)` | => `(d)` | check if an element is a member of a set |\n| `(subsetp s r)` | => `nil` | see if all elements of one set are in another |\n| `(adjoin 'b s`) | => `(b` c `d` e) | add an element to a set |\n| `(adjoin 'c s)` | => (c `d` e) | ... but don't add duplicates |\n\nIt is also possible to represent a set with a sequence of bits, given a particular universe of discourse.\nFor example, if every set we are interested in must be a subset of (`a b c d e`), then we can use the bit sequence 11110 to represent (`a b cd`), 00000 to represent the empty set, and 11001 to represent (`a b e`).\nThe bit sequence can be represented in Common Lisp as a bit vector, or as an integer in binary notation.\nFor example, (`a b e`) would be the bit vector `#*11001` or the integer 25, which can also be written as `#bll001`.\n\nThe advantage of using bit sequences is that it takes less space to encode a set, assuming a small universe.\nComputation will be faster, because the computer's underlying instruction set will typically process 32 elements at a time.\n\nCommon Lisp provides a full complement of functions on both bit vectors and integers.\nThe following table lists some, their correspondence to the list functions.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `lists` | `integers` | `bit vectors` |\n| `intersection` | `logand` | `bit-and` |\n| `union` | `logior` | `bit-ior` |\n| `set-difference` | `logandc2` | `bit-andc2` |\n| `member` | `logbitp` | `bit` |\n| `length` | `logcount` | |\n\nFor example,\n\n```lisp\n(intersection '(a b c d) '(a b e))` => `(A B)` `(bit-and    #*11110   #*11001)` => `#*11000` `(logand     #bllll0    #bll001)` => `24 = #bll000\n```\n\n## 3.10 Destructive Functions\n{:#s0100}\n{:.h1hd}\n\nIn mathematics, a function is something that computes an output value given some input arguments.\nFunctions do not \"do\" anything, they just compute results.\nFor example, if I tell you that *x =* 4 and *y =* 5 and ask you to apply the function \"plus\" to *x* and *y,* I expect you to tell me 9.\nIf I then ask, \"Now what is the value of *x*?\" it would be surprising if *x* had changed.\nIn mathematics, applying an operator to *x* can have no effect on the value of *x.*\n\nIn Lisp, some functions *are* able to take effect beyond just Computing the result . These \"functions\" are not functions in the mathematical sense,[2](#fn0015) and in other languages they are known as \"procedures.\" Of course, most of the Lisp functions *are* true mathematical functions, but the few that are not can cause great problems.\nThey can also be quite useful in certain situations.\nFor both reasons, they are worth knowing about.\n\nConsider the following:\n\n```lisp\n> (setf x '(a b c))` => `(A B C)` `> (setf y '(1 2 3))` => `(1 2 3)` `> (append x y)` => `(A B C 1 2 3)\n```\n\n`append` is a pure function, so after evaluating the call to `append,` we can rightfully expect that `x` and `y` retain their values.\nNow consider this:\n\n```lisp\n> (nconc x y)` => `(A B C 1 2 3)` `> x` => `(A B C 1 2 3)` `> y` => `(1 2 3)\n```\n\nThe function `nconc` computes the same result as `append,` but it has the side effect of altering its first argument.\nIt is called a *destructive* function, because it destroys existing structures, replacing them with new ones.\nThis means that there is quite a conceptual load on the programmer who dares to use `nconc.\nHe` or she must be aware that the first argument may be altered, and plan accordingly.\nThis is far more complicated than the case with nondestructive functions, where the programmer need worry only about the results of a function call.\n\nThe advantage of `nconc` is that it doesn't use any storage.\nWhile `append` must make a complete copy of `x` and then have that copy end with `y, nconc` does not need to copy anything.\nInstead, it just changes the rest field of the last element of `x` to point to `y.` So use destructive functions when you need to conserve storage, but be aware of the consequences.\n\nBesides `nconc`, many of the destructive functions have names that start with `n`, including `nreverse, nintersection, nunion, nset-difference`, and `nsubst`.\nAn important exception is `delete`, which is the name used for the destructive version of `remove`.\nOf course, the `setf` special form can also be used to alter structures, but it is the destructive functions that are most dangerous, because it is easier to overlook their effects.\n\n**Exercise 3.5 [h]** (Exercise in altering structure.) Write a program that will play the role of the guesser in the game Twenty Questions.\nThe user of the program will have in mind any type of thing.\nThe program will ask questions of the user, which must be answered yes or no, or \"it\" when the program has guessed it.\nIf the program runs out of guesses, it gives up and asks the user what \"it\" was.\nAt first the program will not play well, but each time it plays, it will remember the user's replies and use them for subsequent guesses.\n\n## 3.11 Overview of Data Types\n{:#s0105}\n{:.h1hd}\n\nThis chapter has been organized around functions, with similar functions grouped together.\nBut there is another way of organizing the Common Lisp world: by considering the different data types.\nThis is useful for two reasons.\nFirst, it gives an alternative way of seeing the variety of available functionality.\nSecond, the data types themselves are objects in the Common Lisp language, and as we shall see, there are functions that manipulate data types.\nThese are useful mainly for testing objects (as with the typecase macro) and for making declarations.\n\nHere is a table of the most commonly used data types:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Type | Example | Explanation |\n| `character` | `#\\c` | A single letter, number, or punctuation mark. |\n| `number` | `42` | The most common numbers are floats and integers. |\n| `float` | `3.14159` | A number with a decimal point. |\n| `integer` | `42` | A whole number, of either fixed or indefinite size: |\n| `fixnum` | `123` | An integer that fits in a single word of storage. |\n| `bignum` | `123456789` | An integer of unbounded size. |\n| `function` | `#'sin` | A function can be applied to an argument list. |\n| `symbol` | `sin` | Symbols can name fns and vars, and are themselves objects. |\n| `null` | `nil` | The object `nil` is the only object of type null. |\n| `keyword` | `:key` | Keywords are a subtype of symbol. |\n| `sequence` | `(a b c)` | Sequences include lists and vectors. |\n| `list` | `(a b c)` | A list is either a cons or `null`. |\n| `vector` | `#(a b c)` | A vector is a subtype of sequence. |\n| `cons` | `(a b c)` | A cons is a non-nil list. |\n| `atom` | `t` | An atom is anything that is not a cons. |\n| `string` | `\"abc\"` | A string is a type of vector of characters. |\n| `array` | `#lA(a b c)` | Arrays include vectors and higher-dimensional arrays. |\n| `structure` | `#S(type ...)` | Structures are defined by `defstruct`. |\n| `hash-table` | ... | Hash tables are created by `make-hash-table`. |\n\nAlmost every data type has a *recognizer predicate*-a function that returns true for only elements of that type.\nIn general, a predicate is a function that always returns one of two values: true or false.\nIn Lisp, the false value is `nil`, and every other value is considered true, although the most common true value is `t.` In most cases, the recognizer predicate's name is composed of the type name followed by `p: characterp` recognizes characters, `numberp` recognizes numbers, and so on.\nFor example, `(numberp` 3) returns `t` because 3 is a number, but `(numberp`\"`x`\") returns `nil` because \"`x`\" is a string, not a number.\n\nUnfortunately, Common Lisp is not completely regular.\nThere are no recognizers for fixnums, bignums, sequences, and structures.\nTwo recognizers, `null` and `atom`, do not end in `p.` Also note that there is a hyphen before the `p` in `hash-table-p,` because the type has a hyphen in it.\nIn addition, all the recognizers generated by `defstruct` have a hyphen before the `p.`\n\nThe function `type-of` returns the type of its argument, and `typep` tests if an object is of a specified type.\nThe function `subtypep` tests if one type can be determined to be a subtype of another.\nFor example:\n\n```lisp\n> (type-of 123)` => `FIXNUM` `> (typep 123 'fixnum)` => `T` `> (typep 123 'number)` => `T` `> (typep 123 'integer)` => `T` `> (typep 123.0 'integer)` => `NIL` `> (subtypep 'fixnum 'number) T\n```\n\nThe hierarchy of types is rather complicated in Common Lisp.\nAs the prior example shows, there are many different numeric types, and a number like 123 is considered to be of type `fixnum, integer,` and `number.` We will see later that it is also of type `rational` and `t.`\n\nThe type hierarchy forms a graph, not just a tree.\nFor example, a vector is both a sequence and an array, although neither array nor sequence are subtypes of each other.\nSimilarly, `null` is a subtype of both `symbol` and `list.`\n\nThe following table shows a number of more specialized data types that are not used as often:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Type | Example | Explanation |\n| `t` | `42` | Every object is of type `t.` |\n| `nil` | | No object `is` of type `nil.` |\n| `complex` | `#C(0 1)` | Imaginary numbers. |\n| `bit` | 0 | Zero or one. |\n| `rational` | `2/3` | Rationals include integers and ratios. |\n| `ratio` | `2/3` | Exact fractional numbers. |\n| `simple-array` | #lA(x `y)` | An array that is not displaced or adjustable. |\n| `readtable` | `...` | A mapping from characters to their meanings to read. |\n| `package` | `...` | A collection of symbols that form a module. |\n| `pathname` | `#P\"/usr/spool/mail\"` | A file or directory name. |\n| `stream` | `...` | A pointer to an open file; used for reading or printing. |\n| `random-state` | `...` | A state used as a seed by `random.` |\n\nIn addition, there are even more specialized types, such as `short-flat`, `compiled- function`, and `bit-vector`.\nIt is also possible to construct more exact types, such as (`vector (integer 0 3) 100`), which represents a vector of 100 elements, each of which is an integer from 0 to 3, inclusive.\n[Section 10.1](B9780080571157500108.xhtml#s0010) gives more information on types and their use.\n\nWhile almost every type has a predicate, it is also true that there are predicates that are not type recognizers but rather recognize some more general condition.\nFor example, `oddp` is true only of odd integers, and `string-greaterp` is true if one string is alphabetically greater than another.\n\n## 3.12 Input/Output\n{:#s0110}\n{:.h1hd}\n\nInput in Lisp is incredibly easy because a complete lexical and syntactic parser is available to the user.\nThe parser is called read.\nIt is used to read and return a single Lisp expression.\nIf you can design your application so that it reads Lisp expressions, then your input worries are over.\nNote that the expression parsed by `read` need not be a legal *evaluable* Lisp expression.\nThat is, you can read (`\"hello\" cons zzz`) just as well as (+ 2 2).\nIn cases where Lisp expressions are not adequate, the function `read`-`char` reads a single character, and `read`-`line` reads everything up to the next newline and returns it as a string.\n\nTo read from the terminal, the functions `read, read-char,` or `read-line` (with no arguments) return an expression, a character, and a string up to the end of line, respectively.\nIt is also possible to read from a file.\nThe function open or the macro `with-open-stream` can be used to open a file and associate it with a *stream,* Lisp's name for a descriptor of an input/output source.\nall three read functions take three optional arguments.\nThe first is the stream to read from.\nThe second, if true, causes an error to be signaled at end of file.\nIf the second argument is nil, then the third argument indicates the value to return at end of file.\n\nOutput in Lisp is similar to output in other languages, such as C.\nThere are a few low-level functions to do specific kinds of output, and there is a very general function to do formatted output.\nThe function `print` prints any object on a new line, with a space following it.\n`prin1` will print any object without the new line and space.\nFor both functions, the object is printed in a form that could be processed by `read.` For example, the string `\"hello there\"` would print as `\"hello there\".` The function `prin`c is used to print in a human-readable format.\nThe string in question would print as `hello there` with `princ-`the quote marks are not printed.\nThis means that `read` cannot recover the original form; `read` would interpret it as two symbols, not one string.\nThe function `write` accepts eleven different keyword arguments that control whether it acts like `prin1` or `princ,` among other things.\n\nThe output functions also take a stream as an optional argument.\nIn the following, we create the file \"test.text\" and print two expressions to it.\nThen we open the file for reading, and try to read back the first expression, a single character, and then two more expressions.\nNote that the `read-char` returns the character #\\`G`, so the following `read` reads the characters 00DBYE and turns them into a symbol.\nThe final `read` hits the end of file, and so returns the specified value, `eof`.\n\n```lisp\n> (with-open-file (stream \"test.text\" :direction :output)`   `(print '(hello there) stream)`   `(princ 'goodbye stream))`=> `GOODBYE    :`*and creates the file test.text* `> (with-open-file (stream \"test.text\" :direction :input)`   `(list (read stream) (read-char stream) (read stream)`      `(read stream nil 'eof)))`=> `((HELLO THERE) #\\G OODBYE EOF)\n```\n\nThe function `terpri` stands for \"terminate print line,\" and it skips to the next line.\nThe function `fresh` -`line` also skips to the next line, unless it can be determined that the output is already at the start of a line.\n\nCommon Lisp also provides a very general function for doing formatted output, called `format.` The first argument to `format` is always the stream to print to; use `t` to print to the terminal.\nThe second argument is the format string.\nIt is printed out Verbatim, except for *format directives*, which begin with the character \" ~ \".\nThese directives tell how to print out the remaining arguments.\nUsers of C's `printf` function or FORTRAN's `format` statement should be familiar with this idea.\nHere's an example:\n\n```lisp\n> (format t \"hello, world\")` `hello, world` `NIL\n```\n\nThings get interesting when we put in additional arguments and include format directives:\n\n```lisp\n> (format t \"~&~a plus ~s is ~f\" \"two\" \"two\" 4)` `two plus \"two\" is 4.0` `NIL\n```\n\nThe directive \"`~&`\" moves to a fresh line, \"`~a`\" prints the next argument as `princ` would, \"~`s` \" prints the next argument as `prin1` would, and \"`~f`\" prints a number in floating-point format.\nIf the argument is not a number, then `princ` is used.\n`format` always returns nil.\nThere are 26 different format directives.\nHere's a more complex example:\n\n```lisp\n> (let ((numbers '(1234 5)))`   `(format t \"~&~{~ r~^ plus ~} is ~@r\"`       `numbers (apply #'+ numbers)))` `one plus two plus three plus four plus five is XV` `NIL\n```\n\nThe directive \"~`r`\" prints the next argument, which should be a number, in English, and \"~`@r`\" prints a number as a roman numeral.\nThe compound directive \"{...~}\" takes the next argument, which must be a list, and formats each element of the list according to the format string inside the braces.\nFinally, the directive \"~^\" exits from the enclosing \"~{...~}\" loop if there are no more arguments.\nYou can see that `format`, like `loop`, comprises almost an entire programming language, which, also like `loop`, is not a very Lisplike language.\n\n## 3.13 Debugging Tools\n{:#s0115}\n{:.h1hd}\n\nIn many languages, there are two strategies for debugging: (1) edit the program to insert print statements, recompile, and try again, or (2) use a debugging program to investigate (and perhaps alter) the internal state of the running program.\n\nCommon Lisp admits both these strategies, but it also offers a third: (3) add annotations that are not part of the program but have the effect of automatically altering the running program.\nThe advantage of the third strategy is that once you are done you don't have to go back and undo the changes you would have introduced in the first strategy.\nIn addition, Common Lisp provides functions that display information about the program.\nYou need not rely solely on looking at the source code.\n\nWe have already seen how `trace` and `untrace` can be used to provide debugging information (page 65).\nAnother useful tool is `step`, which can be used to halt execution before each subform is evaluated.\nThe form (`step`*expression*) will evaluate and return *expression*, but pauses at certain points to allow the user to inspect the computation, and possibly change things before proceeding to the next step.\nThe commands available to the user are implementation-dependent, but typing a ? should give you a list of commands.\nAs an example, here we step through an expression twice, the first time giving commands to stop at each subevaluation, and the second time giving commands to skip to the next function call.\nIn this implementation, the commands are control characters, so they do not show up in the output.\nall output, including the symbols <= and => are printed by the stepper itself; I have added no annotation.\n\n```lisp\n> (step (+ 3 4 (* 5 6 (/ 7 8))))` <= `(+ 3 4 (* 5 6 (/ 7 8)))`  <= `3` => `3`  <= `4` => `4`  <= `(* 5 6 (/ 7 8))`   <= `5` => `5`   <= `6` => `6`   <= `(/ 7 8)`    <= `7` => `7`    <= `8` => `8`   <=`(/ 7 8)` => `7/8`  <= `(* 5 6 (/ 7 8))` => `105/4` <= `(+ 3 4 (* 5 6 (/ 7 8)))` => `133/4` `133/4` `> (step (+ 3 4 (* 5 6 (/ 7 8))))` <= `(+ 3 4 (* 5 6 (/ 7 8)))`  `/: 7 8` => `7/8`  `*: 5 6 7/8` => `105/4`  `+: 3 4 105/4` => `133/4` <= `(+ 3 4 (* 5 6 (/ 7 8)))` => `133/4` `133/4\n```\n\nThe functions `describe`, `inspect, documentation,` and `apropos` provide information about the state of the current program.\n`apropos` prints information about all symbols whose name matches the argument:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (apropos 'string)` | |\n| `MAKE-STRING` | `function (LENGTH &KEY INITIAL-ELEMENT)` |\n| `PRIN1-T0-STRING` | `function (OBJECT)` |\n| `PRINC-T0-STRING` | `function (OBJECT)` |\n| `STRING` | `function (X)` |\n| `...` | |\n\nOnce you know what object you are interested in, `describe` can give more information on it:\n\n```lisp\n> (describe 'make-string)` `Symbol MAKE-STRING is in LISP package.` `The function definition is #<FUNCTI0N MAKE-STRING -42524322 >:` ` NAME:      MAKE-STRING` ` ARGLIST:    (LENGTH &KEY INITIAL-ELEMENT)` ` DOCUMENTATION: \"Creates and returns a string of LENGTH elements. all set to INITIAL-ELEMENT.\"` ` DEFINITION:   (LAMBDA (LENGTH &KEY INITIAL-ELEMENT)` `          (MAKE-ARRAY LENGTH : ELEMENT-TYPE 'CHARACTER` `           :INITIAL-ELEMENT (OR INITIAL-ELEMENT #\\SPACE)))` `MAKE-STRING has property INLINE: INLINE` `MAKE-STRING has property :SOURCE-FILE: #P\"SYS:KERNEL; STRINGS\"` `> (describe 1234.56)` `1234.56 is a single-precision floating-point number.`  `Sign 0, exponent #o211, 23-bit fraction #o6450754\n```\n\nIf all you want is a symbol's documentation string, the function `documentation` will do the trick:\n\n```lisp\n> (documentation 'first 'function)` => `\"Return the first element of LIST.\"` `> (documentation 'pi 'variable) =$> \"pi\"\n```\n\nIf you want to look at and possibly alter components of a complex structure, then `inspect` is the tool.\nIn some implementations it invokes a fancy, window-based browser.\n\nCommon Lisp also provides a debugger that is entered automatically when an error is signalled, either by an inadvertant error or by deliberate action on the part of the program.\nThe details of the debugger vary between implementations, but there are standard ways of entering it.\nThe function `break` enters the debugger after printing an optional message.\nIt is intended as the primary method for setting debugging break points, `break` is intended only for debugging purposes; when a program is deemed to be working, all calls to `break` should be removed.\nHowever, it is still a good idea to check for unusual conditions with `error, cerror, assert,` or `check - type`, which will be described in the following section.\n\n## 3.14 Antibugging Tools\n{:#s0120}\n{:.h1hd}\n\nIt is a good idea to include *antibugging* checks in your code, in addition to doing normal debugging.\nAntibugging code checks for errors and possibly takes corrective action.\n\nThe functions `error` and `cerror` are used to signal an error condition.\nThese are intended to remain in the program even after it has been debugged.\nThe function error takes a format string and optional arguments.\nIt signals a fatal error; that is, it stops the program and does not offer the user any way of restarting it.\nFor example:\n\n```lisp\n(defun average (numbers)`  `(if (null numbers)`   `(error \"Average of the empty list is undefined.\")`   `(/ (reduce #'+ numbers)`    `(length numbers))))\n```\n\nIn many cases, a fatal error is a little drastic.\nThe function `cerror` stands for continuable error.\n`cerror` takes two format strings; the first prints a message indicating what happens if we continue, and the second prints the error message itself.\n`cerror` does not actually take any action to repair the error, it just allows the user to signal that continuing is alright.\nIn the following implementation, the user continues by typing : `continue`.\nIn ANSI Common Lisp, there are additional ways of specifying options for continuing.\n\n```lisp\n(defun average (numbers)`  `(if (null numbers)`   `(progn`    `(cerror \"Use 0 as the average.\"`      `\"Average of the empty list is undefined.\")`    `0)`   `(/ (reduce #+ numbers)`    `(length numbers))))` `> (average '())` `Error: Average of the empty list is undefined.` `Error signaled by function AVERAGE.` `If continued: Use 0 as the average.` `>> : continue` `0\n```\n\nIn this example, adding error checking nearly doubled the length of the code.\nThis is not unusual; there is a big difference between code that works on the expected input and code that covers all possible errors.\nCommon Lisp tries to make it easier to do error checking by providing a few special forms.\nThe form ecase stands for \"exhaustive case\" or \"error case.\" It is like a normal case form, except that if none of the cases are satisfied, an error message is generated.\nThe form `ccase` stands for \"continuable case.\" It is like `ecase`, except that the error is continuable.\nThe system will ask for a new value for the test object until the user supplies one that matches one of the programmed cases.\n\nTo make it easier to include error checks without inflating the length of the code too much, Common Lisp provides the special forms `check-type` and `assert`.\nAs the name implies, `check-type` is used to check the type of an argument.\nIt signals a continuable error if the argument has the wrong type.\nFor example:\n\n```lisp\n(defun sqr (x)`  `\"Multiply` x `by itself.\"`  `(check-type` x `number)`  `(* x x))\n```\n\nIf `sqr` is called with a non-number argument, an appropriate error message is printed:\n\n```lisp\n> (sqr \"hello\")` `Error: the argument X was \"hello\", which is not a NUMBER.` `If continued: replace X with new value` `>> : continue 4` `16\n```\n\nassert is more general than check-type.\nIn the simplest form, assert tests an expression and signals an error if it is false.\nFor example:\n\n```lisp\n(defun sqr (x)`  `\"Multiply` x `by itself.\"`  `(assert (numberp x))`  `(* x x))\n```\n\nThere is no possibility of continuing from this kind of assertion.\nIt is also possible to give assert a list of places that can be modified in an attempt to make the assertion true.\nIn this example, the variable `x` is the only thing that can be changed:\n\n```lisp\n(defun sqr (x)`  `\"Multiply x by itself.\"`  `(assert (numberp x) (x))`  `(* x x))\n```\n\nIf the assertion is violated, an error message will be printed and the user will be given the option of continuing by altering `x`.\nIf `x` is given a value that satisfies the assertion, then the program continues, assert always returns nil.\n\nFinally, the user who wants more control over the error message can provide a format control string and optional arguments.\nSo the most complex syntax for assert is:\n\n`(assert`*test-form* (*place...*) *format-ctl-string format-arg...*)\n\nHere is another example.\nThe assertion tests that the temperature of the bear's porridge is neither too hot nor too cold.\n\n```lisp\n(defun eat-porridge (bear)`  `(assert (< too-cold (temperature (bear-porridge bear)) too-hot)`      `(bear (bear-porridge bear))`      `\"~a's porridge is not just right: ~a\"`      `bear (hotness (bear-porridge bear)))`  `(eat (bear-porridge bear)))\n```\n\nIn the interaction below, the assertion failed, and the programmer's error message was printed, along with two possibilities for continuing.\nThe user selected one, typed in a call to `make` - `porridge` for the new value, and the function succesfully continued.\n\n```lisp\n> (eat-porridge momma-bear)` `Error: #<M0MMA BEAR>'s porridge is not just right: 39` `Restart actions (select using :continue):`  `0: Supply a new value for BEAR`  `1: Supply a new value for (BEAR-PORRIDGE BEAR)` `>> : continue 1` `Form to evaluate and use to replace (BEAR-PORRIDGE BEAR):` `(make-porridge :temperature just-right)` `nil\n```\n\nIt may seem like wasted effort to spend time writing assertions that (if all goes well) will never be used.\nHowever, for all but the perfect programmer, bugs do occur, and the time spent antibugging will more than pay for itself in saving debugging time.\n\nWhenever you develop a complex data structure, such as some kind of data base, it is a good idea to develop a corresponding consistency checker.\nA consistency checker is a function that will look over a data structure and test for all possible errors.\nWhen a new error is discovered, a check for it should be incorporated into the consistency checker.\nCalling the consistency checker is the fastest way to help isolate bugs in the data structure.\n\nIn addition, it is a good idea to keep a list of difficult test cases on hand.\nThat way, when the program is changed, it will be easy to see if the change reintroduces a bug that had been previously removed.\nThis is called *regression testing,* and [Waters (1991)](B9780080571157500285.xhtml#bb1350) presents an interesting tool for maintaining a suite of regression tests.\nBut it is simple enough to maintain an informal test suite with a function that calls assert on a series of examples:\n\n```lisp\n(defun test-ex ()`  `\"Test the program EX on a series of examples.\"`  `(init-ex) ; Initialize the EX program first.`  `(assert (equal (ex 3 4) 5))`  `(assert (equal (ex 5 0) 0))`  `(assert (equal (ex 'x 0) 0)))\n```\n\n### Timing Tools\n{:#s0130}\n{:.h2hd}\n\nA program is not complete just because it gives the right output.\nIt must also deliver the output in a timely fashion.\nThe form (`time`*expression*) can be used to see how long it takes to execute *expression.* Some implementations also print statistics on the amount of storage required.\nFor example:\n\n```lisp\n> (defun f (n) (dotimes (i n) nil))` => `F` `> (time (f 10000)) NIL` `Evaluation of (F 10000) took 4.347272 Seconds of elapsed time, including 0.0 seconds of paging time for 0 faults, Consed 27 words.` `> (compile 'f) F` `> (time (f 10000))` => `NIL` `Evaluation of (F 10000) took 0.011518 Seconds of elapsed time, including 0.0 seconds of paging time for 0 faults, Consed 0 words.\n```\n\nThis shows that the compiled version is over 300 times faster and uses less storage to boot.\nMost serious Common Lisp programmers work exclusively with compiled functions.\nHowever, it is usually a bad idea to worry too much about efficiency details while starting to develop a program.\nIt is better to design a flexible program, get it to work, and then modify the most frequently used parts to be more efficient.\nIn other words, separate the development stage from the fine-tuning stage.\nChapters 9 and 10 give more details on efficiency consideration, and [chapter 25](B978008057115750025X.xhtml) gives more advice on debugging and antibugging techniques.\n\n## 3.15 Evaluation\n{:#s0135}\n{:.h1hd}\n\nThere are three functions for doing evaluation in Lisp: `funcall, apply,` and `eval`.\n`funcall` is used to apply a function to individual arguments, while `apply` is used to apply a function to a list of arguments.\nActually, `apply` can be given one or more individual arguments before the final argument, which is always a list.\n`eval` is passed a single argument, which should be an entire form-a function or special form followed by its arguments, or perhaps an atom.\nThe following five forms are equivalent:\n\n```lisp\n>(+ 1234)          => 10` `> (funcall #'+ 12 3 4)`  => `10` `> (apply #'+ '(1 2 3 4))` => `10` `> (apply #'+ 1 2 '(3 4))` => `10` `> (eval '(+ 123 4))`    => `10\n```\n\nIn the past, `eval` was seen as the key to Lisp's flexibility.\nIn modem Lisps with lexical scoping, such as Common Lisp, `eval` is used less often (in fact, in Scheme there is no `eval` at all).\nInstead, programmers are expected to use `lambda` to create a new function, and then `apply` or `funcall` the function.\nIn general, if you find yourself using `eval,` you are probably doing the wrong thing.\n\n## 3.16 Closures\n{:#s0140}\n{:.h1hd}\n\nWhat does it mean to create a new function?\nCertainly every time a `function (or # ')` special form is evaluated, a function is returned.\nBut in the examples we have seen and in the following one, it is always the *same* function that is returned.\n\n```lisp\n> (mapcar #'(lambda (x) (+ x x)) '(1 3 10))` => `(2 6 20)\n```\n\nEvery time we evaluate the #' (`lambda`...) form, it returns the function that doubles its argument.\nHowever, in the general case, a function consists of the body of the function coupled with any *free lexical variables* that the function references.\nSuch a pairing is called a *lexical closure,* or just a *closure,* because the lexical variables are enclosed within the function.\nConsider this example:\n\n```lisp\n(defun adder (c)`  `\"Return a function that adds c to its argument.\"`  `#'(lambda (x) (+ x c)))` `> (mapcar (adder 3) '(1 3 10))` => `(4 6 13)` `> (mapcar (adder 10) '(1 3 10))` => `(11 13 20)\n```\n\nEach time we call `adder` with a different value for `c`, it creates a different function, the function that adds `c` to its argument.\nSince each call to `adder` creates a new local variable named `c`, each function returned by `adder` is a unique function.\n\nHere is another example.\nThe function bank-account returns a closure that can be used as a representation of a bank account.\nThe closure captures the local variable balance.\nThe body of the closure provides code to access and modify the local variable.\n\n```lisp\n(defun bank-account (balance)`  `\"Open a bank account starting with the given balance.\"`  `#'(lambda (action amount)` `  (case action`    `(deposit (setf balance (+ balance amount)))`    `(withdraw (setf balance (- balance amount))))))\n```\n\nIn the following, two calls to bank-account create two different closures, each with a separate value for the lexical variable `balance`.\nThe subsequent calls to the two closures change their respective balances, but there is no confusion between the two accounts.\n\n```lisp\n> (setf my-account (bank-account 500.00))` => `#<CL0SURE 52330407 >` `> (setf your-account (bank-account 250.00))` => `#<CL0SURE 52331203 >` `> (funcall my-account 'withdraw 75.00)` => `425.0` `> (funcall your-account 'deposit 250.00)` => `500.0` `> (funcall your-account 'withdraw 100.00)` => `400.0` `> (funcall my-account 'withdraw 25.00)` => `400.0\n```\n\nThis style of programming will be considered in more detail in [chapter 13](B9780080571157500133.xhtml).\n\n## 3.17 Special Variables\n{:#s0145}\n{:.h1hd}\n\nCommon Lisp provides for two kinds of variables: *lexical* and *special* variables.\nFor the beginner, it is tempting to equate the special variables in Common Lisp with global variables in other languages.\nUnfortunately, this is not quite correct and can lead to problems.\nIt is best to understand Common Lisp variables on their own terms.\n\nBy default, Common Lisp variables are *lexical variables.* Lexical variables are introduced by some syntactic construct like `let` or `defun` and get their name from the fact that they may only be referred to by code that appears lexically within the body of the syntactic construct.\nThe body is called the *scope* of the variable.\n\nSo far, there is no difference between Common Lisp and other languages.\nThe interesting part is when we consider the *extent,* or lifetime, of a variable.\nIn other languages, the extent is the same as the scope: a new local variable is created when a block is entered, and the variable goes away when the block is exited.\nBut because it is possible to create new functions-closures-in Lisp, it is therefore possible for code that references a variable to live on after the scope of the variable has been exited.\nConsider again the `bank-account` function, which creates a closure representing a bank account:\n\n```lisp\n(defun bank-account (balance)`  `\"Open a bank account starting with the given balance.\"`  `#'(lambda (action amount)`   `(case action`    `(deposit (setf balance (+ balance amount)))`    `(withdraw (setf balance (- balance amount))))))\n```\n\nThe function introduces the lexical variable `balance.` The scope of `balance` is the body of the function, and therefore references to `balance` can occur only within this scope.\nWhat happens when `bank-account` is called and exited?\nOnce the body of the function has been left, no other code can refer to that instance of `balance.` The scope has been exited, but the extent of `balance` lives on.\nWe can call the closure, and it can reference `balance`, because the code that created the closure appeared lexically within the scope of `balance`.\n\nIn summary, Common Lisp lexical variables are different because they can be captured inside closures and referred to even after the flow of control has left their scope.\n\nNow we will consider special variables.\nA variable is made special by a `defvar` or defparameter form.\nFor example, if we say\n\n```lisp\n(defvar *counter* 0)\n```\n\nthen we can refer to the special variable `*counter*` anywhere in our program.\nThis is just like a familiar global variable.\nThe tricky part is that the global binding of `*counter*` can be shadowed by a local binding for that variable.\nIn most languages, the local binding would introduce a local lexical variable, but in Common Lisp, special variables can be bound both locally and globally.\nHere is an example:\n\n```lisp\n(defun report ()`  `(format t \"Counter = ~d\" *counter*))` `> (report)` `Counter = 0` `NIL` `>(let ((*counter* 100))`  `(report))` `Counter = 100` `NIL` `> (report)` `Counter = 0` `NIL\n```\n\nThere are three calls to `report` here.\nIn the first and third, `report` prints the global value of the special variable `*counter*.` In the second call, the `let` form introduces a new binding for the special variable `*counter*,` which is again printed by `report.` Once the scope of the 1 et is exited, the new binding is disestablished, so the final call to `report` uses the global value again.\n\nIn summary, Common Lisp special variables are different because they have global scope but admit the possibility of local (dynamic) shadowing.\nRemember: A lexical variable has lexical scope and indefinite extent.\nA special variable has indefinite scope and dynamic extent.\n\nThe function call (`symbol` - `value`*var*), where *var* evaluates to a symbol, can be used to get at the current value of a special variable.\nTo set a special variable, the following two forms are completely equivalent:\n\n`(setf (symbol-value`*var*) *value*) `(set`*var value*)\n\nwhere both *var* and *value* are evaluated.\nThere are no corresponding forms for accessing and setting lexical variables.\nSpecial variables set up a mapping between symbols and values that is accessible to the running program.\nThis is unlike lexical variables (and all variables in traditional languages) where symbols (identifiers) have significance only while the program is being compiled.\nOnce the program is running, the identifiers have been compiled away and cannot be used to access the variables; only code that appears within the scope of a lexical variable can reference that variable.\n\n**Exercise 3.6 [s]** Given the following initialization for the lexical variable a and the special variable *`b`*, what will be the value of the `let` form?\n\n```lisp\n(setf a 'global-a)` `(defvar *b* 'global-b)` `(defun fn () *b*)` `(let ((a 'local-a)`    `(*b* 'local-b))`  `(list a *b* (fn) (symbol-value 'a) (symbol-value '*b*)))\n```\n\n## 3.18 Multiple Values\n{:#s0150}\n{:.h1hd}\n\nThroughout this book we have spoken of \"the value returned by a function.\" Historically, Lisp was designed so that every function returns a value, even those functions that are more like procedures than like functions.\nBut sometimes we want a single function to return more than one piece of information.\nOf course, we can do that by making up a list or structure to hold the information, but then we have to go to the trouble of defining the structure, building an instance each time, and then taking that instance apart to look at the pieces.\nConsider the function `round.` One way it can be used is to round off a floating-point number to the nearest integer.\nSo (`round` 5.1) is 5.\nSometimes, though not always, the programmer is also interested in the fractional part.\nThe function `round` serves both interested and disinterested programmers by returning two values: the rounded integer and the remaining fraction:\n\n```lisp\n> (round 5.1) => 5 .1\n```\n\nThere are two values after the => because `round` returns two values.\nMost of the time, multiple values are ignored, and only the first value is used.\nSo (`* 2 (round 5.1)`) is 10, just as if `round` had only returned a single value.\nIf you want to get at multiple values, you have to use a special form, such as `multiple-value-bind`:\n\n```lisp\n(defun show-both (x)`  `(multiple-value-bind (int rem)`    `(round x)`   `(format t \"~f = ~d + ~f\" x int rem)))` `>(show-both 5.1)` `5.1 = 5 + 0.1\n```\n\nYou can write functions of your own that return multiple values using the function `values`, which returns its arguments as multiple values:\n\n```lisp\n> (values 1 2 3)` => `1 2 3\n```\n\nMultiple values are a good solution because they are unobtrusive until they are needed.\nMost of the time when we are using `round,` we are only interested in the integer value.\nIf `round` did not use multiple values, if it packaged the two values up into a list or structure, then it would be harder to use in the normal cases.\n\nIt is also possible to return no values from a function with (values).\nThis is sometimes used by procedures that are called for effect, such as printing.\nFor example, `describe` is defined to print information and then return no values:\n\n```lisp\n> (describe 'x)` `Symbol X is in the USER package.` `It has no value, definition or properties.\n```\n\nHowever, when (`values`) or any other expression returning no values is nested in a context where a value is expected, it still obeys the Lisp rule of one-value-per-expression and returns `nil`.\nIn the following example, `describe` returns no values, but then `list` in effect asks for the first value and gets `nil`.\n\n```lisp\n> (list (describe 'x))` `Symbol X is in AILP package.` `It has no value, definition or properties.` `(NIL)\n```\n\n## 3.19 More about Parameters\n{:#s0155}\n{:.h1hd}\n\nCommon Lisp provides the user with a lot of flexibility in specifying the parameters to a function, and hence the arguments that the function accepts.\nFollowing is a program that gives practice in arithmetic.\nIt asks the user a series of *n* problems, where each problem tests the arithmetic operator op (which can be +, -, *, or /, or perhaps another binary operator).\nThe arguments to the operator will be random integers from 0 to range.\nHere is the program:\n\n```lisp\n(defun math-quiz (op range n)`  `\"Ask the user a series of math problems.\"`  `(dotimes (i n)`   `(problem (random range) op (random range))))` `(defun problem` (x `op y)`  `\"Ask a math problem, read a reply, and say if it is correct.\"`  `(format t \"~&How much is ~d ~a ~d?\"` x `op y)`  `(if (eql (read) (funcall op` x `y))`   `(princ \"Correct!\")`   `(princ \"Sorry, that's not right.\")))\n```\n\nand here is an example of its use:\n\n```lisp\n> (math-quiz '+ 100 2)` `How much is 32 + 60? 92` `Correct!` `How much is 91 + 19? 100` `Sorry, that's not right.\n```\n\nOne problem with the function `math-quiz` is that it requires the user to type three arguments: the operator, a range, and the number of iterations.\nThe user must remember the order of the arguments, and remember to quote the operator.\nThis is quite a lot to expect from a user who presumably is just learning to add!\n\nCommon Lisp provides two ways of dealing with this problem.\nFirst, a programmer can specify that certain arguments are *optional* and provide default values for those arguments.\nFor example, in `math - quiz` we can arrange to make + be the default operator, 100 be the default number range, and 10 be the default number of examples with the following definition:\n\n```lisp\n(defun math-quiz (&optional (op '+) (range 100) (n 10))`  `\"Ask the user a series of math problems.\"`  `(dotimes (i n)`   `(problem (random range) op (random range))))\n```\n\nNow `(math`-`quiz`) means the same as (`math-quiz '+ 100 10`).\nIf an optional parameter appears alone without a default value, then the default is ni 1.\nOptional parameters are handy; however, what if the user is happy with the operator and range but wants to change the number of iterations?\nOptional parameters are still position-dependent, so the only solution is to type in all three arguments: (`math-quiz '+ 100 5`).\n\nCommon Lisp also allows for parameters that are position-independent.\nThese *keyword* parameters are explicitly named in the function call.\nThey are useful when there are a number of parameters that normally take default values but occasionally need specific values.\nFor example, we could have defined `math - quiz` as:\n\n```lisp\n(defun math-quiz (&key (op '+) (range 100) (n 10))`  `\"Ask the user a series of math problems.\"`  `(dotimes (i n)`   `(problem (random range) op (random range))))\n```\n\nNow (`math-quiz :n 5`) and (`math-quiz :op '+ :n 5 :range 100`) mean the same.\nKeyword arguments are specified by the parameter name preceded by a colon, and followed by the value.\nThe keyword/value pairs can come in any order.\n\nA symbol starting with a colon is called a *keyword*, and can be used anywhere, not just in argument lists.\nThe term *keyword* is used differently in Lisp than in many other languages.\nFor example, in Pascal, keywords (or *reserved* words) are syntactic symbols, like `if, else, begin`, and `end`.\nIn Lisp we call such symbols *special form operators* or just *special forms.* Lisp keywords are symbols that happen to reside in the keyword package.[3](#fn0020) They have no special syntactic meaning, although they do have the unusual property of being self-evaluating: they are constants that evaluate to themselves, unlike other symbols, which evaluate to whatever value was stored in the variable named by the symbol.\nKeywords also happen to be used in specifying &key argument lists, but that is by virtue of their value, not by virtue of some syntax rule.\nIt is important to remember that keywords are used in the function call, but normal nonkeyword symbols are used as parameters in the function definition.\n\nJust to make things a little more confusing, the symbols `&optional, &rest,` and &key are called *lambda-list keywords*, for historical reasons.\nUnlike the colon in real keywords, the & in lambda-list keywords has no special significance.\nConsider these annotated examples:\n\n```lisp\n> :xyz => :XYZ`        *; keywords are self-evaluating* `>&optional =>`        *; lambda-list keywords are normal symbols Error: the symbol &optional has no value* `> '&optional => &OPTIONAL` `> (defun f (&xyz) (+ &xyz &xyz)) F ;`*& has no significance* `> (f 3) => 6` `> (defun f (:xyz) (+ :xyz :xyz)) =>` *Error: the keyword :xyz appears in a variable list.* *Keywords are constants, and so cannot be used as names of variables.* `> (defun g (&key x y) (list x y)) => G` `> (let ((key s '(:x :y :z)))`      ; *keyword args can be computed* `(g (second keys) 1 (first keys) 2)) => (2 1)\n```\n\nMany of the functions presented in this chapter take keyword arguments that make them more versatile.\nFor example, remember the function `find`, which can be used to look for a particular element in a sequence:\n\n```lisp\n> (find 3 '(12 3 4-5 6.0)) => 3\n```\n\nIt turns out that `find` takes several optional keyword arguments.\nFor example, suppose we tried to find 6 in this sequence:\n\n```lisp\n> (find 6 '(1 2 3 4 -5 6.0)) => nil\n```\n\nThis fails because `find` tests for equality with `eql`, and 6 is not `eql` to 6.0.\nHowever, 6 is equal p to 6.0, so we could use the : test keyword:\n\n```lisp\n> (find 6 '(1 2 3 4 -5 6.0) :test #'equalp) => 6.0\n```\n\nIn fact, we can specify any binary predicate for the : test keyword; it doesn't have to be an equality predicate.\nFor example, we could find the first number that 4 is less than:\n\n```lisp\n> (find 4 '(1 2 3 4 -5 6.0) :test #'<) => 6.0\n```\n\nNow suppose we don't care about the sign of the numbers; if we look for 5, we want to find the - 5.\nWe can handle this with the key keyword to take the absolute value of each element of the list with the abs function:\n\n```lisp\n> (find 5 '(1 2 3 4 -5 6.0) :key #'abs) => -5\n```\n\nKeyword parameters significantly extend the usefulness of built-in functions, and they can do the same for functions you define.\nAmong the built-in functions, the most common keywords fall into two main groups: : `test, : test - not` and : `key,` which are used for matching functions, and : `start, rend,` and :`from-end,` which are used on sequence functions.\nSome functions accept both sets of keywords.\n(*Common Lisp the Language*, 2d edition, discourages the use of : `test-not` keywords, although they are still a part of the language.)\n\nThe matching functions include `sublis, position, subst, union, intersection, set-difference, remove, remove-if, subsetp, assoc, find,` and `member.` By default, each tests if some item is eql to one or more of a series of other objects.\nThis test can be changed by supplying some other predicate as the argument to : test, or it can be reversed by specifying : `test - not.` In addition, the comparison can be made against some part of the object rather than the whole object by specifying a selector function as the : `key` argument.\n\nThe sequence functions include `remove, remove-if, position,` and `find.` The most common type of sequence is the list, but strings and vectors can also be used as sequences.\nA sequence function performs some action repeatedly for some elements of a sequence.\nThe default is to go through the sequence from beginning to end, but the reverse order can be specified with : `from-end t,` and a subsequence can be specifed by supplying a number for the : `start` or : `end` keyword.\nThe first element of a sequence is numbered 0, not 1, so be careful.\n\nAs an example of keyword parameters, suppose we wanted to write sequence functions that are similar to `find` and `find-if`, except that they return a list of all matching elements rather than just the first matching element.\nWe will call the new functions `find - all` and `find - all` - `if`.\nAnother way to look at these functions is as variations of remove.\nInstead of removing items that match, they keep all the items that match, and remove the ones that don't.\nViewed this way, we can see that the function `find - all` - `if` is actually the same function as `remove - if-not`.\nIt is sometimes useful to have two names for the same function viewed in different ways (like not and `null`).\nThe new name could be defined with a defun, but it is easier to just copy over the definition:\n\n```lisp\n(setf (symbol-function 'find-all-if) #'remove-if-not)\n```\n\nUnfortunately, there is no built-in function that corresponds exactly to `find - all`, so we will have to define it.\nFortunately, `remove` can do most of the work.\nall we have to do is arrange to pass remove the complement of the : test predicate.\nFor example, finding all elements that are equal to 1 in a list is equivalent to removing elements that are not equal to 1:\n\n```lisp\n> (setf nums '(1 2 3 2 1)) => (1 2 3 2 1)` `> (find-all 1 nums :test #'=) = (remove 1 nums :test #'/=) => (1 1)\n```\n\nNow what we need is a higher-order function that returns the complement of a function.\nIn other words, given =, we want to return /=.\nThis function is called compl ement in ANSI Common Lisp, but it was not defined in earlier versions, so it is given here:\n\n```lisp\n(defun complement (fn)` ` \"If FN returns y, then (complement FN) returns (not y).\"` ` ;; This function is built-in in ANSI Common Lisp,` ` ;; but is defined here for those with non-ANSI compilers.` ` #'(lambda (&rest args) (not (apply fn args))))\n```\n\nWhen `find-all` is called with a given :`test` predicate, all we have to do is call remove with the complement as the :`test` predicate.\nThis is true even when the : `test` function is not specified, and therefore defaults to `eql`.\nWe should also test for when the user specifies the : `test -not` predicate, which is used to specify that the match succeeds when the predicate is false.\nIt is an error to specify both a : `test` and : `test-not` argument to the same call, so we need not test for that case.\nThe definition is:\n\n```lisp\n(defun find-all (item sequence &rest keyword-args` `        &key (test #'eql) test-not &allow-other-keys)`  `\"Find all those elements of sequence that match item,`  `according to the keywords. Doesn't alter sequence.\"`  `(if test-not`   `(apply #'remove item sequence`     `:test-not (complement test-not) keyword-args)`   `(apply #'remove item sequence`     `:test (complement test) keyword-args)))\n```\n\nThe only hard part about this definition is understanding the parameter list.\nThe &rest accumulates all the keyword/value pairs in the variable `keyword-args`.\nIn addition to the `&rest` parameter, two specific keyword parameters, :`test` and : `test-not`, are specified.\nAny time you put a `&key` in a parameter list, you need an `&allow-other- keys` if, in fact, other keywords are allowed.\nIn this case we want to accept keywords like : `start` and : key and pass them on to remove.\n\nAll the keyword/value pairs will be accumulated in the list `keyword - args, including the : test or : test - not` values.\nSo we will have:\n\n```lisp\n(find-all 1 nums :test #'= :key #'abs)`  `= (remove 1 nums :test (complement #'=) :test #'= :key #'abs)`  => `(1 1)\n```\n\nNote that the call to remove will contain two :`test` keywords.\nThis is not an error; Common Lisp declares that the leftmost value is the one that counts.\n\n**Exercise 3.7 [s]** Why do you think the leftmost of two keys is the one that counts, rather than the rightmost?\n\n**Exercise 3.8 [m]** Some versions of Kyoto Common Lisp (KCL) have a bug wherein they use the rightmost value when more than one keyword/value pair is specified for the same keyword.\nChange the definition of `find - a11` so that it works in KCL.\n\nThere are two more lambda-list keywords that are sometimes used by advanced programmers.\nFirst, within a macro definition (but not a function definition), the symbol &body can be used as a synonym for &`rest`.\nThe difference is that &body instructs certain formatting programs to indent the rest as a body.\nThus, if we defined the macro:\n\n```lisp\n(defmacro while2 (test &body body)`  `\"Repeat body while test is true.\"`  `'(loop (if (not .test) (return nil))`    `. ,body))\n```\n\nThen the automatic indentation of `while2` (on certain systems) is prettier than `while`:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(while (< i 10)` | `(while2 (< i 10)` |\n|       `(print (* i i))` |       `(print (* i i))` |\n|     `(setf i (+ i 1)))` |     `(setf i (+ i 1)))` |\n\nFinally, an `&aux` can be used to bind a new local variable or variables, as if bound with `let`*.\nPersonally, I consider this an abomination, because `&aux` variables are not parameters at all and thus have no place in a parameter list.\nI think they should be clearly distinguished as local variables with a `let`.\nBut some good programmers do use &aux, presumably to save space on the page or screen.\nAgainst my better judgement, I show an example:\n\n```lisp\n(defun lengthl4 (list &aux (len 0))`  `(dolist (element list len)`   `(incf len)))\n```\n\n## 3.20 The Rest of Lisp\n{:#s0160}\n{:.h1hd}\n\nThere is a lot more to Common Lisp than what we have seen here, but this overview should be enough for the reader to comprehend the programs in the chapters to come.\nThe serious Lisp programmer will further his or her education by continuing to consult reference books and online documentation.\nYou may also find part V of this book to be helpful, particularly [chapter 24](B9780080571157500248.xhtml), which covers advanced features of Common Lisp (such as packages and error handling) and [chapter 25](B978008057115750025X.xhtml), which is a collection of troubleshooting hints for the perplexed Lisper.\n\nWhile it may be distracting for the beginner to be continually looking at some reference source, the alternative-to explain every new function in complete detail as it is introduced-would be even more distracting.\nIt would interrupt the description of the AI programs, which is what this book is all about.\n\n## 3.21 Exercises\n{:#s0165}\n{:.h1hd}\n\n**Exercise 3.9 [m]** Write a version of `length` using the function `reduce`.\n\n**Exercise 3.10 [m]** Use a reference manual or `describe` to figure out what the functions `1 cm and nreconc do`.\n\n**Exercise 3.11** [m] There is a built-in Common Lisp function that, given a key, a value, and an association list, returns a new association list that is extended to include the key/value pair.\nWhat is the name of this function?\n\n**Exercise 3.12 [m]** Write a single expression using format that will take a list of words and print them as a sentence, with the first word capitalized and a period after the last word.\nYou will have to consult a reference to learn new format directives.\n\n## 3.22 Answers\n{:#s0170}\n{:.h1hd}\n\n**Answer 3.2**`(cons`*a b*`) = (list ***`ab`)`\n\n**Answer 3.3**\n\n```lisp\n (defun dprint (x)` `  \"Print an expression in dotted pair notation.\"` `  (cond ((atom x) (princ x))` `    (t (princ \"(\")` `     (dprint (first x))` `     (pr-rest (rest x))` `     (princ \")\")` `     x)))` ` (defun pr-rest (x)` `  (princ \" . \")` `  (dprint x))\n```\n\n**Answer 3.4** Use the same `dprint` function defined in the last exercise, but change `pr-rest`.\n\n```lisp\n (defun pr-rest (x)` `  (cond ((null x))` `    ((atom x) (princ \" . \") (princ x))` `    (t (princ \" \") (dprint (first x)) (pr-rest (rest x)))))\n```\n\n**Answer 3.5** We will keep a data base called *`db`*.\nThe data base is organized into a tree structure of nodes.\nEach node has three fields: the name of the object it represents, a node to go to if the answer is yes, and a node for when the answer is no.\nWe traverse the nodes until we either get an \"it\" reply or have to give up.\nIn the latter case, we destructively modify the data base to contain the new information.\n\n```lisp\n(defstruct node` ` name` ` (yes nil)` ` (no nil))` `(defvar *db*` ` (make-node:name 'animal` `    :yes (make-node :name 'mammal)` `    :no (make-node` `     :name 'vegetable` `     :no (make-node :name 'mineral))))` `(defun questions (&optional (node *db*))` ` (format t \"~&Is it a ~a? \" (node-name node))` ` (case (read)` `  ((y yes) (if (not (null (node-yes node)))` `     (questions (node-yes node))` `     (setf (node-yes node) (give-up))))` `  ((n no) (if (not (null (node-no node)))` `     (questions (node-no node))` `     (setf (node-no node) (give-up))))` `  (it 'aha!)` `  (t (format t \"Reply with YES, NO, or IT if I have guessed it.\")` `   (questions node))))` `(defun give-up ()` ` (format t \"~&I give up - what is it? \")` ` (make-node :name (read)))\n```\n\nHere it is used:\n\n```lisp\n> (questions)` `Is it a ANIMAL? yes` `Is it a MAMMAL? yes` `I give up - what is it? bear` `#S(NODE :NAME BEAR)\n> (questions)` `Is it a ANIMAL? yes` `Is it a MAMMAL? no` `I give up - what is it? penguin` `#S(NODE :NAME PENGUIN)\n> (questions)` `Is it a ANIMAL? yes` `Is it a MAMMAL? yes` `Is it a BEAR? it` `AHA!\n```\n\n**Answer 3.6** The value is (`LOCAL-A LOCAL-B LOCAL-B GLOBAL-A LOCAL-B`).\n\nThe `let` form binds a lexically and `*b*` dynamically, so the references to a and `*b*` (including the reference to `*b*` within `fn)` all get the local values.\nThe function `symbol` - value always treats its argument as a special variable, so it ignores the lexical binding for a and returns the global binding instead.\nHowever, the `symbol` - `value` of `*b*` is the local dynamic value.\n\n**Answer 3.7** There are two good reasons: First, it makes it faster to search through the argument list: just search until you find the key, not all the way to the end.\nSecond, in the case where you want to override an existing keyword and pass the argument list on to another function, it is cheaper to cons the new keyword/value pair on the front of a list than to append it to the end of a list.\n\n**Answer 3.9**\n\n```lisp\n(defun length-r (list)` ` (reduce #'+ (mapcar #'(lambda (x) 1) list)))\n```\n\nor more efficiently:\n\n```lisp\n(defun length-r (list)` ` (reduce #'(lambda (x y) (+ x 1)) list` `   :initial-value 0))\n```\n\nor, with an ANSI-compliant Common Lisp, you can specify a : key\n\n```lisp\n(defun length-r (list)` `(reduce #'+ list :key #'(lambda (x) 1)))\n```\n\n**Answer 3.12**`(format t \"~@(~{~a~^ ~).~)\" '(this is a test))`\n\n----------------------\n\n[1](#xfn0010) Association lists are covered in [section 3.6](#s0080).\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) In mathematics, a function must associate a unique output value with each input value.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0020) A *package* is a symbol table: a mapping between strings and the symbols they name.\n!!!(p) {:.ftnote1}\n\nPart II\nEarly AI Programs\n!!!(p) {:.parttitle}\n\n# Chapter 4\n## GPS: The General Problem Solver\n{:.chaptitle}\n\n> *There are now in the world machines that think.*\n\n> -Herbert Simon\n\n> Nobel Prize-winning Al researcher\n\nThe General Problem Solver, developed in 1957 by Alan Newell and Herbert Simon, embodied a grandiose vision: a single computer program that could solve *any* problem, given a suitable description of the problem.\nGPS caused quite a stir when it was introduced, and some people in AI felt it would sweep in a grand new era of intelligent machines.\nSimon went so far as to make this statement about his creation:\n\n> *It is not my aim to surprise or shock you.... But the simplest way I can summarize is to say that there are now in the world machines that think, that learn and create.\nMoreover, their ability to do these things is going to increase rapidly until-in a visible future-the range of problems they can handle will be coextensive with the range to which the human mind has been applied.*\n\nAlthough GPS never lived up to these exaggerated claims, it was still an important program for historical reasons.\nIt was the first program to separate its problem solving strategy from its knowledge of particular problems, and it spurred much further research in problem solving.\nFor ail these reasons, it is a fitting object of study.\n\nThe original GPS program had a number of minor features that made it quite complex.\nIn addition, it was written in an obsolete low-level language, IPL, that added gratuitous complexity.\nIn fact, the conf using nature of IPL was probably an important reason for the grand claims about GPS.\nIf the program was that complicated, it *must* do something important.\nWe will be ignoring some of the subtleties of the original program, and we will use Common Lisp, a much more perspicuous language than IPL.\nThe result will be a version of GPS that is quite simple, yet illustrates some important points about AI.\n\nOn one level, this chapter is about GPS.\nBut on another level, it is about the process of developing an AI computer program.\nWe distinguish five stages in the development of a program.\nFirst is the problem description, which is a rough idea-usually written in English prose-of what we want to do.\nSecond is the program speification, where we redescribe the problem in terms that are closer to a computable procedure.\nThe third stage is the implementation of the program in a programming language such as Common Lisp, the fourth is testing, and the fifth is debugging and analysis.\nThe boundaries between these stages are fluid, and the stages need not be completed in the order stated.\nProblems at any stage can lead to a change in the previous stage, or even to complete redesign or abandonment of the project.\nA programmer may prefer to complete only a partial description or specification, proceed directly to implementation and testing, and then return to complete the specification based on a better understanding.\n\nWe follow all five stages in the development of our versions of GPS, with the hope that the reader will understand GPS better and will also come to understand better how to write a program of his or her own.\nTo summarize, the five stages of an AI programming project are:\n\n1. **Describe** the problem in vague terms\n!!!(p) {:.numlist}\n\n2. **Specify** the problem in algorithmic terms\n!!!(p) {:.numlist}\n\n3. **Implement** the problem in a programming language\n!!!(p) {:.numlist}\n\n4. **Test** the program on representative examples\n!!!(p) {:.numlist}\n\n5. **Debug** and **analyze** the resulting program, and repeat the process\n!!!(p) {:.numlist}\n\n## 4.1 Stage 1: Description\n{:#s0010}\n{:.h1hd}\n\nAs our problem description, we will start with a quote from Newell and Simon's 1972 book, *Human Problem Solving:*\n\n> *The main methods of GPS jointly embody the heuristic of means-ends analysis.\nMeans-ends analysis is typified by the following kind of common-sense argument:*\n\n*I want to take my son to nursery school.\nWhat's the difference between what I have and what I want?\nOne of distance.\nWhat changes distance?\nMy automobile.\nMy automobile won't work.\nWhat is needed to make it work?\nA new battery.\nWhat has new batteries?\nAn auto repair shop.\nI want the repair shop to put in a new battery; but the shop doesn't know I need one.\nWhat is the difficulty?\nOne of communication.\nWhat allows communication?\nA telephone... and so on.*\n\n> *The kind of analysis-classifying things in terms of the functions they serve and oscillating among ends, functions required, and means that perform them-forms the basic system of heuristic of GPS.*\n\nOf course, this kind of analysis is not exactly new.\nThe theory of means-ends analysis was laid down quite elegantly by Aristotle 2300 years earlier in the chapter entitled \"The nature of deliberation and its objects\" of the *Nicomachean Ethics* (Book III.\n3,1112b):\n\n> *We deliberate not about ends, but about means.\nFor a doctor does not deliberate whether he shall heal, nor an orator whether he shall persuade, nor a statesman whether he shall produce law and order, nor does any one else deliberate about his end.\nThey assume the end and consider how and by what means it is attained; and if it seems to be produced by several means they consider by which it is most easily and best produced, while if it is achieved by one only they consider how it will be achieved by this and by what means this will be achieved, till they come to the first cause, which in the order of discovery is last... and what is last in the order of analysis seems to be first in the order of becoming.\nAnd if we come on an impossibility, we give up the search, e.g., if we need money and this cannot be got; but if a thing appears possible we try to do it.*\n\nGiven this description of a theory of problem solving, how should we go about writing a program?\nFirst, we try to understand more fully the procedure outlined in the quotes.\nThe main idea is to solve a problem using a process called means-ends analysis, where the problem is stated in terms of what we want to happen.\nIn Newell and Simon's example, the problem is to get the kid to school, but in general we would like the program to be able to solve a broad class of problems.\nWe can solve a problem if we can find some way to eliminate \"the difference between what I have and what I want.\" For example, if what I have is a child at home, and what I want is a child at school, then driving may be a solution, because we know that driving leads to a change in location.\nWe should be aware that using means-ends analysis is a choice: it is also possible to start from the current situation and search forward to the goal, or to employ a mixture of different search strategies.\n\nSome actions require the solving of *preconditions* as subproblems.\nBefore we can drive the car, we need to solve the subproblem of getting the car in working condition.\nIt may be that the car is already working, in which case we need do nothing to solve the subproblem.\nSo a problem is solved either by taking appropriate action directly, or by first solving for the preconditions of an appropriate action and then taking the action.\nIt is clear we will need some description of allowable actions, along with their preconditions and effects.\nWe will also need to develop a definition of appropriateness.\nHowever, if we can define these notions better, it seems we won't need any new notions.\nThus, we will arbitrarily decide that the problem description is complete, and move on to the problem specification.\n\n## 4.2 Stage 2: Specification\n{:#s0015}\n{:.h1hd}\n\nAt this point we have an idea-admittedly vague-of what it means to solve a problem in GPS`.` We can refine these notions into representations that are closer to Lisp as follows:\n\n*  We can represent the current state of the world-\"what I have\"-or the goal state-\"what I want\"-as sets of conditions.\nCommon Lisp doesn't have a data type for sets, but it does have lists, which can be used to implement sets.\nEach condition can be represented by a symbol.\nThus, a typical goal might be the list of two conditions (`rich famous`), and a typical current state might be (`unknown poor`).\n\n*  We need a list of allowable operators.\nThis list will be constant over the course of a problem, or even a series of problems, but we want to be able to change it and tackle a new problem domain.\n\n*  An operator can be represented as a structure composed of an action, a list of preconditions, and a list of effects.\nWe can place limits on the kinds of possible effects by saying that an effect either adds or deletes a condition from the current state.\nThus, the list of effects can be split into an add-list and a delete-list.\nThis was the approach taken by the Strips !!!(span) {:.smallcaps} [1](#fn0010) implementation of GPS, which we will be in effect reconstructing in this chapter.\nThe original GPS allowed more flexibility in the specification of effects, but flexibility leads to inefficiency.\n\n*  A complete problem is described to GPS in terms of a starting state, a goal state, and a set of known operators.\nThus, GPS will be a function of three arguments.\nFor example, a sample call might be: `(GPS '(unknown poor)'(rich famous) list-of-ops)` In other words, starting from the state of being poor and unknown, achieve the state of being rich and famous, using any combination of the known operators.\nGPS should return a true value only if it solves the problem, and it should print a record of the actions taken.\nThe simplest approach is to go through the conditions in the goal state one at a time and try to achieve each one.\nIf they can all be achieved, then the problem is solved.\n\n*  A single goal condition can be achieved in two ways.\nIf it is already in the current state, the goal is trivially achieved with no effort.\nOtherwise, we have to find some appropriate operator and try to apply it.\n\n*  An operator is appropriate if one of the effects of the operator is to add the goal in question to the current state; in other words, if the goal is in the operator's add-list.\n\n*  We can apply an operator if we can achieve all the preconditions.\nBut this is easy, because we just defined the notion of achieving a goal in the previous paragraph.\nOnce the preconditions have been achieved, applying an operator means executing the action and updating the current state in term of the operator's add-list and delete-list.\nSince our program is just a simulation-it won't be actually driving a car or dialing a telephone-we must be content simply to print out the action, rather than taking any real action.\n\n## 4.3 Stage 3: Implementation\n{:#s0020}\n{:.h1hd}\n\nThe specification is complete enough to lead directly to a complete Common Lisp program.\n[Figure 4.1](#f0010) summarizes the variables, data types, and functions that make up the GPS program, along with some of the Common Lisp functions used to implement it.\n\n![f04-01-9780080571157](images/B9780080571157500042/f04-01-9780080571157.jpg)     \nFigure 4.1\n!!!(span) {:.fignum}\nGlossary for the GPS Program\nHere is the complete GPS program itself:\n\n```lisp\n(defvar *state* nil \"The current state: a list of conditions.\")\n(defvar *ops* nil \"A list of available operators.\")\n(defstruct op \"An operation\"\n (action nil) (preconds nil) (add-list nil) (del-list nil))\n(defun GPS (*state* goals *ops*)\n \"General Problem Solver: achieve ail goals using *ops*.\"\n (if (every #'achieve goals) 'solved))\n(defun achieve (goal)\n \"A goal is achieved if it already holds,\n or if there is an appropriate op for it that is applicable.\"\n (or (member goal *state*)\n  (some #'apply-op\n   (find-all goal *ops* :test #'appropriate-p))))\n(defun appropriate-p (goal op)\n \"An op is appropriate to a goal if it is in its add list.\"\n (member goal (op-add-list op)))\n(defun apply-op (op)\n \"Print a message and update *state* if op is applicable.\"\n (when (every #'achieve (op-preconds op))\n  (print (list 'executing (op-action op)))\n  (setf *state* (set-difference *state* (op-del-list op)))\n  (setf *state* (union *state* (op-add-list op)))\n t))\n```\n\nWe can see the program is made up of seven definitions.\nThese correspond to the seven items in the specification above.\nIn general, you shouldn't expect such a perfect fit between specification and implementation.\nThere are two `defvar` forms, one `defstruct`, and `four defun forms`.\nThese are the Common Lisp forms for defining variables, structures, and functions, respectively.\nThey are the most common toplevel forms in Lisp, but there is nothing magic about them; they are just special forms that have the side effect of adding new definitions to the Lisp environment.\n\nThe two `defvar` forms, repeated below, declare special variables named `*state*` and `*ops*,` which can then be accessed from anywhere in the program.\n\n```lisp\n(defvar *state* nil \"The current state: a list of conditions.\")\n(defvar *ops* nil \"A list of available operators.\")\n```\n\nThe `defstruct` form defines a structure called an `op`, which has slots called `action, preconds, add-list,` and `del-list`.\nStructures in Common Lisp are similar to structures in C, or records in Pascal.\nThe `defstruct` automatically defines a constructor function, which is called `make-op`, and an access function for each slot of the structure.\nThe access functions are called `op-action`, `op-preconds, op-add-list`, and `op-del-list`.\nThe `defstruct` also defines a copier function, `copy-op`, a predicate, `op-p`, and `setf` definitions for changing each slot.\nNone of those are used in the GPS program.\nRoughly speaking, it is as if the `defstruct` form\n\n```lisp\n(defstruct op \"An operation\"\n (action nil) (preconds nil) (add-list nil) (del-list nil))\n```\n\nexpanded into the following definitions:\n\n```lisp\n(defun make-op (&key action precondsadd-list del-list)\n (vector 'op action preconds add-list del-list))\n(defun op-action (op) (elt op 1))\n(defun op-preconds (op) (elt op 2))\n(defun op-add-list (op) (elt op 3))\n(defun op-del-list (op) (elt op 4))\n(defun copy-op (op) (copy-seq op))\n(defun op-p (op)\n (and (vectorp op) (eq (elt op 0) 'op)))\n(setf (documentation 'op 'structure) \"An operation\")\n```\n\nNext in the GPS program are four function definitions.\nThe main function GPS`,` is passed three arguments.\nThe first is the current state of the world, the second the goal state, and the third a list of allowable operators.\nThe body of the function say s simply that if we can achieve every one of the goals we have been given, then the problem is solved.\nThe unstated alternative is that otherwise, the problem is not solved.\n\nThe function a chieve is given as an argument a single goal.\nThe function succeeds if that goal is already true in the current state (in which case we don't have to do anything) or if we can apply an appropriate operator.\nThis is accomplished by first building the list of appropriate operators and then testing each in turn until one can be applied.\n`achieve` calls `find-all`, which we defined on [page 101](B9780080571157500030.xhtml#p101).\nIn this use, `find-all` returns a list of operators that match the current goal, according to the predicate `appropriate-p`.\n\nThe function `appropriate-p` tests if an operator is appropriate for achieving a goal.\n(It follows the Lisp naming convention that predicates end in `-p`.)\n\nFinally, the function `apply-op` says that if we can achieve all the preconditions for an appropriate operator, then we can apply the operator.\nThis involves printing a message to that effect and changing the state of the world by deleting what was in the delete-list and adding what was in the add-list.\n`apply-op` is also a predicate; it returns t only when the operator can be applied.\n\n## 4.4 Stage 4: Test\n{:#s0025}\n{:.h1hd}\n\nThis section will define a list of operators applicable to the \"driving to nursery school\" domain and will show how to pose and solve some problems in that domain.\nFirst, we need to construct the list of operators for the domain.\nThe `defstruct` form for the type `op` automatically defines the function `make-op`, which can be used as follows:\n\n```lisp\n(make-op :action 'drive-son-to-school\n  :preconds '(son-at-home car-works)\n  :add-list '(son-at-school)\n  :del-list '(son-at-home))\n```\n\nThis expression returns an operator whose action is the symbol `drive-son-to-school` and whose preconditions, add-list and delete-list are the specified lists.\nThe intent of this operator is that whenever the son is at home and the car works, `drive-son-to-school` can be applied, changing the state by deleting the fact that the son is at home, and adding the fact that he is at school.\n\nIt should be noted that using long hyphenated atoms like `son-at-home` is a useful approach only for very simple examples like this one.\nA better representation would break the atom into its components: perhaps (`at son home`).\nThe problem with the atom-based approach is one of combinatorics.\nIf there are 10 predicates (such as `at`) and 10 people or objects, then there will be 10 x 10 x 10 = 1000 possible hyphenated atoms, but only 20 components.\nClearly, it would be easier to describe the components.\nIn this chapter we stick with the hyphenated atoms because it is simpler, and we do not need to describe the whole world.\nSubsequent chapters take knowledge representation more seriously.\n\nWith this operator as a model, we can define other operators corresponding to Newell and Simon's quote on [page 109](B9780080571157500042.xhtml#p109).\nThere will be an operator for installing a battery, telling the repair shop the problem, and telephoning the shop.\nWe can fill in the \"and so on\" by adding operators for looking up the shop's phone number and for giving the shop money:\n\n```lisp\n(defparameter *school-ops*\n (list\n  (make-op :action 'drive-son-to-school\n   :preconds '(son-at-home car-works)\n   :add-list '(son-at-school)\n   :del-list '(son-at-home))\n  (make-op :action 'shop-installs-battery\n   :preconds '(car-needs-battery shop-knows-problem shop-has-money)\n   :add-list '(car-works))\n  (make-op :action 'tel 1-shop-problem\n   :preconds '(in-communication-with-shop)\n   :add-list '(shop-knows-problem))\n  (make-op raction 'telephone-shop\n   :preconds '(know-phone-number)\n   :add-list '(in-communication-with-shop))\n  (make-op .-action 'look-up-number\n   :preconds '(have-phone-book)\n   :add-list '(know-phone-number))\n  (make-op :action 'give-shop-money\n   :preconds '(have-money)\n   :add-list '(shop-has-money)\n   :del-list '(have-money))))\n```\n\nThe next step is to pose some problems to GPS and examine the solutions.\nFollowing are three sample problems.\nIn each case, the goal is the same: to achieve the single condition `son-at-school`.\nThe list of available operators is also the same in each problem; the difference is in the initial state.\nEach of the three examples consists of the prompt, \">\", which is printed by the Lisp system, followed by a call to GPS, \" ( `gps`... )\", which is typed by the user, then the output from the program, \"(`EXECUTING`...)\", and finally the resuit of the function call, which can be either `SOLVED` or `NIL`.\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n  '(son-at-school)\n  *school-ops*)\n(EXECUTING LOOK-UP-NUMBER)\n(EXECUTING TELEPHONE-SHOP)\n(EXECUTING TELL-SHOP-PROBLEM)\n(EXECUTING GIVE-SHOP-MONEY)\n(EXECUTING SHOP-INSTALLS-BATTERY)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n> (gps '(son-at-home car-needs-battery have-money)\n  '(son-at-school)\n  *school-ops*)\nNIL\n> (gps '(son-at-home car-works)\n  '(son-at-school)\n  *school-ops*)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n```\n\nIn all three examples the goal is to have the son at school.\nThe only operator that has `son-at-school` in its add-list is `drive-son-to-school`, so GPS selects that operator initially.\nBefore it can execute the operator, GPS has to solve for the preconditions.\nIn the first example, the program ends up working backward through the operators `shop-installs-battery, give-shop-money, tel1-shop-problem`, and `telephone-shop` to `look-up-number`, which has no outstanding preconditions.\nThus, the `look-up-number` action can be executed, and the program moves on to the other actions.\nAs Aristotle said, \"What is the last in the order of analysis seems to be first in the order of becoming.\"\n\nThe second example starts out exactly the same, but the `look-up-number` operator fails because its precondition, `have-phone-book`, cannot be achieved.\nKnowing the phone number is a precondition, directly or indirectly, of ail the operators, so no action is taken and GPS returns `NIL`.\n\nFinally, the third example is much more direct; the initial state specifies that the car works, so the driving operator can be applied immediately.\n\n## 4.5 Stage 5: Analysis, or \"We Lied about the G\"\n{:#s0030}\n{:.h1hd}\n\nIn the sections that follow, we examine the question of just how general this General Problem Solver is.\nThe next four sections point out limitations of our version of GPS, and we will show how to correct these limitations in a second version of the program.\n\nOne might ask if \"limitations\" is just a euphemism for \"bugs.\" Are we \"enhancing\" the program, or are we \"correcting\" it?\nThere are no clear answers on this point, because we never insisted on an unambiguous problem description or spcification.\nAI programming is largely exploratory programming; the aim is often to discover more about the problem area rather than to meet a clearly defined specification.\nThis is in contrast to a more traditional notion of programming, where the problem is completely specified before the first line of code is written.\n\n## 4.6 The Running Around the Block Problem\n{:#s0035}\n{:.h1hd}\n\nRepresenting the operator \"driving from home to school\" is easy: the precondition and delete-list includes being at home, and the add-list includes being at school.\nBut suppose we wanted to represent \"running around the block.\" There would be no net change of location, so does that mean there would be no addor delete-list?\nIf so, there would be no reason ever to apply the operator.\nPerhaps the add-list should contain something like \"got some exercise\" or \"feel tired,\" or something more general like \"experience running around the block.\" We will return to this question later.\n\n## 4.7 The Clobbered Sibling Goal Problem\n{:#s0040}\n{:.h1hd}\n\nConsider the problem of not only getting the child to school but also having some money left over to use for the rest of the day.\nGPS can easily solve this problem from the following initial condition:\n\n```lisp\n(gps '(son-at-home have-money car-works)\n  '(have-money son-at-school)\n  *school-ops*)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n```\n\nHowever, in the next example GPS incorrectly reports success, when in fact it has spent the money on the battery.\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n  '(have-money son-at-school)\n  *school-ops*)\n(EXECUTING LOOK-UP-NUMBER)\n(EXECUTING TELEPHONE-SHOP)\n(EXECUTING TELL-SHOP-PROBLEM)\n(EXECUTING GIVE-SHOP-MONEY)\n(EXECUTING SHOP-INSTALLS-BATTERY)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n```\n\nThe \"bug\" is that GPS uses the expression (`every #'achieve goals`) to achieve a set of goals.\nIf this expression returns true, it means that every one of the goals has been achieved in sequence, but it doesn't mean they are ail still true at the end.\nIn other words, the goal (`have-money son-at-school`), which we intended to mean \"end up in a state where both have-money and son-at-school are true,\" was interpreted by GPS to mean \"`first achieve have-money`, and then achieve `son-at-school`.\" Sometimes achieving one goal can undo another, previously achieved goal.\nWe will call this the \"prerequisite clobbers sibling goal\" problem.[2](#fn0015) That is, `have-money` and `son-at-school` are sibling goals, one of the prerequisites for the plan for `son-at-school` is `car-works`, and achieving that goal clobbers the `have-money goal`.\n\nModifying the program to recognize the \"prerequisite clobbers sibling goal\" problem is straightforward.\nFirst note that we call (`every #`'`achieve`*something*) twice within the program, so let's replace those two forms with ( `achieve-all`*something*).\nWe can then define `achieve-all` as follows:\n\n```lisp\n(defun achieve-all (goals)\n \"Try to achieve each goal, then make sure they still hold.\"\n (and (every #'achieve goals) (subsetp goals *state*)))\n```\n\nThe Common Lisp function subsetp returns true if its first argument is a subset of its second.\nIn `achieve-all`, it returns true if every one of the goals is still in the current state after achieving ail the goals.\nThis is just what we wanted to test.\n\nThe introduction of `achieve-all` prevents GPS from returning true when one of the goals gets clobbered, but it doesn't force GPS to replan and try to recover from a clobbered goal.\nWe won't consider that possibility now, but we will take it up again in the section on the blocks world domain, which was Sussman's primary example.\n\n## 4.8 The Leaping before You Look Problem\n{:#s0045}\n{:.h1hd}\n\nAnother way to address the \"prerequisite clobbers sibling goal\" problem is just to be more careful about the order of goals in a goal list.\nIf we want to get the kid to school and still have some money left, why not just specify the goal as (`son-at-school have-money`) rather than (`have-money son-at-school`)?\nLet's see what happens when we try that:\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n  '(son-at-school have-money)\n  *school-ops*)\n(EXECUTING LOOK-UP-NUMBER)\n(EXECUTING TELEPHONE-SHOP)\n(EXECUTING TELL-SHOP-PROBLEM)\n(EXECUTING GIVE-SHOP-MONEY)\n(EXECUTING SHOP-INSTALLS-BATTERY)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nNIL\n```\n\nGPS returns nil, reflecting the fact that the goal cannot be achieved, but only after executing all actions up to and including driving to school.\nI call this the \"leaping before you look\" problem, because if you asked the program to solve for the two goals `(jump off-cliff land-safely)` it would happily jump first, only to discover that it had no operator to land safely.\nThis is less than prudent behavior.\n\nThe problem arises because planning and execution are interleaved.\nOnce the preconditions for an operator are achieved, the action is taken-and `*state*` is irrevocably changed-even if this action may eventually lead to a dead end.\nAn alternative would be to replace the single global `*state*` with distinct local state variables, such that a new variable is created for each new state.\nThis alternative is a good one for another, independent reason, as we shall see in the next section.\n\n## 4.9 The Recursive Subgoal Problem\n{:#s0050}\n{:.h1hd}\n\nIn our simulated nursery school world there is only one way to find out a phone number: to look it up in the phone book.\nSuppose we want to add an operator for finding out a phone number by asking someone.\nOf course, in order to ask someone something, you need to be in communication with him or her.\nThe asking-for-aphone-number operator could be implemented as follows:\n\n```lisp\n(push (make-op :action 'ask-phone-number\n   :preconds '(in-communication-with-shop)\n   :add-1 i st '(know-phone-number))\n  *school-ops*)\n```\n\n(The special form ( `push`*item list*) puts the item on the front of the list; it is equivalent to (setf *list* (`cons`*item list*) ) in the simple case.) Unfortunately, something unexpected happens when we attempt to solve seemingly simple problems with this new set of operators.\nConsider the following:\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money)\n  '(son-at-school)\n  *school-ops*)\n>>TRAP 14877 (SYSTEM:PDL-OVERFLOW EH: :REGULAR)\nThe regular push-down list has overflown.\nWhile in the function ACHIEVE <- EVERY <- REMOVE\n```\n\nThe error message (which will vary from one implementation of Common Lisp to another) means that too many recursively nested function calls were made.\nThis indicates either a very complex problem or, more commonly, a bug in the program leading to infinite recursion.\nOne way to try to see the cause of the bug is to trace a relevant function, such as `achieve`:\n\n```lisp\n> (trace achieve)`=> `(ACHIEVE)\n> (gps '(son-at-home car-needs-battery have-money)\n  '(son-at-school)\n  *school-ops*)\n(1 ENTER ACHIEVE: SON-AT-SCHOOL)\n (2 ENTER ACHIEVE: SON-AT-HOME)\n (2 EXIT ACHIEVE: (SON-AT-HOME CAR-NEEDS-BATTERY HAVE-MONEY))\n (2 ENTER ACHIEVE: CAR-WORKS)\n  (3 ENTER ACHIEVE: CAR-NEEDS-BATTERY)\n  (3 EXIT ACHIEVE: (CAR-NEEDS-BATTERY HAVE-MONEY))\n  (3 ENTER ACHIEVE: SHOP-KNOWS-PROBLEM)\n   (4 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP)\n    (5 ENTER ACHIEVE: KNOW-PHONE-NUMBER)\n     (6 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP)\n      (7 ENTER ACHIEVE: KNOW-PHONE-NUMBER)\n       (8 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP)\n        (9 ENTER ACHIEVE: KNOW-PHONE-NUMBER)\n```\n\nThe output from trace gives us the necessary clues.\nNewell and Simon talk of \"oscillating among ends, functions required, and means that perform them.\" Here it seems we have an infinite oscillation between being in communication with the shop (levels 4, 6, 8,...) and knowing the shop's phone number (levels 5, 7, 9,...).\nThe reasoning is as follows: we want the shop to know about the problem with the battery, and this requires being in communication with him or her.\nOne way to get in communication is to phone, but we don't have a phone book to look up the number.\nWe could ask them their phone number, but this requires being in communication with them.\nAs Aristotle put it, \"If we are to be always deliberating, we shall have to go on to infinity.\" We will call this the \"recursive subgoal\" problem: trying to solve a problem in terms of itself.\nOne way to avoid the problem is to have achieve keep track of all the goals that are being worked on and give up if it sees a loop in the goal stack.\n\n## 4.10 The Lack of Intermediate Information Problem\n{:#s0055}\n{:.h1hd}\n\nWhen GPS fails to find a solution, it just returns `nil`.\nThis is annoying in cases where the user expected a solution to be found, because it gives no information about the cause of failure.\nThe user could always trace some function, as we traced achieve above, but the output from trace is rarely exactly the information desired.\nIt would be nice to have a general debugging output tool where the programmer could insert print statements into his code and have them selectively printed, depending on the information desired.\n\nThe function `dbg` provides this capability.\n`dbg` prints output in the same way as `format`, but it will only print when debugging output is desired.\nEach call to `dbg` is accompanied by an identifer that is used to specify a class of debugging messages.\nThe functions `debug` and `undebug` are used to add or remove message classes to the list of classes that should be printed.\nIn this chapter, all the debugging output will use the identifier :`gps`.\nOther programs will use other identifiers, and a complex program will use many identifiers.\n\nA call to `dbg` will resuit in output if the first argument to `dbg`, the identifier, is one that was specified in a call to `debug`.\nThe other arguments to `dbg` are a format string followed by a list of arguments to be printed according to the format string.\nIn other words, we will write functions that include calls to `dbg` like:\n\n```lisp\n(dbg :gps \"The current goal is: ~a\" goal)\n```\n\nIf we have turned on debugging with `(debug :gps)`, then calls to dbg with the identifier :`gps` will print output.\nThe output is turned off with `(undebug :gps)`.\n`debug` and `undebug` are designed to be similar to `trace` and `untrace`, in that they turn diagnostic output on and off.\nThey also follow the convention that `debug` with no arguments returns the current list of identifiers, and that `undebug` with no arguments turns all debugging off.\nHowever, they differ from `trace` and `untrace` in that they are functions, not macros.\nIf you use only keywords and integers for identifiers, then you won't notice the difference.\n\nTwo new built-in features are introduced here.\nFirst, `*debug-io*` is the stream normally used for debugging input/output.\nIn all previous calls to `format` we have used t as the stream argument, which causes output to go to the `*standard-output*` stream.\nSending different types of output to different streams allows the user some flexibility.\nFor example, debugging output could be directed to a separate window, or it could be copied to a file.\nSecond, the function `fresh-line` advances to the next line of output, unless the output stream is already at the start of the line.\n\n```lisp\n(defvar *dbg-ids* nil \"Identifiers used by dbg\")\n(defun dbg (id format-string &rest args)\n \"Print debugging info if (DEBUG ID) has been specified.\"\n (when (member id *dbg-ids*)\n  (fresh-line *debug-io*)\n  (apply #'format *debug-io* format-string args)))\n(defun debug (&rest ids)\n \"Start dbg output on the given ids.\"\n (setf *dbg-ids* (union ids *dbg-ids*)))\n(defun undebug (&rest ids)\n \"Stop dbg on the ids. With no ids, stop dbg al together. \"\n (setf *dbg-ids* (if (null ids) nil\n      (set-difference *dbg-ids* ids))))\n```\n\nSometimes it is easier to view debugging output if it is indented according to some pattern, such as the depth of nested calls to a function.\nTo generate indented output, the function `dbg-indent` is defined:\n\n```lisp\n(defun dbg-indent (id indent format-string &rest args)\n \"Print indented debugging info if (DEBUG ID) has been specified.\"\n (when (member id *dbg-ids*)\n  (fresh-line *debug-io*)\n  (dotimes (i indent) (princ \" \" *debug-io*))\n  (apply #'format *debug-io* format-string args)))\n```\n\n## 4.11 GPS Version 2: A More General Problem Solver\n{:#s0060}\n{:.h1hd}\n\nAt this point we are ready to put together a new version of GPS with solutions for the \"running around the block,\" \"prerequisite clobbers sibling goal,\" \"leaping before you look,\" and \"recursive subgoal\" problems.\nThe glossary for the new version is in [figure 4.2](#f0015).\n\n![f04-02-9780080571157](images/B9780080571157500042/f04-02-9780080571157.jpg)     \nFigure 4.2\n!!!(span) {:.fignum}\nGlossary for Version 2 of`GPS`\nThe most important change is that, instead of printing a message when each operator is applied, we will instead have `GPS` return the resulting state.\nA list of \"messages\" in each state indicates what actions have been taken.\nEach message is actually a condition, a list of the form (executing *operator*).\nThis solves the \"running around the block\" problem: we could call `GPS` with an initial goal of `((executing run-around-block))`, and it would execute the `run-around-block` operator, thereby satisfying the goal.\nThe following code defines a new function, op, which builds operators that include the message in their add-list.\n\n```lisp\n(defun executing-p (x)\n \"Is x of the form: (executing ...) ?\"\n (starts-with x 'executing))\n(defun starts-with (list x)\n \"Is this a list whose first element is x?\"\n (and (consp list) (eql (first list) x)))\n(defun convert-op (op)\n \"Make op conform to the (EXECUTING op) convention.\"\n (unless (some #'executing-p (op-add-list op))\n  (push (list 'executing (op-action op)) (op-add-list op)))\n op)\n(defun op (action &key preconds add-list del-list)\n \"Make a new operator that obeys the (EXECUTING op) convention.\"\n (convert-op\n  (make-op :action action :preconds preconds\n     :add-list add-list :del-list del-list)))\n```\n\nOperators built by op will be correct, but we can convert existing operators using `convert-op` directly:\n\n```lisp\n(mapc #'convert-op *school-ops*)\n```\n\nThis is an example of exploratory programming: instead of starting ail over when we discover a limitation of the first version, we can use Lisp to alter existing data structures for the new version of the program.\n\nThe definition of the variable `*ops*` and the structure op are exactly the same as before, and the rest of the program consists of five functions we have already seen: `GPS, achieve-all, achieve, appropriate-p`, and `apply-op`.\nAt the top level, the function `GPS` calls `achieve-all`, which returns either nil or a valid state.\nFrom this we remove all the atoms, which leaves only the elements of the final state that are lists-in other words, the actions of the form (`executing`*operator*).\nThus, the value of `GPS` itself is the list of actions taken to arrive at the final state.\n`GPS` no longer returns `SOLVED` when it finds a solution, but it still obeys the convention of returning nil for failure, and non-nil for success.\nIn general, it is a good idea to have a program return a meaningful value rather than print that value, if there is the possibility that some other program might ever want to use the value.\n\n```lisp\n(defvar *ops* nil \"A list of available operators.\")\n(defstruct op \"An operation\"\n (action nil) (preconds nil) (add-list nil) (del-list nil))\n(defun GPS (state goals &optional (*ops* *ops*))\n \"General Problem Solver: from state, achieve goals using *ops*.\"\n (remove-if #'atom (achieve-all (cons '(start) state) goals nil)))\n```\n\nThe first major change in version 2 is evident from the first line of the program: there is no `*state*` variable.\nInstead, the program keeps track of local state variables.\nThis is to solve the \"leaping before you look\" problem, as outlined before.\nThe functions `achieve`, `achieve-all`, and `apply-op` ail take an extra argument which is the current state, and all return a new state as their value.\nThey also must still obey the convention of returning nil when they fail.\n\nThus we have a potential ambiguity: does nil represent failure, or does it represent a valid state that happens to have no conditions?\nWe resolve the ambiguity by adopting the convention that ail states must have at least one condition.\nThis convention is enforced by the function GPS.\nInstead of calling (`achieve-all state goals nil`), GPS calls `(achieve-all (cons '(start) state) goals nil)`.\nSoeven if the user passes GPS a null initial state, it will pass on a state containing `(start)` to `achieve-all`.\nFrom then on, we are guaranteed that no state will ever become nil, because the only function that builds a new state is `apply-op`, and we can see by looking at the last line of `apply-op` that it always appends something onto the state it is returning.\n(An add-list can never be nil, because if it were, the operator would not be appropriate.\nBesides, every operator includes the (executing ...) condition.)\n\nNote that the final value we return from GPS has ail the atoms removed, so we end up reporting only the actions performed, since they are represented by conditions of the form (`executing *action*`).\nAdding the `(start)` condition at the beginning also serves to differentiate between a problem that cannot be solved and one that is solved without executing any actions.\nFailure returns nil, while a solution with no steps will at least include the `(start)` condition, if nothing else.\n\nFunctions that return nil as an indication of failure and return some useful value otherwise are known as *semipredicates*.\nThey are error prone in just these cases where nil might be construed as a useful value.\nBe careful when defining and using semipredicates: (1) Decide if nil could ever be a meaningful value.\n(2) Insure that the *user* can't corrupt the program by supplying nil as a value.\nIn this program, GPS is the only function the user should call, so once we have accounted for it, we're covered.\n(3) Insure that the *program* can't supply nil as a value.\nWe did this by seeing that there was only one place in the program where new states were constructed, and that this new state was formed by appending a one-element list onto another state.\nBy following this three-step procedure, we have an informai proof that the semipredicates involving states will function properly.\nThis kind of informai proof procedure is a common element of good program design.\n\nThe other big change in version 2 is the introduction of a goal stack to solve the recursive subgoal problem.\nThe program keeps track of the goals it is working on and immediately fails if a goal appears as a subgoal of itself.\nThis test is made in the second clause of `achieve`.\n\nThe function `achieve-a11` tries to achieve each one of the goals in turn, setting the variable `state2` to be the value returned from each successive call to `achieve`.\nIf all goals are achieved in turn, and if all the goals still hold at the end (as `subsetp` checks for), then the final state is returned; otherwise the function fails, returning nil.\n\nMost of the work is done `by achieve`, which gets passed a state, a single goal condition, and the stack of goals worked on so far.\nIf the condition is already in the state, then achieve succeeds and returns the state.\nOn the other hand, if the goal condition is already in the goal stack, then there is no sense continuing-we will be stuck in an endless loop-so `achieve` returns nil.\nOtherwise, `achieve` looks through the list of operators, trying to find one appropriate to apply.\n\n```lisp\n(defun achieve-all (state goals goal-stack)\n \"Achieve each goal, and make sure they still hold at the end.\"\n (let ((current-state state))\n  (if (and (every #'(lambda (g)\n      (setf current-state\n       (achieve current-state g goal-stack)))\n     goals)\n    (subsetp goals current-state :test #'equal))\n   current-state)))\n(defun achieve (state goal goal-stack)\n \"A goal is achieved if it already holds,\n or if there is an appropriate op for it that is applicable.\"\n (dbg-indent :gps (length goal-stack) \"Goal: \"a\" goal)\n (cond ((member-equal goal state) state)\n   ((member-equal goal goal-stack) nil)\n   (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n     (find-all goal *ops* :test #'appropriate-p)))))\n```\n\nThe goal `( (executing run-around-block) )` is a list of one condition, where the condition happens to be a two-element list.\nAllowing lists as conditions gives us more flexibility, but we also have to be careful.\nThe problem is that not all lists that look alike actually are the same.\nThe predicate equal essentially tests to see if its two arguments look alike, while the predicate `eql` tests to see if its two arguments actually are identical.\nSince functions like `member` use `eql` by default, we have to specify with `a :test` keyword that we want `equal` instead.\nSince this is done several times, we introduce the function `member-equal`.\nIn fact, we could have carried the abstraction one step further and defined `member-situation`, a function to test if a condition is true in a situation.\nThis would allow the user to change the matching function from `eql` to `equal`, and to anything else that might be useful.\n\n```lisp\n(defun member-equal (item list)\n (member item list :test #'equal))\n```\n\nThe function `apply-op`, which used to change the state irrevocably and print a message reflecting this, now returns the new state instead of printing anything.\nIt first computes the state that would result from achieving all the preconditions of the operator.\nIf it is possible to arrive at such a state, then `apply-op` returns a new state derived from this state by adding what's in the add-list and removing everything in the delete-list.\n\n```lisp\n(defun apply-op (state goal op goal-stack)\n \"Return a new, transformed state if op is applicable.\"\n (dbg-indent :gps (length goal-stack) \"Consider: ~a\" (op-action op))\n (let ((state2 (achieve-all state (op-preconds op)\n      (cons goal goal-stack))))\n  (unless (null state2)\n   ;; Return an updated state\n   (dbg-indent :gps (length goal-stack) \"Action: ~a\" (op-action op))\n   (append (remove-if #'(lambda (x)\n      (member-equal x (op-del-list op)))\n     state2)\n    (op-add-list op)))))\n(defun appropriate-p (goal op)\n \"An op is appropriate to a goal if it is in its add-list.\"\n (member-equal goal (op-add-list op)))\n```\n\nThere is one last complication in the way we compute the new state.\nIn version 1 of GPS, states were (conceptually) unordered sets of conditions, so we could use uni on and `set-difference` to operate on them.\nIn version 2, states become ordered lists, because we need to preserve the ordering of actions.\nThus, we have to use the functions append and `remove-if`, since these are defined to preserve order, while union and `set-diffrence` are not.\n\nFinally, the last difference in version 2 is that it introduces a new function: use.\nThis function is intended to be used as a sort of declaration that a given list of operators is to be used for a series of problems.\n\n```lisp\n(defun use (oplist)\n \"Use oplist as the default list of operators.\"\n ;; Return something useful, but not too verbose:\n ;; the number of operators.\n  (length (setf *ops* oplist)))\n```\n\nCalling use sets the parameter `*ops*,` so that it need not be specified on each call to GPS.\nAccordingly, in the definition of GPS itself the third argument, `*ops*`, is now optional; if it is not supplied, a default will be used.\nThe default value for *`ops*` is given as `*ops*`.\nThis may seem redundant or superfluous-how could a variable be its own default?\nThe answer is that the two occurrences of `*ops*` look alike, but they actually refer to two completely separate bindings of the special variable `*ops*`.\nMost of the time, variables in parameter lists are local variables, but there is no rule against binding a special variable as a parameter.\nRemember that the effect of binding a special variable is that all references to the special variable that occur anywhere in the program-even outside the lexical scope of the function-refer to the new binding of the special variable.\nSo after a sequence of calls we eventually reach achieve, which references `*ops*`, and it will see the newly bound value of `*ops*`.\n\nThe definition of GPS is repeated here, along with an alternate version that binds a local variable and explicitly sets and resets the special variable `*ops*`.\nClearly, the idiom of binding a special variable is more concise, and while it can be initially confusing, it is useful once understood.\n\n```lisp\n(defun GPS (state goals &optional (*ops* *ops*))\n \"General Problem Solver: from state, achieve goals using *ops*.\"\n (remove-if #'atom (achieve-all (cons '(start) state) goals nil)))\n(defun GPS (state goals &optional (ops *ops*))\n \"General Problem Solver: from state, achieve goals using *ops*.\"\n (let ((old-ops *ops*))\n  (setf *ops* ops)\n  (let ((resuit (remove-if #'atom (achieve-all\n         (cons'(start) state)\n         goals nil ))))\n   (setf *ops* old-ops)\n   resuit)))\n```\n\nNow let's see how version 2 performs.\nWe use the list of operators that includes the \"asking the shop their phone number\" operator.\nFirst we make sure it will still do the examples version 1 did:\n\n```lisp\n> (use *school-ops*)`=> `7\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n   '(son-at-school))\n((START)\n (EXECUTING LOOK-UP-NUMBER)\n (EXECUTING TELEPHONE-SHOP)\n (EXECUTING TELL-SHOP-PROBLEM)\n (EXECUTING GIVE-SHOP-MONEY)\n (EXECUTING SHOP-INSTALLS-BATTERY)\n (EXECUTING DRIVE-SON-TO-SCHOOL))\n> (debug :gps)`=> `(:GPS)\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n   '(son-at-school))\nGoal: SON-AT-SCHOOL\nConsider: DRIVE-SON-TO-SCHOOL\n Goal: SON-AT-HOME\n Goal: CAR-WORKS\n Consider: SHOP-INSTALLS-BATTERY\n  Goal: CAR-NEEDS-BATTERY\n  Goal: SHOP-KNOWS-PROBLEM\n  Consider: TELL-SHOP-PROBLEM\n   Goal: IN-COMMUNICATION-WITH-SHOP\n   Consider: TELEPHONE-SHOP\n    Goal: KNOW-PHONE-NUMBER\n    Consider: ASK-PHONE-NUMBER\n     Goal: IN-COMMUNICATION-WITH-SHOP\n    Consider: LOOK-UP-NUMBER\n     Goal: HAVE-PHONE-BOOK\n    Action: LOOK-UP-NUMBER\n   Action: TELEPHONE-SHOP\n  Action: TELL-SHOP-PROBLEM\n  Goal: SHOP-HAS-MONEY\n  Consider: GIVE-SHOP-MONEY\n   Goal: HAVE-MONEY\n  Action: GIVE-SHOP-MONEY\n Action: SHOP-INSTALLS-BATTERY\nAction: DRIVE-SON-TO-SCHOOL\n((START)\n (EXECUTING LOOK-UP-NUMBER)\n (EXECUTING TELEPHONE-SHOP)\n (EXECUTING TELL-SHOP-PROBLEM)\n (EXECUTING GIVE-SHOP-MONEY)\n (EXECUTING SHOP-INSTALLS-BATTERY)\n (EXECUTING DRIVE-SON-TO-SCHOOL))\n> (undebug)`=> `NIL\n> (gps '(son-at-home car-works)\n   '(son-at-school))\n((START)\n (EXECUTING DRIVE-SON-TO-SCHOOL))\n```\n\nNow we see that version 2 can also handle the three cases that version 1 got wrong.\nIn each case, the program avoids an infinite loop, and also avoids leaping before it looks.\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n   '(have-money son-at-school))\nNIL\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n   '(son-at-school have-money))\nNIL\n(gps '(son-at-home car-needs-battery have-money)\n   '(son-at-school) )\nNIL\n```\n\nFinally, we see that this version of GPS also works on trivial problems requiring no action:\n\n```lisp\n> (gps '(son-at-home) '(son-at-home))`=> `((START))\n```\n\n## 4.12 The New Domain Problem: Monkey and Bananas\n{:#s0065}\n{:.h1hd}\n\nTo show that GPS is at all general, we have to make it work in different domains.\nWe will start with a \"classic\" AI problem.[3](#fn0020) Imagine the following scenario: a hungry monkey is standing at the doorway to a room.\nIn the middle of the room is a bunch of bananas suspended from the ceiling by a rope, well out of the monkey's reach.\nThere is a chair near the door, which is light enough for the monkey to push and tall enough to reach almost to the bananas.\nJust to make things complicated, assume the monkey is holding a toy ball and can only hold one thing at a time.\n\nIn trying to represent this scenario, we have some flexibility in choosing what to put in the current state and what to put in with the operators.\nFor now, assume we define the operators as follows:\n\n```lisp\n(defparameter *banana-ops*\n (list\n  (op 'climb-on-chair\n   :preconds '(chair-at-middle-room at-middle-room on-floor)\n   :add-list '(at-bananas on-chair)\n   :del-list '(at-middle-room on-floor))\n  (op 'push-chair-from-door-to-middle-room\n   :preconds '(chair-at-door at-door)\n   :add-list '(chair-at-middle-room at-middle-room)\n   :del-list '(chair-at-door at-door))\n  (op 'walk-from-door-to-middle-room\n   :preconds '(at-door on-floor)\n   :add-list '(at-middle-room)\n   :del-list '(at-door))\n  (op 'grasp-bananas\n   :preconds '(at-bananas empty-handed)\n   :add-list '(has-bananas)\n   :del-list '(empty-handed))\n  (op 'drop-ball\n   :preconds '(has-ball)\n   :add-list '(empty-handed)\n   :del-list '(has-ball))\n  (op 'eat-bananas\n   :preconds '(has-bananas)\n   :add-list '(empty-handed not-hungry)\n   :del-list '(has-bananas hungry))))\n```\n\nUsing these operators, we could pose the problem of becoming not-hungry, given the initial state of being at the door, standing on the floor, holding the ball, hungry, and with the chair at the door.\n`GPS` can find a solution to this problem:\n\n```lisp\n> (use *banana-ops*)`=> `6\n> (GPS '(at-door on-floor has-ball hungry chair-at-door)\n   '(not-hungry))\n((START)\n (EXECUTING PUSH-CHAIR-FROM-D00R-T0-MIDDLE-R00M)\n (EXECUTING CLIMB-ON-CHAIR)\n (EXECUTING DROP-BALL)\n (EXECUTING GRASP-BANANAS)\n (EXECUTING EAT-BANANAS))\n```\n\nNotice we did not need to make any changes at all to the `GPS` program.\nWe just used a different set of operators.\n\n## 4.13 The Maze Searching Domain\n{:#s0070}\n{:.h1hd}\n\nNow we will consider another \"classic\" problem, maze searching.\nWe will assume a particular maze, diagrammed here.\n\n![u04-01-9780080571157](images/B9780080571157500042/u04-01-9780080571157.jpg)     \n\nIt is much easier to define some functions to help build the operators for this domain than it would be to type in all the operators directly.\nThe following code defines a set of operators for mazes in general, and for this maze in particular:\n\n```lisp\n(defun make-maze-ops (pair)\n \"Make maze ops in both directions\"\n (list (make-maze-op (first pair) (second pair))\n   (make-maze-op (second pair) (first pair))))\n(defun make-maze-op (here there)\n \"Make an operator to move between two places\"\n (op '(move from ,here to ,there)\n  :preconds '((at ,here))\n  :add-list '((at .there))\n  :del-list '((at .here))))\n(defparameter *maze-ops*\n (mappend #'make-maze-ops\n  '((1 2) (2 3) (3 4) (4 9) (9 14) (9 8) (8 7) (7 12) (12 13)\n   (12 11) (11 6) (11 16) (16 17) (17 22) (21 22) (22 23)\n   (23 18) (23 24) (24 19) (19 20) (20 15) (15 10) (10 5) (20 25))))\n```\n\nNote the backquote notation, ( ' ).\nIt is covered in [section 3.2](B9780080571157500030.xhtml#s0020), [page 67](B9780080571157500030.xhtml#p67).\n\nWe can now use this list of operators to solve several problems with this maze.\nAnd we could easily create another maze by giving another list of connections.\nNote that there is nothing that says the places in the maze are arranged in a five-by-five layout-that is just one way of visualizing the connectivity\n\n```lisp\n> (use *maze-ops*)`=> `48\n> (gps '((at 1)) '((at 25)))\n((START)\n (EXECUTING-(M0VE-FROM-1 TO 2))\n (EXECUTING-(M0VE-FROM-2 TO 3))\n (EXECUTING-(M0VE-FROM-3 TO 4))\n (EXECUTING-(M0VE-FROM-4 TO 9))\n (EXECUTING-(M0VE-FROM-9 TO 8))\n (EXECUTING-(M0VE-FROM-8 TO 7))\n (EXECUTING-(MOVE-FROM-7 TO 12))\n (EXECUTING-(MOVE-FROM-12 TO 11))\n (EXECUTING-(MOVE-FROM-11 TO 16))\n (EXECUTING-(MOVE-FROM-16 TO 17))\n (EXECUTING-(MOVE-FROM-17 TO 22))\n (EXECUTING-(MOVE-FROM-22 TO 23))\n (EXECUTING-(MOVE-FROM-23 TO 24))\n (EXECUTING-(MOVE-FROM-24 TO 19))\n (EXECUTING-(MOVE-FROM-19 TO 20))\n (EXECUTING-(MOVE-FROM-20 TO 25))\n (AT 25))\n```\n\nThere is one subtle bug that the maze domain points out.\nWe wanted GPS to return a list of the actions executed.\nHowever, in order to account for the case where the goal can be achieved with no action, I included `(START)` in the value returned by GPS.\nThese examples include the `START` and `EXECUTING` forms but also a list of the form (AT *n*), for some *n*.\nThis is the bug.\nIf we go back and look at the function GPS, we find that it reports the resuit by removing all atoms from the state returned by `achieve-all`.\nThis is a \"pun\"-we said remove atoms, when we really meant to remove all conditions except the `(START)` and `(EXECUTING *action*)` forms.\nUp to now, all these conditions were atoms, so this approach worked.\nThe maze domain introduced conditions of the form (`AT`*n*), so for the first time there was a problem.\nThe moral is that when a programmer uses puns-saying what's convenient instead of what's really happening-there's bound to be trouble.\nWhat we really want to do is not to remove atoms but to find all elements that denote actions.\nThe code below say s what we mean:\n\n```lisp\n(defun GPS (state goals &optional (*ops* *ops*))\n \"General Problem Solver: from state, achieve goals using *ops*.\"\n (find-all-if #'action-p\n    (achieve-all (cons '(start) state) goals nil)))\n(defun action-p (x)\n \"Is x something that is (start) or (executing ...)?\"\n (or (equal x '(start)) (executing-p x)))\n```\n\nThe domain of maze solving also points out an advantage of version 2: that it returns a representation of the actions taken rather than just printing them out.\nThe reason this is an advantage is that we may want to use the results for something, rather than just look at them.\nSuppose we wanted a function that gives us a path through a maze as a list of locations to visit in turn.\nWe could do this by calling GPS as a subfunction and then manipulating the results:\n\n```lisp\n(defun find-path (start end)\n \"Search a maze for a path from start to end.\"\n (let ((results (GPS '((at .start)) '((at .end)))))\n  (unless (null results)\n   (cons start (mapcar #'destination\n       (remove '(start) results\n         :itest #'equal))))))\n(defun destination (action)\n \"Find the Y in (executing (move from X to Y))\"\n (fifth (second action)))\n```\n\nThe function `find-path` calls GPS to get the `results`.\nIf this is `nil`, there is no answer, but if it is not, then take the `rest` of `results` (in other words, ignore the `(START)` part).\nPick out the destination, `*y*,` from each `(EXECUTING (MOVE FROM x TO y))` form, and remember to include the starting point.\n\n```lisp\n> (use *maze-ops*)`=> `48\n```\n\n`> (find-path 1 25)`=>\n\n```lisp\n(1 2 3 4 9 8 7 12 11 16 17 22 23 24 19 20 25)\n> (find-path 1 1)`=> `(1)\n> (equal (find-path 1 25) (reverse (find-path 25 1)))`=> `T\n```\n\n## 4.14 The Blocks World Domain\n{:#s0075}\n{:.h1hd}\n\nAnother domain that has attracted more than its share of attention in AI circles is the blocks world domain.\nImagine a child's set of building blocks on a table top.\nThe problem is to move the blocks from their starting configuration into some goal configuration.\nWe will assume that each block can have only one other block directly on top of it, although they can be stacked to arbitrary height.\nThe only action that can be taken in this world is to move a single block that has nothing on top of it either to the top of another block or onto the table that represents the block world.\nWe will create an operator for each possible block move.\n\n```lisp\n(defun make-block-ops (blocks)\n (let ((ops nil))\n  (dolist (a blocks)\n   (dolist (b blocks)\n    (unless (equal a b)\n     (dolist (c blocks)\n      (unless (or (equal c a) (equal c b))\n       (push (move-op abc) ops)))\n     (push (move-op a 'table b) ops)\n     (push (move-op a b 'table) ops))))\n  ops))\n(defun move-op (a b c)\n \"Make an operator to move A from B to C.\"\n (op '(move ,a from ,b to ,c)\n   :preconds '((space on ,a) (space on ,c) (,a on ,b))\n   :add-list (move-ons abc)\n   :del-list (move-ons a c b)))\n(defun move-ons (a b c)\n (if (eq b 'table)\n   '((,a on ,c))\n   '((.a on ,c) (space on ,b))))\n```\n\nNow we try these operators out on some problems.\nThe simplest possible problem is stacking one block on another:\n\n![u04-02-9780080571157](images/B9780080571157500042/u04-02-9780080571157.jpg)     \n\n```lisp\n> (use (make-block-ops '(a b)))`=> `4\n> (gps '((a on table) (b on table) (space on a) (space on b)\n   (space on table))\n  '((a on b) (b on table)))\n((START)\n (EXECUTING (MOVE A FROM TABLE TO B)))\n```\n\nHere is a slightly more complex problem: inverting a stack of two blocks.\nThis time we show the debugging output.\n\n![u04-03-9780080571157](images/B9780080571157500042/u04-03-9780080571157.jpg)     \n\n```lisp\n> (debug :gps)`=> `(:GPS)\n> (gps '((a on b) (b on table) (space on a) (space on table))\n   '((b on a)))\nGoal: (B ON A)\nConsider: (MOVE B FROM TABLE TO A)\n Goal: (SPACE ON B)\n Consider: (MOVE A FROM B TO TABLE)\n  Goal: (SPACE ON A)\n  Goal: (SPACE ON TABLE)\n  Goal: (A ON B)\n Action: (MOVE A FROM B TO TABLE)\n Goal: (SPACE ON A)\n Goal: (B ON TABLE)\nAction: (MOVE B FROM TABLE TO A)\n((START)\n (EXECUTING (MOVE A FROM B TO TABLE))\n (EXECUTING (MOVE B FROM TABLE TO A)))\n> (undebug)`=> `NIL\n```\n\nSometimes it matters what order you try the conjuncts in.\nFor example, you can't have your cake and eat it too, but you can take a picture of your cake and eat it too, as long as you take the picture *before* eating it.\nIn the blocks world, we have:\n\n![u04-04-9780080571157](images/B9780080571157500042/u04-04-9780080571157.jpg)     \n\n```lisp\n> (use (make-block-ops '(a b c))) 18\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n   '((b on a) (c on b)))\n((START)\n (EXECUTING (MOVE A FROM B TO TABLE))\n (EXECUTING (MOVE B FROM C TO A))\n (EXECUTING (MOVE C FROM TABLE TO B)))\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n   '((c on b) (b on a)))\nNIL\n```\n\nIn the first case, the tower was built by putting B on A first, and then C on B.\nIn the second case, the program gets C on B first, but clobbers that goal while getting B on A.\nThe \"prerequisite clobbers sibling goal\" situation is recognized, but the program doesn't do anything about it.\nOne thing we could do is try to vary the order of the conjunct goals.\nThat is, we could change `achieve-all` as follows:\n\n```lisp\n(defun achieve-all (state goals goal-stack)\n \"Achieve each goal, trying several orderings.\"\n (some #'(lambda (goals) (achieve-each state goals goal-stack))\n   (orderings goals)))\n(defun achieve-each (state goals goal-stack)\n \"Achieve each goal, and make sure they still hold at the end.\"\n (let ((current-state state))\n  (if (and (every #'(lambda (g)\n      (setf current-state\n       (achieve current-state g goal-stack)))\n     goals)\n    (subsetp goals current-state :test #'equal))\n   current-state)))\n(defun orderings (l)\n (if (> (length l) l)\n   (list l (reverse l))\n   (list l)))\n```\n\nNow we can represent the goal either way, and we'll still get an answer.\nNotice that we only consider two orderings: the order given and the reversed order.\nObviously, for goal sets of one or two conjuncts this is all the orderings.\nIn general, if there is only one interaction per goal set, then one of these two orders will work.\nThus, we are assuming that \"prerequisite clobbers sibling goal\" interactions are rare, and that there will seldom be more than one interaction per goal set.\nAnother possibility would be to consider all possible permutations of the goals, but that could take a long time with large goal sets.\n\nAnother consideration is the efficiency of solutions.\nConsider the simple task of getting block C on the table in the following diagram:\n\n![u04-05-9780080571157](images/B9780080571157500042/u04-05-9780080571157.jpg)     \n\n```lisp\n> (gps '((c on a) (a on table) (b on table)\n   (space on c) (space on b) (space on table))\n  '((c on table)))\n((START)\n (EXECUTING (MOVE C FROM A TO B))\n (EXECUTING (MOVE C FROM B TO TABLE)))\n```\n\nThe solution is correct, but there is an easier solution that moves C directly to the table.\nThe simpler solution was not found because of an accident: it happens that `make-block-ops` defines the operators so that moving C from B to the table comes before moving C from A to the table.\nSo the first operator is tried, and it succeeds provided C is on B.\nThus, the two-step solution is found before the one-step solution is ever considered.\nThe following example takes four steps when it could be done in two:\n\n![u04-06-9780080571157](images/B9780080571157500042/u04-06-9780080571157.jpg)     \n\n```lisp\n> (gps '((c on a) (a on table) (b on table)\n   (space on c) (space on b) (space on table))\n  '((c on table) (a on b)))\n((START)\n (EXECUTING (MOVE C FROM A TO B))\n (EXECUTING (MOVE C FROM B TO TABLE))\n (EXECUTING (MOVE A FROM TABLE TO C))\n (EXECUTING (MOVE A FROM C TO B)))\n```\n\nHow could we find shorter solutions?\nOne way would be to do a full-fledged search: shorter solutions are tried first, temporarily abandoned when something else looks more promising, and then reconsidered later on.\nThis approach is taken up in [chapter 6](B9780080571157500066.xhtml), using a general searching function.\nA less drastic solution is to do a limited rearrangement of the order in which operators are searched: the ones with fewer unfulfilled preconditions are tried first.\nIn particular, this means that operators with all preconditions filled would always be tried before other operators.\nTo implement this approach, we change `achieve`:\n\n```lisp\n(defun achieve (state goal goal-stack)\n \"A goal is achieved if it already holds,\n or if there is an appropriate op for it that is applicable.\"\n (dbg-indent :gps (length goal-stack) \"Goal:~a\" goal)\n (cond ((member-equal goal state) state)\n   ((member-equal goal goal-stack) nil)\n   (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n     (appropriate-ops goal state))))) ;***\n(defun appropriate-ops (goal state)\n \"Return a list of appropriate operators,\n sorted by the number of unfulfilled preconditions.\"\n (sort (copy-list (find-all goal *ops* :test #'appropriate-p)) #'<\n   :key #'(lambda (op)\n     (count-if #'(lambda (precond)\n       (not (member-equal precond state)))\n      (op-preconds op)))))\n```\n\nNow we get the solutions we wanted:\n\n![u04-07-9780080571157](images/B9780080571157500042/u04-07-9780080571157.jpg)     \n\n```lisp\n> (gps '((c on a) (a on table) (b on table)\n   (space on c) (space on b) (space on table))\n  '((c on table) (a on b)))\n((START)\n (EXECUTING (MOVE C FROM A TO TABLE))\n (EXECUTING (MOVE A FROM TABLE TO B)))\n```\n\n![u04-08-9780080571157](images/B9780080571157500042/u04-08-9780080571157.jpg)     \n\n```lisp\n(gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n   '((b on a) (c on b)))\n((START)\n (EXECUTING (MOVE A FROM B TO TABLE))\n (EXECUTING (MOVE B FROM C TO A))\n (EXECUTING (MOVE C FROM TABLE TO B)))\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n   '((c on b) (b on a)))\n((START)\n (EXECUTING (MOVE A FROM B TO TABLE))\n (EXECUTING (MOVE B FROM C TO A))\n (EXECUTING (MOVE C FROM TABLE TO B)))\n```\n\n### The Sussman Anomaly\n{:#s0085}\n{:.h2hd}\n\nSurprisingly, there are problems that can't be solved by *any* reordering of goals.\nConsider:\n\n![u04-09-9780080571157](images/B9780080571157500042/u04-09-9780080571157.jpg)     \n\nThis doesn't look too hard, so let's see how our GPS handles it:\n\n```lisp\n> (setf start '((c on a) (a on table) (b on table) (space on c)\n    (space on b) (space on table)))\n((C ON A) (A ON TABLE) (B ON TABLE) (SPACE ON C)\n (SPACE ON B) (SPACE ON TABLE))\n> (gps start '((a on b) (b on c)))`=> `NIL\n> (gps start '((b on c) (a on b)))`=> `NIL\n```\n\nThere is a \"prerequisite clobbers sibling goal\" problem regardless of which way we order the conjuncts!\nIn other words, no combination of plans for the two individual goals can solve the conjunction of the two goals.\nThis is a surprising fact, and the example has come to be known as \"the Sussman anomaly.\"[4](#fn0025) We will return to this problem in [chapter 6](B9780080571157500066.xhtml).\n\n## 4.15 Stage 5 Repeated: Analysis of Version 2\n{:#s0090}\n{:.h1hd}\n\nWe have shown that GPS is extensible to multiple domains.\nThe main point is that we didn't need to change the program itself to get the new domains to work; we just changed the list of operators passed to GPS.\nExperience in different domains did suggest changes that could be made, and we showed how to incorporate a few changes.\nAlthough version 2 is a big improvement over version 1, it still leaves much to be desired.\nNow we will discover a few of the most troubling problems.\n\n## 4.16 The Not Looking after You Don't Leap Problem\n{:#s0095}\n{:.h1hd}\n\nWe solved the \"leaping before you look\" problem by introducing variables to hold a representation of possible future states, rather than just a single variable representing the current state.\nThis prevents GPS from taking an ill-advised action, but we shall see that even with all the repair strategies introduced in the last section, it doesn't guarantee that a solution will be found whenever one is possible.\n\nTo see the problem, add another operator to the front of the `*school-ops*` list and turn the debugging output back on:\n\n```lisp\n(use (push (op 'taxi-son-to-school\n    :preconds '(son-at-home have-money)\n    :add-list '(son-at-school)\n    :del-list '(son-at-home have-money))\n   *school-ops*))\n(debug :gps)\n```\n\nNow, consider the problem of getting the child to school without using any money:\n\n```lisp\n> (gps '(son-at-home have-money car-works)\n   '(son-at-school have-money))\nGoal: SON-AT-SCHOOL\nConsider: TAXI-S0N-T0-SCH00L\n Goal: SON-AT-HOME\n Goal: HAVE-MONEY\nAction: TAXI-S0N-T0-SCH00L\nGoal: HAVE-MONEY\nGoal: HAVE-MONEY\nGoal: SON-AT-SCHOOL\nConsider: TAXI-S0N-T0-SCH00L\n Goal: SON-AT-HOME\n Goal: HAVE-MONEY\nAction: TAXI-SON-TO-SCHOOL\nNIL\n```\n\nThe first five lines of output succesfully solve the `son-at-school` goal with the `TAXI-SON-TO-SCHOOL` action.\nThe next line shows an unsuccesful attempt to solve the `have-money` goal.\nThe next step is to try the other ordering.\nThis time, the `have-money` goal is tried first, and succeeds.\nThen, the `son-at-school` goal is achieved again by the `TAXI-SON-TO-SCHOOL` action.\nBut the check for consistency in `achieve-each` fails, and there are no repairs available.\nThe goal fails, even though there is a valid solution: driving to school.\n\nThe problem is that `achieve` uses some to look at the `appropriate-ops`.\nThus, if there is some appropriate operator, `achieve` succeeds.\nIf there is only one goal, this will yield a correct solution.\nHowever, if there are multiple goals, as in this case, achieve will still only find one way to fulfill the first goal.\nIf the first solution is a bad one, the only recourse is to try to repair it.\nIn domains like the block world and maze world, repair often works, because all steps are reversible.\nBut in the taxi example, no amount of plan repair can get the money back once it is spent, so the whole plan fails.\n\nThere are two ways around this problem.\nThe first approach is to examine ail possible solutions, not just the first solution that achieves each subgoal.\nThe language Prolog, to be discussed in [chapter 11](B978008057115750011X.xhtml), does just that.\nThe second approach is to have achieve and `achieve-all` keep track of a list of goals that must be *protected*.\nIn the taxi example, we would trivially achieve the `have-money` goal and then try to achieve `son-at-school`, while protecting the goal `have-money`.\nAn operator would only be appropriate if it didn't delete any protected goals.\nThis approach still requires some kind of repair or search through multiple solution paths.\nIf we tried only one ordering-achieving `son-at-school` and then trying to protect it while achieving `have-money`-then we would not find the solution.\nDavid Warren's WARPLAN !!!(span) {:.smallcaps} planner makes good use of the idea of protected goals.\n\n## 4.17 The Lack of Descriptive Power Problem\n{:#s0100}\n{:.h1hd}\n\nIt would be a lot more economical, in the maze domain, to have one operator that says we can move from here to there if we are at \"here,\" and if there is a connection from \"here\" to \"there.\" Then the input to a particular problem could list the valid connections, and we could solve any maze with this single operator.\nSimilarly, we have defined an operator where the monkey pushes the chair from the door to the middle of the room, but it would be better to have an operator where the monkey can push the chair from wherever it is to any other nearby location, or better yet, an operator to push any \"pushable\" object from one location to a nearby one, as long as there is no intervening obstacle.\nThe conclusion is that we would like to have variables in the operators, so we could say something like:\n\n```lisp\n(op '(push X from A to B)\n :preconds '((monkey at A) (X at A) (pushable X) (path A B))\n :add-list '((monkey at B) (X at B))\n :del-list '((monkey at A) (X at A)))\n```\n\nOften we want to characterize a state in terms of something more abstract than a list of conditions.\nFor example, in solving a chess problem, the goal is to have the opponent in checkmate, a situation that cannot be economically described in terms of primitives like `(black king on A 4)`, so we need to be able to state some kind of constraint on the goal state, rather than just listing its components.\nWe might want to be able to achieve a disjunction or negation of conditions, where the current formalism allows only a conjunction.\n\nIt also is important, in many domains, to be able to state problems dealing with time: we want to achieve *X* before time *T*0, and then achieve *Y* before time *T*2, but not before *T*1.\nScheduling work on a factory floor or building a house are examples of planning where time plays an important role.\n\nOften there are costs associated with actions, and we want to find a solution with minimal, or near-minimal costs.\nThe cost might be as simple as the number of operators required for a solution-we saw in the blocks world domain that sometimes an operator that could be applied immediately was ignored, and an operator that needed several preconditions satisfied was chosen instead.\nOr we may be satisfied with a partial solution, if a complete solution is impossible or too expensive.\nWe may also want to take the cost (and time) of computation into account.\n\n## 4.18 The Perfect Information Problem\n{:#s0105}\n{:.h1hd}\n\nAll the operators we have seen so far have unambiguous results; they add or delete certain things from the current state, and GPS always knows exactly what they are going to do.\nIn the real world, things are rarely so cut and dried.\nGoing back to the problem of becoming rich, one relevant operator would be playing the lottery.\nThis operator has the effect of consuming a few dollars, and once in a while paying off a large sum.\nBut we have no way to represent a payoff \"once in a while.\" Similarly, we have no way to represent unexpected difficulties of any kind.\nIn the nursery school problem, we could represent the problem with the car battery by having GPS explicitly check to see if the car was working, or if it needed a battery, every time the program considered the driving operator.\nIn the real world, we are seldom this careful; we get in the car, and only when it doesn't start do we consider the possibility of a dead battery.\n\n## 4.19 The Interacting Goals Problem\n{:#s0110}\n{:.h1hd}\n\nPeople tend to have multiple goals, rather than working on one at a time.\nNot only do I want to get the kid to nursery school, but I want to avoid getting hit by another car, get to my job on time, get my work done, meet my friends, have some fun, continue breathing, and so on.\nI also have to discover goals on my own, rather than work on a set of predefined goals passed to me by someone else.\nSome goals I can keep in the background for years, and then work on them when the opportunity presents itself.\nThere is never a notion of satisfying all possible goals.\nRather, there is a continual process of achieving some goals, partially achieving others, and deferring or abandoning still others.\n\nIn addition to having active goals, people also are aware of undesirable situations that they are trying to avoid.\nFor example, suppose I have a goal of visiting a friend in the hospital.\nThis requires being at the hospital.\nOne applicable operator might be to walk to the hospital, while another would be to severly injure myself and wait for the ambulance to take me there.\nThe second operator achieves the goal just as well (perhaps faster), but it has an undesirable side effect.\nThis could be addressed either with a notion of solution cost, as outlined in the last section, or with a list of background goals that every solution attempts to protect.\n\nHerb Simon coined the term \"satisficing\" to describe the strategy of satisfying a reasonable number of goals to a reasonable degree, while abandoning or postponing other goals.\nGPS only knows success and failure, and thus has no way of maximizing partial success.\n\n## 4.20 The End of GPS\n{:#s0115}\n{:.h1hd}\n\nThese last four sections give a hint as to the scope of the limitations of GPS.\nIn fact, it is not a very general problem solver at ail.\nIt *is* general in the sense that the algorithm is not tied to a particular domain; we can change domain by changing the operators.\nBut GPS fails to be general in that it can't solve many interesting problems.\nIt is confined to small tricks and games.\n\nThere is an important yet subtle reason why GPS was destined to fail, a reason that was not widely appreciated in 1957 but now is at the core of computer science.\nIt is now recognized that there are problems that computers can't solve-not because a theoretically correct program can't be written, but because the execution of the program will take too long.\nA large number of problems can be shown to fall into the class of \"NP-hard\" problems.\nComputing a solution to these problems takes time that grows exponentially as the size of the problem grows.\nThis is a property of the problems themselves, and holds no matter how clever the programmer is.\nExponential growth means that problems that can be solved in seconds for, say, a five-input case may take trillions of years when there are 100 inputs.\nBuying a faster computer won't help much.\nAf ter all, if a problem would take a trillion years to solve on your computer, it won't help much to buy 1000 computers each 1000 times faster than the one you have: you're still left with a million years wait.\nFor a theoretical computer scientist, discovering that a problem is NP-hard is an end in itself.\nBut for an AI worker, it means that the wrong question is being asked.\nMany problems are NP-hard when we insist on the optimal solution but are much easier when we accept a solution that might not be the best.\n\nThe input to GPS is essentially a program, and the execution of GPS is the execution of that program.\nIf GPS's input language is general enough to express any program, then there will be problems that can't be solved, either because they take too long to execute or because they have no solution.\nModem problem-solving programs recognize this fundamental limitation, and either limit the class of problems they try to solve or consider ways of finding approximate or partial solutions.\nSome problem solvers also monitor their own execution time and know enough to give up when a problem is too hard.\n\nThe following quote from Drew McDermott's article \"Artificial Intelligence Meets Natural Stupidity\" sums up the current feeling about GPS.\nKeep it in mind the next time you have to name a program.\n\n> *Remember GPS?\nBy now, \"GPS\" is a colorless term denotinga particularly stupid program to solve puzzles.\nBut it originally meant \"General Problem Solver \" which caused everybody a lot of needless excitement and distraction.\nIt should have been called*lfgns !!!(span) {:.smallcaps} *-\"Local Feature-Guided Network Searcher.\"*\n\nNonetheless, GPS has been a useful vehicle for exploring programming in general, and AI programming in particular.\nMore importantly, it has been a useful vehicle for exploring \"the nature of deliberation.\" Surely we'll admit that Aristotle was a smarter person than you or me, yet with the aid of the computational model of mind as a guiding metaphor, and the further aid of a working computer program to help explore the metaphor, we have been led to a more thorough appreciation of means-ends analysis-at least within the computational model.\nWe must resist the temptation to believe that all thinking follows this model.\n\nThe appeal of AI can be seen as a split between means and ends.\nThe end of a successful AI project can be a program that accomplishes some useful task better, faster, or cheaper than it could be before.\nBy that measure, GPS is a mostly a failure, as it doesn't solve many problems particularly well.\nBut the means toward that end involved an investigation and formalization of the problem-solving process.\nBy that measure, our reconstruction of GPS is a success to the degree in which it leads the reader to a better under standing of the issues.\n\n## 4.21 History and References\n{:#s0120}\n{:.h1hd}\n\nThe original GPS is documented in Newell and Simon's 1963 paper and in their 1972 book, *Human Problem Solving*, as well as in Ernst and Newell 1969.\nThe implementation in this chapter is based on the Strips !!!(span) {:.smallcaps} program (Fikes and Nilsson 1971).\n\nThere are other important planning programs.\nEarl Sacerdoti's Abstrips !!!(span) {:.smallcaps} program was a modification of Strips !!!(span) {:.smallcaps} that allowed for hierarchical planning.\nThe idea was to sketch out a skeletal plan that solved the entire program at an abstract level, and then fill in the details.\nDavid Warren's Warplan !!!(span) {:.smallcaps} planner is covered in Warren 1974a,b and in a section of Coelho and Cotta 1988.\nAustin Tate's Nonlin !!!(span) {:.smallcaps} system (Tate 1977) achieved greater efficiency by considering a plan as a partially ordered sequence of operations rather than as a strictly ordered sequence of situations.\nDavid Chapman's Tweak !!!(span) {:.smallcaps} synthesizes and formalizes the state of the art in planning as of 1987.\n\nAil of these papers-and quite a few other important planning papers-are reprinted in Allen, Hendler, and Tate 1990.\n\n## 4.22 Exercises\n{:#s0125}\n{:.h1hd}\n\n**Exercise 4.1 [m]** It is possible to implement dbg using a single call to format.\nCan you figure out the format directives to do this?\n\n**Exercise 4.2 [m]** Write a function that generates all permutations of its input.\n\n**Exercise 4.3 [h]** GPS does not recognize the situation where a goal is accidentally solved as part of achieving another goal.\nConsider the goal of eating dessert.\nAssume that there are two operators available: eating ice cream (which requires having the ice cream) and eating cake (which requires having the cake).\nAssume that we can buy a cake, and that the bakery has a deal where it gives out free ice cream to each customer who purchases and eats a cake.\n(1) Design a list of operators to represent this situation.\n(2) Give gps the goal of eating dessert.\nShow that, with the right list of operators, `gps` will decide to eat ice cream, then decide to buy and eat the cake in order to get the free ice cream, and then go ahead and eat the ice cream, even though the goal of eating dessert has already been achieved by eating the cake.\n(3) Fix gps so that it does not manifest this problem.\n\nThe following exercises address the problems in version 2 of the program.\n\n**Exercise 4.4 [h]***The Not Looking after You Don't Leap Problem*.\nWrite a program that keeps track of the remaining goals so that it does not get stuck considering only one possible operation when others will eventually lead to the goal.\nHint: have achieve take an extra argument indicating the goals that remain to be achieved after the current goal is achieved.\n`achieve` should succeed only if it can achieve the current goal and also `achieve-all` the remaining goals.\n\n**Exercise 4.5 [d]** Write a planning program that, like Warren's Warplan !!!(span) {:.smallcaps} , keeps track of the list of goals that remain to be done as well as the list of goals that have been achieved and should not be undone.\nThe program should never undo a goal that has been achieved, but it should allow for the possibility of reordering steps that have already been taken.\nIn this way, the program will solve the Sussman anomaly and similar problems.\n\n**Exercise 4.6 [d]***The Lack of Descriptive Power Problem*.\nRead [chapters 5](B9780080571157500054.xhtml) and [6](B9780080571157500066.xhtml) tolearn about pattern matching.\nWrite a version of GPS that uses the pattern matching tools, and thus allows variables in the operators.\nApply it to the maze and blocks world domains.\nYour program will be more efficient if, like Chapman's Tweak !!!(span) {:.smallcaps} program, you allow for the possibility of variables that remain unbound as long as possible.\n\n**Exercise 4.7 [d]** Speculate on the design of a planner that can address the *Perfect Information* and *Interacting Goals* problems.\n\n## 4.23 Answers\n{:#s0130}\n{:.h1hd}\n\n**Answer 4.1** In this version, the format string `\"\"&\"V@T\"?`\" breaks down as follows: means go to a fresh line; `\"\"V@T\"` means insert spaces `(@T)` but use the next argument `(V)` to get the number of spaces.\nThe`\"\"?\"` is the indirection operator: use the next argument as a format string, and the argument following that as the list of arguments for the format string.\n\n```lisp\n(defun dbg-indent (id indent format-string &rest args)\n \"Print indented debugging info if (DEBUG ID) has been specified.\"\n (when (member id *dbg-ids*)\n  (format *debug-io* \"\"&\"V@T\"?\" (* 2 indent) format-string args)))\n```\n\n**Answer 4.2** Here is one solution.\nThe sophisticated Lisp programmer should also see the exercise on [page 680](B9780080571157500194.xhtml#p680).\n\n```lisp\n(defun permutations (bag)\n \"Return a list of ail the permutations of the input.\"\n ;; If the input is nil, there is only one permutation:\n ;; nil itself\n (if (null bag)\n   '(())\n   ;; Otherwise, take an element, e, out of the bag\n   ;; Generate ail permutations of the remaining elements,\n   ;; And add e to the front of each of these.\n   ;; Do this for ail possible e to generate ail permutations,\n   (mapcan #'(lambda (e)\n     (mapcar #'(lambda (p) (cons e p))\n      (permutations\n       (remove e bag :count 1 :test #'eq))))\n    bag)))\n```\n\n----------------------\n\n[1](#xfn0010)Strips !!!(span) {:.smallcaps} is the Stanford Research Institute Problem Solver, designed by [Richard Fikes and Nils Nilsson (1971)](B9780080571157500285.xhtml#bb0405).\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) Gerald Sussman, in his book *A Computer Model of Skill Acquisition,* uses the term \"prerequisite clobbers brother goal\" or PCBG.\nI prefer to be gender neutral, even at the risk of being labeled a historical revisionist.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0020) Originally posed by [Saul Amarel (1968)](B9780080571157500285.xhtml#bb0045).\n!!!(p) {:.ftnote1}\n\n[4](#xfn0025) A footnote in Waldinger 1977 says, \"This problem was proposed by Allen Brown.\nPerhaps many children thought of it earlier but did not recognize that it was hard.\" The problem is named after Gerald Sussman because he popularized it in Sussman 1973.\n!!!(p) {:.ftnote1}\n\n# Chapter 5\n## ELIZA: Dialog with a Machine\n{:.chaptitle}\n\n> *It is said that to explain is to explain away.*\n\n> -Joseph Weizenbaum\n\n> MIT computer scientist\n\nThis chapter and the rest of part I will examine three more well-known AI programs of the 1960s.\nELIZA !!!(span) {:.smallcaps} held a conversation with the user in which it simulated a psychotherapist.\nSTUDENT !!!(span) {:.smallcaps} solved word problems of the kind found in high school algebra books, and MACSYMA !!!(span) {:.smallcaps} solved a variety of symbolic mathematical problems, including differential and integral calculus.\nWe will develop versions of the first two programs that duplicate most of the essential features, but for the third we will implement only a tiny fraction of the original program's capabilities.\n\nAll three programs make heavy use of a technique called pattern matching.\nPart I serves to show the versatility-and also the limitations-of this technique.\n\nOf the three programs, the first two process input in plain English, and the last two solve non-trivial problems in mathematics, so there is some basis for describing them as being \"intelligent.\" On the other hand, we shall see that this intelligence is largely an illusion, and that ELIZA !!!(span) {:.smallcaps} in particular was actually designed to demonstrate this illusion, not to be a \"serious\" AI program.\n\nELIZA !!!(span) {:.smallcaps} was one of the first programs to feature English output as well as input.\nThe program was named after the heroine of *Pygmalion,* who was taught to speak proper English by a dedicated teacher.\nELIZA'S !!!(span) {:.smallcaps} principal developer, MIT professor Joseph Weizenbaum, published a paper on ELIZA !!!(span) {:.smallcaps} in the January 1966 issue of the *Communications of the Association for Computing Machinery.* The introduction to that paper is reproduced in its entirety here:\n\n> *It is said that to explain is to explain away.\nThis maxim is nowhere so well fulfilled as in the area of computer programming, especially in what is called heuristic programming and artificial intelligence.\nFor in those realms machines are made to behave in wondrous ways, often sufficient to dazzle even the most experienced observer.\nBut once a particular program is unmasked, once its inner workings are explained in language sufficiently plain to induce understanding, its magic crumbles away; it stands revealed as a mere collection of procedures, each quite comprehensible.\nThe observer says to himself, \"I could have written that.\" With that thought he moves the program in question from the shelf marked \"intelligent,\" to that reserved for curios, fit to be discussed only with people less enlightened than he.*\n\n> *The object of this paper is to cause just such a re-evaluation of the program about to be \"explained.\" Few programs ever needed it more.*\n\nLet me point out in passing that the main object of this book is to cause the reader to say to him or herself, \"I could have written that.\" It is hoped that in some cases this will be because the reader has gained something, and not solely because the programs in question have lost their ability to dazzle.\n\nLet's start our investigation of ELIZA !!!(span) {:.smallcaps} by looking at a sample dialog from the Weizenbaum article.\nELIZA !!!(span) {:.smallcaps} was designed to be instructed by a variety of scripts, or patterns of interaction.\nIn fact it had several scripts, including ones in German and Welsh.\nBut the only script that was used to any extent was in English, and it made ELIZA !!!(span) {:.smallcaps} emulate a Rogerian psychoanalyst.\nRogerians are \"nondirective\"-they try to let the patient reveal himself.\nThis is an easy script for ELIZA !!!(span) {:.smallcaps} to follow, because it involves being passive and reacting, rather than volunteering new information.\nIn the listing that follows, the user's input is in mixed case, and ELIZA'S !!!(span) {:.smallcaps} response is in capitals:\n\n```lisp\nMen are all alike.\nIN WHAT WAY\nThey're always bugging us about something or another.\nCAN YOU BE MORE SPECIFIC\nWell, my boyfriend made me come here.\nYOUR BOYFRIEND MADE YOU COME HERE\nHe says I'm depressed much of the time.\nI AM SORRY TO HEAR YOU ARE DEPRESSED\n  It's true. I am unhappy.\n  DO YOU THINK COMING HERE WILL HELP YOU NOT TO BE UNHAPPY\n  I need some help, that much seems certain.\n  WHAT WOULD IT MEAN TO YOU IF YOU GOT SOME HELP\n  Perhaps I could learn to get along with my mother.\n  TELL ME MORE ABOUT YOUR FAMILY\n```\n\nThis seems quite impressive; the program is responding reasonably to a variety of inputs and appears to be exhibiting true \"understanding.\" But, as Weizenbaum explains, this appearance is an illusion, and the program has finessed the difficult task of understanding by carefully recognizing, transforming, and echoing pieces of the input.\nThe procedure is to look for specific patterns, based on a key word or words in the input.\nFor example, whenever the program sees the words \"alike\" or \"same,\" it prints a message asking about similarity, in this case, \"`IN WHAT WAY.`\" Other patterns are more complicated.\nIn the next to last exchange, ELIZA !!!(span) {:.smallcaps} first throws away everything after the comma, and then uses a pattern that looks for input of the form \"I need X\" and transforms it to the output \"What would it mean to you if you got X,\" where X is the phrase \"some help\" in this case.\nThe great advantage of this approach is that the response will make sense for a variety of inputs: \"I need a vacation\" will elicit \"What would it mean to you if you got a vacation.\" This will work automatically, without having to tell the program the difference between \"some help\" and \"a vacation.\" The disadvantage is that the program will sometimes make silly responses: \"I need this like a hole in the head\" will be answered with \"What would it mean to you if you got this like a hole in the head.\" In fact, the program only makes any sense at all if it is receiving input from someone who makes sense-and someone who interprets its answers charitably.\nWhen given \"I need gibble plix zzq,\" ELIZA !!!(span) {:.smallcaps} would reply \" What would it mean to you if you got gibble plix zzq,\" without any inkling that something is wrong.\nAnother example of the original ELIZA !!!(span) {:.smallcaps} program has it communicating with another program, PARRY, !!!(span) {:.smallcaps} which was written by Dr.\nKenneth Colby to mimic paranoid behavior.\nPart of the conversation follows, with ELIZA !!!(span) {:.smallcaps} again in capitals and PARRY !!!(span) {:.smallcaps} in mixed case:\n\n```lisp\nI don't understand your motives.\nWHY DON'T YOU UNDERSTAND MY MOTIVES?\nShouldn't I be?\nWHY DO YOU SAY THAT JUST NOW?\nThat's just the way it is.\nSUPPOSE THAT'S JUST THE WAY IT WERE NOT.\nSo?\nI AM NOT SURE I UNDERSTAND YOU FULLY.\nYou harp on the same questions too much.\nWHAT DOES THAT SIMILARITY SUGGEST TO YOU?\nI don't get you.\nDO YOU WISH THAT YOU DID GET I?\n```\n\nThis suggests that neither ELIZA !!!(span) {:.smallcaps} nor PARRY !!!(span) {:.smallcaps} had a deep understanding of the dialog.\nWhen there is a human to take on most of the burden of carrying forth the conversation, these programs can be convincing, but when the human is taken out of the conversation, the weaknesses of the programs are revealed.\n\n## 5.1 Describing and Specifying ELIZA\n!!!(span) {:.smallcaps}\n\n{:#s0010}\n{:.h1hd}\n\nNow that we have an idea of what ELIZA !!!(span) {:.smallcaps} is like, we can begin the description and specification of the program, and eventually move to the implementation and debugging.\n\nThe ELIZA !!!(span) {:.smallcaps} algorithm can be described simply as: (1) read an input, (2) find a pattern that matches the input, (3) transform the input into a response, and (4) print the response.\nThese four steps are repeated for each input.\n\nThe specification and implementation of steps (1) and (4) are trivial: for (1), use the built-in `read` function to read a list of words, and for (4) use `print` to print the list of words in the response.\n\nOf course, there are some drawbacks to this specification.\nThe user will have to type a real list-using parentheses-and the user can't use characters that are special to `read`, like quotation marks, commas, and periods.\nSo our input won't be as unconstrained as in the sample dialog, but that's a small price to pay for the convenience of having half of the problem neatly solved.\n\n## 5.2 Pattern Matching\n{:#s0015}\n{:.h1hd}\n\nThe hard part comes with steps (2) and (3)-this notion of pattern matching and transformation.\nThere are four things to be concerned with: a general pattern and response, and a specific input and transformation of that input.\nSince we have agreed to represent the input as a list, it makes sense for the other components to be lists too.\nFor example, we might have:\n\nPattern: `(i need a X)`\n\nResponse: `(what would it mean to you if you got a X ?)`\n\nInput: `(i need a vacation)`\n\nTransformation: `(what would it mean to you if you got a vacation ?)`\n\nThe pattern matcher must match the literals `i` with `i`, `need` with `need`, and `a` with `a`, as well as match the variable `X` with `vacation`.\nThis presupposes that there is some way of deciding that `X` is a variable and that `need` is not.\nWe must then arrange to substitute `vacation` for `X` within the response, in order to get the final transformation.\n\nIgnoring for a moment the problem of transforming the pattern into the response, we can see that this notion of pattern matching is just a generalization of the Lisp function `equal`.\nBelow we show the function `simple-equal`, which is like the built-in function `equal`,[1](#fn0010) and the function `pat-match`, which is extended to handle pattern-matching variables:\n\n```lisp\n(defun simple-equal (x y)\n \"Are x and y equal? (Don't check inside strings.)\"\n (if (or (atom x) (atom y))\n  (eql x y)\n  (and (simple-equal (first x) (first y))\n   (simple-equal (rest x) (rest y)))))\n(defun pat-match (pattern input)\n \"Does pattern match input? Any variable can match anything.\"\n (if (variable-p pattern)\n  t\n  (if (or (atom pattern) (atom input))\n   (eql pattern input)\n   (and (pat-match (first pattern) (first input))\n    (pat-match (rest pattern) (rest input))))))\n```\n\n**Exercise 5.1 [s]** Would it be a good idea to replace the complex and form in `pat-match` with the simpler `(every #'pat-match pattern input)?`\n\nBefore we can go on, we need to decide on an implementation for pattern-matching variables.\nWe could, for instance, say that only a certain set of symbols, such as {X,Y,Z}, are variables.\nAlternately, we could define a structure of type `variable`, but then we'd have to type something verbose like `(make-variable :name' X )` every time we wanted one.\nAnother choice would be to use symbols, but to distinguish variables from constants by the name of the symbol.\nFor example, in Prolog, variables start with capital letters and constants with lowercase.\nBut Common Lisp is case-insensitive, so that won't work.\nInstead, there is a tradition in Lisp-based AI programs to have variables be symbols that start with the question mark character.\n\nSo far we have dealt with symbols as atoms-objects with no internal structure.\nBut things are always more complicated than they first appear and, as in Lisp as in physics, it turns out that even atoms have components.\nIn particular, symbols have names, which are strings and are accessible through the `symbol-name` function.\nStrings in turn have elements that are characters, accessible through the function `char`.\nThe character '?' is denoted by the self-evaluating escape sequence #\\?.\nSo the predicate `variable-p` can be defined as follows, and we now have a complete pattern matcher:\n\n```lisp\n(defun variable-p (x)\n \"Is x a variable (a symbol beginning with '?')?\"\n (and (symbolp x) (equal (char (symbol-name x) 0) #\\?)))\n> (pat-match '(I need a ?X) '(I need a vacation))\nT\n> (pat-match '(I need a ?X) '(I really need a vacation))\nNIL\n```\n\nIn each case we get the right answer, but we don't get any indication of what `?X` is, so we couldn't substitute it into the response.\nWe need to modify `pat-match` to return some kind of table of variables and corresponding values.\nIn making this choice, the experienced Common Lisp programmer can save some time by being opportunistic: recognizing when there is an existing function that will do a large part of the task at hand.\nWhat we want is to substitute values for variables throughout the response.\nThe alert programmer could refer to the index of this book or the Common Lisp reference manual and find the functions `substitute, subst`, and `sublis`.\nAll of these substitute some new expression for an old one within an expression.\nIt turns out that `sublis` is most appropriate because it is the only one that allows us to make several substitutions all at once.\n`sublis` takes two arguments, the first a list of old-new pairs, and the second an expression in which to make the substitutions.\nFor each one of the pairs, the `car` is replaced by the `cdr`.\nIn other words, we would form each pair with something like `(cons old new)`.\n(Such a list of pairs is known as an *association list*, or *a-list,* because it associates keys with values.\nSee [section 3.6.](B9780080571157500030.xhtml#s0035)) In terms of the example above, we would use:\n\n```lisp\n(sublis '((?X . vacation))\n   '(what would it mean to you if you got a ?X ?))\n(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)\n```\n\nNow we need to arrange for `pat-match` to return an a-list, rather than just T for success.\nHere's a first attempt:\n\n```lisp\n(defun pat-match (pattern input)\n \"Does pattern match input? WARNING: buggy version.\"\n (if (variable-p pattern)\n  (list (cons pattern input))\n  (if (or (atom pattern) (atom input))\n   (eql pattern input)\n   (append (pat-match (first pattern) (first input))\n    (pat-match (rest pattern) (rest input))))))\n```\n\nThis implementation looks reasonable: it returns an a-list of one element if the pattern is a variable, and it appends alists if the pattern and input are both lists.\nHowever, there are several problems.\nFirst, the test `(eql pattern input)` may return `T`, which is not a list, so `append` will complain.\nSecond, the same test might return nil, which should indicate failure, but it will just be treated as a list, and will be appended to the rest of the answer.\nThird, we haven't distinguished between the case where the match fails-and returns nil-versus the case where everything matches, but there are no variables, so it returns the null a-list.\n(This is the semipredicate problem discussed on [page 127](B9780080571157500042.xhtml#p127).) Fourth, we want the bindings of variables to agree-if `?X` is used twice in the pattern, we don't want it to match two different values in the input.\nFinally, it is inefficient for `pat-match` to check both the `first` and `rest` of lists, even when the corresponding `first` parts fail to match.\n(Isn't it amazing that there could be five bugs in a seven-line function?)\n\nWe can resolve these problems by agreeing on two major conventions.\nFirst, it is very convenient to make `pat-match` a true predicate, so we will agree that it returns `ni1` only to indicate failure.\nThat means that we will need a non-nil value to represent the empty binding list.\nSecond, if we are going to be consistent about the values of variables, then the `first` will have to know what the `rest` is doing.\nWe can accomplish this by passing the binding list as a third argument to `pat-match`.\nWe make it an optional argument, because we want to be able to say simply `(pat-match *a b*)`.\n\nTo abstract away from these implementation decisions, we define the constants `fai1` and `no-bindings` to represent the two problematic return values.\nThe special form `defconstant` is used to indicate that these values will not change.\n(It is customary to give special variables names beginning and ending with asterisks, but this convention usually is not followed for constants.\nThe reasoning is that asterisks shout out, \"Careful!\nI may be changed by something outside of this lexical scope.\" Constants, of course, will not be changed.)\n\n```lisp\n(defconstant fail nil \"Indicates pat-match failure\")\n(defconstant no-bindings '((t . t))\n \"Indicates pat-match success, with no variables.\")\n```\n\nNext, we abstract away from assoc by introducing the following four functions:\n\n```lisp\n(defun get-binding (var bindings)\n \"Find a (variable . value) pair in a binding list.\"\n (assoc var bindings))\n(defun binding-val (binding)\n \"Get the value part of a single binding.\"\n (cdr binding))\n(defun lookup (var bindings)\n \"Get the value part (for var) from a binding list.\"\n (binding-val (get-binding var bindings)))\n(defun extend-bindings (var val bindings)\n \"Add a (var . value) pair to a binding list.\"\n (cons (cons var val) bindings))\n```\n\nNow that variables and bindings are defined, `pat-match` is easy.\nIt consists of five cases.\nFirst, if the binding list is `fai1`, then the match fails (because some previous match must have failed).\nIf the pattern is a single variable, then the match returns whatever `match-variable` returns; either the existing binding list, an extended one, or `fai1`.\nNext, if both pattern and input are lists, we first call `pat-match` recursively on the first element of each list.\nThis returns a binding list (or `fai1`), which we use to match the rest of the lists.\nThis is the only case that invokes a nontrivial function, so it is a good idea to informally prove that the function will terminate: each of the two recursive calls reduces the size of both pattern and input, and `pat-match` checks the case of atomic patterns and inputs, so the function as a whole must eventually return an answer (unless both pattern and input are of infinite size).\nIf none of these four cases succeeds, then the match fails.\n\n```lisp\n(defun pat-match (pattern input &optional (bindings no-bindings))\n \"Match pattern against input in the context of the bindings\"\n (cond ((eq bindings fail) fail)\n   ((variable-p pattern)\n    (match-variable pattern input bindings))\n   ((eql pattern input) bindings)\n   ((and (consp pattern) (consp input))\n    (pat-match (rest pattern) (rest input)\n     (pat-match (first pattern) (first input)\n      bindings)))\n   (t fail)))\n(defun match-variable (var input bindings)\n \"Does VAR match input? Uses (or updates) and returns bindings.\"\n (let ((binding (get-binding var bindings)))\n  (cond ((not binding) (extend-bindings var input bindings))\n    ((equal input (binding-val binding)) bindings)\n    (t fail))))\n```\n\nWe can now test `pat-match` and see how it works:\n\n```lisp\n> (pat-match '(i need a ?X) '(i need a vacation))\n((?X . VACATION) (T . T))\n```\n\nThe answer is a list of variable bindings in dotted pair notation; each element of the list is a (`*variable . value*`) pair.\nThe `(T . T)` is a remnant from `no-bindings`.\nIt does no real harm, but we can eliminate it by making `extend-bindings` a little more complicated:\n\n```lisp\n(defun extend-bindings (var val bindings)\n \"Add a (var . value) pair to a binding list.\"\n (cons (cons var val)\n   ;; Once we add a \"real\" binding,\n   ;; we can get rid of the dummy no-bindings\n    (if (eq bindings no-bindings)\n     nil\n     bindings)\n> (sublis (pat-match '(i need a ?X) '(i need a vacation))\n     '(what would it mean to you if you got a ?X ?))\n(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)\n> (pat-match '(i need a ?X) '(i really need a vacation))\nNIL\n> (pat-match '(this is easy) '(this is easy))\n((T . T))\n> (pat-match '(?X is ?X) '((2 + 2) is 4))\nNIL\n> (pat-match '(?X is ?X) '((2 + 2) is (2 + 2)))\n((?X 2 + 2))\n> (pat-match '(?P need . ?X) '(i need a long vacation))\n((?X A LONG VACATION) (?P . I))\n```\n\nNotice the distinction between `NIL` and `((T . T))`.\nThe latter means that the match succeeded, but there were no bindings to return.\nAlso, remember that `(?X 2 + 2)` means the same as `(?X . (2 + 2))`.\n\nA more powerful implementation of `pat-match` is given in [chapter 6](B9780080571157500066.xhtml).\nYet another implementation is given in [section 10.4](B9780080571157500108.xhtml#s0025).\nIt is more efficient but more cumbersome to use.\n\n## 5.3 Segment Pattern Matching\n{:#s0020}\n{:.h1hd}\n\nIn the pattern `(?P need . ?X)`, the variable `?X` matches the rest of the input list, regardless of its length.\nThis is in contrast to `?P`, which can only match a single element, namely, the first element of the input.\nFor many applications of pattern matching, this is fine; we only want to match corresponding elements.\nHowever, ELIZA !!!(span) {:.smallcaps} is somewhat different in that we need to account for variables in any position that match a sequence of items in the input.\nWe will call such variables *segment variables.* We will need a notation to differentiate segment variables from normal variables.\nThe possibilities fail into two classes: either we use atoms to represent segment variables and distinguish them by some spelling convention (as we did to distinguish variables from constants) or we use a nonatomic construct.\nWe will choose the latter, using a list of the form (`?*`*variable*) to denote segment variables.\nThe symbol `?*` is chosen because it combines the notion of variable with the Kleenestar notation.\nSo, the behavior we want from `pat-match` is now:\n\n```lisp\n> (pat-match '((?* ?p) need (?* ?x))\n    '(Mr Hulot and I need a vacation))\n((?P MR HULOT AND I) (?X A VACATION))\n```\n\nIn other words, when both pattern and input are lists and the first element of the pattern is a segment variable, then the variable will match some initial part of the input, and the rest of the pattern will attempt to match the rest.\nWe can update `pat-match` to account for this by adding a single cond-clause.\nDefining the predicate to test for segment variables is also easy:\n\n```lisp\n(defun pat-match (pattern input &optional (bindings no-bindings))\n \"Match pattern against input in the context of the bindings\"\n (cond ((eq bindings fail) fail)\n   ((variable-p pattern)\n    (match-variable pattern input bindings))\n   ((eql pattern input) bindings)\n   ((segment-pattern-p pattern); ***\n    (segment-match pattern input bindings)); ***\n   ((and (consp pattern) (consp input))\n    (pat-match (rest pattern) (rest input)\n     (pat-match (first pattern) (first input)\n      bindings)))\n   (t fail)))\n(defun segment-pattern-p (pattern)\n \"Is this a segment matching pattern: ((?* var) . pat)\"\n (and (consp pattern)\n  (starts-with (first pattern) '?*)))\n```\n\nIn writing `segment-match`, the important question is how much of the input the segment variable should match.\nOne answer is to look at the next element of the pattern (the one after the segment variable) and see at what position it occurs in the input.\nIf it doesn't occur, the total pattern can never match, and we should `fail`.\nIf it does occur, call its position `pos`.\nWe will want to match the variable against the initial part of the input, up to `pos`.\nBut first we have to see if the rest of the pattern matches the rest of the input.\nThis is done by a recursive call to `pat-match`.\nLet the result of this recursive call be named `b2`.\nIf `b2` succeeds, then we go ahead and match the segment variable against the initial subsequence.\n\nThe tricky part is when `b2` fails.\nWe don't want to give up completely, because it may be that if the segment variable matched a longer subsequence of the input, then the rest of the pattern would match the rest of the input.\nSo what we want is to try `segment-match` again, but forcing it to consider a longer match for the variable.\nThis is done by introducing an optional parameter, `start`, which is initially 0 and is increased with each failure.\nNotice that this policy rules out the possibility of any kind of variable following a segment variable.\n(Later we will remove this constraint.)\n\n```lisp\n(defun segment-match (pattern input bindings &optiona1 (start 0))\n \"Match the segment pattern ((?* var) . pat) against input.\"\n (let ((var (second (first pattern)))\n   (pat (rest pattern))) (if (null pat)\n  (if (null pat)\n   (match-variable var input bindings)\n   ;; We assume that pat starts with a constant\n   ;; In other words, a pattern can't have 2 consecutive vars\n   (let ((pos (position (first pat) input\n        :start start :test #'equal)))\n    (if (null pos)\n     fail\n     (let ((b2 (pat-match pat (subseq input pos) bindings)))\n      ;; If this match failed, try another longer one\n      ;; If it worked, check that the variables match\n      (if (eq b2 fail)\n       (segment-match pattern input bindings (+ pos 1))\n       (match-variable var (subseq input 0 pos) b2))))))))\n```\n\nSome examples of segment matching follow:\n\n```lisp\n> (pat-match '((?* ?p) need (?* ?x))\n      '(Mr Hulot and I need a vacation))\n((?P MR HULOT AND I) (?X A VACATION))\n> (pat-match '((?* ?x) is a (?* ?y)) '(what he is is a fool))\n((?X WHAT HE IS) (?Y FOOL))\n```\n\nThe first of these examples shows a fairly simple case: `?p` matches everything up to need, and `?x` matches the rest.\nThe next example involves the more complicated backup case.\nFirst `?x` matches everything up to the first `is` (this is position 2, since counting starts at 0 in Common Lisp).\nBut then the pattern a fails to match the input `is`, so `segment-match` tries again with starting position 3.\nThis time everything works; `is` matches `is`, `a` matches a, and `(?* ?y)` matches `fool`.\n\nUnfortunately, this version of `segment-match` does not match as much as it should.\nConsider the following example:\n\n```lisp\n> (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) => NIL\n```\n\nThis fails because `?x` is matched against the subsequence `(1 2)`, and then the remaining pattern succesfully matches the remaining input, but the final call to `match-variable` fails, because `?x` has two different values.\nThe fix is to call `match-variable` before testing whether the `b2` fails, so that we will be sure to try `segment-match` again with a longer match no matter what the cause of the failure.\n\n```lisp\n(defun segment-match (pattern input bindings &optional (start 0))\n \"Match the segment pattern ((?* var) . pat) against input.\"\n (let ((var (second (first pattern)))\n   (pat (rest pattern)))\n  (if (null pat)\n   (match-variable var input bindings)\n   ;; We assume that pat starts with a constant\n   ;; In other words, a pattern can't have 2 consecutive vars\n   (let ((pos (position (first pat) input\n        :start start :test #'equal)))\n   (if (null pos)\n    fail\n    (let ((b2 (pat-match\n     pat (subseq input pos)\n     (match-variable var (subseq input 0 pos)\n         bindings))))\n     ;; If this match failed, try another longer one\n     (if (eq b2 fail)\n      (segment-match pattern input bindings (+ pos 1))\n      b2)))))))\n```\n\nNow we see that the match goes through:\n\n```lisp\n> (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) ((?X 1 2 A B))\n```\n\nNote that this version of `segment-match` tries the shortest possible match first.\nIt would also be possible to try the longest match first.\n\n## 5.4 The ELIZA\n!!!(span) {:.smallcaps}\n Program: A Rule-Based Translator\n{:#s0025}\n{:.h1hd}\n\nNow that we have a working pattern matcher, we need some patterns to match.\nWhat's more, we want the patterns to be associated with responses.\nWe can do this by inventing a data structure called a `rule`, which consists of a pattern and one or more associated responses.\nThese are rules in the sense that they assert, \"If you see A, then respond with B or C, chosen at random.\" We will choose the simplest possible implementation for rules: as lists, where the first element is the pattern and the rest is a list of responses:\n\n```lisp\n(defun rule-pattern (rule) (first rule))\n(defun rule-responses (rule) (rest rule))\n```\n\nHere's an example of a rule:\n\n```lisp\n(((?* ?x) I want (?* ?y))\n (What would it mean if you got ?y)\n (Why do you want ?y)\n (Suppose you got ?y soon))\n```\n\nWhen applied to the input `(I want to test this program)`, this rule (when interpreted by the ELIZA !!!(span) {:.smallcaps} program) would pick a response at random, substitute in the value of `?y`, and respond with, say, `(why do you want to test this program)`.\n\nNow that we know what an individual rule will do, we need to decide how to handle a set of rules.\nIf ELIZA !!!(span) {:.smallcaps} is to be of any interest, it will have to have a variety of responses.\nSo several rules may all be applicable to the same input.\nOne possibility would be to choose a rule at random from among the rules having patterns that match the input.\n\nAnother possibility is just to accept the first rule that matches.\nThis implies that the rules form an ordered list, rather than an unordered set.\nThe clever ELIZA !!!(span) {:.smallcaps} rule writer can take advantage of this ordering and arrange for the most specific rules to come first, while more vague rules are near the end of the list.\n\nThe original ELIZA !!!(span) {:.smallcaps} had a system where each rule had a priority number associated with it.\nThe matching rule with the highest priority was chosen.\nNote that putting the rules in order achieves the same effect as having a priority number on each rule: the first rule implicitly has the highest priority, the second rule is next highest, and so on.\n\nHere is a short list of rules, selected from Weizenbaum's original article, but with the form of the rules updated to the form we are using.\nThe answer to exercise 5.19 contains a longer list of rules.\n\n```lisp\n(defparameter *eliza-rules*\n '((((?* ?x) hello (?* ?y))\n   (How do you do. Please state your problem.))\n  (((?* ?x) I want (?* ?y))\n   (What would it mean if you got ?y)\n   (Why do you want ?y) (Suppose you got ?y soon))\n  (((?* ?x) if (?* ?y))\n   (Do you really think its likely that ?y) (Do you wish that ?y)\n   (What do you think about ?y) (Really-- if ?y))\n  (((?* ?x) no (?* ?y))\n   (Why not?) (You are being a bit negative)\n   (Are you saying \"NO\" just to be negative?))\n  (((?* ?x) I was (?* ?y))\n   (Were you really?) (Perhaps I already knew you were ?y)\n   (Why do you tell me you were ?y now?))\n  (((?* ?x) I feel (?* ?y))\n   (Do you often feel ?y ?))\n  (((?* ?x) I felt (?* ?y))\n   (What other feelings do you have?))))\n```\n\nFinally we are ready to define ELIZA !!!(span) {:.smallcaps} proper.\nAs we said earlier, the main program should be a loop that reads input, transforms it, and prints the result.\nTransformation is done primarily by finding some rule such that its pattern matches the input, and then substituting the variables into the rule's response.\nThe program is summarized in [figure 5.1](#f0010).\n\n![f05-01-9780080571157](images/B9780080571157500054/f05-01-9780080571157.jpg)     \nFigure 5.1\n!!!(span) {:.fignum}\nGlossary for the ELIZA\n!!!(span) {:.smallcaps}\nProgram\nThere are a few minor complications.\nWe print a prompt to tell the user to input something.\nWe use the function `flatten` to insure that the output won't have imbedded lists after variable substitution.\nAn important trick is to alter the input by swapping \"you\" for \"me\" and so on, since these terms are relative to the speaker.\nHere is the complete program:\n\n```lisp\n(defun eliza ()\n \"Respond to user input using pattern matching rules.\"\n (loop\n  (print 'eliza >)\n  (write (flatten (use-eliza-rules (read))) :pretty t)))\n(defun use-eliza-rules (input)\n \"Find some rule with which to transform the input.\"\n (some #'(lambda (rule)\n    (let ((result (pat-match (rule-pattern rule) input)))\n     (if (not (eq result fail))\n      (sublis (switch-viewpoint result)\n          (random-elt (rule-responses rule))))))\n   *eliza-rules*))\n(defun switch-viewpoint (words)\n \"Change I to you and vice versa, and so on.\"\n (sublis '((I . you) (you . I) (me . you) (am . are))\n    words))\n```\n\nNote the use of `write` with the : `pretty` keyword true.\nThis will give better formatted output in some cases.\nThe program makes use of the previously defined `random-elt`, and `flatten`, which is defined here using `mappend` and `mklist`, a function that is defined in the InterLisp dialect but not in Common Lisp.\n\n```lisp\n(defun flatten (the-list)\n \"Append together elements (or lists) in the list.\"\n (mappend #'mklist the-list))\n(defun mklist (x)\n \"Return x if it is a list, otherwise (x).\"\n (if (listp x)\n  x\n  (list x)))\n(defun mappend (fn the-list)\n \"Apply fn to each element of list and append the results.\"\n (apply #'append (mapcar fn the-list)))\n(defun random-elt (choices)\n \"Choose an element from a list at random.\"\n (elt choices (random (length choices))))\n```\n\nThe actual ELIZA !!!(span) {:.smallcaps} program had a few complications that don't show up in this version.\nFirst, there was an alias method for associating several words with the same pattern; both \"mother\" and \"father\" could be associated with the \"family\" pattern.\nThere was also a synonym mechanism that would treat \"don't\" and \"do not\" or \"everybody\" and \"everyone\" the same.\nIn the case of input with several comma-separated phrases, each phrase was processed separately, and the response with the highest priority was selected.\nIn addition, the original ELIZA !!!(span) {:.smallcaps} had a \"memory\" mechanism.\nWhen no pattern matched the input, it said something like \"Tell me more about X,\" where X is some input given earlier.\nFinally, our version has fewer rules.\nDespite the shortcomings of our version, it can occasionally hold up its end of a conversation, as shown below:\n\n```lisp\n> (eliza)\nELIZA > (hello there)\n(HOW DO YOU DO. PLEASE STATE YOUR PROBLEM.)\nELIZA > (i want to test this program)\n(WHAT WOULD IT MEAN IF YOU GOT TO TEST THIS PROGRAM)\nELIZA > (i could see if it works)\n(DO YOU REALLY THINK ITS LIKELY THAT IT WORKS)\nELIZA > (no not really)\n(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?)\nELIZA > (no)\n(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?)\nELIZA > (forget it-- i was wondering how general the program is)\n(WHY DO YOU TELL ME YOU WERE WONDERING HOW GENERAL THE PROGRAM IS NOW?)\nELIZA > (i felt like it)\n(WHAT OTHER FEELINGS DO YOU HAVE?)\nELIZA > (i feel this is enough)\n(DO YOU OFTEN FEEL THIS IS ENOUGH ?)\nELIZA > [Abort]\n>\n```\n\nIn the end, it is the technique that is important-not the program.\nELIZA !!!(span) {:.smallcaps} has been \"explained away\" and should rightfully be moved to the curio shelf.\nPattern matching in general remains important technique, and we will see it again in subsequent chapters.\nThe notion of a rule-based translator is also important.\nThe problem of understanding English (and other languages) remains an important part of AI.\nClearly, the problem of understanding English is not solved by ELIZA.\n!!!(span) {:.smallcaps} In part V, we will address the problem again, using more sophisticated techniques.\n\n## 5.5 History and References\n{:#s0030}\n{:.h1hd}\n\nAs mentioned above, the original article describing ELIZA !!!(span) {:.smallcaps} is Weizenbaum 1966.\nAnother dialog system using similar pattern-matching techniques is [Kenneth Colby's (1975)](B9780080571157500285.xhtml#bb0235)PARRY.\n!!!(span) {:.smallcaps} This program simulated the conversation of a paranoid person well enough to fool several professional psychologists.\nAlthough the pattern matching techniques were simple, the model of belief maintained by the system was much more sophisticated than ELIZA !!!(span) {:.smallcaps} . Colby has suggested that dialog programs like ELIZA, !!!(span) {:.smallcaps} augmented with some sort of belief model like PARRY !!!(span) {:.smallcaps} , could be useful tools in treating mentally disturbed people.\nAccording to Colby, it would be inexpensive and effective to have patients converse with a specially designed program, one that could handle simple cases and alert doctors to patients that needed more help.\nWeizenbaum's book *Computer Power and Human Reason* (1976) discusses ELIZA !!!(span) {:.smallcaps} and PARRY !!!(span) {:.smallcaps} and takes a very critical view toward Colby's suggestion.\nOther interesting early work on dialog systems that model belief is reported by[Allan Collins (1978)](B9780080571157500285.xhtml#bb0240) and [Jamie Carbonell (1981)](B9780080571157500285.xhtml#bb0160).\n\n## 5.6 Exercises\n{:#s0035}\n{:.h1hd}\n\n**Exercise 5.2 [m]** Experiment with this version of ELIZA !!!(span) {:.smallcaps} . Show some exchanges where it performs well, and some where it fails.\nTry to characterize the difference.\nWhich failures could be fixed by changing the rule set, which by changing the `pat-match` function (and the pattern language it defines), and which require a change to the `eliza` program itself?\n\n**Exercise 5.3 [h]** Define a new set of rules that make ELIZA !!!(span) {:.smallcaps} give stereotypical responses to some situation other than the doctor-patient relationship.\nOr, write a set of rules in a language other than English.\nTest and debug your new rule set.\n\n**Exercise 5.4 [s]** We mentioned that our version of ELIZA !!!(span) {:.smallcaps} cannot handle commas or double quote marks in the input.\nHowever, it seems to handle the apostrophe in both input and patterns.\nExplain.\n\n**Exercise 5.5 [h]** Alter the input mechanism to handle commas and other punctuation characters.\nAlso arrange so that the user doesn't have to type parentheses around the whole input expression.\n(Hint: this can only be done using some Lisp functions we have not seen yet.\nLookat `read-lineand read-from-string`.)\n\n**Exercise 5.6 [m]** Modify ELIZA !!!(span) {:.smallcaps} to have an explicit exit.\nAlso arrange so that the output is not printed in parentheses either.\n\n**Exercise 5.7 [m]** Add the \"memory mechanism\" discussed previously to ELIZA.\n!!!(span) {:.smallcaps} Also add some way of definining synonyms like \"everyone\" and \"everybody.\"\n\n**Exercise 5.8 [h]** It turns out that none of the rules in the given script uses a variable more than once-there is no rule of the form `(?x... ?x)`.\nWrite a pattern matcher that only adds bindings, never checks variables against previous bindings.\nUse the `time` special form to compare your function against the current version.\n\n**Exercise 5.9 [h]** Winston and Horn's book *Lisp* presents a good pattern-matching program.\nCompare their implementation with this one.\nOne difference is that they handle the case where the first element of the pattern is a segment variable with the following code (translated into our notation):\n\n```lisp\n(or (pat-match (rest pattern) (rest input) bindings)\n   (pat-match pattern (rest input) bindings))\n```\n\nThis says that a segment variable matches either by matching the first element of the input, or by matching more than the first element.\nIt is much simpler than our approach using `position`, partly because they don't update the binding list.\nCan you change their code to handle bindings, and incorporate it into our version of `pat-match?` Is it still simpler?\nIs it more or less efficient?\n\n**Exercise 5.10** What is wrong with the following definition of `simple-equal?`\n\n```lisp\n(defun simple-equal (x y)\n \"Test if two lists or atoms are equal.\"\n ;; Warning - incorrect\n (or (eql x y)\n   (and (listp x) (listp y)\n    (simple-equal (first x) (first y))\n    (simple-equal (rest x) (rest y)))))\n```\n\n**Exercise 5.11 [m]** Weigh the advantages of changing `no-bindings` to `nil`, and `fail` to something else.\n\n**Exercise 5.12 [m]** Weigh the advantagesof making `pat-match` return multiple values: the first would be true for a match and false for failure, and the second would be the binding list.\n\n**Exercise 5.13 [m]** Suppose that there is a call to `segment-match` where the variable already has a binding.\nThe current definition will keep making recursive calls to `segment-match`, one for each possible matching position.\nBut this is silly-if the variable is already bound, there is only one sequence that it can possibly match against.\nChange the definition so that it looks only for this one sequence.\n\n**Exercise 5.14 [m]** Define a version of `mappend` that, like `mapcar`, accepts any number of argument lists.\n\n**Exercise 5.15 [m]** Give an informal proof that `segment-match` always terminates.\n\n**Exercise 5.16 [s]** Trick question: There is an object in Lisp which, when passed to `variable-p`, results in an error.\nWhat is that object?\n\n**Exercise 5.17 [m]** The current version of ELIZA !!!(span) {:.smallcaps} takes an input, transforms it according to the first applicable rule, and outputs the result.\nOne can also imagine a system where the input might be transformed several times before the final output is printed.\nWould such a system be more powerful?\nIf so, in what way?\n\n**Exercise 5.18 [h]** Read Weizenbaum's original article on ELIZA !!!(span) {:.smallcaps} and transpose his list of rules into the notation used in this chapter.\n\n## 5.7 Answers\n{:#s0040}\n{:.h1hd}\n\n**Answer 5.1** No.\nIf either the pattern or the input were shorter, but matched every existing element, the every expression would incorrectly return true.\n\n```lisp\n(every #'pat-match '(a b c) '(a))`=> `T\n```\n\nFurthermore, if either the pattern or the input were a dotted list, then the result of the every would be undefined-some implementations might signal an error, and others might just ignore the expression after the dot.\n\n```lisp\n(every #'pat-match '(a b . c) '(a b . d))`=> `T, NIL.or error.\n```\n\n**Answer 5.4** The expression `don't` may look like a single word, but to the Lisp reader it is composed of the two elements `don` and `'t`, or `(quote t )`.\nIf these elements are used consistently, they will match correctly, but they won't print quite right-there will be a space before the quote mark.\nIn fact the `:pretty t` argument to `write` is specified primarily to make `(quote t)` print as `'t` (See [page 559](B9780080571157500169.xhtml#p559) of Steele's *Common Lisp the Language*, 2d edition.)\n\n**Answer 5.5** One way to do this is to read a whole line of text with `read-line` rather than `read`.\nThen, substitute spaces for any punctuation character in that string.\nFinally, wrap the string in parentheses, and read it back in as a list:\n\n```lisp\n(defun read-line-no-punct ()\n \"Read an input line, ignoring punctuation.\"\n (read-from-string\n  (concatenate 'string \"(\" (substitute-if #\\space#'punctuation-p\n          (read-line))\n     \")\")))\n(defun punctuation-p (char) (find char \".,;:'!?#-()\\\\\\\"\"))\n```\n\nThis could also be done by altering the readtable, as in [section 23.5](B9780080571157500236.xhtml#s0030), [page 821](B9780080571157500236.xhtml#p821).\n\n**Answer 5.6**\n\n```lisp\n(defun eliza ()\n \"Respond to user input using pattern matching rules.\"\n (loop\n  (print 'eliza >)\n  (let* ((input (read-line-no-punct))\n    (response (flatten (use-eliza-rules input))))\n   (print-with-spaces response)\n   (if (equal response '(good bye)) (RETURN)))))\n(defun print-with-spaces (list)\n (mapc #'(lambda (x) (prinl x) (princ \" \")) list))\n```\n\n***`or`***\n\n```lisp\n(defun print-with-spaces (list)\n (format t \"~{~a ~}H list))\n```\n\n**Answer 5.10** Hint: consider `(simple-equal '() '(nil . nil))`.\n\n**Answer 5.14**\n\n```lisp\n(defun mappend (fn &rest list)\n \"Apply fn to each element of lists and append the results.\"\n (apply #'append (apply #'mapcar fn lists)))\n```\n\n**Answer 5.16** It must be a symbol, because for nonsymbols, `variable-p` justreturns nil.\nGetting the `symbol-name` of a symbol is just accessing a slot, so that can't cause an error.\nThe only thing left is `elt;` if the symbol name is the empty string, then accessing element zero of the empty string is an error.\nIndeed, there is a symbol whose name is the empty string: the symbol.\n\n**Answer 5.17** Among other things, a recursive transformation system could be used to handle abbreviations.\nThat is, a form like \"don't\" could be transformed into \"do not\" and then processed again.\nThat way, the other rules need only work on inputs matching \"do not.\"\n\n**Answer 5.19** The following includes most of Weizenbaum's rules:\n\n```lisp\n(defparameter *eliza-rules*\n '((((?* ?x) hello (?* ?y))\n   (How do you do. Please state your problem.))\n  (((?* ?x) computer (?* ?y))\n   (Do computers worry you?) (What do you think about machines?)\n   (Why do you mention computers?)\n   (What do you think machines have to do with your problem?))\n  (((?* ?x) name (?* ?y))\n   (I am not interested in names))\n  (((?* ?x) sorry (?* ?y))\n   (Please don't apologize) (Apologies are not necessary)\n   (What feelings do you have when you apologize))\n  (((?* ?x) I remember (?* ?y))\n   (Do you often think of ?y)\n   (Does thinking of ?y bring anything else to mind?)\n   (What else do you remember) (Why do you recall ?y right now?)\n   (What in the present situation reminds you of ?y)\n   (What is the connection between me and ?y))\n  (((?* ?x) do you remember (?* ?y))\n   (Did you think I would forget ?y ?)\n   (Why do you think I should recall ?y now)\n   (What about ?y) (You mentioned ?y))\n  (((?* ?x) if (?* ?y))\n   (Do you really think its likely that ?y) (Do you wish that ?y)\n   (What do you think about ?y) (Really-- if ?y))\n  (((?* ?x) I dreamt (?* ?y))\n   (Really-- ?y) (Have you ever fantasized ?y while you were awake?)\n   (Have you dreamt ?y before?))\n  (((?* ?x) dream about (?* ?y))\n   (How do you feel about ?y in reality?))\n  (((?* ?x) dream (?* ?y))\n   (What does this dream suggest to you?) (Do you dream often?)\n   (What persons appear in your dreams?)\n   (Don't you believe that dream has to do with your problem?))\n  (((?* ?x) my mother (?* ?y))\n   (Who else in your family ?y) (Tell me more about your family))\n  (((?* ?x) my father (?* ?y))\n   (Your father) (Does he influence you strongly?)\n   (What else comes to mind when you think of your father?))\n  (((?* ?x) I want (?* ?y))\n   (What would it mean if you got ?y)\n   (Why do you want ?y) (Suppose you got ?y soon))\n  (((?* ?x) I am glad (?* ?y))\n   (How have I helped you to be ?y) (What makes you happy just now)\n   (Can you explain why you are suddenly ?y))\n  (((?* ?x) I am sad (?* ?y))\n   (I am sorry to hear you are depressed)\n   (I'm sure it's not pleasant to be sad))\n  (((?* ?x) are like (?* ?y))\n   (What resemblance do you see between ?x and ?y))\n  (((?* ?x) is like (?* ?y))\n   (In what way is it that ?x is like ?y)\n   (What resemblance do you see?)\n   (Could there really be some connection?) (How?))\n  (((?* ?x) alike (?* ?y))\n   (In what way?) (What similarities are there?))\n  (((?* ?x) same (?* ?y))\n   (What other connections do you see?))\n  (((?* ?x) I was (?* ?y))\n   (Were you really?) (Perhaps I already knew you were ?y)\n   (Why do you tell me you were ?y now?))\n  (((?* ?x) was I (?* ?y))\n   (What if you were ?y ?) (Do you think you were ?y)\n   (What would it mean if you were ?y))\n  (((?* ?x) I am (?* ?y))\n   (In what way are you ?y) (Do you want to be ?y ?))\n  (((?* ?x) am I (?* ?y))\n   (Do you believe you are ?y) (Would you want to be ?y)\n   (You wish I would tell you you are ?y)\n   (What would it mean if you were ?y))\n  (((?* ?x) am (?* ?y))\n   (Why do you say \"AM?\") (I don't understand that))\n  (((?* ?x) are you (?* ?y))\n   (Why are you interested in whether I am ?y or not?)\n   (Would you prefer if I weren't ?y)\n   (Perhaps I am ?y in your fantasies))\n  (((?* ?x) you are (?* ?y))\n   (What makes you think I am ?y ?))\n  (((?* ?x) because (?* ?y))\n   (Is that the real reason?) (What other reasons might there be?)\n   (Does that reason seem to explain anything else?))\n  (((?* ?x) were you (?* ?y))\n   (Perhaps I was ?y) (What do you think?) (What if I had been ?y))\n  (((?* ?x) I can't (?* ?y))\n   (Maybe you could ?y now) (What if you could ?y ?))\n  (((?* ?x) I feel (?* ?y))\n   (Do you often feel ?y ?))\n  (((?* ?x) I felt (?* ?y))\n   (What other feelings do you have?))\n  (((?* ?x) I (?* ?y) you (?* ?z)\n   (Perhaps in your fantasy we ?y each other))\n  (((?* ?x) why don't you (?* ?y))\n   (Should you ?y yourself?)\n   (Do you believe I don't ?y) (Perhaps I will ?y in good time))\n  (((?* ?x) yes (?* ?y))\n   (You seem quite positive) (You are sure) (I understand))\n  (((?* ?x) no (?* ?y))\n   (Why not?) (You are being a bit negative)\n   (Are you saying \"NO\" just to be negative?))\n  (((?* ?x) someone (?* ?y))\n   (Can you be more specific?))\n  (((?* ?x) everyone (?* ?y))\n   (surely not everyone) (Can you think of anyone in particular?)\n   (Who for example?) (You are thinking of a special person))\n  (((?* ?x) always (?* ?y))\n   (Can you think of a specific example) (When?)\n   (What incident are you thinking of?)\n   (Really-- always))\n  (((?* ?x) what (?* ?y))\n   (Why do you ask?) (Does that question interest you?)\n   (What is it you really want to know?) (What do you think?)\n   (What cornes to your mind when you ask that?))\n  (((?* ?x) perhaps (?* ?y))\n   (You do not seem quite certain))\n  (((?* ?x) are (?* ?y))\n   (Did you think they might not be ?y)\n   (Possibly they are ?y))\n  (((?* ?x))\n   (Very interesting) (I am not sure I understand you fully)\n   (What does that suggest to you?) (Please continue) (Go on)\n   (Do you feel strongly about discussing such things?))))\n```\n\n----------------------\n\n[1](#xfn0010) The difference is that `simple-equal` does not handle strings.\n!!!(p) {:.ftnote1}\n\n# Chapter 6\n## Building Software Tools\n{:.chaptitle}\n\n> *Man is a tool-using animal...Without tools he is nothing with tools he is all.*\n\n> -Thomas Carlyle (1795-1881)\n\nIn [chapters 4](B9780080571157500042.xhtml) and [5](B9780080571157500054.xhtml) we were concerned with building two particular programs, GPS !!!(span) {:.smallcaps} and ELIZA !!!(span) {:.smallcaps} In this chapter, we will reexamine those two programs to discover some common patterns.\nThose patterns will be abstracted out to form reusable software tools that will prove helpful in subsequent chapters.\n\n## 6.1 An Interactive Interpreter Tool\n{:#s0010}\n{:.h1hd}\n\nThe structure of the function `eliza` is a common one.\nIt is repeated below:\n\n```lisp\n(defun eliza ()\n \"Respond to user input using pattern matching rules.\"\n (loop\n  (print 'eliza >)\n  (print (flatten (use-eliza-rules (read))))))\n```\n\nMany other applications use this pattern, including Lisp itself.\nThe top level of Lisp could be defined as:\n\n```lisp\n(defun lisp ()\n (loop\n  (print '>)\n  (print (eval (read)))))\n```\n\nThe top level of a Lisp system has historically been called the \"read-eval-print loop.\" Most modern Lisps print a prompt before reading input, so it should really be called the \"prompt-read-eval-print loop,\" but there was no prompt in some early systems like MacLisp, so the shorter name stuck.\nIf we left out the prompt, we could write a complete Lisp interpreter using just four symbols:\n\n```lisp\n(loop (print (eval (read))))\n```\n\nIt may seem facetious to say those four symbols and eight parentheses constitute a Lisp interpreter.\nWhen we write that line, have we really accomplished anything?\nOne answer to that question is to consider what we would have to do to write a Lisp (or Pascal) interpreter in Pascal.\nWe would need a lexical analyzer and a symbol table manager.\nThis is a considerable amount of work, but it is all handled by read.\nWe would need a syntactic parser to assemble the lexical tokens into statements.\nread also handles this, but only because Lisp statements have trivial syntax: the syntax of lists and atoms.\nThus read serves fine as a syntactic parser for Lisp, but would fail for Pascal.\nNext, we need the evaluation or interpretation part of the interpreter; eval does this nicely, and could handle Pascal just as well if we parsed Pascal syntax into Lisp expressions, `print` does much less work than `read` or `eval`, but is still quite handy.\n\nThe important point is not whether one line of code can be considered an implementation of Lisp; it is to recognize common patterns of computation.\nBoth `eliza` and `lisp` can be seen as interactive interpreters that read some input, transform or evaluate the input in some way, print the result, and then go back for more input.\nWe can extract the following common pattern:\n\n```lisp\n(defun *program* ()\n (loop\n  (print *prompt*)\n  (print (*transform* (read)))))\n```\n\nThere are two ways to make use of recurring patterns like this: formally and informally.\nThe informal alternative is to treat the pattern as a cliche or idiom that will occur frequently in our writing of programs but will vary from use to use.\nWhen we want to write a new program, we remember writing or reading a similar one, go back and look at the first program, copy the relevant sections, and then modify them for the new program.\nIf the borrowing is extensive, it would be good practice to insert a comment in the new program citing the original, but there would be no \"official\" connection between the original and the derived program.\n\nThe formal alternative is to create an abstraction, in the form of functions and perhaps data structures, and refer explicitly to that abstraction in each new application-in other words, to capture the abstraction in the form of a useable software tool.\nThe interpreter pattern could be abstracted into a function as follows:\n\n```lisp\n(defun interactive-interpreter (prompt transformer)\n \"Read an expression, transform it, and print the result.\"\n (loop\n  (print prompt)\n  (print (funcall transformer (read)))))\n```\n\nThis function could then be used in writing each new interpreter:\n\n```lisp\n(defun lisp ()\n (interactive-interpreter '> #'eval))\n(defun eliza ()\n (interactive-interpreter 'eliza >\n  #'(lambda (x) (flatten (use-eliza-rules x)))))\n```\n\nOr, with the help of the higher-order function compose:\n\n```lisp\n(defun compose (f g)\n \"Return the function that computes (f (g x)).\"\n #'(lambda (x) (funcall f (funcall g x))))\n(defun eliza ()\n (interactive-interpreter 'eliza >\n  (compose #'flatten #'use-eliza-rules)))\n```\n\nThere are two differences between the formal and informal approaches.\nFirst, they look different.\nIf the abstraction is a simple one, as this one is, then it is probably easier to read an expression that has the loop explicitly written out than to read one that calls `interactive-interpreter`, since that requires finding the definition of `interactive-interpreter` and understanding it as well.\n\nThe other difference shows up in what's called *maintenance*.\nSuppose we find a missing feature in the definition of the interactive interpreter.\nOne such omission is that the `loop` has no exit.\nI have been assuming that the user can terminate the loop by hitting some interrupt (or break, or abort) key.\nA cleaner implementation would allow the user to give the interpreter an explicit termination command.\nAnother useful feature would be to handle errors within the interpreter.\nIf we use the informal approach, then adding such a feature to one program would have no effect on the others.\nBut if we use the formal approach, then improving `interactive-interpreter` would automatically bring the new features to all the programs that use it.\n\nThe following version of `interactive-interpreter` adds two new features.\nFirst, it uses the macro `handler-case`[1](#fn0015) to handle errors.\nThis macro evaluates its first argument, and normally just returns that value.\nHowever, if an error occurs, the subsequent arguments are checked for an error condition that matches the error that occurred.\nIn this use, the case `error` matches all errors, and the action taken is to prints the error condition and continue.\n\nThis version also allows the prompt to be either a string or a function of no arguments that will be called to print the prompt.\nThe function `prompt-generator`, for example, returns a function that will print prompts of the form [1], [2], and so forth.\n\n```lisp\n(defun interactive-interpreter (prompt transformer)\n \"Read an expression, transform it, and print the result.\"\n (loop\n  (handler-case\n   (progn\n    (if (stringp prompt)\n     (print prompt)\n     (funcall prompt))\n    (print (funcall transformer (read))))\n   ;; In case of error. do this:\n   (error (condition)\n    (format t \"~&;; Error ~a ignored, back to top level.\"\n     condition)))))\n(defun prompt-generator (&optional (num 0) (ctl-string \"[~d] \"))\n \"Return a function that prints prompts like [l], [2], etc.\"\n #'(lambda () (format t ctl-string (incf num))))\n```\n\n## 6.2 A Pattern-Matching Tool\n{:#s0015}\n{:.h1hd}\n\nThe `pat-match` function was a pattern matcher defined specifically for the ELIZA !!!(span) {:.smallcaps} program.\nSubsequent programs will need pattern matchers too, and rather than write specialized matchers for each new program, it is easier to define one general pattern matcher that can serve most needs, and is extensible in case novel needs come up.\n\nThe problem in designing a \"general\" tool is deciding what features to provide.\nWe can try to define features that might be useful, but it is also a good idea to make the list of features open-ended, so that new ones can be easily added when needed.\n\nFeatures can be added by generalizing or specializing existing ones.\nFor example, we provide segment variables that match zero or more input elements.\nWe can specialize this by providing for a kind of segment variable that matches one or more elements, or for an optional variable that matches zero or one element.\nAnother possibility is to generalize segment variables to specify a match of *m* to *n* elements, for any specified *m* and *n*.\nThese ideas come from experience with notations for writing regular expressions, as well as from very general heuristics for generalization, such as \"consider important special cases\" and \"zero and one are likely to be important special cases.\"\n\nAnother useful feature is to allow the user to specify an arbitrary predicate that a match must satisfy.\nThe notation `(?is ?n numberp)` could be used to match any expression that is a number and bind it to the variable `?n`.\nThis would look like:\n\n```lisp\n> (pat-match '(x = (?is ?n numberp)) '(x = 34)) => ((?n . 34))\n> (pat-match '(x = (?is ?n numberp)) '(x = x)) => NIL\n```\n\nSince patterns are like boolean expressions, it makes sense to allow boolean operators on them.\nFollowing the question-mark convention, we will use `?and, ?or` and `?not` for the operators.[2](#fn0020) Here is a pattern to match a relational expression with one of three relations.\nIt succeeds because the < matches one of the three possibilities specified by `(?or < = >).`\n\n```lisp\n> (pat-match '(?x (?or < = >) ?y) '(3 < 4)) => ((?Y . 4) (?X . 3))\n```\n\nHere is an example of an `?and` pattern that checks if an expression is both a number and odd:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (pat-match` | `'(x = (?and (?is ?n numberp) (?is ?n oddp)))` |\n| | `'(x = 3))` |\n| `((?N . 3))` | |\n\nThe next pattern uses `?not` to insure that two parts are not equal:\n\n```lisp\n> (pat-match '(?x /= (?not ?x)) '(3 /= 4)) => ((?X . 3))\n```\n\nThe segment matching notation we have seen before.\nIt is augmented to allow for three possibilities: zero or more expressions; one or more expressions; and zero or one expressions.\nFinally, the notation `(?if *exp*)` can be used to test a relationship between several variables.\nIt has to be listed as a segment pattern rather than a single pattern because it does not consume any of the input at all:\n\n```lisp\n> (pat-match '(?x > ?y (?if (> ?x ?y))) '(4 > 3)) =>\n((?Y . 3) (?X . 4))\n```\n\nWhen the description of a problem gets this complicated, it is a good idea to attempt a more formal specification.\nThe following table describes a grammar of patterns, using the same grammar rule format described in [chapter 2](B9780080571157500029.xhtml).\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| *pat*=> | *var* | match any one expression |\n| *Constant* | match just this atom |\n| *segment*-*pat* | match something against a sequence |\n| *single*-*pat* | match something against one expression |\n| (*pat*. *pat*) | match the first and the rest |\n| *single*-*pat*=> | (?`is`*var predicate*) | test predicate on one expression |\n| (?`or`*pat*...) | match any pattern on one expression |\n| (?`and`*pat*...) | match every pattern on one expression |\n| (?`not`*pat*...) | succeed if pattern(s) do not match |\n| *segment*-*pat*=> | ( (?* *var*)...) | match zero or more expressions |\n| ( (?+ *var*) ... ) | match one or more expressions |\n| ( ( ?? *var*) ... ) | match zero or one expression |\n| ( ( ?`if`*exp* )...) | test if exp (which may contain variables) is true |\n| *Var*=> | ?*chars* | a symbol starting with ? |\n| *constant*=> | *atom* | any nonvariable atom |\n\n![t0015](images/B9780080571157500066/t0015.png)\n\nDespite the added complexity, all patterns can still be classified into five cases.\nThe pattern must be either a variable, constant, a (generalized) segment pattern, a (generalized) single-element pattern, or a cons of two patterns.\nThe following definition of `pat-match` reflects the five cases (along with two checks for failure):\n\n```lisp\n(defun pat-match (pattern input &optional (bindings no-bindings))\n \"Match pattern against input in the context of the bindings\"\n (cond ((eq bindings fail) fail)\n  ((variable-p pattern)\n   (match-variable pattern input bindings))\n  ((eq1 pattern input) bindings)\n  ((segment-pattern-p pattern)\n   (segment-matcher pattern input bindings))\n  ((single-pattern-p pattern) ; ***\n   (single-matcher pattern input bindings)) ; ***\n  ((and (consp pattern) (consp input))\n   (pat-match (rest pattern) (rest input)\n      (pat-match (first pattern) (first input)\n        bindings)))\n  (t fail)))\n```\n\nFor completeness, we repeat here the necessary constants and low-level functions from ELIZA !!!(span) {:.smallcaps} :\n\n```lisp\n(defconstant fail nil \"Indicates pat-match failure\")\n(defconstant no-bindings '((t . t))\n \"Indicates pat-match success, with no variables.\")\n(defun variable-p (x)\n \"Is x a variable (a symbol beginning with '?')?\"\n (and (symbolp x) (equal (char (symbol-name x) 0) #\\?)))\n(defun get-binding (var bindings)\n \"Find a (variable . value) pair in a binding list.\"\n (assoc var bindings))\n(defun binding-var (binding)\n \"Get the variable part of a single binding.\"\n (car binding))\n(defun binding-val (binding)\n \"Get the value part of a single binding.\"\n (cdr binding))\n(defun make-binding (var val) (cons var val))\n(defun lookup (var bindings)\n \"Get the value part (for var) from a binding list.\"\n (binding-val (get-binding var bindings)))\n(defun extend-bindings (var val bindings)\n \"Add a (var . value) pair to a binding list.\"\n (cons (make-binding var val)\n  ;; Once we add a \"real\" binding,\n  ;; we can get rid of the dumrny no-bindings\n  (if (eq bindings no-bindings)\n   nil\n   bindings)\n(defun match-variable (var input bindings)\n \"Does VAR match input? Uses (or updates) and returns bindings.\"\n (let ((binding (get-binding var bindings)))\n  (cond ((not binding) (extend-bindings var input bindings))\n   ((equal input (binding-val binding)) bindings)\n   (t fail))))\n```\n\nThe next step is to define the predicates that recognize generalized segment and single-element patterns, and the matching functions that operate on them.\nWe could implement `segment-matcher` and `single-matcher` with case statements that consider all possible cases.\nHowever, that would make it difficult to extend the matcher.\nA programmer who wanted to add a new kind of segment pattern would have to edit the definitions of both `segment-pattern-p` and `segment-matcher` to install the new feature.\nThis by itself may not be too bad, but consider what happens when two programmers each add independent features.\nIf you want to use both, then neither version of `segment-matcher` (or `segment-pattern-p`) will do.\nYou'll have to edit the functions again, just to merge the two extensions.\n\nThe solution to this dilemma is to write one version of `segment-pattern-p` and `segment-matcher`, once and for all, but to have these functions refer to a table of pattern/action pairs.\nThe table would say \"if you see ?* in the pattern, then use the function `segment-match`,\" and so on.\nThen programmers who want to extend the matcher just add entries to the table, and it is trivial to merge different extensions (unless of course two programmers have chosen the same symbol to mark different actions).\n\nThis style of programming, where pattern/action pairs are stored in a table, is called *data*-*driven programming*.\nIt is a very flexible style that is appropriate for writing extensible systems.\n\nThere are many ways to implement tables in Common Lisp, as discussed in [section 3.6](B9780080571157500030.xhtml#s0080), [page 73](B9780080571157500030.xhtml#p73).\nIn this case, the keys to the table will be symbols (like ?*), and it is fine if the representation of the table is distributed across memory.\nThus, property lists are an appropriate choice.\nWe will have two tables, represented by the `segment-match` property and the `single-match` property of symbols like ?*.\nThe value of each property will be the name of a function that implements the match.\nHere are the table entries to implement the grammar listed previously:\n\n```lisp\n(setf (get '?is 'single-match) 'match-is)\n(setf (get '?or 'single-match) 'match-or)\n(setf (get '?and 'single-match) 'match-and)\n(setf (get '?not 'single-match) 'match-not)\n(setf (get '?* 'segment-match) 'segment-match)\n(setf (get '?+ 'segment-match) 'segment-match +)\n(setf (get '?? 'segment-match) 'segment-match?)\n(setf (get '?if 'segment-match) 'match-if)\n```\n\nWith the table defined, we need to do two things.\nFirst, define the \"glue\" that holds the table together: the predicates and action-taking functions.\nA function that looks up a data-driven function and calls it (such as `segment-matcher` and `single-matcher`) is called a *dispatch function*.\n\n```lisp\n(defun segment-pattern-p (pattern)\n \"Is this a segment-matching pattern like ((?* var) . pat)?\"\n (and (consp pattern) (consp (first pattern))\n  (symbolp (first (first pattern)))\n  (segment-match-fn (first (first pattern)))))\n(defun single-pattern-p (pattern)\n \"Is this a single-matching pattern?\n E.g. (?is x predicate) (?and . patterns) (?or . patterns).\"\n (and (consp pattern)\n   (single-match-fn (first pattern))))\n(defun segment-matcher (pattern input bindings)\n \"Call the right function for this kind of segment pattern.\"\n (funcall (segment-match-fn (first (first pattern)))\n    pattern input bindings))\n(defun single-matcher (pattern input bindings)\n \"Call the right function for this kind of single pattern.\"\n (funcall (single-match-fn (first pattern))\n    (rest pattern) input bindings))\n(defun segment-match-fn (x)\n \"Get the segment-match function for x,\n if it is a symbol that has one.\"\n (when (symbolp x) (get x 'segment-match)))\n(defun single-match-fn (x)\n \"Get the single-match function for x,\n if it is a symbol that has one.\"\n (when (symbolp x) (get x 'single-match)))\n```\n\nThe last thing to do is define the individual matching functions.\nFirst, the single-pattern matching functions:\n\n```lisp\n(defun match-is (var-and-pred input bindings)\n \"Succeed and bind var if the input satisfies pred,\n where var-and-pred is the list (var pred).\"\n (let* ((var (first var-and-pred))\n   (pred (second var-and-pred))\n   (new-bindings (pat-match var input bindings)))\n  (if (or (eq new-bindings fail)\n    (not (funcall pred input)))\n   fail\n   new-bindings)))\n(defun match-and (patterns input bindings)\n \"Succeed if all the patterns match the input.\"\n (cond ((eq bindings fail) fail)\n   ((null patterns) bindings)\n   (t (match-and (rest patterns) input\n       (pat-match (first patterns) input\n         bindings)))))\n(defun match-or (patterns input bindings)\n \"Succeed if any one of the patterns match the input.\"\n (if (null patterns)\n   fail\n    (let ((new-bindings (pat-match (first patterns)\n          input bindings)))\n    (if (eq new-bindings fail)\n     (match-or (rest patterns) input bindings)\n     new-bindings))))\n(defun match-not (patterns input bindings)\n \"Succeed if none of the patterns match the input\n This will never bind any variables.\"\n (if (match-or patterns input bindings)\n   fail\n   bindings))\n```\n\nNow the segment-pattern matching functions.\n`segment-match` is similar to the version presented as part of ELIZA !!!(span) {:.smallcaps} . The difference is in how we determine pos, the position of the first element of the input that could match the next element of the pattern after the segment variable.\nIn ELIZA !!!(span) {:.smallcaps} , we assumed that the segment variable was either the last element of the pattern or was followed by a constant.\nIn the following version, we allow nonconstant patterns to follow segment variables.\nThe function `first -match - pos` is added to handle this.\nIf the following element is in fact a constant, the same calculation is done using `position`.\nIf it is not a constant, then we just return the first possible starting position-unless that would put us past the end of the input, in which case we return nil to indicate failure:\n\n```lisp\n(defun segment-match (pattern input bindings &optional (start 0))\n \"Match the segment pattern ((?* var) . pat) against input.\"\n (let ((var (second (first pattern)))\n   (pat (rest pattern)))\n  (if (null pat)\n   (match-variable var input bindings)\n   (let ((pos (first-match-pos (first pat) input start)))\n    (if (null pos)\n      fail\n      (let ((b2 (pat-match\n          pat (subseq input pos)\n          (match-variable var (subseq input 0 pos)\n            bindings))))\n       ;; If this match failed, try another longer one\n       (if (eq b2 fail)\n        (segment-match pattern input bindings (+ pos 1))\n        b2)))))))\n(defun first-match-pos (patl input start)\n \"Find the first position that pat1 could possibly match input,\n starting at position start. If pat1 is non-constant, then just\n return start.\"\n (cond ((and (atom pat1) (not (variable-p pat1)))\n    (position pat1 input :start start :test #'equal))\n   ((< start (length input)) start)\n   (t nil)))\n```\n\nIn the first example below, the segment variable ?`x` matches the sequence (`b c`).\nIn the second example, there are two segment variables in a row.\nThe first successful match is achieved with the first variable, ?`x`, matching the empty sequence, and the second one, ?`y`, matching (`b c`).\n\n```lisp\n> (pat-match '(a (?* ?x) d) '(a b c d)) => ((?X B C))\n> (pat-match '(a (?* ?x) (?* ?y) d) '(a b c d))=> ((?Y B C) (?X))\n```\n\nIn the next example, ?`x` is first matched against nil and ?`y` against (`b c d` ), but that fails, so we try matching ?`x` against a segment of length one.\nThat fails too, but finally the match succeeds with ?`x` matching the two-element segment (`b c`), and ?`y` matching (`d`).\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (pat-match` | `'(a (?* ?x) (?* ?y) ?x ?y)` |\n| | `'(a b c d (b c) (d))) => ((?Y D) (?X B C))` |\n\nGiven `segment-match`, it is easy to define the function to match one-or-more elements and the function to match zero-or-one element:\n\n```lisp\n(defun segment-match + (pattern input bindings)\n \"Match one or more elements of input.\"\n (segment-match pattern input bindings 1))\n(defun segment-match? (pattern input bindings)\n \"Match zero or one element of input.\"\n (let ((var (second (first pattern)))\n   (pat (rest pattern)))\n  (or (pat-match (cons var pat) input bindings)\n   (pat-match pat input bindings))))\n```\n\nFinally, we supply the function to test an arbitrary piece of Lisp code.\nIt does this by evaluating the code with the bindings implied by the binding list.\nThis is one of the few cases where it is appropriate to call `eval`: when we want to give the user unrestricted access to the Lisp interpreter.\n\n```lisp\n(defun match-if (pattern input bindings)\n \"Test an arbitrary expression involving variables\n The pattern looks like ((?if code) . rest).\"\n (and (progv (mapcar #'car bindings)\n    (mapcar #'cdr bindings)\n   (eval (second (first pattern))))\n  (pat-match (rest pattern) input bindings)))\n```\n\nHere are two examples using `?if`.\nThe first succeeds because `(+ 3 4)` is indeed `7`, and the second fails because `(> 3 4)` is false.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (pat-match` | `'(?x ?op ?y is ?z (?if (eq1 (?op ?x ?y) ?z)))` |\n| | `'(3 + 4 is 7))` |\n| `((?Z . 7) (?Y . 4) (?0P . +) (?X . 3))` |\n| `> (pat-match` | `'(?x ?op ?y (?if (?op ?x ?y)))` |\n| | `'(3 > 4))` |\n| `NIL` | |\n\n![t0025](images/B9780080571157500066/t0025.png)\n\nThe syntax we have defined for patterns has two virtues: first, the syntax is very general, so it is easy to extend.\nSecond, the syntax can be easily manipulated by `pat-match`.\nHowever, there is one drawback: the syntax is a little verbose, and some may find it ugly.\nCompare the following two patterns:\n\n```lisp\n(a (?* ?x) (?* ?y) d)\n(a ?x* ?y* d)\n```\n\nMany readers find the second pattern easier to understand at a glance.\nWe could change `pat-match` to allow for patterns of the form ?`x*`, but that would mean `pat-match` would have a lot more work to do on every match.\nAn alternative is to leave `pat-match` as is, but define another level of syntax for use by human readers only.\nThat is, a programmer could type the second expression above, and have it translated into the first, which would then be processed by `pat-match.`\n\nIn other words, we will define a facility to define a kind of pattern-matching macro that will be expanded the first time the pattern is seen.\nIt is better to do this expansion once than to complicate `pat-match` and in effect do the expansion every time a pattern is used.\n(Of course, if a pattern is only used once, then there is no advantage.\nBut in most programs, each pattern will be used again and again.)\n\nWe need to define two functions: one to define pattern-matching macros, and another to expand patterns that may contain these macros.\nWe will only allow symbols to be macros, so it is reasonable to store the expansions on each symbol's property list:\n\n```lisp\n(defun pat-match-abbrev (symbol expansion)\n \"Define symbol as a macro standing for a pat-match pattern.\"\n (setf (get symbol 'expand-pat-match-abbrev)\n  (expand-pat-match-abbrev expansion))\n(defun expand-pat-match-abbrev (pat)\n \"Expand out all pattern matching abbreviations in pat.\"\n (cond ((and (symbolp pat) (get pat 'expand-pat-match-abbrev)))\n   ((atom pat) pat)\n   (t (cons (expand-pat-match-abbrev (first pat))\n     (expand-pat-match-abbrev (rest pat))))))\n```\n\nWe would use this facility as follows:\n\n```lisp\n> (pat-match-abbrev '?x* '(?* ?x)) => (?* ?X)\n> (pat-match-abbrev '?y* '(?* ?y)) => (?* ?Y)\n> (setf axyd (expand-pat-match-abbrev '(a ?x* ?y* d))) =>\n(A (?* ?X) (?* ?Y) D)\n> (pat-match axyd '(a b c d)) => ((?Y B C) (?X))\n```\n\n**Exercise 6**.**1** [**m**] Go back and change the ELIZA !!!(span) {:.smallcaps} rules to use the abbreviation facility.\nDoes this make the rules easier to read?\n\n**Exercise 6**.**2** [**h**] In the few prior examples, every time there was a binding of pattern variables that satisfied the input, that binding was found.\nInformally, show that `pat-match` will always find such a binding, or show a counterexample where it fails to find one.\n\n## 6.3 A Rule-Based Translator Tool\n{:#s0020}\n{:.h1hd}\n\nAs we have defined it, the pattern matcher matches one input against one pattern.\nIn `eliza`, we need to match each input against a number of patterns, and then return a result based on the rule that contains the first pattern that matches.\nTo refresh your memory, here is the function `use-eliza-rules`:\n\n```lisp\n(defun use-eliza-rules (input)\n \"Find some rule with which to transform the input.\"\n (some #'(lambda (rule)\n   (let ((result (pat-match (rule-pattern rule) input)))\n    (if (not (eq result fail))\n     (sublis (switch-viewpoint result)\n      (random-elt (rule-responses rule))))))\n  *eliza-rules*))\n```\n\nIt turns out that this will be a quite common thing to do: search through a list of rules for one that matches, and take action according to that rule.\nTo turn the structure of `use-eliza-rules` into a software tool, we will allow the user to specify each of the following:\n\n*  What kind of rule to use.\nEvery rule will be characterized by an if-part and a then-part, but the ways of getting at those two parts may vary.\n\n*  What list of rules to use.\nIn general, each application will have its own list of rules.\n\n*  How to see if a rule matches.\nBy default, we will use `pat-match`, but it should be possible to use other matchers.\n\n*  What to do when a rule matches.\nOnce we have determined which rule to use, we have to determine what it means to use it.\nThe default is just to substitute the bindings of the match into the then-part of the rule.\n\nThe rule-based translater tool now looks like this:\n\n```lisp\n(defun rule-based-translator\n   (input rules &key (matcher #'pat-match)\n    (rule-if #'first) (rule-then #'rest) (action #'sublis))\n \"Find the first rule in rules that matches input,\n and apply the action to that rule.\"\n (some\n  #'(lambda (rule)\n    (let ((result (funcall matcher (funcall rule-if rule)\n        input)))\n    (if (not (eq result fail))\n     (funcall action result (funcall rule-then rule)))))\n  rules))\n(defun use-eliza-rules (input)\n \"Find some rule with which to transform the input.\"\n (rule-based-translator input *eliza-rules*\n  :action #'(lambda (bindings responses)\n     (sublis (switch-viewpoint bindings)\n        (random-elt responses)))))\n```\n\n## 6.4 A Set of Searching Tools\n{:#s0025}\n{:.h1hd}\n\nThe GPS program can be seen as a problem in *search*.\nIn general, a search problem involves exploring from some starting state and investigating neighboring states until a solution is reached.\nAs in GPS, *state* means a description of any situation or state of affairs.\nEach state may have several neighbors, so there will be a choice of how to search.\nWe can travel down one path until we see it is a dead end, or we can consider lots of different paths at the same time, expanding each path step by step.\nSearch problems are called *nondeterministic* because there is no way to determine what is the best step to take next.\nAI problems, by their very nature, tend to be nondeterministic.\nThis can be a source of confusion for programmers who are used to deterministic problems.\nIn this section we will try to clear up that confusion.\nThis section also serves as an example of how higher-order functions can be used to implement general tools that can be specified by passing in specific functions.\n\nAbstractly, a search problem can be characterized by four features:\n\n*  The *start* state.\n\n*  The *goal* state (or states).\n\n*  The *successors*, or states that can be reached from any other state.\n\n*  The *strategy* that determines the *order* in which we search.\n\nThe first three features are part of the problem, while the fourth is part of the solution.\nIn GPS, the starting state was given, along with a description of the goal states.\nThe successors of a state were determined by consulting the operators.\nThe search strategy was means-ends analysis.\nThis was never spelled out explicitly but was implicit in the structure of the whole program.\nIn this section we will formulate a general searching tool, show how it can be used to implement several different search strategies, and then show how GPS could be implemented with this tool.\n\nThe first notion we have to define is the *state space*, or set of all possible states.\nWe can view the states as nodes and the successor relation as links in a graph.\nSome state space graphs will have a small number of states, while others have an infinite number, but they can still be solved if we search cleverly.\nSome graphs will have a regular structure, while others will appear random.\nWe will start by considering only trees-that is, graphs where a state can be reached by only one unique sequence of successor links.\nHere is a tree:\n\n![u06-01-9780080571157](images/B9780080571157500066/u06-01-9780080571157.jpg)     \n\n### Searching Trees\n{:#s0035}\n{:.h2hd}\n\nWe will call our first searching tool `tree-search`, because it is designed to search state spaces that are in the form of trees.\nIt takes four arguments: (1) a list of valid starting states, (2) a predicate to decide if we have reached a goal state, (3) a function to generate the successors of a state, and (4) a function that decides in what order to search.\nThe first argument is a list rather than a single state so that `tree-search` can recursively call itself after it has explored several paths through the state space.\nThink of the first argument not as a starting state but as a list of possible states from which the goal may be reached.\nThis lists represents the fringe of the tree that has been explored so far.\n`tree-search` has three cases: If there are no more states to consider, then give up and return `fai1`.\nIf the first possible state is a goal state, then return the succesful state.\nOtherwise, generate the successors of the first state and combine them with the other states.\nOrder this combined list according to the particular search strategy and continue searching.\nNote that `tree-search` itself does not specify any particular searching strategy.\n\n```lisp\n(defun tree-search (states goal-p successors combiner)\n \"Find a state that satisfies goal-p. Start with states,\n and search according to successors and combiner.\"\n (dbg :search \"~&; ; Search: ~ a\" states)\n (cond ((null states) fail)\n   ((funcall goal-p (first states)) (first states))\n   (t (tree-search\n     (funcall combiner\n        (funcall successors (first states))\n        (rest states))\n     goal-p successors combiner))))\n```\n\nThe first strategy we will consider is called *depth*-*first search*.\nIn depth-first search, the longest paths are considered first.\nIn other words, we generate the successors of a state, and then work on the first successor first.\nWe only return to one of the subsequent successors if we arrive at a state that has no successors at all.\nThis strategy can be implemented by simply appending the previous states to the end of the list of new successors on each iteration.\nThe function `depth-first-search` takes a single starting state, a goal predicate, and a successor function.\nIt packages the starting state into a list as expected by `tree-search`, and specifies append as the combining function:\n\n```lisp\n(defun depth-first-search (start goal-p successors)\n \"Search new states first until goal is reached.\"\n (tree-search (list start) goal-p successors #'append))\n```\n\nLet's see how we can search through the binary tree defined previously.\nFirst, we define the successor function `binary-tree`.\nIt returns a list of two states, the two numbers that are twice the input state and one more than twice the input state.\nSo the successors of 1 will be 2 and 3, and the successors of 2 will be 4 and 5.\nThe `binary-tree` function generates an infinite tree of which the first 15 nodes are diagrammed in our example.\n\n```lisp\n(defun binary-tree (x) (list (* 2 x) (+ 1 (* 2 x))))\n```\n\nTo make it easier to specify a goal, we define the function is as a function that returns a predicate that tests for a particular value.\nNote that is does not do the test itself.\nRather, it returns a function that can be called to perform tests:\n\n```lisp\n(defun is (value) #'(lambda (x) (eq1 x value)))\n```\n\nNow we can turn on the debugging output and search through the binary tree, starting at 1, and looking for, say, 12, as the goal state.\nEach line of debugging output shows the list of states that have been generated as successors but not yet examined:\n\n```lisp\n> (debug :search) => (SEARCH)\n> (depth-first-search 1 (is 12) #'binary-tree)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (4 5 3)\n;; Search: (8 9 5 3)\n;; Search: (16 17 9 5 3)\n;; Search: (32 33 17 9 5 3)\n;; Search: (64 65 33 17 9 5 3)\n;; Search: (128 129 65 33 17 9 5 3)\n;; Search: (256 257 129 65 33 17 9 5 3)\n;; Search: (512 513 257 129 65 33 17 9 5 3)\n;; Search: (1024 1025 513 257 129 65 33 17 9 5 3)\n;; Search: (2048 2049 1025 513 257 129 65 33 17 9 5 3)\n[Abort]\n```\n\nThe problem is that we are searching an infinite tree, and the depth-first search strategy just dives down the left-hand branch at every step.\nThe only way to stop the doomed search is to type an interrupt character.\n\nAn alternative strategy is *breadth*-*first search*, where the shortest path is extended first at each step.\nIt can be implemented simply by appending the new successor states to the end of the existing states:\n\n```lisp\n(defun prepend (x y) \"Prepend y to start of x\" (append y x))\n(defun breadth-first-search (start goal-p successors)\n \"Search old states first until goal is reached.\"\n (tree-search (list start) goal-p successors #'prepend))\n```\n\nThe only difference between depth-first and breadth-first search is the difference between `append` and `prepend`.\nHere we see `breadth-first-search` in action:\n\n```lisp\n> (breadth-first-search 1 (is 12) 'binary-tree)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 4 5)\n;; Search: (4 5 6 7)\n;; Search: (5 6 7 8 9)\n;; Search: (6 7 8 9 10 11)\n;; Search: (7 8 9 10 11 12 13)\n;; Search: (8 9 10 11 12 13 14 15)\n;; Search: (9 10 11 12 13 14 15 16 17)\nSearch: (10 11 12 13 14 15 16 17 18 19)\n;; Search: (11 12 13 14 15 16 17 18 19 20 21)\n;; Search: (12 13 14 15 16 17 18 19 20 21 22 23)\n12\n```\n\nBreadth-first search ends up searching each node in numerical order, and so it will eventually find any goal.\nIt is methodical, but therefore plodding.\nDepth-first search will be much faster-if it happens to find the goal at all.\nFor example, if we were looking for 2048, depth-first search would find it in 12 steps, while breadth-first would take 2048 steps.\nBreadth-first search also requires more storage, because it saves more intermediate states.\n\nIf the search tree is finite, then either breadth-first or depth-first will eventually find the goal.\nBoth methods search the entire state space, but in a different order.\nWe will now show a depth-first search of the 15-node binary tree diagrammed previously.\nIt takes about the same amount of time to find the goal (12) as it did with breadth-first search.\nIt would have taken more time to find 15; less to find 8.\nThe big difference is in the number of states considered at one time.\nAt most, depth-first search considers four at a time; in general it will need to store only log2*n* states to search a *n*-node tree, while breadth-first search needs to store *n*/2 states.\n\n```lisp\n(defun finite-binary-tree (n)\n \"Return a successor function that generates a binary tree\n with n nodes.\"\n #'(lambda (x)\n     (remove-if #'(lambda (child) (> child n))\n        (binary-tree x))))\n(depth-first-search 1 (is 12) (finite-binary-tree 15))\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (4 5 3)\n;; Search: (8 9 5 3)\n;; Search: (9 5 3)\n;; Search: (5 3)\n;; Search: (10 11 3)\n;; Search: (11 3)\n;; Search: (3)\n;; Search: (6 7)\n;; Search: (12 13 7)\n12\n```\n\n### Guiding the Search\n{:#s0040}\n{:.h2hd}\n\nWhile breadth-first search is more methodical, neither strategy is able to take advantage of any knowledge about the state space.\nThey both search blindly.\nIn most real applications we will have some estimate of how far a state is from the solution.\nIn such cases, we can implement a *best*-*first search*.\nThe name is not quite accurate; if we could really search best first, that would not be a search at all.\nThe name refers to the fact that the state that *appears* to be best is searched first.\n\nTo implement best-first search we need to add one more piece of information: a cost function that gives an estimate of how far a given state is from the goal.\n\nFor the binary tree example, we will use as a cost estimate the numeric difference from the goal.\nSo if we are looking for 12, then 12 has cost 0, 8 has cost 4 and 2048 has cost 2036.\nThe higher-order function `diff`, shown in the following, returns a cost function that computes the difference from a goal.\nThe higher-order function sorter takes a cost function as an argument and returns a combiner function that takes the lists of old and new states, appends them together, and sorts the result based on the cost function, lowest cost first.\n(The built-in function `sort` sorts a list according to a comparison function.\nIn this case the smaller numbers come first.\n`sort` takes an optional : `key` argument that says how to compute the score for each element.\nBe careful-`sort` is a destructive function.)\n\n```lisp\n(defun diff (num)\n \"Return the function that finds the difference from num.\"\n #'(lambda (x) (abs (- x num))))\n(defun sorter (cost-fn)\n \"Return a combiner function that sorts according to cost-fn.\"\n #'(lambda (new old)\n   (sort (append new old) #'< :key cost-fn)))\n(defun best-first-search (start goal-p successors cost-fn)\n \"Search lowest cost states first until goal is reached.\"\n (tree-search (list start) goal-p successors (sorter cost-fn)))\n```\n\nNow, using the difference from the goal as the cost function, we can search using best-first search:\n\n```lisp\n> (best-first-search 1 (is 12) #'binary-tree (diff 12))\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (14 15 6 2)\n;; Search: (15 6 2 28 29)\n;; Search: (6 2 28 29 30 31)\n;; Search: (12 13 2 28 29 30 31)\n12\n```\n\nThe more we know about the state space, the better we can search.\nFor example, if we know that all successors are greater than the states they come from, then we can use a cost function that gives a very high cost for numbers above the goal.\nThe function `price- is - right` is like `diff`, except that it gives a high penalty for going over the goal.[3](#fn0025) Using this cost function leads to a near-optimal search on this example.\nIt makes the \"mistake\" of searching 7 before 6 (because 7 is closer to 12), but does not waste time searching 14 and 15:\n\n```lisp\n(defun price-is-right (price)\n \"Return a function that measures the difference from price,\n but gives a big penalty for going over price.\"\n #'(lambda (x) (if (> x price)\n       most-positive-fixnum\n       (- price x))))\n> (best-first-search 1 (is 12) #'binary-tree (price-is-right 12)) ;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (6 2 14 15)\n;; Search: (12 2 13 14 15)\n12\n```\n\nAll the searching methods we have seen so far consider ever-increasing lists of states as they search.\nFor problems where there is only one solution, or a small number of solutions, this is unavoidable.\nTo find a needle in a haystack, you need to look at a lot of hay.\nBut for problems with many solutions, it may be worthwhile to discard unpromising paths.\nThis runs the risk of failing to find a solution at all, but it can save enough space and time to offset the risk.\nA best-first search that keeps only a fixed number of alternative states at any one time is known as a *beam search*.\nThink of searching as shining a light through the dark of the state space.\nIn other search strategies the light spreads out as we search deeper, but in beam search the light remains tightly focused.\nBeam search is a variant of best-first search, but it is also similar to depth-first search.\nThe difference is that beam search looks down several paths at once, instead of just one, and chooses the best one to look at next.\nBut it gives up the ability to backtrack indefinitely.\nThe function `beam-search` is just like `best-first-search`, except that after we sort the states, we then take only the first `beam-width` states.\nThis is done with `subseq`; (`subseq`*list start end*) returns the sublist that starts at position *start* and ends just before position *end*.\n\n```lisp\n(defun beam-search (start goal-p successors cost-fn beam-width)\n \"Search highest scoring states first until goal is reached,\n but never consider more than beam-width states at a time.\"\n (tree-search (list start) goal-p successors\n    #'(lambda (old new)\n     (let ((sorted (funcall (sorter cost-fn) old new)))\n      (if (> beam-width (length sorted))\n       sorted\n       (subseq sorted0 beam-width))))))\n```\n\nWe can successfully search for 12 in the binary tree using a beam width of only 2:\n\n```lisp\n> (beam-search 1 (is 12) #'binary-tree (price-is-right 12) 2)\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6)\n;; Search: (6 14)\n;; Search: (12 13)\n12\n```\n\nHowever, if we go back to the scoring function that just takes the difference from 12, then beam search fails.\nWhen it generates 14 and 15, it throws away 6, and thus loses its only chance to find the goal:\n\n```lisp\n> (beam-search 1 (is 12) #'binary-tree (diff 12) 2)\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6)\n;; Search: (14 15)\n;; Search: (15 28)\n;; Search: (28 30)\n;; Search: (30 56)\n;; Search: (56 60)\n;; Search: (60 112)\n;; Search: (112 120)\n;; Search: (120 224)\n[Abort]\n```\n\nThis search would succeed if we gave a beam width of 3.\nThis illustrates a general principle: we can find a goal either by looking at more states, or by being smarter about the states we look at.\nThat means having a better ordering function.\n\nNotice that with a beam width of infinity we get best-first search.\nWith a beam width of 1, we get depth-first search with no backup.\nThis could be called \"depth-only search,\" but it is more commonly known as *hill*-*climbing*.\nThink of a mountaineer trying to reach a peak in a heavy fog.\nOne strategy would be for the mountaineer to look at adjacent locations, climb to the highest one, and look again.\nThis strategy may eventually hit the peak, but it may also get stuck at the top of a foothill, or *local maximum*.\nAnother strategy would be for the mountaineer to turn back and try again when the fog lifts, but in AI, unfortunately, the fog rarely lifts.[4](#fn0030)\n\nAs a concrete example of a problem that can be solved by search, consider the task of planning a flight across the North American continent in a small airplane, one whose range is limited to 1000 kilometers.\nSuppose we have a list of selected cities with airports, along with their position in longitude and latitude:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(defstruct (city (:type list)) name long lat)` |\n| `(defparameter *cities*` |\n| `'((Atlanta` | `84.23 33.45)` | `(Los-Angeles` | `118.15 34.03` |\n| `(Boston` | `71.05 42.21)` | `(Memphis` | `90.03 35.09)` |\n| `(Chicago` | `87.37 41.50)` | `(New-York` | `73.58 40.47)` |\n| `(Denver` | `105.00 39.45)` | `(Oklahoma-City` | `97.28 35.26)` |\n| `(Eugene` | `123.05 44.03)` | `(Pittsburgh` | `79.57 40.27)` |\n| `(Flagstaff` | `111.41 35.13)` | `(Quebec` | `71.11 46.49)` |\n| `(Grand-Jet` | `108.37 39.05)` | `(Reno` | `119.49 39.30)` |\n| `(Houston` | `105.00 34.00)` | `(San-Francisco` | `122.26 37.47)` |\n| `(Indianapolis` | `86.10 39.46)` | `(Tampa` | `82.27 27.57)` |\n| `(Jacksonville` | `81.40 30.22)` | `(Victoria` | `123.21 48.25)` |\n| `(Kansas-City` | `94.35 39.06)` | `(Wilmington` | `77.57 34.14)))` |\n\n![t0030](images/B9780080571157500066/t0030.png)\n\nThis example introduces a new option to `defstruct`.\nInstead of just giving the name of the structure, it is also possible to use:\n\n```lisp\n(defstruct *(structure*-*name (option value*)...) *\"optional doc\" slot*...)\n```\n\nFor city, the option : type is specified as `list`.\nThis means that cities will be implemented as lists of three elements, as they are in the initial value for `*cities*`.\n\nThe cities are shown on the map in [figure 6.1](#f0010), which has connections between all cities within the 1000 kilometer range of each other.[5](#fn0035) This map was drawn with the help of `air-distance`, a function that returns the distance in kilometers between two cities \"as the crow flies.\" It will be defined later.\nTwo other useful functions are `neighbors`, which finds all the cities within 1000 kilometers, and `city`, which maps from a name to a city.\nThe former uses `find-a11-if`, which was defined on [page 101](B9780080571157500030.xhtml#p101) as a synonym for `remove-if-not`.\n\n![f06-01-9780080571157](images/B9780080571157500066/f06-01-9780080571157.jpg)     \nFigure 6.1\n!!!(span) {:.fignum}\nA Map of Some Cities\n```lisp\n(defun neighbors (city)\n \"Find all cities within 1000 kilometers.\"\n (find-all-if #'(lambda (c)\n     (and (not (eq c city))\n       (< (air-distance c city) 1000.0)))\n    *cities*))\n(defun city (name)\n \"Find the city with this name.\"\n (assoc name *cities*))\n```\n\nWe are now ready to plan a trip.\nThe function `trip` takes the name of a starting and destination city and does a beam search of width one, considering all neighbors as successors to a state.\nThe cost for a state is the air distance to the destination city:\n\n```lisp\n(defun trip (start dest)\n \"Search for a way from the start to dest.\"\n (beam-search start (is dest) #'ne1ghbors\n     #'(lambda (c) (air-distance c dest))\n     1))\n```\n\nHere we plan a trip from San Francisco to Boston.\nThe result seems to be the best possible path:\n\n```lisp\n> (trip (city ' san-francisco) (city 'boston))\n;; Search: ((SAN-FRANCISCO 122.26 37.47))\n;; Search: ((RENO 119.49 39.3))\n;; Search: ((GRAND-JCT 108.37 39.05))\n;; Search: ((DENVER 105.0 39.45))\n;; Search: ((KANSAS-CITY 94.35 39.06))\n;; Search: ((INDIANAP0LIS 86.1 39.46))\n;; Search: ((PITTSBURGH 79.57 40.27))\n;; Search: ((BOSTON 71.05 42.21))\n(BOSTON 71.05 42.21)\n```\n\nBut look what happens when we plan the return trip.\nThere are two detours, to Chicago and Flagstaff:\n\n```lisp\n> (trip (city 'boston) (city 'san-francisco))\n;; Search: ((BOSTON 71.05 42.21))\n;; Search: ((PITTSBURGH 79.57 40.27))\n;; Search: ((CHICAGO 87.37 41.5))\n;; Search: ((KANSAS-CITY 94.35 39.06))\n;; Search: ((DENVER 105.0 39.45))\n;; Search: ((FLAGSTAFF 111.41 35.13))\n;; Search: ((RENO 119.49 39.3))\n;; Search: ((SAN-FRANCISCO 122.26 37.47))\n(SAN-FRANCISCO 122.26 37.47)\n```\n\nWhy did `trip` go from Denver to San Francisco via Flagstaff?\nBecause Flagstaff is closer to the destination than Grand Junction.\nThe problem is that we are minimizing the distance to the destination at each step, when we should be minimizing the sum of the distance to the destination plus the distance already traveled.\n\n### Search Paths\n{:#s0045}\n{:.h2hd}\n\nTo minimize the total distance, we need some way to talk about the *path* that leads to the goal.\nBut the functions we have defined so far only deal with individual states along the way.\nRepresenting paths would lead to another advantage: we could return the path as the solution, rather than just return the goal state.\nAs it is, `trip` only returns the goal state, not the path to it.\nSo there is no way to determine what `trip` has done, except by reading the debugging output.\n\nThe data structure path is designed to solve both these problems.\nA path has four fields: the current state, the previous partial path that this path is extending, the cost of the path so far, and an estimate of the total cost to reach the goal.\nHere is the structure definition for path.\nIt uses the : `print-function` option to say that all paths are to be printed with the function `print-path`, which will be defined below.\n\n```lisp\n(defstruct (path (:print-function print-path))\n  state (previous nil) (cost-so-far 0) (total-cost 0))\n```\n\nThe next question is how to integrate paths into the searching routines with the least amount of disruption.\nClearly, it would be better to make one change to `tree-search` rather than to change `depth-first-search`, `breadth-first-search`, and `beam-search`.\nHowever, looking back at the definition of `tree-search`, we see that it makes no assumptions about the structure of states, other than the fact that they can be manipulated by the goal predicate, successor, and combiner functions.\nThis suggests that we can use `tree-search` unchanged if we pass it paths instead of states, and give it functions that can process paths.\n\nIn the following redefinition of `trip`, the `beam-search` function is called with five arguments.\nInstead of passing it a city as the start state, we pass a path that has the city as its state field.\nThe goal predicate should test whether its argument is a path whose state is the destination; we assume (and later define) a version of `is` that accommodates this.\nThe successor function is the most difficult.\nInstead of just generating a list of neighbors, we want to first generate the neighbors, then make each one into a path that extends the current path, but with an updated cost so far and total estimated cost.\nThe function `path-saver` returns a function that will do just that.\nFinally, the cost function we are trying to minimize is `path-total-cost`, and we provide a beam width, which is now an optional argument to `trip` that defaults to one:\n\n```lisp\n(defun trip (start dest &optional (beam-width 1))\n \"Search for the best path from the start to dest.\"\n (beam-search\n  (make-path :state start)\n  (is dest :key #'path-state)\n  (path-saver #'neighbors #'air-distance\n     #,(lambda (c) (air-distance c dest)))\n#'path-total-cost\nbeam-width))\n```\n\nThe calculation of `air-distance` involves some complicated conversion of longitude and latitude to `x-y-z` coordinates.\nSince this is a problem in solid geometry, not AI, the code is presented without further comment:\n\n```lisp\n(defconstant earth-diameter 12765.0\n \"Diameter of planet earth in kilometers.\")\n(defun air-distance (city1 city2)\n \"The great circle distance between two cities.\"\n (let ((d (distance (xyz-coords city1) (xyz-coords city2))))\n  ;; d is the straight-1ine chord between the two cities,\n  ;; The length of the subtending arc is given by:\n  (* earth-diameter (asin (/ d 2)))))\n(defun xyz-coords (city)\n \"Returns the x,y,z coordinates of a point on a sphere.\n The center is (0 0 0) and the north pole is (0 0 1).\"\n (let ((psi (deg->radians (city-lat city)))\n    (phi (deg->radians (city-long city))))\n   (list (* (cos psi) (cos phi))\n      (* (cos psi) (sin phi))\n      (sin psi))))\n(defun distance (point1 point2)\n \"The Euclidean distance between two points.\n The points are coordinates in n-dimensional space.\"\n (sqrt (reduce #'+ (mapcar #'(lambda (a b) (expt (- a b) 2))\n        point1 point2))))\n(defun deg->radians (deg)\n \"Convert degrees and minutes to radians.\"\n (* (+ (truncate deg) (* (rem deg 1) 100/60)) pi 1/180))\n```\n\nBefore showing the auxiliary functions that implement this, here are some examples that show what it can do.\nWith a beam width of 1, the detour to Flagstaff is eliminated, but the one to Chicago remains.\nWith a beam width of 3, the correct optimal path is found.\nIn the following examples, each call to the new version of `trip` returns a path, which is printed by `show-city-path`:\n\n```lisp\n> (show-city-path (trip (city 'san-francisco) (city 'boston) 1))\n#<Path 4514.8 km: San-Francisco - Reno - Grand-Jet - Denver -\n Kansas-City - Indianapolis - Pittsburgh - Boston >\n> (show-city-path (trip (city 'boston) (city 'san-francisco) 1))\n#<Path 4577.3 km: Boston - Pittsburgh - Chicago - Kansas-City -\n Denver - Grand-Jet - Reno - San-Francisco >\n> (show-city-path (trip (city 'boston) (city 'san-francisco) 3))\n#<Path 4514.8 km: Boston - Pittsburgh - Indianapolis -\n Kansas-City - Denver - Grand-Jet - Reno - San-Francisco >\n```\n\nThis example shows how search is susceptible to irregularities in the search space.\nIt was easy to find the correct path from west to east, but the return trip required more search, because Flagstaff is a falsely promising step.\nIn general, there may be even worse dead ends lurking in the search space.\nLook what happens when we limit the airplane's range to 700 kilometers.\nThe map is shown in [figure 6.2](#f0015).\n\n![f06-02-9780080571157](images/B9780080571157500066/f06-02-9780080571157.jpg)     \nFigure 6.2\n!!!(span) {:.fignum}\nA Map of Cities within 700 km\nIf we try to plan a trip from Tampa to Quebec, we can run into problems with the dead end at Wilmington, North Carolina.\nWith a beam width of 1, the path to Jacksonville and then Wilmington will be tried first.\nFrom there, each step of the path alternates between Atlanta and Wilmington.\nThe search never gets any closer to the goal.\nBut with a beam width of 2, the path from Tampa to Atlanta is not discarded, and it is eventually continued on to Indianapolis and eventually to Quebec.\nSo the capability to back up is essential in avoiding dead ends.\n\nNow for the implementation details.\nThe function `is` still returns a predicate that tests for a value, but now it accepts : `key` and : `test` keywords:\n\n```lisp\n(defun is (value &key (key #'identity) (test #'eq1))\n \"Returns a predicate that tests for a given value.\"\n #'(lambda (path) (funcall test value (funcall key path))))\n```\n\nThe `path-saver` function returns a function that will take a path as an argument and generate successors paths.\n`path-saver` takes as an argument a successor function that operates on bare states.\nIt calls this function and, for each state returned, builds up a path that extends the existing path and stores the cost of the path so far as well as the estimated total cost:\n\n```lisp\n(defun path-saver (successors cost-fn cost-left-fn)\n #'(lambda (old-path)\n   (let ((old-state (path-state old-path)))\n    (mapcar\n     #'(lambda (new-state)\n      (let ((old-cost\n         (+ (path-cost-so-far old-path)\n           (funcall cost-fn old-state new-state))))\n       (make-path\n        :state new-state\n        :previous old-path\n        :cost-so-far old-cost\n        :total-cost (+ old-cost (funcall cost-left-fn\n            new-state)))))\n     (funcall successors old-state)))))\n```\n\nBy default a path structure would be printed as `#S ( PATH ... )`.\nBut because each path has a `previous` field that is filled by another path, this output would get quite verbose.\nThat is why we installed `print-path` as the print function for paths when we defined the structure.\nIt uses the notation `#<...>`, which is a Common Lisp convention for printing output that can not be reconstructed by `read`.\nThe function `show-city-path` prints a more complete representation of a path.\nWe also define `map-path` to iterate over a path, collecting values:\n\n```lisp\n(defun print-path (path &optional (stream t) depth)\n (declare (ignore depth))\n (format stream \"#<Path to ~a cost ~,lf>\"\n    (path-state path) (path-total-cost path)))\n(defun show-city-path (path &optional (stream t))\n \"Show the length of a path, and the cities along it.\"\n (format stream \"#<Path ~,lf km: ~{~:(~a~)~^- ~}>\"\n    (path-total-cost path)\n    (reverse (map-path #'city-name path)))\n (values))\n(defun map-path (fn path)\n \"Call fn on each state in the path, collecting results.\"\n (if (null path)\n   nil\n   (cons (funcall fn (path-state path))\n     (map-path fn (path-previous path)))))\n```\n\n### Guessing versus Guaranteeing a Good Solution\n{:#s0050}\n{:.h2hd}\n\nElementary AI textbooks place a great emphasis on search algorithms that are guaranteed to find the best solution.\nHowever, in practice these algorithms are hardly ever used.\nThe problem is that guaranteeing the best solution requires looking at a lot of other solutions in order to rule them out.\nFor problems with large search spaces, this usually takes too much time.\nThe alternative is to use an algorithm that will probably return a solution that is close to the best solution, but gives no guarantee.\nSuch algorithms, traditionally known as *non*-*admissible heuristic search* algorithms, can be much faster.\n\nOf the algorithms we have seen so far, best-first search almost, but not quite, guarantees the best solution.\nThe problem is that it terminates a little too early.\nSuppose it has calculated three paths, of cost 90, 95 and 110.\nIt will expand the 90 path next.\nSuppose this leads to a solution of total cost 100.\nBest-first search will then return that solution.\nBut it is possible that the 95 path could lead to a solution with a total cost less than 100.\nPerhaps the 95 path is only one unit away from the goal, so it could result in a complete path of length 96.\nThis means that an optimal search should examine the 95 path (but not the 110 path) before exiting.\n\nDepth-first search and beam search, on the other hand, are definitely heuristic algorithms.\nDepth-first search finds a solution without any regard to its cost.\nWith beam search, picking a good value for the beam width can lead to a good, quick solution, while picking the wrong value can lead to failure, or to a poor solution.\nOne way out of this dilemma is to start with a narrow beam width, and if that does not lead to an acceptable solution, widen the beam and try again.\nWe will call this *iterative widening*, although that is not a standard term.\nThere are many variations on this theme, but here is a simple one:\n\n```lisp\n(defun iter-wide-search (start goal-p successors cost-fn\n        &key (width 1) (max 100))\n \"Search, increasing beam width from width to max.\n Return the first solution found at any width.\"\n (dbg :search \"; Width: ~d\" width)\n (unless (> width max)\n  (or (beam-search start goal-p successors cost-fn width)\n   (iter-wide-search start goal-p successors cost-fn\n            :width (+ width 1) :max max))))\n```\n\nHere `iter-wide-search` is used to search through a binary tree, failing with beam width 1 and 2, and eventually succeeding with beam width 3:\n\n```lisp\n> (iter-wide-search 1 (is 12) (finite-binary-tree 15) (diff 12))\nWidth: 1\n;; Search: (1)\n;; Search: (3)\n;; Search: (7)\n;; Search: (14)\n; Width: 2\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6)\n;; Search: (14 15)\n;; Search: (15)\n;; Search: NIL\n; Width: 3\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (14 15 6)\n;; Search: (15 6)\n;; Search: (6)\n;; Search: (12 13)\n12\n```\n\nThe name iterative widening is derived from the established term *iterative deepening*.\nIterative deepening is used to control depth-first search when we don't know the depth of the desired solution.\nThe idea is first to limit the search to a depth of 1, then 2, and so on.\nThat way we are guaranteed to find a solution at the minimum depth, just as in breadth-first search, but without wasting as much storage space.\nOf course, iterative deepening does waste some time because at each increasing depth it repeats all the work it did at the previous depth.\nBut suppose that the average state has ten successors.\nThat means that increasing the depth by one results in ten times more search, so only 10% of the time is wasted on repeated work.\nSo iterative deepening uses only slightly more time and much less space.\nWe will see it again in [chapters 11](B978008057115750011X.xhtml) and [18](B9780080571157500182.xhtml).\n\n### Searching Graphs\n{:#s0055}\n{:.h2hd}\n\nSo far, `tree-search` has been the workhorse behind all the searching routines.\nThis is curious, when we consider that the city problem involves a graph that is not a tree at all.\nThe reason `tree-search` works is that any graph can be treated as a tree, if we ignore the fact that certain nodes are identical.\nFor example, the graph in [figure 6.3](#f0020) can be rendered as a tree.\n[Figure 6.4](#f0025) shows only the top four levels of the tree; each of the bottom nodes (except the 6 s) needs to be expanded further.\n\n![f06-03-9780080571157](images/B9780080571157500066/f06-03-9780080571157.jpg)     \nFigure 6.3\n!!!(span) {:.fignum}\nA Graph with Six Nodes\n![f06-04-9780080571157](images/B9780080571157500066/f06-04-9780080571157.jpg)     \nFigure 6.4\n!!!(span) {:.fignum}\nThe Corresponding Tree\nIn searching for paths through the graph of cities, we were implicitly turning the graph into a tree.\nThat is, if `tree-search` found two paths from Pittsburgh to Kansas City (via Chicago or Indianapolis), then it would treat them as two independent paths, just as if there were two distinct Kansas Cities.\nThis made the algorithms simpler, but it also doubles the number of paths left to examine.\nIf the destination is San Francisco, we will have to search for a path from Kansas City to San Francisco twice instead of once.\nIn fact, even though the graph has only 22 cities, the tree is infinite, because we can go back and forth between adjacent cities any number of times.\nSo, while it is possible to treat the graph as a tree, there are potential savings in treating it as a true graph.\n\nThe function `graph-search` does just that.\nIt is similar to `tree-search`, but accepts two additional arguments: a comparison function that tests if two states are equal, and a list of states that are no longer being considered, but were examined in the past.\nThe difference between `graph-search` and `tree-search` is in the call to `new-states`, which generates successors but eliminates states that are in either the list of states currently being considered or the list of old states considered in the past.\n\n```lisp\n(defun graph-search (states goal-p successors combiner\n        &optional (state = #'eq1) old-states)\n \"Find a state that satisfies goal-p. Start with states,\n and search according to successors and combiner.\n Don't try the same state twice.\"\n (dbg :search \"~&;; Search: ~a\" states)\n (cond ((null states) fail)\n    ((funcall goal-p (first states)) (first states))\n    (t (graph-search\n      (funcall\n       combiner\n       (new-states states successors state = old-states)\n       (rest states))\n      goal-p successors combiner state =\n      (adjoin (first states) old-states\n           :test state =)))))\n(defun new-states (states successors state = old-states)\n \"Generate successor states that have not been seen before.\"\n (remove-if\n  #'(lambda (state)\n   (or (member state states :test state =)\n    (member state old-states :test state =)))\n   (funcall successors (first states))))\n```\n\nUsing the successor function `next2`, we can search the graph shown here either as a tree or as a graph.\nIf we search it as a graph, it takes fewer iterations and less storage space to find the goal.\nOf course, there is additional overhead to test for identical states, but on graphs like this one we get an exponential speed-up for a constant amount of overhead.\n\n```lisp\n(defun next2 (x) (list (+ x 1) (+ x 2)))\n> (tree-search '(1) (is 6) #'next2 #'prepend)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 3 4)\n;; Search: (3 4 4 5)\n;; Search:(4 4 5 4 5)\n;; Search: (4 5 4 5 5 6)\n;; Search: (5 4 5 5 6 5 6)\n;; Search: (4 5 5 6 5 6 6 7)\n;; Search: (5 5 6 5 6 6 7 5 6)\n;; Search: (5 6 5 6 6 7 5 6 6 7)\n;; Search: (6 5 6 6 7 5 6 6 7 6 7)\n6\n> (graph-search '(1) (is 6) #'next2 #'prepend)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 4)\n;; Search: (4 5)\n;; Search: (5 6)\n;; Search: (6 7)\n6\n```\n\nThe next step is to extend the `graph-search` algorithm to handle paths.\nThe complication is in deciding which path to keep when two paths reach the same state.\nIf we have a cost function, then the answer is easy: keep the path with the cheaper cost.\nBest-first search of a graph removing duplicate states is called *A* * *search*.\n\nA* search is more complicated than `graph-search` because of the need both to add and to delete paths to the lists of current and old paths.\nFor each new successor state, there are three possibilites.\nThe new state may be in the list of current paths, in the list of old paths, or in neither.\nWithin the first two cases, there are two subcases.\nIf the new path is more expensive than the old one, then ignore the new path-it can not lead to a better solution.\nIf the new path is cheaper than a corresponding path in the list of current paths, then replace it with the new path.\nIf it is cheaper than a corresponding path in the list of the old paths, then remove that old path, and put the new path in the list of current paths.\n\nAlso, rather than sort the paths by total cost on each iteration, they are kept sorted, and new paths are inserted into the proper place one at a time using `insert-path`.\nTwo more functions, `better-path` and `find-path`, are used to compare paths and see if a state has already appeared.\n\n```lisp\n(defun a*-search (paths goal-p successors cost-fn cost-left-fn\n      &optional (state = #'eq1) old-paths)\n \"Find a path whose state satisfies goal-p. Start with paths,\n and expand successors, exploring least cost first.\n When there are duplicate states, keep the one with the\n lower cost and discard the other.\"\n (dbg :search \";; Search: ~a\" paths)\n (cond\n  ((null paths) fail)\n  ((funcall goal-p (path-state (first paths)))\n   (values (first paths) paths))\n  (t (let* ((path (pop paths))\n     (state (path-state path)))\n    ;; Update PATHS and OLD-PATHS to reflect\n    ;; the new successors of STATE:\n    (setf old-paths (insert-path path old-paths))\n    (dolist (state2 (funcall successors state))\n     (let* ((cost (+ (path-cost-so-far path)\n            (funcall cost-fn state state2)))\n       (cost2 (funcall cost-left-fn state2))\n       (path2 (make-path\n            :state state2 :previous path\n            :cost-so-far cost\n            :total-cost (+ cost cost2)))\n       (old nil)\n      ;; Place the new path, path2, in the right list:\n      (cond\n       ((setf old (find-path state2 paths state =))\n       (when (better-path path2 old)\n        (setf paths (insert-path\n             path2 (delete old paths)))))\n       ((setf old (find-path state2 old-paths state =))\n       (when (better-path path2 old)\n        (setf paths (insert-path path2 paths))\n        (setf old-paths (delete old old-paths))))\n       (t (setf paths (insert-path path2 paths))))))\n     ;; Finally, call A* again with the updated path lists:\n     (a*-search paths goal-p successors cost-fn cost-left-fn\n     state = old-paths)))))\n```\n\nHere are the three auxiliary functions:\n\n```lisp\n(defun find-path (state paths state =)\n \"Find the path with this state among a list of paths.\"\n (find state paths :key #'path-state :test state =))\n(defun better-path (pathl path2)\n \"Is path1 cheaper than path2?\"\n (< (path-total-cost path1) (path-total-cost path2)))\n(defun insert-path (path paths)\n \"Put path into the right position, sorted by total cost.\"\n ;; MERGE is a built-in function\n (merge 'list (list path) paths #'< :key #'path-total-cost))\n(defun path-states (path)\n \"Collect the states along this path.\"\n (if (null path)\n   nil\n   (cons (path-state path)\n      (path-states (path-previous path)))))\n```\n\nBelow we use `a*-search` to search for 6 in the graph previously shown in [figure 6.3](#f0020).\nThe cost function is a constant 1 for each step.\nIn other words, the total cost is the length of the path.\nThe heuristic evaluation function is just the difference from the goal.\nThe A* algorithm needs just three search steps to come up with the optimal solution.\nContrast that to the graph search algorithm, which needed five steps, and the tree search algorithm, which needed ten steps-and neither of them found the optimal solution.\n\n```lisp\n> (path-states\n   (a*-search (list (make-path :state 1)) (is 6)\n          #'next2 #'(lambda (x y) 1) (diff 6)))\n;; Search: (#<Path to 1 cost 0.0 >)\n;; Search: (#<Path to 3 cost 4.0 > #<Path to 2 cost 5.0 >)\n;; Search: (#<Path to 5 cost 3.0 > #<Path to 4 cost 4.0 >\n        #<Path to 2 cost 5.0 >)\n;; Search: (#<Path to 6 cost 3.0 > #<Path to 7 cost 4.0 >\n        #<Path to 4 cost 4.0 > #<Path to 2 cost 5.0 >)\n(6 5 3 1)\n```\n\nIt may seem limiting that these search functions all return a single answer.\nIn some applications, we may want to look at several solutions, or at all possible solutions.\nOther applications are more naturally seen as optimization problems, where we don't know ahead of time what counts as achieving the goal but are just trying to find some action with a low cost.\n\nIt turns out that the functions we have defined are not limiting at all in this respect.\nThey can be used to serve both these new purposes-provided we carefully specify the goal predicate.\nTo find all solutions to a problem, all we have to do is pass in a goal predicate that always fails, but saves all the solutions in a list.\nThe goal predicate will see all possible solutions and save away just the ones that are real solutions.\nOf course, if the search space is infinite this will never terminate, so the user has to be careful in applying this technique.\nIt would also be possible to write a goal predicate that stopped the search after finding a certain number of solutions, or after looking at a certain number of states.\nHere is a function that finds all solutions, using beam search:\n\n```lisp\n(defun search-all (start goal-p successors cost-fn beam-width)\n \"Find all solutions to a search problem, using beam search.\"\n ;; Be careful: this can lead to an infinite loop.\n (let ((solutions nil))\n  (beam-search\n   start #'(lambda (x)\n       (when (funcall goal-p x) (push x solutions))\n       nil)\n   successors cost-fn beam-width)\n solutions))\n```\n\n## 6.5 GPS as Search\n{:#s0060}\n{:.h1hd}\n\nThe GPS program can be seen as a problem in search.\nFor example, in the three-block blocks world, there are only 13 different states.\nThey could be arranged in a graph and searched just as we searched for a route between cities.\n[Figure 6.5](#f0030) shows this graph.\n\n![f06-05-9780080571157](images/B9780080571157500066/f06-05-9780080571157.jpg)     \nFigure 6.5\n!!!(span) {:.fignum}\nThe Blocks World as a Graph\nThe function `search-gps` does just that.\nLike the gps function on [page 135](B9780080571157500042.xhtml#p135), it computes a final state and then picks out the actions that lead to that state.\nBut it computes the state with a beam search.\nThe goal predicate tests if the current state satisfies every condition in the goal, the successor function finds all applicable operators and applies them, and the cost function simply sums the number of actions taken so far, plus the number of conditions that are not yet satisfied:\n\n```lisp\n(defun search-gps (start goal &optional (beam-width 10))\n \"Search for a sequence of operators leading to goal.\"\n (find-all-if\n  #'action-p\n  (beam-search\n   (cons '(start) start)\n   #'(lambda (state) (subsetp goal state :test #'equal))\n   #'gps-successors\n   #'(lambda (state)\n    (+ (count-if #'action-p state)\n     (count-if #'(lambda (con)\n          (not (member-equal con state)))\n        goal)))\n   beam-width)))\n```\n\nHere is the successor function:\n\n```lisp\n(defun gps-successors (state)\n \"Return a list of states reachable from this one using ops.\"\n (mapcar\n  #'(lambda (op)\n  (append\n   (remove-if #'(lambda (x)\n          (member-equal x (op-del-list op)))\n        state)\n   (op-add-list op)))\n  (applicable-ops state)))\n(defun applicable-ops (state)\n \"Return a list of all ops that are applicable now.\"\n (find-all-if\n  #'(lambda (op)\n    (subsetp (op-preconds op) state :test #'equal))\n  *ops*))\n```\n\nThe search technique finds good solutions quickly for a variety of problems.\nHere we see the solution to the Sussman anomaly in the three-block blocks world:\n\n```lisp\n(setf start '((c on a) (a on table) (b on table) (space on c)\n      (space on b) (space on table)))\n> (search-gps start '((a on b) (b on c)))\n((START)\n (EXECUTING (MOVE C FROM A TO TABLE))\n (EXECUTING (MOVE B FROM TABLE TO C))\n (EXECUTING (MOVE A FROM TABLE TO B)))\n> (search-gps start '((b on c) (a on b)))\n((START)\n (EXECUTING (MOVE C FROM A TO TABLE))\n (EXECUTING (MOVE B FROM TABLE TO C))\n (EXECUTING (MOVE A FROM TABLE TO B)))\n```\n\nIn these solutions we search forward from the start to the goal; this is quite different from the means-ends approach of searching backward from the goal for an appropriate operator.\nBut we could formulate means-ends analysis as forward search simply by reversing start and goal: GPS's goal state is the search's start state, and the search's goal predicate tests to see if a state matches GPS's start state.\nThis is left as an exercise.\n\n## 6.6 History and References\n{:#s0065}\n{:.h1hd}\n\nPattern matching is one of the most important tools for AI.\nAs such, it is covered in most textbooks on Lisp.\nGood treatments include Abelson and Sussman (1984), [Wilensky (1986)](B9780080571157500285.xhtml#bb1390), [Winston and Horn (1988)](B9780080571157500285.xhtml#bb1410), and [Kreutzer and McKenzie (1990)](B9780080571157500285.xhtml#bb0680).\nAn overview is presented in the \"pattern-matching\" entry in *Encyclopedia of AI* ([Shapiro 1990](B9780080571157500285.xhtml#bb1085)).\n\nNilsson's *Problem*-*Solving Methods in Artificial Intelligence* (1971) was an early text-book that emphasized search as the most important defining characteristic of AI.\nMore recent texts give less importance to search; Winston's *Artificial Intelligence* (1984) gives a balanced overview, and his *Lisp* (1988) provides implementations of some of the algorithms.\nThey are at a lower level of abstraction than the ones in this chapter.\nIterative deepening was first presented by [Korf (1985)](B9780080571157500285.xhtml#bb0640), and iterative broadening by [Ginsberg and Harvey (1990)](B9780080571157500285.xhtml#bb0470).\n\n## 6.7 Exercises\n{:#s0070}\n{:.h1hd}\n\n**Exercise 6**.**3** [**m**] Write a version of `interaetive-interpreter` that is more general than the one defined in this chapter.\nDecide what features can be specified, and provide defaults for them.\n\n**Exercise 6**.**4** [**m**] Define a version of `compose` that allows any number of arguments, not just two.\nHint: You may want to use the function `reduce`.\n\n**Exercise 6**.**5** [**m**] Define a version of `compose` that allows any number of arguments but is more efficient than the answer to the previous exercise.\nHint: try to make decisions when `compose` is called to build the resulting function, rather than making the same decisions over and over each time the resulting function is called.\n\n**Exercise 6**.**6** [**m**] One problem with `pat-match` is that it gives special significance to symbols starting with ?, which means that they can not be used to match a literal pattern.\nDefine a pattern that matches the input literally, so that such symbols can be matched.\n\n**Exercise 6**.**7** [**m**] Discuss the pros and cons of data-driven programming compared to the conventional approach.\n\n**Exercise 6**.**8** [**m**] Write a version of `tree-search` using an explicit loop rather than recursion.\n\n**Exercise 6**.**9** [**m**] The `sorter` function is inefficient for two reasons: it calls `append`, which has to make a copy of the first argument, and it sorts the entire result, rather than just inserting the new states into the already sorted *old* states.\nWrite a more efficient `sorter`.\n\n**Exercise 6**.**10** [**m**] Write versions of `graph-search` and `a*-search` that use hash tables rather than lists to test whether a state has been seen before.\n\n**Exercise 6**.**11** [**m**] Write a function that calls `beam-search` to find the first *n* solutions to a problem and returns them in a list.\n\n**Exercise 6**.**12** [**m**] On personal computers without floating-point hardware, the `air-distance` calculation will be rather slow.\nIf this is a problem for you, arrange to compute the `xyz-coords` of each city only once and then store them, or store a complete table of air distances between cities.\nAlso precompute and store the neighbors of each city.\n\n**Exercise 6**.**13** [**d**] Write a version of GPS that uses A* search instead of beam search.\nCompare the two versions in a variety of domains.\n\n**Exercise 6**.**14** [**d**] Write a version of GPS that allows costs for each operator.\nFor example, driving the child to school might have a cost of 2, but calling a limousine to transport the child might have a cost of 100.\nUse these costs instead of a constant cost of 1 for each operation.\n\n**Exercise 6**.**15** [**d**] Write a version of GPS that uses the searching tools but does means-ends analysis.\n\n## 6.8 Answers\n{:#s0075}\n{:.h1hd}\n\n**Answer 6**.**2** Unfortunately, `pat-match` does not always find the answer.\nThe problem is that it will only rebind a segment variable based on a failure to match the rest of the pattern after the segment variable.\nIn all the examples above, the \"rest of the pattern after the segment variable\" was the whole pattern, so `pat-match` always worked properly.\nBut if a segment variable appears nested inside a list, then the rest of the segment variable's sublist is only a part of the rest of the whole pattern, as the following example shows:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (pat-match` | `'(((?* ?x) (?* ?y)) ?x ?y)` |\n| | `'((a b c d ) (a b) (c d)))`=> `NIL` |\n\nThe correct answer with `?x` bound to `(a b)` and `?y` bound to `(c d)` is not found because the inner segment match succeeds with `?x` bound to `( )` and `?y` bound to `(a b c d)`, and once we leave the inner match and return to the top level, there is no going back for alternative bindings.\n\n**Answer 6**.**3** The following version lets the user specify all four components of the prompt-read-eval-print loop, as well as the streams to use for input and output.\nDefaults are set up as for a Lisp interpreter.\n\n```lisp\n(defun interactive-interpreter\n    (&key (read #'read) (eval #'eval) (print #'print)\n     (prompt \"> \") (input t) (output t))\n \"Read an expression, evaluate it, and print the result.\"\n (loop\n  (fresh-line output)\n  (princ prompt output)\n   (funcall print (funcall eval (funcall read input))\n       output)))\n```\n\nHere is another version that does all of the above and also handles multiple values and binds the various \"history variables\" that the Lisp top-level binds.\n\n```lisp\n(defun interactive-interpreter\n   (&key (read #'read) (eval #'eval) (print #'print)\n   (prompt \"> \") (input t) (output t))\n \"Read an expression, evaluate it, and print the result(s).\n Does multiple values and binds: * ** ***-+ ++ +++/ // ///\"\n (let (* ** ***-+ ++ +++/ // /// vais)\n  ;; The above variables are all special, except VALS\n  ;; The variable - holds the current input\n  ;; * *** *** are the 3 most recent values\n  ;; + ++ +++ are the 3 most recent inputs\n  ;;/ // /// are the 3 most recent lists of multiple-values\n  (loop\n   (fresh-line output)\n   (princ prompt output)\n   ;; First read and evaluate an expression\n   (setf - (funcall read input)\n     vals (multiple-value-list (funcall eval -)))\n   ;; Now update the history variables\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(setf +++ ++` | `/// //` | `*** (first ///)` |\n| `++ +` | `// /` | `** (first //)` |\n| `+ -` | `/ vais` | `* (first /))` |\n\n```lisp\n   ;; Finally print the computed value(s)\n   (dolist (value vais)\n    (funcall print value output)))))\n```\n\n**Answer 6**.**4**\n\n```lisp\n(defun compose (&rest functions)\n \"Return the function that is the composition of all the args.\n i.e. (compose f g h) = (lambda (x) (f (g (h x)))).\n \" #'(lambda (x)\n   (reduce #'funcall functions :from-end t .-initial-value x)))\n```\n\n**Answer 6**.**5**\n\n```lisp\n(defun compose (&rest functions)\n \"Return the function that is the composition of all the args.\n i.e. (compose f g h) = (lambda (x) (f (g (h x)))).\"\n (case (length functions)\n  (0 #'identity)\n  (1 (first functions))\n  (2 (let ((f (first functions))\n      (g (second functions)))\n    #'(lambda (x) (funcall f (funcall g x)))))\n  (t #'(lambda (x)\n     (reduce #'funcall functions :from-end t\n         :initia1-value x)))))\n```\n\n**Answer 6**.**8**\n\n```lisp\n(defun tree-search (states goal-p successors combiner)\n \"Find a state that satisfies goal-p. Start with states,\n and search according to successors and combiner.\"\n (loop\n  (cond ((null states) (RETURN fail))\n     ((funcall goal-p (first states))\n     (RETURN (first states))\n     (t (setf states\n         (funcall combiner\n             (funcall successors (first states))\n             (rest states))))))))\n```\n\n**Answer 6**.**9**\n\n```lisp\n(defun sorter (cost-fn)\n \"Return a combiner function that sorts according to cost-fn.\"\n #'(lambda (new old)\n   (merge 'list (sort new #'> :key cost-fn)\n     old #'> :key cost-fn)))\n```\n\n**Answer 6**.**11**\n\n```lisp\n(defun search-n (start n goal-p successors cost-fn beam-width)\n \"Find n solutions to a search problem, using beam search.\"\n (let ((solutions nil))\n  (beam-search\n   start #'(lambda (x)\n     (cond ((not (funcall goal-p x)) nil)\n       ((= n 0) x)\n       (t (decf n)\n         (push x solutions)\n         nil)))\n   successors cost-fn beam-width)\n  solutions))\n```\n\n----------------------\n\n[1](#xfn0015) The macro `handler-case` is only in ANSI Common Lisp.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0020) An alternative would be to reserve the question mark for variables only and use another notation for these match operators.\nKeywords would be a good choice, such as : `and, : or,``: is`, etc.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0025) The built-in constant `most-positive-fixnum` is a large integer, the largest that can be expressed without using bignums.\nIts value depends on the implementation, but in most Lisps it is over 16 million.\n!!!(p) {:.ftnote1}\n\n[4](#xfn0030) In [chapter 8](B978008057115750008X.xhtml) we will see an example where the fog did lift: symbolic integration was once handled as a problem in search, but new mathematical results now make it possible to solve the same class of integration problems without search.\n!!!(p) {:.ftnote1}\n\n[5](#xfn0035) The astute reader will recognize that this graph is not a tree.\nThe difference between trees and graphs and the implications for searching will be covered later.\n!!!(p) {:.ftnote1}\n\n# Chapter 7\n## STUDENT: Solving Algebra Word Problems\n{:.chaptitle}\n\n> *[This] is an example par excellence* of the power of using meaning to solve linguistic problems\n\n> -[Marvin Minsky (1968)](B9780080571157500285.xhtml#bb0845)\n\n> MIT computer scientist\n\nSTUDENT !!!(span) {:.smallcaps} was another early language understanding program, written by Daniel Bobrow as his Ph.D.\nresearch project in 1964.\nIt was designed to read and solve the kind of word problems found in high school algebra books.\nAn example is:\n\n> If the number of customers Tom gets is twice the square of 20% of the number of advertisements he runs, and the number of advertisements is 45, then what is the number of customers Tom gets?\n\nSTUDENT !!!(span) {:.smallcaps} could correctly reply that the number of customers is 162.\nTo do this, STUDENT !!!(span) {:.smallcaps} must be far more sophisticated than ELIZA !!!(span) {:.smallcaps} ; it must process and \"understand\" a great deal of the input, rather than just concentrate on a few key words.\nAnd it must compute a response, rather than just fill in blanks.\nHowever, we shall see that the STUDENT !!!(span) {:.smallcaps} program uses little more than the pattern-matching techniques of ELIZA !!!(span) {:.smallcaps} to translate the input into a set of algebraic equations.\nFrom there, it must know enough algebra to solve the equations, but that is not very difficult.\n\nThe version of STUDENT !!!(span) {:.smallcaps} we develop here is nearly a full implementation of the original.\nHowever, remember that while the original was state-of-the-art as of 1964, AI has made some progress in a quarter century, as subsequent chapters will attempt to show.\n\n## 7.1 Translating English into Equations\n{:#s0010}\n{:.h1hd}\n\nThe description of STUDENT !!!(span) {:.smallcaps} is:\n\n1. Break the input into phrases that will represent equations.\n!!!(p) {:.numlist}\n\n2. Break each phrase into a pair of phrases on either side of the = sign.\n!!!(p) {:.numlist}\n\n3. Break these phrases down further into sums and products, and so on, until finally we bottom out with numbers and variables.\n(By \"variable\" here, I mean \"mathematical variable,\" which is distinct from the idea of a \"pattern-matching variable\" as used in `pat-match` in [chapter 6](B9780080571157500066.xhtml)).\n!!!(p) {:.numlist}\n\n4. Translate each English phrase into a mathematical expression.\nWe use the idea of a rule-based translator as developed for ELIZA !!!(span) {:.smallcaps} .\n!!!(p) {:.numlist}\n\n5. Solve the resulting mathematical equations, coming up with a value for each unknown variable.\n!!!(p) {:.numlist}\n\n6. Print the values of all the variables.\n!!!(p) {:.numlist}\n\nFor example, we might have a pattern of the form (`If ?x then ?y`), with an associated response that says that `?x` and `?y` will each be equations or lists of equations.\nApplying the pattern to the input above, `?y` would have the value (`what is the number of customers Tomgets`).\nAnother pattern of the form (`?x is ?y`) could have a response corresponding to an equation where `?x` and `?y` are the two sides of the equation.\nWe could then make up a mathematical variable for (`what`) and another for (`the number of customers Tom gets`).\nWe would recognize this later phrase as a variable because there are no patterns to break it down further.\nIn contrast, the phrase (`twice the square of 20 per cent of the number of advertisements he runs`) could match a pattern of the form (`twice ?x`) and transform to `(* 2 (the square of 20 per cent of the number of advertisements he runs)),` and by further applying patterns of the form (`the square of ?x`) and (`?x per cent of ?y`) we could arrive at a final response of `(* 2 (expt (* (/ 20 100) n) 2))`, where `n` is the variable generated by (`the number of advertisements he runs`).\n\nThus, we need to represent variables, expressions, equations, and sets of equations.\nThe easiest thing to do is to use something we know: represent them just as Lisp itself does.\nVariables will be symbols, expressions and equations will be nested lists with prefix operators, and sets of equations will be lists of equations.\nWith that in mind, we can define a list of pattern-response rules corresponding to the type of statements found in algebra word problems.\nThe structure definition for a rule is repeated here, and the structure `exp`, an expression, is added.\n`lhs` and `rhs` stand for left-and right-hand side, respectively.\nNote that the constructor `mkexp` is defined as a constructor that builds expressions without taking keyword arguments.\nIn general, the notation (`:constructor`*fn args*) creates a constructor function with the given name and argument list.[1](#fn0015)\n\n```lisp\n(defstruct (rule (:type list)) pattern response)\n(defstruct (exp (:type list)\n            (:constructor mkexp (lhs op rhs)))\n   op lhs rhs)\n(defun exp-p (x) (consp x))\n(defun exp-args (x) (rest x))\n```\n\nWe ignored commas and periods in ELIZA !!!(span) {:.smallcaps} , but they are crucial for STUDENT !!!(span) {:.smallcaps} , so we must make allowances for them.\nThe problem is that a `\",\"` in Lisp normally can be used only within a backquote construction, and a `\".\"` normally can be used only as a decimal point or in a dotted pair.\nThe special meaning of these characters to the Lisp reader can be escaped either by preceding the character with a backslash (\\,) or by surrounding the character by vertical bars (| , |).\n\n```lisp\n(pat-match-abbrev '?x* '(?* ?x))\n(pat-match-abbrev '?y* '(?* ?y))\n(defparameter *student-rules* (mapcar #'expand-pat-match-abbrev\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `'(((?x* |.|)` | `    ?x)` |\n| `  ((?x* |.| ?y*)` | `(?x ?y))` |\n| `  ((if ?x* |,| then ?y*)` | `(?x ?y))` |\n| `  ((if ?x* then ?y*)` | `(?x ?y))` |\n| `  ((if ?x* |,| ?y*)` | `(?x ?y))` |\n| `  ((?x* |,| and ?y*)` | `(?x ?y))` |\n| `  ((find ?x* and ?y*)` | `((= to-find-1 ?x) (= to-find-2 ?y)))` |\n| `  ((find ?x*)` | `(= to-find ?x))` |\n| `  ((?x* equals ?y*)` | `(= ?x ?y))` |\n| `  ((?x* same as ?y*)` | `(= ?x ?y))` |\n| `  ((?x* = ?y*)` | `(= ?x ?y))` |\n| `  ((?x* is equal to ?y*)` | `(= ?x ?y))` |\n| `  ((?x* is ?y*)` | `(= ?x ?y))` |\n| `  ((?x* - ?y*)` | `(- ?x ?y))` |\n| `  ((?x* minus ?y*)` | `(- ?x ?y))` |\n| `((difference between ?x* and ?y*)` | `(- ?y ?x))` |\n| `((difference ?x* and ?y*)` | `(- ?y ?x))` |\n| `((?x* + ?y*)` | `(+ ?x ?y))` |\n| `((?x* plus ?y*)` | `(+ ?x ?y))` |\n| `((sum ?x* and ?y*)` | `(+ ?x ?y))` |\n| `((product ?x* and ?y*)` | `(* ?x ?y))` |\n| `((?x* * ?y*)` | `(* ?x ?y))` |\n| `((?x* times ?y*)` | `(* ?x ?y))` |\n| `((?x* / ?y*)` | `(/ ?x ?y))` |\n| `((?x* per ?y*)` | `(/ ?x ?y))` |\n| `((?x* divided by ?y*)` | `(/ ?x ?y))` |\n| `((half ?x*)` | `(/ ?x 2))` |\n| `((one half ?x*)` | `(/ ?x 2))` |\n| `((twice ?x*)` | `(* 2 ?x))` |\n| `((square ?x*)` | `(* ?x ?x))` |\n| `((?x* % less than ?y*)` | `(* ?y (/ (- 100 ?x) 100)))` |\n| `((?x* % more than ?y*)` | `(* ?y (/ (+ 100 ?x) 100)))` |\n| `((?x* % ?y*)` | `(* (/ ?x 100) ?y)))))` |\n\nThe main section of STUDENT !!!(span) {:.smallcaps} will search through the list of rules for a response, just as ELIZA !!!(span) {:.smallcaps} did.\nThe first point of deviation is that before we substitute the values of the `pat-match` variables into the response, we must first recursively translate the value of each variable, using the same list of pattern-response rules.\nThe other difference is that once we're done, we don't just print the response; instead we have to solve the set of equations and print the answers.\nThe program is summarized in [figure 7.1](#f0010).\n\n![f08-01-9780080571157](images/B9780080571157500078/f08-01-9780080571157.jpg)     \nFigure 7.1\n!!!(span) {:.fignum}\nGlossary for the STUDENT\n!!!(span) {:.smallcaps}\nProgram\nBefore looking carefully at the program, let's try a sample problem: \"If z is 3, what is twice z?\" Applying the rules to the input gives the following trace:\n\n```lisp\nInput: (If z is 3, what is twice z)\nRule: ((if ?x |,| ?y)      (?x ?y))\nBinding: ((?x . (z is 3)) (?y . (what is twice z)))\n Input: (z is 3)\n Rule: ((?x is ?y)         (= ?x ?y))\n Result: (= z 3)\n Input: (what is twice z ?)\n Rule: ((?x is ?y)         (= ?x ?y))\n Binding:((?x . what) (?y . (twice z)))\n  Input: (twice z)\n  Rule: ((twice ?x)        (* 2 ?x))\n  Result: (* 2 z)\n Result: (= what (* 2 z))\nResult: ((= z 3) (= what (* 2 z)))\n```\n\nThere are two minor complications.\nFirst, we agreed to implement sets of equations as lists of equations.\nFor this example, everything worked out, and the response was a list of two equations.\nBut if nested patterns are used, the response could be something like `((= a 5) ((= b (+ a 1)) (= c (+ a b))))`, which is not a list of equations.\nThe function `create-list-of-equations` transforms a response like this into a proper list of equations.\nThe other complication is choosing variable names.\nGiven a list of words like (`the number of customers Tom gets`), we want to choose a symbol to represent it.\nWe will see below that the symbol `customers` is chosen, but that there are other possibilities.\n\nHere is the main function for STUDENT !!!(span) {:.smallcaps} . It first removes words that have no content, then translates the input to one big expression with `translate-to-expression`, and breaks that into separate equations with `create-list-of-equations`.\nFinally, the function `solve-equations` does the mathematics and prints the solution.\n\n```lisp\n(defun student (words)\n  \"Solve certain Algebra Word Problems.\"\n  (solve-equations\n    (create-list-of-equations\n      (translate-to-expression (remove-if #'noise-word-p words)))))\n```\n\nThe function `translate-to-expression` is a rule-based translator.\nIt either finds some rule in `*student-rules*` to transform the input, or it assumes that the entire input represents a single variable.\nThe function `translate-pair` takes a variable/value binding pair and translates the value by a recursive call to `translate-to-expression.`\n\n```lisp\n(defun translate-to-expression (words)\n  \"Translate an English phrase into an equation or expression.\"\n  (or (rule-based-translator\n      words *student-rules*\n      :rule-if #'rule-pattern :rule-then #'rule-response\n      :action #'(lambda (bindings response)\n               (sublis (mapcar #'translate-pair bindings)\n                       response)))\n     (make-variable words)))\n(defun translate-pair (pair)\n  \"Translate the value part of the pair into an equation or expression.\"\n  (cons (binding-var pair)\n      (translate-to-expression (binding-val pair))))\n```\n\nThe function `create-list-of-equations` takes a single expression containing embedded equations and separates them into a list of equations:\n\n```lisp\n(defun create-list-of-equations (exp)\n  \"Separate out equations embedded in nested parens.\"\n  (cond ((null exp) nil)\n      ((atom (first exp)) (list exp))\n      (t (append (create-list-of-equations (first exp))\n              (create-list-of-equations (rest exp))))))\n```\n\nFinally, the function `make-variable` creates a variable to represent a list of words.\nWe do that by first removing all \"noise words\" from the input, and then taking the first symbol that remains.\nSo, for example, \"the distance John traveled\" and \"the distance traveled by John\" will both be represented by the same variable, `distance,` which is certainly the right thing to do.\nHowever, \"the distance Mary traveled\" will also be represented by the same variable, which is certainly a mistake.\nFor (`the number of customers Tom gets`), the variable will be `customers`, since `the, of` and `number` are all noise words.\nThis will match (`the customers mentioned above`) and (`the number of customers`), but not (`Tom's customers`).\nFor now, we will accept the first-non-noise-word solution, but note that exercise 7.3 asks for a correction.\n\n```lisp\n(defun make-variable (words)\n  \"Create a variable name based on the given list of words\"\n  ;; The list of words will already have noise words removed\n  (first words))\n(defun noise-word-p (word)\n  \"Is this a low-content word that can be safely ignored?\"\n  (member word '(a an the this number of $)))\n```\n\n## 7.2 Solving Algebraic Equations\n{:#s0015}\n{:.h1hd}\n\nThe next step is to write the equation-solving section of STUDENT !!!(span) {:.smallcaps} . This is more an exercise in elementary algebra than in AI, but it is a good example of a symbol-manipulation task, and thus an interesting programming problem.\n\nThe STUDENT !!!(span) {:.smallcaps} program mentioned the function `solve-equations`, passing it one argument, a list of equations to be solved.\n`solve-equations` prints the list of equations, attempts to solve them using `solve`, and prints the result.\n\n```lisp\n(defun solve-equations (equations)\n  \"Print the equations and their solution\"\n  (print-equations \"The equations to be solved are:\" equations)\n  (print-equations \"The solution is:\" (solve equations nil)))\n```\n\nThe real work is done by solve, which has the following specification: (1) Find an equation with exactly one occurrence of an unknown in it.\n(2) Transform that equation so that the unknown is isolated on the left-hand side.\nThis can be done if we limit the operators to +, -, *,and /.\n(3) Evaluate the arithmetic on the right-hand side, yielding a numeric value for the unknown.\n(4) Substitute the numeric value for the unknown in all the other equations, and remember the known value.\nThen try to solve the resulting set of equations.\n(5) If step (1) fails-if there is no equation with exactly one unknown-then just return the known values and don't try to solve anything else.\n\nThe function `solve` is passed a system of equations, along with a list of known variable/value pairs.\nInitially no variables are known, so this list will be empty.\n`solve` goes through the list of equations searching for an equation with exactly one unknown.\nIf it can find such an equation, it calls `isolate` to solve the equation in terms of that one unknown.\n`solve` then substitutes the value for the variable throughout the list of equations and calls itself recursively on the resulting list.\nEach time `solve` calls itself, it removes one equation from the list of equations to be solved, and adds one to the list of known variable/value pairs.\nSince the list of equations is always growing shorter, `solve` must eventually terminate.\n\n```lisp\n(defun solve (equations known)\n  \"Solve a system of equations by constraint propagation.\"\n  ;; Try to solve for one equation, and substitute its value into\n  ;; the others. If that doesn't work, return what is known.\n  (or (some #'(lambda (equation)\n        (let ((x (one-unknown equation)))\n          (when x\n            (let ((answer (solve-arithmetic\n                      (isolate equation x))))\n              (solve (subst (exp-rhs answer) (exp-lhs answer)\n                      (remove equation equations))\n                (cons answer known))))))\n       equations)\n    known))\n```\n\n`isolate` is passed an equation guaranteed to have one unknown.\nIt returns an equivalent equation with the unknown isolated on the left-hand side.\nThere are five cases to consider: when the unknown is alone on the left, we're done.\nThe second case is when the unknown is anywhere on the right-hand side.\nBecause '=' is commutative, we can reduce the problem to solving the equivalent equation with left- and right-hand sides reversed.\n\nNext we have to deal with the case where the unknown is in a complex expression on the left-hand side.\nBecause we are allowing four operators and the unknown can be either on the right or the left, there are eight possibilities.\nLetting X stand for an expression containing the unknown and A and B stand for expressions with no unknowns, the possibilities and their solutions are as follows:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| (1) `X*A=B` => `X=B/A` | (5) `A*X=B` => `X=B/A` |\n| (2) `X+A=B` => `X=B-A` | (6) `A+X=B` => `X=B-A` |\n| (3) `X/A=B` => `X=B*A` | (7) `A/X=B` => `X=A/B` |\n| (4) `X-A=B` => `X=B+A` | (8) `A-X=B` => `X=A-B` |\n\nPossibilities (1) through (4) are handled by case III, (5) and (6) by case IV, and (7) and (8) by case V.\nIn each case, the transformation does not give us the final answer, since X need not be the unknown; it might be a complex expression involving the unknown.\nSo we have to call isolate again on the resulting equation.\nThe reader should try to verify that transformations (1) to (8) are valid, and that cases III to V implement them properly.\n\n```lisp\n(defun isolate (e x)\n  \"Isolate the lone x in e on the left-hand side of e.\"\n  ;; This assumes there is exactly one x in e,\n  ;; and that e is an equation.\n  (cond ((eq (exp-lhs e) x)\n      ;; Case I: X = A -> X = n\n      e)\n     ((in-exp x (exp-rhs e))\n      ;; Case II: A = f(X) -> f(X) = A\n      (isolate (mkexp (exp-rhs e) '= (exp-lhs e)) x))\n     ((in-exp x (exp-lhs (exp-lhs e)))\n      ;; Case III: f(X)*A = B -> f(X) = B/A\n      (isolate (mkexp (exp-lhs (exp-lhs e)) '=\n            (mkexp (exp-rhs e)\n               (inverse-op (exp-op (exp-lhs e)))\n               (exp-rhs (exp-lhs e)))) x))\n     ((commutative-p (exp-op (exp-lhs e)))\n      ;; Case IV: A*f(X) = B -> f(X) = B/A\n      (isolate (mkexp (exp-rhs (exp-lhs e)) '=\n            (mkexp (exp-rhs e)\n               (inverse-op (exp-op (exp-lhs e)))\n               (exp-lhs (exp-lhs e)))) x))\n     (t ;; Case V: A/f(X) = B -> f(X) = A/B\n      (isolate (mkexp (exp-rhs (exp-lhs e)) '=\n            (mkexp (exp-lhs (exp-lhs e))\n               (exp-op (exp-lhs e))\n               (exp-rhs e))) x))))\n```\n\nRecall that to prove a function is correct, we have to prove both that it gives the correct answer when it terminates and that it will eventually terminate.\nFor a recursive function with several alternative cases, we must show that each alternative is valid, and also that each alternative gets closer to the end in some way (that any recursive calls involve 'simpler' arguments).\nFor `isolate`, elementary algebra will show that each step is valid-or at least *nearly* valid.\nDividing both sides of an equation by 0 does not yield an equivalent equation, and we never checked for that.\nIt's also possible that similar errors could sneak in during the call to `eval`.\nHowever, if we assume the equation does have a single valid solution, then `isolate` performs only legal transformations.\n\nThe hard part is to prove that `isolate` terminates.\nCase I clearly terminates, and the others all contribute towards isolating the unknown on the left-hand side.\nFor any equation, the sequence will be first a possible use of case II, followed by a number of recursive calls using cases III to V.\nThe number of calls is bounded by the number of subexpressions in the equation, since each successive call effectively removes an expression from the left and places it on the right.\nTherefore, assuming the input is of finite size, we must eventually reach a recursive call to `isolate` that will use case I and terminate.\n\nWhen `isolate` returns, the right-hand side must consist only of numbers and operators.\nWe could easily write a function to evaluate such an expression.\nHowever, we don't have to go to that effort, since the function already exists.\nThe data structure exp was carefully selected to be the same structure (lists with prefix functions) used by Lisp itself for its own expressions.\nSo Lisp will find the right-hand side to be an acceptable expression, one that could be evaluated if typed in to the top level.\nLisp evaluates expressions by calling the function `eval`, so we can call `eval` directly and have it return a number.\nThe function `solve-arithmetic` returns an equation of the form (= *var number*).\n\nAuxiliary functions for `solve` are shown below.\nMost are straightforward, but I will remark on a few of them.\nThe function `prefix->infix` takes an expression in prefix notation and converts it to a fully parenthesized infix expression.\nUnlike `isolate`, it assumes the expressions will be implemented as lists.\n`prefix->infix` is used by `print-equations` to produce more readable output.\n\n```lisp\n(defun print-equations (header equations)\n  \"Print a list of equations.\"\n  (format t \"~%~a~{~% ~ a ~}~}~%\" header\n      (mapcar #'prefix->infix equations)))\n(defconstant operators-and-inverses\n  '((+ -) (- +) (* /) (/ *) (= =)))\n(defun inverse-op (op)\n  (second (assoc op operators-and-inverses)))\n(defun unknown-p (exp)\n  (symbolp exp))\n(defun in-exp (x exp)\n  \"True if x appears anywhere in exp\"\n  (or (eq x exp)\n      (and (exp-p exp)\n          (or (in-exp x (exp-lhs exp)) (in-exp x (exp-rhs exp))))))\n(defun no-unknown (exp)\n  \"Returns true if there are no unknowns in exp.\"\n  (cond ((unknown-p exp) nil)\n       ((atom exp) t)\n       ((no-unknown (exp-lhs exp)) (no-unknown (exp-rhs exp)))\n       (t nil)))\n(defun one-unknown (exp)\n  \"Returns the single unknown in exp, if there is exactly one.\"\n  (cond ((unknown-p exp) exp)\n       ((atom exp) nil)\n       ((no-unknown (exp-lhs exp)) (one-unknown (exp-rhs exp)))\n       ((no-unknown (exp-rhs exp)) (one-unknown (exp-lhs exp)))\n       (t nil)))\n(defun commutative-p (op)\n  \"Is operator commutative?\"\n  (member op '(+*=)))\n(defun solve-arithmetic (equation)\n  \"Do the arithmetic for the right-hand side.\"\n  ;; This assumes that the right-hand side is in the right form.\n  (mkexp (exp-lhs equation) '= (eval (exp-rhs equation))))\n(defun binary-exp-p (x)\n  (and (exp-p x) (= (length (exp-args x)) 2)))\n(defun prefix->infix (exp)\n  \"Translate prefix to infix expressions.\"\n  (if (atom exp) exp\n     (mapcar #'prefix->infix\n           (if (binary-exp-p exp)\n               (list (exp-lhs exp) (exp-op exp) (exp-rhs exp))\n               exp))))\n```\n\nHere's an example of `solve-equations` in action, with a system of two equations.\nThe reader should go through the trace, discovering which case was used at each call to `isolate`, and verifying that each step is accurate.\n\n```lisp\n> (trace isolate solve)\n(isolate solve)\n> (solve-equations '((= (+ 3 4) (* (- 5 (+ 2 x)) 7))\n              (= (+ (* 3 x) y) 12)))\nThe equations to be solved are:\n   (3 + 4) = ((5 - (2 + X)) * 7)\n   ((3 * X) + Y) = 12\n(1 ENTER SOLVE: ((= (+ 3 4) (* (- 5 (+ 2 X)) 7))\n              (= (+ (* 3 X) Y) 12)) NIL)\n  (1 ENTER ISOLATE: (= (+ 3 4) (* (- 5 (+ 2 X)) 7)) X)\n    (2 ENTER ISOLATE: (= (* (- 5 (+ 2 X)) 7) (+ 3 4)) X)\n      (3 ENTER ISOLATE: (= (- 5 (+ 2 X)) (/ (+ 3 4) 7)) X)\n        (4 ENTER ISOLATE: (= (+ 2 X) (- 5 (/ (+ 3 4) 7))) X)\n          (5 ENTER ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2)) X)\n          (5 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2)))\n        (4 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2)))\n      (3 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2)))\n    (2 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2)))\n  (1 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2)))\n  (2 ENTER SOLVE: ((= (+ (* 3 2) Y) 12)) ((= X 2)))\n    (1 ENTER ISOLATE: (= (+ (* 3 2) Y) 12) Y)\n     (2 ENTER ISOLATE: (= Y (- 12 (* 3 2))) Y)\n     (2 EXIT ISOLATE: (= Y (- 12 (* 3 2))))\n    (1 EXIT ISOLATE: (= Y (- 12 (* 3 2))))\n    (3 ENTER SOLVE: NIL ((= Y 6) (= X 2)))\n    (3 EXIT SOLVE: ((= Y 6) (= X 2)))\n  (2 EXIT SOLVE: ((= Y 6) (= X 2)))\n(1 EXIT SOLVE: ((= Y 6) (= X 2)))\nThe solution is:\n   Y = 6\n   X = 2\nNIL\n```\n\nNow let's tackle the `format` string `\"~%~a~{~% ~{ ~ a ~}~}~*%\"*` in `print-equations.` This may look like random gibberish, but there is actually sense behind it.\n`format` processes the string by printing each character, except that `\"~\"` indicates some special formatting action, depending on the following character.\nThe combination `\"~%\"` prints a newline, and `\"~a\"` prints the next argument to `format` that has not been used yet.\nThus the first four characters of the format string, `\"~%~a\"`, print a newline followed by the argument `header`.\nThe combination `\"~{\"` treats the corresponding argument as a list, and processes each element according to the specification between the `\"~{\"` and the next `\"~}\"`.\nIn this case, `equations` is a list of equations, so each one gets printed with a newline (`\"~%\"`) followed by two spaces, followed by the processing of the equation itself as a list, where each element is printed in the `\"~a\"` format and preceded by a blank.\nThe `t` given as the first argument to `format` means to print to the standard output; another output stream may be specified there.\n\nOne of the annoying minor holes in Lisp is that there is no standard convention on where to print newlines!\nIn C, for example, the very first line of code in the reference manual is\n\n```lisp\nprintf(\"hello, world\\n\");\n```\n\nThis makes it clear that newlines are printed *after* each line.\nThis convention is so ingrained in the UNIX world that some UNIX programs will go into an infinite loop if the last line in a file is not terminated by a newline.\nIn Lisp, however, the function `print` puts in a newline *before* the object to be printed, and a space after.\nSome Lisp programs carry the newline-before policy over to `format`, and others use the newline-after policy.\nThis only becomes a problem when you want to combine two programs written under different policies.\nHow did the two competing policies arise?\nIn UNIX there was only one reasonable policy, because all input to the UNIX interpreter (the shell) is terminated by newlines, so there is no need for a newline-before.\nIn some Lisp interpreters, however, input can be terminated by a matching right parenthesis.\nIn that case, a newline-before is needed, lest the output appear on the same line as the input.\n\n**Exercise 7.1 [m]** Implement `print-equations` using only primitive printing functions such as `terpri` and `princ`, along with explicit loops.\n\n## 7.3 Examples\n{:#s0020}\n{:.h1hd}\n\nNow we move on to examples, taken from Bobrow's thesis.\nIn the first example, it is necessary to insert a \"then\" before the word \"what\" to get the right answer:\n\n```lisp\n> (student '(If the number of customers Tom gets is twice the square of\n      20 % of the number of advertisements he runs |,|\n      and the number of advertisements is 45 |,|\n      then what is the number of customers Tom gets ?))\nThe equations to be solved are:\n   CUSTOMERS = (2 * (((20 / 100) * ADVERTISEMENTS) *\n           ((20 / 100) * ADVERTISEMENTS)))\n   ADVERTISEMENTS = 45\n   WHAT = CUSTOMERS\nThe solution is:\n   WHAT = 162\n   CUSTOMERS = 162\n   ADVERTISEMENTS = 45\nNIL\n```\n\nNotice that our program prints the values for all variables it can solve for, while Bobrow's program only printed the values that were explicitly asked for in the text.\nThis is an example of \"more is less\"-it may look impressive to print all the answers, but it is actually easier to do so than to decide just what answers should be printed.\nThe following example is not solved correctly:\n\n```lisp\n> (student '(The daily cost of living for a group is the overhead cost plus\n      the running cost for each person times the number of people in\n      the group |.| This cost for one group equals $ 100 |,|\n      and the number of people in the group is 40 |.|\n      If the overhead cost is 10 times the running cost |,|\n      find the overhead and running cost for each person |.|))\nThe equations to be solved are:\n   DAILY = (OVERHEAD + (RUNNING * PEOPLE))\n   COST = 100\n   PEOPLE = 40\n   OVERHEAD = (10 * RUNNING)\n   TO-FIND-1 = OVERHEAD\n   TO-FIND-2 = RUNNING\nThe solution is:\n   PEOPLE = 40\n   COST = 100\nNIL\n```\n\nThis example points out two important limitations of our version of student as compared to Bobrow's.\nThe first problem is in naming of variables.\nThe phrases \"the daily cost of living for a group\" and \"this cost\" are meant to refer to the same quantity, but our program gives them the names `daily` and `cost` respectively.\nBobrow's program handled naming by first considering phrases to be the same only if they matched perfectly.\nIf the resulting set of equations could not be solved, he would try again, this time considering phrases with words in common to be identical.\n(See the following exercises.)\n\nThe other problem is in our `solve` function.\nAssuming we got the variables equated properly, `solve` would be able to boil the set of equations down to two:\n\n```lisp\n100 = (OVERHEAD + (RUNNING * 40))\nOVERHEAD = (10 * RUNNING)\n```\n\nThis is a set of two linear equations in two unknowns and has a unique solution at `RUNNING = 2, OVERHEAD = 20`.\nBut our version of `solve` couldn't find this solution, since it looks for equations with one unknown.\nHere is another example that `student` handles well:\n\n```lisp\n> (student '(Fran's age divided by Robin's height is one half Kelly's IQ |.|\n      Kelly's IQ minus 80 is Robin's height |.|\n      If Robin is 4 feet tall |,| how old is Fran ?))\nThe equations to be solved are:\n   (FRAN / ROBIN) = (KELLY / 2)\n   (KELLY - 80) = ROBIN\n   ROBIN = 4\n   HOW = FRAN\nThe solution is:\n   HOW = 168\n   FRAN = 168\n   KELLY = 84\n   ROBIN = 4\nNIL\n```\n\nBut a slight variation leads to a problem:\n\n```lisp\n> (student '(Fran's age divided by Robin's height is one half Kelly's IQ |.|\n      Kelly's IQ minus 80 is Robin's height |.|\n      If Robin is 0 feet tall |,| how old is Fran ?))\nThe equations to be solved are:\n   (FRAN / ROBIN) = (KELLY / 2)\n   (KELLY - 80) = ROBIN\n   ROBIN = 0\n   HOW = FRAN\nThe solution is:\n   HOW = 0\n   FRAN = 0\n   KELLY = 80\n   ROBIN = 0\nNIL\n```\n\nThere is no valid solution to this problem, because it involves dividing by zero (Robin's height).\nBut `student` is willing to transform the first equation into:\n\n```lisp\nFRAN = ROBIN * (KELLY / 2)\n```\n\nand then substitutes to get `0` for `FRAN`.\nWorse, dividing by zero could also come up inside `eval`:\n\n```lisp\n> (student '(Fran's age times Robin's height is one half Kelly's IQ |.|\n      Kelly's IQ minus 80 is Robin's height |.|\n      If Robin is 0 feet tall |,| how old is Fran ?))\nThe equations to be solved are:\n   (FRAN * ROBIN) = (KELLY / 2)\n   (KELLY - 80) = ROBIN\n   ROBIN = 0\n   HOW = FRAN\n>>Error: There was an attempt to divide a number by zero\n```\n\nHowever, one could claim that nasty examples with division by zero don't show up in algebra texts.\n\nIn summary, STUDENT !!!(span) {:.smallcaps} behaves reasonably well, doing far more than the toy program ELIZA !!!(span) {:.smallcaps} . STUDENT !!!(span) {:.smallcaps} is also quite efficient; on my machine it takes less than one second for each of the prior examples.\nHowever, it could still be extended to have more powerful equation-solving capabilities.\nIts linguistic coverage is another matter.\nWhile one could add new patterns, such patterns are really just tricks, and don't capture the underlying structure of English sentences.\nThat is why the STUDENT !!!(span) {:.smallcaps} approach was abandoned as a research topic.\n\n## 7.4 History and References\n{:#s0025}\n{:.h1hd}\n\nBobrow's Ph.D.\nthesis contains a complete description of STUDENT !!!(span) {:.smallcaps} . It is reprinted in [Minsky 1968](B9780080571157500285.xhtml#bb0845).\nSince then, there have been several systems that address the same task, with increased sophistication in both their mathematical and linguistic ability.\n[Wong (1981)](B9780080571157500285.xhtml#bb1420) describes a system that uses its understanding of the problem to get a better linguistic analysis.\n[Sterling et al.\n(1982)](B9780080571157500285.xhtml#bb1195) present a much more powerful equation solver, but it does not accept natural language input.\nCertainly Bobrow's language analysis techniques were not very sophisticated by today's measures.\nBut that was largely the point: if you know that the language is describing an algebraic problem of a certain type, then you don't need to know very much linguistics to get the right answer most of the time.\n\n## 7.5 Exercises\n{:#s0030}\n{:.h1hd}\n\n**Exercise 7.2 [h]** We said earlier that our program was unable to solve pairs of linear equations, such as:\n\n```lisp\n100 = (OVERHEAD + (RUNNING * 40))\nOVERHEAD = (10 * RUNNING)\n```\n\nThe original STUDENT !!!(span) {:.smallcaps} could solve these equations.\nWrite a routine to do so.\nYou may assume there will be only two equations in two unknowns if you wish, or if you are more ambitious, you could solve a system of *n* linear equations with *n* unknowns.\n\n**Exercise 7.3 [h]** Implement a version of Bobrow's variable-naming algorithm.\nInstead of taking the first word of each equation, create a unique symbol, and associate with it the entire list of words.\nIn the first pass, each nonequal list of words will be considered a distinct variable.\nIf no solution is reached, word lists that share words in common are considered to be the same variable, and the solution is attempted again.\nFor example, an input that contains the phrases \"the rectangle's width\" and \"the width of the rectangle\" might assign these two phrases the variables `v1` and `v2`.\nIf an attempt to solve the problem yields no solutions, the program should realize that `v1` and `v2` have the words \"rectangle\" and \"width\" in common, and add the equation (`= v1 v2`) and try again.\nSince the variables are arbitrary symbols, the printing routine should probably print the phrases associated with each variable rather than the variable itself.\n\n**Exercise 7.4 [h]** The original STUDENT !!!(span) {:.smallcaps} also had a set of \"common knowledge\" equations that it could use when necessary.\nThese were mostly facts about conversion factors, such as (`1 inch = 2.54 cm`).\nAlso included were equations like (`distance equal s rate times time`), which could be used to solve problems like \"If the distance from Anabru to Champaign is 10 miles and the time it takes Sandy to travel this distance is 2 hours, what is Sandy's rate of speed?\" Make changes to incorporate this facility.\nIt probably only helps in conjunction with a solution to the previous exercise.\n\n**Exercise 7.5 [h]** Change `student` so that it prints values only for those variables that are being asked for in the problem.\nThat is, given the problem \"X is 3.\nY is 4.\nHow much is X + Y ?\" it should not print values for X and Y.\n\n**Exercise 7.6 [m]** Try STUDENT !!!(span) {:.smallcaps} on the following examples.\nMake sure you handle special characters properly:\n\n(a) The price of a radio is 69.70 dollars.\nIf this price is 15% less than the marked The number of soldiers the Russians have is one half of the number of guns\n!!!(p) {:.numlist1}\n\n(b) The number of soldiers the Russians have is one half of the number of guns they have.\nThe number of guns they have is 7000.\nWhat is the number of soldiers they have?\n!!!(p) {:.numlist1}\n\n(c) If the number of customers Tom gets is twice the square of 20 % of the number of advertisements he runs, and the number of advertisements is 45, and the profit Tom receives is 10 times the number of customers he gets, then what is the profit?\n!!!(p) {:.numlist1}\n\n(d) The average score is 73.\nThe maximum score is 97.\nWhat is the square of the difference between the average and the maximum?\n!!!(p) {:.numlist1}\n\n(e) Tom is twice Mary's age, and Jane's age is half the difference between Mary and Tom.\nIf Mary is 18 years old, how old is Jane?\n!!!(p) {:.numlist1}\n\n(f) What is 4 + 5* 14/7?\n!!!(p) {:.numlist1}\n\n(g) *x x b = c + d.\nb x c = x.\nx = b + b.\nb = 5.*\n!!!(p) {:.numlist1}\n\n**Exercise 7.7 [h]**`Student's` infix-to-prefix rules account for the priority of operators properly, but they don't handle associativity in the standard fashion.\nFor example, (`12 - 6 - 3`) translates to (`- 12 (- 6 3)`) or `9`, when the usual convention is to interpret this as (`- (- 12 6) 3`) or `3`.\nFix student to handle this convention.\n\n**Exercise 7.8 [d]** Find a mathematically oriented domain that is sufficiently limited so that STUDENT !!!(span) {:.smallcaps} can solve problems in it.\nThe chemistry of solutions (calculating pH concentrations) might be an example.\nWrite the necessary `*student-rules*`, and test the resulting program.\n\n**Exercise 7.9 [m]** Analyze the complexity of `one-unknown` and implement a more efficient version.\n\n**Exercise 7.10 [h]** Bobrow's paper on STUDENT !!!(span) {:.smallcaps} (1968) includes an appendix that abstractly characterizes all the problems that his system can solve.\nGenerate a similar characterization for this version of the program.\n\n## 7.6 Answers\n{:#s0035}\n{:.h1hd}\n\n**Answer 7.1**\n\n```lisp\n(defun print-equations (header equations)\n  (terpri)\n  (princ header)\n  (dolist (equation equations)\n    (terpri)\n    (princ \" \")\n    (dolist (x (prefix->infix equation))\n      (princ \" \")\n      (princ x))))\n```\n\n**Answer 7.9**`one-unknown` is very inefficient because it searches each subcomponent of an expression twice.\nFor example, consider the equation:\n\n```lisp\n(= (+ (+` x `2) (+ 3 4)) (+ (+ 5 6) (+ 7 8)))\n```\n\nTo decide if this has one unknown, `one-unknown` will call `no-unknown` on the left-hand side, and since it fails, call it again on the right-hand side.\nAlthough there are only eight atoms to consider, it ends up calling `no-unknown 17` times and `one-unknown 4` times.\nIn general, for a tree of depth *n*, approximately 2*n* calls to `no-unknown` are made.\nThis is clearly wasteful; there should be no need to look at each component more than once.\n\nThe following version uses an auxiliary function, `find-one-unknown,` that has an accumulator parameter, `unknown.` This parameter can take on three possible values: nil, indicating that no unknown has been found; or the single unknown that has been found so far; or the number 2 indicating that two unknowns have been found and therefore the final result should be nil.\nThe function `find-one-unknown` has four cases: (1) If we have already found two unknowns, then return 2 to indicate this.\n(2) If the input expression is a nonatomic expression, then first look at its left-hand side for unknowns, and pass the result found in that side as the accumulator to a search of the right-hand side.\n(3) If the expression is an unknown, and if it is the second one found, return `2`; otherwise return the unknown itself.\n(4) If the expression is an atom that is not an unknown, then just return the accumulated result.\n\n```lisp\n(defun one-unknown (exp)\n  \"Returns the single unknown in exp, if there is exactly one.\"\n  (let ((answer (find-one-unknown exp nil)))\n    ;; If there were two unknowns, return nil;\n    ;; otherwise return the unknown (if there was one)\n    (if (eql answer 2)\n       nil\n       answer)))\n(defun find-one-unknown (exp unknown)\n  \"Assuming UNKNOWN is the unknown(s) found so far, decide\n  if there is exactly one unknown in the entire expression.\"\n  (cond ((eql unknown 2) 2)\n        ((exp-p exp)\n          (find-one-unknown\n            (exp-rhs exp)\n            (find-one-unknown (exp-lhs exp) unknown)))\n        ((unknown-p exp)\n          (if unknown\n              2\n              exp))\n        (t unknown)))\n```\n\n----------------------\n\n[1](#xfn0015)[Page 316](B9780080571157500108.xhtml#p316) of *Common Lisp the Language* says, \"Because a constructor of this type operates By Order of Arguments, it is sometimes known as a BOA constructor.\"\n!!!(p) {:.ftnote1}\n\n# Chapter 8\n## Symbolic Mathematics: A Simplification Program\n{:.chaptitle}\n\n> *Our life is frittered away by detail....*\n\n> *Simplify, simplify.*\n\n> -Henry David Thoreau, *Walden* (1854)\n\n\"Symbolic mathematics\" is to numerical mathematics as algebra is to arithmetic: it deals with variables and expressions rather than just numbers.\nComputers were first developed primarily to solve arithmetic problems: to add up large columns of numbers, to multiply many-digit numbers, to solve systems of linear equations, and to calculate the trajectories of ballistics.\nEncouraged by success in these areas, people hoped that computers could also be used on more complex problems; to differentiate or integrate a mathematical expression and come up with another expression as the answer, rather than just a number.\nSeveral programs were developed along these lines in the 1960s and 1970s.\nThey were used primarily by professional mathematicians and physicists with access to large mainframe computers.\nRecently, programs like MATHLAB !!!(span) {:.smallcaps} , DERIVE !!!(span) {:.smallcaps} , and MATHEMATICA !!!(span) {:.smallcaps} have given these capabilities to the average personal computer user.\n\nIt is interesting to look at some of the history of symbolic algebra, beginning in 1963 with SAINT !!!(span) {:.smallcaps} , James Slagle's program to do symbolic integration.\nOriginally, SAINT !!!(span) {:.smallcaps} was heralded as a triumph of AI.\nIt used general problem-solving techniques, similar in kind to GPS !!!(span) {:.smallcaps} , to search for solutions to difficult problems.\nThe program worked its way through an integration problem by choosing among the techniques known to it and backing up when an approach failed to pan out.\nSAINT'S !!!(span) {:.smallcaps} behavior on such problems was originally similar to (and eventually much better than) the performance of undergraduate calculus students.\n\nOver time, the AI component of symbolic integration began to disappear.\nJoel Moses implemented a successor to SAINT !!!(span) {:.smallcaps} called SIN !!!(span) {:.smallcaps} . It used many of the same techniques, but instead of relying on search to find the right combination of techniques, it had additional mathematical knowledge that led it to pick the right technique at each step, without any provision for backing up and trying an alternative.\nSIN !!!(span) {:.smallcaps} solved more problems and was much faster than SAINT !!!(span) {:.smallcaps} , although it was not perfect: it still occasionally made the wrong choice and failed to solve a problem it could have.\n\nBy 1970, the mathematician R.\nRisch and others developed algorithms for indefinite integration of any expression involving algebraic, logarithmic, or exponential extensions of rational functions.\nIn other words, given a \"normal\" function, the Risch algorithm will return either the indefinite integral of the function or an indication that no closed-form integral is possible in terms of elementary functions.\nSuch work effectively ended the era of considering integration as a problem in search.\n\nSIN !!!(span) {:.smallcaps} was further refined, merged with parts of the Risch algorithm, and put into the evolving MACSYMA !!!(span) {:.smallcaps} [1](#fn0010) program.\nFor the most part, refinement of MACSYMA !!!(span) {:.smallcaps} consisted of the incorporation of new algorithms.\nFew heuristics of any sort survive.\nToday MACSYMA !!!(span) {:.smallcaps} is no longer considered an AI program.\nIt is used daily by scientists and mathematicians, while ELIZA !!!(span) {:.smallcaps} and STUDENT !!!(span) {:.smallcaps} are now but historical footnotes.\n\nWith ELIZA !!!(span) {:.smallcaps} and STUDENT !!!(span) {:.smallcaps} we were able to develop miniature programs that duplicated most of the features of the original.\nWe won't even try to develop a program worthy of the name MACSYMA !!!(span) {:.smallcaps} ; instead we will settle for a modest program to do symbolic simplification, which we will call (simply) `simplifier`.\nThen, we will extend `simplifier` to do differentiation, and some integration problems.\nThe idea is that given an expression like (2 - 1)*x* + 0, we want the program to compute the simplified form *x*.\n\nAccording to the *Mathematics Dictionary* (James and James 1949), the word \"simplified\" is \"probably the most indefinite term used seriously in mathematics.\" The problem is that \"simplified\" is relative to what you want to use the expression for next.\nWhich is simpler, *x*2 + 3*x* + 2 or (*x* + 1)(*x* + 2)?\nThe first makes it easier to integrate or differentiate, the second easier to find roots.\nWe will be content to limit ourselves to \"obvious\" simplifications.\nFor example, *x* is almost always preferable to 1*x* + 0.\n\n## 8.1 Converting Infix to Prefix Notation\n{:#s0010}\n{:.h1hd}\n\nWe will represent simplifications as a list of rules, much like the rules for STUDENT !!!(span) {:.smallcaps} and ELIZA !!!(span) {:.smallcaps} . But since each simplification rule is an algebraic equation, we will store each one as an exp rather than as a `rule`.\nTo make things more legible, we will write each expression in infix form, but store them in the prefix form expected by `exp`.\nThis requires an `infix->prefix` function to convert infix expressions into prefix notation.\nWe have a choice as to how general we want our infix notation to be.\nConsider:\n\n```lisp\n(((a * (x ^ 2)) + (b * x)) + c)\n(a * x ^ 2 + b * x + c)\n(a x ^ 2 + b x + c)\na x^2 + b*x+c\n```\n\nThe first is fully parenthesized infix, the second makes use of operator precedence (multiplication binds tighter than addition and is thus performed first), and the third makes use of implicit multiplication as well as operator precedence.\nThe fourth requires a lexical analyzer to break Lisp symbols into pieces.\n\nSuppose we only wanted to handle the fully parenthesized case.\nTo write `infix->prefix`, one might first look at `prefix->infix` (on [page 228](B9780080571157500078.xhtml#p228)) trying to adapt it to our new purposes.\nIn doing so, the careful reader might discover a surprise: `infix->prefix` and `prefix->infix` are in fact the exact same function!\nBoth leave atoms unchanged, and both transform three-element lists by swapping the `exp-op` and `exp- 1hs`.\nBoth apply themselves recursively to the (possibly rearranged) input list.\nOnce we discover this fact, it would be tempting to avoid writing `infix->prefix`, and just call `prefix->infix` instead.\nAvoid this temptation at all costs.\nInstead, define `infix->prefix` as shown below.\nThe intent of your code will be clearer:\n\n```lisp\n(defun infix->prefix (infix-exp)\n \"Convert fully parenthesized infix-exp to a prefix expression\"\n ;; Don't use this version for non-fully parenthesized exps!\n (prefix->infix infix-exp))\n```\n\nAs we saw above, fully parenthesized infix can be quite ugly, with all those extra parentheses, so instead we will use operator precedence.\nThere are a number of ways of doing this, but the easiest way for us to proceed is to use our previously defined tool `rule-based-translator` and its subtool, `pat-match.` Note that the third clause of `infix->prefix`, the one that calls `rule-based-translator` is unusual in that it consists of a single expression.\nMost cond-clauses have two expressions: a test and a result, but ones like this mean, \"Evaluate the test, and if it is non-nil, return it.\nOtherwise go on to the next clause.\"\n\n```lisp\n(defun infix->prefix (exp)\n \"Translate an infix expression into prefix notation.\"\n ;; Note we cannot do implicit multiplication in this system\n (cond ((atom exp) exp)\n   ((= (length exp) 1) (infix->prefix (first exp)))\n   ((rule-based-translator exp *infix->prefix-rules*\n       :rule-if #'rule-pattern :rule-then #'rule-response\n       :action\n       #'(lambda (bindings response)\n   (sublis (mapcar\n     #'(lambda (pair)\n      (cons (first pair)\n       (infix->prefix (rest pair))))\n     bindings)\n     response))))\n   ((symbolp (first exp))\n   (list (first exp) (infix->prefix (rest exp))))\n   (t (error \"Illegal exp\"))))\n```\n\nBecause we are doing mathematics in this chapter, we adopt the mathematical convention of using certain one-letter variables, and redefine `variable-p` so that variables are only the symbols `m` through `z`.\n\n```lisp\n(defun variable-p (exp)\n \"Variables are the symbols M through Z.\"\n ;; put x,y,z first to find them a little faster\n (member exp '(x y z m n o p q r s t u v w)))\n(pat-match-abbrev 'x + '(?+ x))\n(pat-match-abbrev 'y+ '(?+ y))\n(defun rule-pattern (rule) (first rule))\n(defun rule-response (rule) (second rule))\n(defparameter *infix->prefix-rules*\n (mapcar #'expand-pat-match-abbrev\n '(((x+ = y+) (= x y))\n  ((- x+) (- x))\n  ((+ x+)  (+ x))\n  ((x+ + y+) (+ x y))\n  ((x+ - y+) (- x y))\n  ((x+ * y+) (* x y))\n  ((x+ / y+) (/ x y))\n  ((x+ ^ y+) (^ x y))))\n \"A list of rules, ordered by precedence.\")\n```\n\n## 8.2 Simplification Rules\n{:#s0015}\n{:.h1hd}\n\nNow we are ready to define the simplification rules.\nWe use the definition of the data types rule and exp ([page 221](B9780080571157500078.xhtml#p221)) and `prefix->infix` ([page 228](B9780080571157500078.xhtml#p228)) from STUDENT !!!(span) {:.smallcaps} `.` They are repeated here:\n\n```lisp\n(defstruct (rule (:type list)) pattern response)\n(defstruct (exp (:type list)\n     (:constructor mkexp (lhs op rhs)))\n op lhs rhs)\n(defun exp-p (x) (consp x))\n(defun exp-args (x) (rest x))\n(defun prefix->infix (exp)\n \"Translate prefix to infix expressions.\"\n (if (atom exp) exp\n   (mapcar #'prefix->infix\n   (if (binary-exp-p exp)\n      (list (exp-lhs exp) (exp-op exp) (exp-rhs exp))\n      exp))))\n(defun binary-exp-p (x)\n (and (exp-p x) (= (length (exp-args x)) 2)))\n```\n\nWe also use `rule-based-translator` ([page 188](B9780080571157500066.xhtml#p188)) once again, this time on a list of simplification rules.\nA reasonable list of simplification rules is shown below.\nThis list covers the four arithmetic operators, addition, subtraction, multiplication, and division, as well as exponentiation (raising to a power), denoted by the symbol \"^\"\n\nAgain, it is important to note that the rules are ordered, and that later rules will be applied only when earlier rules do not match.\nSo, for example, 0 / 0 simplifies to `undefined,` and not to 1 or 0, because the rule for 0 / 0 cornes before the other rules.\nSee [exercise 8.8](#st0045) for a more complete treatment of this.\n\n```lisp\n(defparameter *simplification-rules* (mapcar #'infix->prefix '(\n (x + 0 = x)\n (0 + x = x)\n (x + x = 2 * x)\n (x - 0 = x)\n (0 - x = - x)\n (x - x = 0)\n (- - x = x)\n (x * 1 = x)\n (x * x = x)\n (x * 0 = 0)\n (x * x = x)\n (x * x = x ^ 2)\n (x / 0 = undefined)\n (0 / x = 0)\n (x / 1 = x)\n (x / x = 1)\n (0 ^ 0 = undefined)\n (x ^ 0 = 1)\n (0 ^ x = 0)\n (1 ^ x = 1)\n (x ^ 1 = x)\n (x ^ - 1 = 1 / x)\n (x *(y / x) = y)\n ((y / x)* x = y)\n ((y * x) / x = y)\n ((x * y) / x = y)\n (x + - x = 0)\n ((- x) + x = 0)\n (x + y - x = y)\n )))\n(defun ^ (x y) \"Exponentiation\" (expt x y))\n```\n\nWe are now ready to go ahead and write the simplifier.\nThe main function, `simplifier` will repeatedly print a prompt, read an input, and print it in simplified form.\nInput and output is in infix and the computation is in prefix, so we need to convert accordingly; the function simp does this, and the function `simplify` takes care of a single prefix expression.\nIt is summarized in [figure 8.1](#f0010).\n\n![f08-01-9780080571157](images/B978008057115750008X/f08-01-9780080571157.jpg)     \nFigure 8.1\n!!!(span) {:.fignum}\nGlossary for the Simplifier\nHere is the program:\n\n```lisp\n(defun simplifier ()\n \"Read a mathematical expression, simplify it, and print the result.\"\n (loop\n (print 'simplifier >)\n (print (simp (read)))))\n(defun simp (inf) (prefix->infix (simplify (infix->prefix inf))))\n(defun simplify (exp)\n \"Simplify an expression by first simplifying its components.\"\n (if (atom exp) exp\n   (simplify-exp (mapcar #'simplify exp))))\n(defun simplify-exp (exp)\n \"Simplify using a rule, or by doing arithmetic.\"\n (cond ((rule-based-translator exp *simplification-rules*\n       :rule-if #'exp-lhs :rule-then #'exp-rhs\n       :action #'(lambda (bindings response)\n       (simplify (subiis bindings response)))))\n   ((evaluable exp) (eval exp))\n   (t exp)))\n   (defun evaluable (exp)\n       \"Is this an arithmetic expression that can be evaluated?\"\n       (and (every #'numberp (exp-args exp))\n     (or (member (exp-op exp) '(+ - */))\n      (and (eq (exp-op exp) '^\n     (integerp (second (exp-args exp)))))))\n```\n\nThe function `simplify` assures that any compound expression will be simplified by first simplifying the arguments and then calling `simplify-exp.` This latter function searches through the simplification rules, much like `use-eliza-rules` and `translate-to-expression`.\nWhen it finds a match, `simplify-exp` substitutes in the proper variable values and calls `simplify` on the result, `simplify-exp` also has the ability to call `eval` to simplify an arithmetic expression to a number.\nAs in STUDENT !!!(span) {:.smallcaps} , it is for the sake of this eval that we require expressions to be represented as lists in prefix notation.\nNumeric evaluation is done *after* checking the rules so that the rules can intercept expressions like (/ 1 0) and simplify them to `undefined`.\nIf we did the numeric evaluation first, these expressions would yield an error when passed to eval.\nBecause Common Lisp supports arbitrary precision rational numbers (fractions), we are guaranteed there will be no round-off error, unless the input explicitly includes inexact (floating-point) numbers.\nNotice that we allow computations involving the four arithmetic operators, but exponentiation is only allowed if the exponent is an integer.\nThat is because expressions like (^ 4 1/2) are not guaranteed to return 2 (the exact square root of 4); the answer might be 2.0 (an inexact number).\nAnother problem is that - 2 is also a square root of 4, and in some contexts it is the correct one to use.\n\nThe following trace shows some examples of the simplifier in action.\nFirst we show that it can be used as a calculator; then we show more advanced problems.\n\n```lisp\n>(simplifier)\nSIMPLIFIER > (2 + 2)\n4\nSIMPLIFIER > (5 * 20 + 30 + 7)\n137\nSIMPLIFIER > (5 * x - (4 + 1) * x)\n0\nSIMPLIFIER > (y / z * (5 * x - (4 + 1) * x))\n0\nSIMPLIFIER > ((4-3) * x + (y / y - 1) * z)\nX\nSIMPLIFIER > (1 * f(x) + 0)\n(F X)\nSIMPLIFIER > (3 * 2 * X)\n(3 * (2 * X))\nSIMPLIFIER > [Abort]\n>\n```\n\nHere we have terminated the loop by hitting the abort key on the terminal.\n(The details of this mechanism varies from one implementation of Common Lisp to another.) The simplifier seems to work fairly well, although it errs on the last example: `(3 * (2 * X ) )` should simplify to `( 6 * X )`.\nIn the next section, we will correct that problem.\n\n## 8.3 Associativity and Commutativity\n{:#s0020}\n{:.h1hd}\n\nWe could easily add a rule to rewrite `(3 * (2 *X))` as `((3 * 2) * X)` andhence `(6 * X)`.\nThe problem is that this rule would also rewrite `(X*(2*3))` as `((X* 2) * 3)`, unless we had a way to limit the rule to apply only when it would group numbers together.\nFortunately, `pat-match` does provide just this capability, with the `?is` pattern.\nWe could write this rule:\n\n```lisp\n(((?is n numberp) * ((?is m numberp) * x)) = ((n * m) * x))\n```\n\nThis transforms `(3 * (2 * x))` into `((3 * 2) * x)`, and hence into `(6 * x)`.\nUnfortunately, the problem is not as simple as that.\nWe also want to simplify `((2 * x) * (y * 3))` to `(6 *(x * y))`.\nWe can do a better job of gathering numbers together by adopting three conventions.\nFirst, make numbers first in products: change `x * 3` to `3 * x`.\nSecond, combine numbers in an outer expression with a number in an inner expression: change `3 *(5 * x)` to `(3 * 5)* x`.\nThird, move numbers out of inner expressions whenever possible: change `(3 * x) *y` to `3 *(x * y)`.\nWe adopt similar conventions for addition, except that we prefer numbers last there: `x + 1` instead of `l + x`.\n\n```lisp\n;; Define n and m as numbers; s as a non-number:\n(pat-match-abbrev 'n '(?is n numberp))\n(pat-match-abbrev 'm '(?is m numberp))\n(pat-match-abbrev 's '(?is s not-numberp))\n(defun not-numberp (x) (not (numberp x)))\n(defun simp-rule (rule)\n \"Transform a rule into proper format.\"\n (let ((exp (infix->prefix rule)))\n (mkexp (expand-pat-match-abbrev (exp-lhs exp))\n       (exp-op exp) (exp-rhs exp))))\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule\n '((s * n = n * s)\n (n * (m * x) = (n * m) * x)\n (x * (n * y) = n * (x * y))\n ((n * x) * y = n * (x * y))\n (n + s = s + n)\n ((x + m) + n = x + n + m)\n (x + (y + n) = (x + y) + n)\n ((x + n) + y = (x + y) + n)))))\n```\n\nWith the new rules in place, we are ready to try again.\nFor some problems we get just the right answers:\n\n```lisp\n> (simplifier)\nSIMPLIFIER > (3 * 2 * x)\n(6 * X)\nSIMPLIFIER > (2 * x * x * 3)\n(6 * (X ^ 2))\nSIMPLIFIER > (2 * x * 3 * y * 4 * z * 5 * 6)\n(720 * (X * (Y * Z)))\nSIMPLIFIER > (3 + x + 4 + x)\n((2 * X) + 7)\nSIMPLIFIER > (2 * x * 3 * x * 4 * (l / x) * 5 * 6)\n(720 * X)\n```\n\nUnfortunately, there are other problems that aren't simplified properly:\n\n```lisp\nSIMPLIFIER > (3 + x + 4 - x)\n((X + (4 - X)) + 3)\nSIMPLIFIER > (x + y + y + x)\n(X + (Y + (Y + X)))\nSIMPLIFIER > (3 * x + 4 * x)\n((3 * X) + (4 * X))\n```\n\nWe will return to these problems in [section 8.5](#s0030).\n\n**Exercise 8.1** Verify that the set of rules just prior does indeed implement the desired conventions, and that the conventions have the proper effect, and always terminate.\nAs an example of a potential problem, what would happen if we used the rule `(x * n = n * x)` instead of the rule `(s * n = n * s)?`\n\n## 8.4 Logs, Trig, and Differentiation\n{:#s0025}\n{:.h1hd}\n\nIn the previous section, we restricted ourselves to the simple arithmetic functions, so as not to intimidate those who are a little leery of complex mathematics.\nIn this section, we add a little to the mathematical complexity, without having to alter the program itself one bit.\nThus, the mathematically shy can safely skip to the next section without feeling they are missing any of the fun.\n\nWe start off by representing some elementary properties of the logarithmic and trigonometric functions.\nThe new rules are similar to the \"zero and one\" rules we needed for the arithmetic operators, except here the constants e and `pi` (*e* = 2.71828... and *&pi;* = 3.14159...) are important in addition to 0 and 1.\nWe also throw in some rules relating logs and exponents, and for sums and differences of logs.\nThe rules assume that complex numbers are not allowed.\nIf they were, log *ex* (and even *xy*) would have multiple values, and it would be wrong to arbitrarily choose one of these values.\n\n```lisp\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule '(\n (log 1          = 0)\n (log 0          = undefined)\n (log e          = 1)\n (sin 0          = 0)\n (sin pi         = 0)\n (cos 0          = 1)\n (cos pi         = -1)\n (sin(pi / 2)    = 1)\n (cos(pi / 2)    = 0)\n (log (e ^ x)    = x)\n (e ^ (log x)    = x)\n ((x ^ y) * (x ^ z) = x ^ (y + z))\n ((x ^ y) / (x ^ z) = x ^ (y - z))\n (log x + log y = log(x * y))\n (log x - log y = log(x / y))\n ((sin x) ^ 2 + (cos x) ^ 2 = 1)\n ))))\n```\n\nNow we would like to go a step further and extend the system to handle differentiation.\nThis is a favorite problem, and one which has historical significance: in the summer of 1958 John McCarthy decided to investigate differentiation as an interesting symbolic computation problem, which was difficult to express in the primitive programming languages of the day.\nThis investigation led him to see the importance of functional arguments and recursive functions in the field of symbolic computation.\nFor example, McCarthy invented what we now call `mapcar` to express the idea that the derivative of a sum is the sum of the derivative function applied to each argument.\nFurther work led McCarthy to the publication in October 1958 of MIT AI Lab Memo No.\n1: \"An Algebraic Language for the Manipulation of Symbolic Expressions,\" which defined the precursor of Lisp.\n\nIn McCarthy's work and in many subsequent texts you can see symbolic differentiation programs with a simplification routine tacked on the end to make the output more readable.\nHere, we take the opposite approach: the simplification routine is central, and differentiation is handled as just another operator, with its own set of simplification rules.\nWe will require a new infix-to-prefix translation rule.\nWhile we're at it, we'll add a rule for indefinite integration as well, although we won't write simplification rules for integration yet.\nHere are the new notations:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| math | infix | prefix |\n| *dy*/*dx* | `d y / d x` | `(d y x)` |\n| *&int; ydx* | `Int y d x` | `(int y x)` |\n\nAnd here are the necessary infix-to-prefix rules:\n\n```lisp\n(defparameter *infix->prefix-rules*\n   (mapcar #'expand-pat-match-abbrev\n     '(((x+ = y+) (= x y))\n     ((- x+) (- x))\n     ((+ x+) (+ x))\n     ((x+ + y+) (+ x y))\n     ((x+ - y+) (- x y))\n     ((d y+ / d x) (d y x))    ;*** New rule\n     ((Int y+ d x) (int y x))  ;*** New rule\n     ((x+ * y+) (* x y))\n     ((x+ / y+) (/ x y))\n     ((x+ ^ y+) (^ x y)))))\n```\n\nSince the new rule for differentiation occurs before the rule for division, there won't be any confusion with a differential being interpreted as a quotient.\nOn the other hand, there is a potential problem with integrals that contain `d` as a variable.\nThe user can always avoid the problem by using (`d`) instead of `d` inside an integral.\n\nNow we augment the simplification rules, by copying a differentiation table out of a reference book:\n\n```lisp\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule '(\n (d x / d x  = 1)\n (d (u + v) / d x = (d u / d x) + (d v / d x))\n (d (u - v) / d x - (d u / d x) - (d v / d x))\n (d (- u) / d x = - (d u / d x))\n (d(u*v)/dx = u*(dv/dx) + v*(d u/d x))\n (d (u / v) / d x = (v * (d u / d x) - u * (d v / d x))\n      / v ^ 2)\n(d (u ^ n) / d x = n * u ^ (n - 1) * (d u / d x))\n(d (u ^ V) / d x = v * u ^ (v - 1) * (d u /d x)\n     + u ^ v * (log u) * (d v / d x))\n(d (log u) / d x = (d u / d x) / u)\n(d (sin u) / d x = (cos u) * (d u / d x))\n(d (cos u) / d x = - (sin u) * (d u / d x))\n(d (e ^ u) / d x = (e ^ u) * (d u / d x))\n(d u / d x  = 0)))))\n```\n\nWe have added a default rule, `(d u / d x = 0)`; this should only apply when the expression `u` is free of the variable `x` (that is, when u is not a function of `x`).\nWe could use `?if` to check this, but instead we rely on the fact that differentiation is closed over the list of operators described here-as long as we don't introduce any new operators, the answer will always be correct.\nNote that there are two rules for exponentiation, one for the case when the exponent is a number, and one when it is not.\nThis was not strictly necessary, as the second rule covers both cases, but that was the way the rules were written in the table of differentials I consulted, so I left both rules in.\n\n```lisp\nSIMPLIFIER > (d (x + x) / d x)\n2\nSIMPLIFIER > (d (a * x ^ 2 + b * x + c) / d x)\n((2 * (A * X)) + B)\nSIMPLIFIER > (d ((a * x ^ 2 + b * x + c) / x) / d x)\n((((A * (X ^ 2)) + ((B * X) + C)) - (X * ((2 * (A * X)) + B)))\n/ (X ^ 2))\nSIMPLIFIER > (log ((d (x + x) / d x) / 2))\n0\nSIMPLIFIER > (log(x + x) - log x)\n(LOG 2)\nSIMPLIFIER > (x ^ cos pi)\n(1 / X)\nSIMPLIFIER > (d (3 * x + (cos x) / x) / d x)\n((((COS X) - (X * (- (SIN X)))) / (X ^ 2)) + 3)\nSIMPLIFIER > (d ((cos x) / x) / d x)\n(((COS X) - (X * (- (SIN X)))) / (X ^ 2))\nSIMPLIFIER > (d (3 * x ^ 2 + 2 * x + 1) / d x)\n((6 * X) + 2)\nSIMPLIFIER > (sin(x + x) ^ 2 + cos(d x ^ 2 / d x) ^ 2)\n1\nSIMPLIFIER > (sin(x + x) * sin(d x ^ 2 / d x) +\n   cos(2 * x) * cos(x * d 2 * y / d y))\n1\n```\n\nThe program handles differentiation problems well and is seemingly clever in its use of the identity sin2*x* + cos2*x* = 1.\n\n## 8.5 Limits of Rule-Based Approaches\n{:#s0030}\n{:.h1hd}\n\nIn this section we return to some examples that pose problems for the simplifier.\nHere is a simple one:\n\n```lisp\nSIMPLIFIER > (x + y + y + x)`=> `(X + (Y + (Y + X)))\n```\n\nWe would prefer `2 * (x + y)`.\nThe problem is that, although we went to great trouble to group numbers together, there was no effort to group non-numbers.\nWe could write rules of the form:\n\n```lisp\n(y + (y + x) = (2 * y) + x)\n(y + (x + y) = (2 * y) + x)\n```\n\nThese would work for the example at hand, but they would not work for `(x + y + z + y + x)`.\nFor that we would need more rules:\n\n```lisp\n(y + (z + (y + x)) = (2 * y) + x + z)\n(y + (z + (x + y)) = (2 * y) + x + z)\n(y + ((y + x) + z) = (2 * y) + x + z)\n(y + ((x + y) + z) = (2 * y) + x + z)\n```\n\nTo handle all the cases, we would need an infinite number of rules.\nThe pattern-matching language is not powerful enough to express this succintly.\nIt might help if nested sums (and products) were unnested; that is, if we allowed + to take an arbitrary number of arguments instead of just one.\nOnce the arguments are grouped together, we could sort them, so that, say, all the `ys` appear before `z` and after `x`.\nThen like terms could be grouped together.\nWe have to be careful, though.\nConsider these examples:\n\n```lisp\nSIMPLIFIER > (3 * x + 4 * x)\n((3 * X) + (4 * X))\nSIMPLIFIER > (3 * x + y + x + 4 * x)\n((3 * X) + (Y + (X + (4 * X))))\n```\n\nWe would want `(3 * x)` to sort to the same place as `x` and `(4 * x )` so that they could all be combined to `(8 * x)`.\nIn [chapter 15](B9780080571157500157.xhtml), we develop a new version of the program that handles this problem.\n\n## 8.6 Integration\n{:#s0035}\n{:.h1hd}\n\nSo far, the algebraic manipulations have been straightforward.\nThere is a direct algorithm for Computing the derivative of every expression.\nWhen we consider integrals, or antiderivatives,[2](#fn0015) the picture is much more complicated.\nAs you may recall from freshman calculus, there is a fine art to Computing integrals.\nIn this section, we try to see how far we can get by encoding just a few of the many tricks available to the calculus student.\n\nThe first step is to recognize that entries in the simplification table will not be enough.\nInstead, we will need an algorithm to evaluate or \"simplify\" integrals.\nWe will add a new case to `simplify-exp` to check each operator to see if it has a simplification function associated with it.\nThese simplification functions will be associated with operators through the functions `set-simp-fn` and `simp-fn`.\nIf an operator does have a simplification function, then that function will be called instead of consulting the simplification rules.\nThe simplification function can elect not to handle the expression after all by returning nil, in which case we continue with the other simplification methods.\n\n```lisp\n(defun simp-fn (op) (get op 'simp-fn))\n(defun set-simp-fn (op fn) (setf (get op 'simp-fn) fn))\n(defun simplify-exp (exp)\n \"Simplify using a rule, or by doing arithmetic.\n or by using the simp function supplied for this operator.\"\n (cond ((simplify-by-fn exp)) ;***\n   ((rule-based-translator exp *simplification-rules*\n       :rule-if #'exp-lhs :rule-then #'exp-rhs\n       :action #'(lambda (bindings response)\n       (simplify (subiis bindings response)))))\n  ((evaluable exp) (eval exp))\n  (t exp)))\n(defun simplify-by-fn (exp)\n \"If there is a simplification fn for this exp,\n and if applying it gives a non-null result,\n then simplify the result and return that.\"\n (let* ((fn (simp-fn (exp-op exp)))\n   (result (if fn (funcall fn exp))))\n (if (null result)\n   nil\n   (simplify result))))\n```\n\nFreshman calculus classes teach a variety of integration techniques.\nFortunately, one technique-the derivative-divides technique-can be adopted to solve most of the problems that come up at the freshman calculus level, perhaps 90% of the problems given on tests.\nThe basic rule is:\n\n&int;fxdx=&int;fududxdx.\n\n![si1_e](images/B978008057115750008X/si1_e.gif)\n\nAs an example, consider *&int; x* sin(*x*2) *dx*.\nUsing the substitution *u* = *x*2, we can differentiate to get *du*/*dx* = 2*x*.\nThen by applying the basic rule, we get:\n\n&int;xsinx2dx=12&int;sinududxdx=12&int;sinudu.\n\n![si2_e](images/B978008057115750008X/si2_e.gif)\n\nAssume we have a table of integrals that includes the rule *&int;* sin(*x*) *dx* = - cos(*x*).\nThen we can get the final answer:\n\n-12cosx2.\n\n![si3_e](images/B978008057115750008X/si3_e.gif)\n\nAbstracting from this example, the general algorithm for integrating an expression *y* with respect to *x* is:\n\n1. Pick a factor of *y*, callingit *f*(*u*).\n!!!(p) {:.numlist}\n\n2. Compute the derivative *du*/*dx*.\n!!!(p) {:.numlist}\n\n3. Divide *y* by *f*(*u*) x *du*/*dx*, calling the quotient *k*.\n!!!(p) {:.numlist}\n\n4. If *k* is a constant (with respect to *x*), then the result is *k &int; f*(*u*)*du*.\n!!!(p) {:.numlist}\n\nThis algorithm is nondeterministic, as there may be many factors of *y*.\nIn our example, *f*(*u*) = sin(*x*2), *u* = *x*2, and *du*/*dx* = 2*x*.\nSo k=12 !!!(span) {:.hiddenClass} ![si4_e](images/B978008057115750008X/si4_e.gif), and the answer is -12cosx2 !!!(span) {:.hiddenClass} ![si5_e](images/B978008057115750008X/si5_e.gif).\n\nThe first step in implementing this technique is to make sure that division is done correctly.\nWe need to be able to pick out the factors of *y*, divide expressions, and then determine if a quotient is free of *x*.\nThe function `factorize` does this.\nIt keeps a list of factors and a running product of constant factors, and augments them with each call to the local function `fac`.\n\n```lisp\n(defun factorize (exp)\n \"Return a list of the factors of exp^n.\n where each factor is of the form (^ y n).\"\n (let ((factors nil)\n   (constant 1))\n (labels\n  ((fac (x n)\n   (cond\n       ((numberp x)\n       (setf constant (* constant (expt x n))))\n       ((starts-with x '*)\n       (fac (exp-lhs x) n)\n       (fac (exp-rhs x) n))\n       ((starts-with x '/)\n       (fac (exp-lhs x) n)\n       (fac (exp-rhs x) (- n)))\n       ((and (starts-with x '-) (length=l (exp-args x)))\n       (setf constant (- constant))\n       (fac (exp-lhs x) n))\n       ((and (starts-with x '^) (numberp (exp-rhs x)))\n       (fac (exp-lhs x) (* n (exp-rhs x))))\n       (t (let ((factor (find x factors :key #'exp-lhs\n         :test #'equal)))\n     (if factor\n      (incf (exp-rhs factor) n)\n      (push '(^ ,x ,n) factors)))))))\n  ;; Body of factorize:\n  (fac exp 1)\n  (case constant\n   (0 '((^ 0 1)))\n   (1 factors)\n   (t '((^ .constant 1) .,factors))))))\n```\n\n`factorize` maps from an expression to a list of factors, but we also need `unfactorize` to turn a list back into an expression:\n\n```lisp\n(defun unfactorize (factors)\n \"Convert a list of factors back into prefix form.\"\n (cond ((null factors) 1)\n   ((length=l factors) (first factors))\n   (t '(* .(first factors) . (unfactorize (rest factors))))))\n```\n\nThe derivative-divides method requires a way of dividing two expressions.\nWe do this by factoring each expression and then dividing by cancelling factors.\nThere may be cases where, for example, two factors in the numerator could be multiplied together to cancel a factor in the denominator, but this possibility is not considered.\nIt turns out that most problems from freshman calculus do not require such sophistication.\n\n```lisp\n(defun divide-factors (numer denom)\n \"Divide a list of factors by another, producing a third.\"\n (let ((result (mapcar #'copy-list numer)))\n (dolist (d denom)\n  (let ((factor (find (exp-lhs d) result :key #'exp-lhs\n     :test #'equal)))\n   (if factor\n       (decf (exp-rhs factor) (exp-rhs d))\n       (push '(^ ,(exp-lhs d) ,(- (exp-rhs d))) result))))\n (delete 0 result :key #'exp-rhs)))\n```\n\nFinally, the predicate `free-of` returns true if an expression does not have any occurrences of a particular variable in it.\n\n```lisp\n(defun free-of (exp var)\n \"True if expression has no occurrence of var.\"\n (not (find-anywhere var exp)))\n(defun find-anywhere (item tree)\n \"Does item occur anywhere in tree? If so, return it.\"\n (cond ((eql item tree) tree)\n   ((atom tree) nil)\n   ((find-anywhere item (first tree)))\n   ((find-anywhere item (rest tree)))))\n```\n\nIn `factorize` we made use of the auxiliary function `length=1.` The function call `(length=l x)` is faster than `(= (length x) 1)` because the latter has to compute the length of the whole list, while the former merely has to see if the list has a `rest` element or not.\n\n```lisp\n(defun length=l (x)\n \"Is X a list of length 1?\"\n (and (consp x) (null (rest x))))\n```\n\nGiven these preliminaries, the function `integrate` is fairly easy.\nWe start with some simple cases for integrating sums and constant expressions.\nThen, we factor the expression and split the list of factors into two: a list of constant factors, and a list of factors containing *x*.\n(This is done with `partition-if`, a combination of `remove-if` and `remove-if-not`.) Finally, we call `deriv-divides`, giving it a chance with each of the factors.\nIf none of them work, we return an expression indicating that the integral is unknown.\n\n```lisp\n(defun integrate (exp x)\n  ;; First try some trivial cases\n (cond\n ((free-of exp x) *(* ,exp x)) ; Int c dx = c*x\n ((starts-with exp '+) ; Int f + g =\n '(+ ,(integrate (exp-lhs exp) x) ; Int f + Int g\n    ,(integrate (exp-rhs exp) x)))\n ((starts-with exp '-)\n (ecase (length (exp-args exp))\n  (1 (integrate (exp-lhs exp) x)) ; Int - f = - Int f\n  (2 '(- ,(integrate (exp-lhs exp) x) ; Int f - g =\n    ,(integrate (exp-rhs exp) x))))) ; Int f - Int g\n ;; Now move the constant factors to the left of the integral\n ((multiple-value-bind (const-factors x-factors)\n       (partition-if #'(lambda (factor) (free-of factor x))\n     (factorize exp))\n  (simplify\n   '(* ,(unfactorize const-factors)\n        ;; And try to integrate:\n        ,(cond ((null x-factors) x)\n     ((some #'(lambda (factor)\n               (deriv-divides factor x-factors x))\n            x-factors))\n       ;; < other methods here >\n       (t '(int? ,(unfactorize x-factors) ,x)))))))))\n(defun partition-if (pred list)\n \"Return 2 values: elements of list that satisfy pred,\n and elements that don't.\"\n (let ((yes-1ist nil)\n  (no-list nil))\n (dolist (item list)\n  (if (funcall pred item)\n       (push item yes-list)\n       (push item no-list)))\n (values (nreverse yes-list) (nreverse no-list))))\n```\n\nNote that the place in integrate where other techniques could be added is marked.\nWe will only implement the derivative-divides method.\nIt turns out that the function is a little more complicated than the simple four-step algorithm outlined before:\n\n```lisp\n(defun deriv-divides (factor factors x)\n (assert (starts-with factor '^))\n (let* ((u (exp-lhs factor)) ; factor = u^n\n (n (exp-rhs factor))\n (k (divide-factors\n   factors (factorize '(* ,factor ,(deriv u x))))))\n (cond ((free-of k x)\n  ;; Int k*u^n*du/dx dx = k*Int u^n du\n  ;;      = k*u^(n+1)/(n+1) for n /= -1\n  ;;      = k*log(u) for n = -1\n  (if (= n -1)\n   '(* .(unfactorize k) (log ,u))\n   '(/ (* ,(unfactorize k) (^ ,u ,(+ n 1)))\n        ,(+ n 1))))\n  ((and (= n 1) (in-integral-table? u))\n  ;; Int y'*f(y) dx = Int f(y) dy\n  (let ((k2 (divide-factors\n     factors\n     (factorize '(* ,u ,(deriv (exp-lhs u) x))))))\n   (if (free-of k2 x)\n       '(* ,(integrate-from-table (exp-op u) (exp-lhs u))\n      ,(unfactorize k2))))))))\n```\n\nThere are three cases.\nIn any case, all factors are of the form `(^ u n)`, so we separate the factor into a base, `u`, and exponent, `n`.\nIf *u* or *un* evenly divides the original expression (here represented as factors), then we have an answer.\nBut we need to check the exponent, because *&int; undu* is *u**n*+1/(*n* + 1) for *n*&ne; - 1, but it is log (*u*) for *n* = - 1.\nBut there is a third case to consider.\nThe factor may be something like `(^ (sin (^ x 2)) 1)`, in which case we should consider *f*(*u*) = sin(*x*2).\nThis case is handled with the help of an integral table.\nWe don't need a derivative table, because we can just use the simplifier for that.\n\n```lisp\n(defun deriv (y x) (simplify '(d ,y ,x)))\n(defun integration-table (rules)\n (dolist (i-rule rules)\n (let ((rule (infix->prefix i-rule)))\n  (setf (get (exp-op (exp-lhs (exp-lhs rule))) 'int)\n   rule))))\n(defun in-integral-table? (exp)\n (and (exp-p exp) (get (exp-op exp) 'int)))\n(defun integrate-from-table (op arg)\n (let ((rule (get op 'int)))\n (subst arg (exp-lhs (exp-lhs (exp-lhs rule))) (exp-rhs rule))))\n(integration-table\n '((Int log(x) d x = x * log(x) - x)\n (Int exp(x) d x = exp(x))\n (Int sin(x) d x = - cos(x))\n (Int cos(x) d x = sin(x))\n (Int tan(x) d x = - log(cos(x)))\n (Int sinh(x) d x = cosh(x))\n (Int cosh(x) d x = sinh(x))\n (Int tanh(x) d x = log(cosh(x)))\n ))\n```\n\nThe last step is to install integrate as the simplification function for the operator Int.\nThe obvious way to do this is:\n\n```lisp\n(set-simp-fn 'Int 'integrate)\n```\n\nUnfortunately, that does not quite work.\nThe problem is that integrate expects two arguments, corresponding to the two arguments *`y`* and *`x`* in `( Int *y x*)`.\nBut the convention for simplification functions is to pass them a single argument, consisting of the whole expression `( Int *y x*)`.\nWe could go back and edit `simplify-exp` to change the convention, but instead I choose to make the conversion this way:\n\n```lisp\n(set-simp-fn 'Int #'(lambda (exp)\n     (integrate (exp-lhs exp) (exp-rhs exp))))\n```\n\nHere are some examples, taken from [chapters 8](#c0040) and [9](B9780080571157500091.xhtml) of *Calculus* ([Loomis 1974](B9780080571157500285.xhtml#bb0750)):\n\n```lisp\nSIMPLIFIER > (Int x * sin(x ^ 2) d x)\n(1/2 * (- (COS (X ^ 2))))\nSIMPLIFIER > (Int ((3 * x ^ 3) - 1 / (3 * x ^ 3)) d x)\n((3 * ((X ^ 4) / 4)) - (1/3 * ((X ^ -2) / -2)))\nSIMPLIFIER > (Int (3 * x + 2) ^ -2/3 d x)\n(((3 * X) + 2) ^ 1/3)\nSIMPLIFIER > (Int sin(x) ^ 2 * cos(x) d x)\n(((SIN X) ^ 3) / 3)\nSIMPLIFIER > (Int sin(x) / (1 + cos(x)) d x)\n(-1 * (LOG ((COS X) + 1)))\nSIMPLIFIER > (Int (2 * x + 1) / (x ^ 2 + x - 1) d x)\n(LOG ((X ^ 2) + (X - 1)))\nSIMPLIFIER > (Int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x)\n(8 * ((1/3 * (((X ^ 3) + 2) ^ -2)) / -2))\n```\n\nAll the answers are correct, although the last one could be made simpler.\nOne quick way to simplify such an expression is to factor and unfactor it, and then simplify again:\n\n```lisp\n(set-simp-fn 'Int\n  #'(lambda (exp)\n   (unfactorize\n    (factorize\n     (integrate (exp-lhs exp) (exp-rhs exp))))))\n```\n\nWith this change, we get:\n\n```lisp\nSIMPLIFIER > (Int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x)\n(-4/3 * (((X ^ 3) + 2) ^ -2))\n```\n\n## 8.7 History and References\n{:#s0040}\n{:.h1hd}\n\nA brief history is given in the introduction to this chapter.\nAn interesting point is that the history of Lisp and of symbolic algebraic manipulation are deeply intertwined.\nIt is not too gross an exaggeration to say that Lisp was invented by John McCarthy to express the symbolic differentiation algorithm.\nAnd the development of the first high-quality Lisp system, MacLisp, was driven largely by the needs of MACSYMA !!!(span) {:.smallcaps} , one of the first large Lisp systems.\nSee [McCarthy 1958](B9780080571157500285.xhtml#bb0790) for early Lisp history and the differentiation algorithm, and [Martin and Fateman 1971](B9780080571157500285.xhtml#bb0775) and [Moses (1975)](B9780080571157500285.xhtml#bb0875) for more details on MACSYMA !!!(span) {:.smallcaps} . A comprehensive book on computer algebra systems is [Davenport 1988](B9780080571157500285.xhtml#bb0270).\nIt covers the MACSYMA !!!(span) {:.smallcaps} and REDUCE !!!(span) {:.smallcaps} systems as well as the algorithms behind those systems.\n\nBecause symbolic differentiation is historically important, it is presented in a number of text books, from the original Lisp 1.5 Primer ([Weissman 1967](B9780080571157500285.xhtml#bb1370)) and Allen's influential [*Anatomy of Lisp* (1978)](B9780080571157500285.xhtml#bb0040) to recent texts like [Brooks 1985](B9780080571157500285.xhtml#bb0135), [Hennessey 1989](B9780080571157500285.xhtml#bb0530), and [Tanimoto 1990](B9780080571157500285.xhtml#bb1220).\nMany of these books use rules or data-driven programming, but each treats differentiation as the main task, with simplification as a separate problem.\nNone of them use the approach taken here, where differentiation is just another kind of simplification.\n\nThe symbolic integration programs SAINT !!!(span) {:.smallcaps} and SIN !!!(span) {:.smallcaps} are covered in [Slagle 1963](B9780080571157500285.xhtml#bb1115) and [Moses 1967](B9780080571157500285.xhtml#bb0870), respectively.\nThe mathematical solution to the problem of integration in closed term is addressed in [Risch 1969](B9780080571157500285.xhtml#bb0985), but be warned; this paper is not for the mathematically naive, and it has no hints on programming the algorithm.\nA better reference is [Davenport et al.\n1988](B9780080571157500285.xhtml#bb0270).\n\nIn this book, techniques for improving the efficiency of algebraic manipulation are covered in [sections 9.6](B9780080571157500091.xhtml#s0035) and [10.4](B9780080571157500108.xhtml#s0025).\n[Chapter 15](B9780080571157500157.xhtml) presents a reimplementation that does not use pattern-matching, and is closer to the techniques used in MACSYMA !!!(span) {:.smallcaps} .\n\n## 8.8 Exercises\n{:#s0045}\n{:.h1hd}\n\n**Exercise 8.2 [s]** Some notations use the operator ** instead of ^ to indicate exponentiation.\n`Fix infix->prefix` so that either notation is allowed.\n\n**Exercise 8.3 [m]** Can the system as is deal with imaginary numbers?\nWhat are some of the difficulties?\n\n**Exercise 8.4 [h]** There are some simple expressions involving sums that are not handled by the `integrate` function.\nThe function can integrate *a*x *x*2 + *b*x *x* + *c* but not 5 x (*a*x *x*2 + *b*x *x* + *c*).\nSimilarly, it can integrate *x*4 + 2 x *x*3 + *x*2 but not (*x*2 + *x*)2, and it can do *x*3 + *x*2 + *x* + 1 but not (*x*2 + 1) x (*x* + 1).\nModify `integrate` so that it expands out products (or small exponents) of sums.\nYou will probably want to try the usual techniques first, and do the expansion only when that fails.\n\n**Exercise 8.5 [d]** Another very general integration technique is called integration by parts.\nIt is based on the rule:\n\n&int;udv=uv-&int;vdu\n\n![si6_e](images/B978008057115750008X/si6_e.gif)\n\nSo, for example, given\n\n&int;xcosxdx\n\n![si7_e](images/B978008057115750008X/si7_e.gif)\n\nwe can take *u* = *x*, *dv* = cos *xdx*.\nThen we can determine *v* = sin *x* by integration, and come up with the solution:\n\n&int;xcosxdx=xsinx-&int;sinxx1dx=xsinx+cosx\n\n![si8_e](images/B978008057115750008X/si8_e.gif)\n\nIt is easy to program an integration by parts routine.\nThe hard part is to program the control component.\nIntegration by parts involves a recursive call to `integrate`, and of all the possible ways of breaking up the original expression into a *u* and a *dv*, few, if any, will lead to a successful integration.\nOne simple control rule is to allow integration by parts only at the top level, not at the recursive level.\nImplement this approach.\n\n**Exercise 8.6 [d]** A more complicated approach is to try to decide which ways of breaking up the original expression are promising and which are not.\nDerive some heuristics for making this division, and reimplement `integrate` to include a search component, using the search tools of [chapter 6](B9780080571157500066.xhtml).\n\nLook in a calculus textbook to see how *&int;* sin2*xdx* is evaluated by two integrations by parts and a division.\nImplement this technique as well.\n\n**Exercise 8.7 [m]** Write simplification rules for predicate calculus expressions.\nFor example,\n\n```lisp\n(true and x = x)\n(false and x = false)\n(true or x = true)\n(false or x = false)\n```\n\n**Exercise 8.8 [m]** The simplification rule `(x / 0 = undefined)` is necessary to avoid problems with division by zero, but the treatment of `undefined` is inadequate.\nFor example, the expression `((0 / 0) - (0 / 0))` will simplify to zero, when it should simplify to `undefined`.\nAdd rules to propagate `undefined` values and prevent them from being simplified away.\n\n**Exercise 8.9 [d]** Extend the method used to handle `undefined` to handle `+ infinity` and `-infinity` as well.\n\n----------------------\n\n[1](#xfn0010)MACSYMA !!!(span) {:.smallcaps} is the Project MAC SYMbolic MAthematics program.\nProject MAC is the MIT research organization that was the precursor of MIT's Laboratory for Computer Science.\nMAC stood either for Machine-Aided Cognition or Multiple-Access Computer, according to one of their annual reports.\nThe cynical have claimed that MAC really stood for Man Against Computer.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) The term antiderivative is more correct, because of branch point problems.\n!!!(p) {:.ftnote1}\n\nPart III\nTools and Techniques\n!!!(p) {:.parttitle}\n\n# Chapter 9\n## Efficiency Issues\n{:.chaptitle}\n\n> A Lisp programmer knows the value of everything, but the cost of nothing.\n\n> -Alan J.\nPerlis\n\n> Lisp is not inherently less efficient than other high-level languages.\n\n> -Richard J.\nFateman\n\nOne of the reasons Lisp has enjoyed a long history is because it is an ideal language for what is now called *rapid-prototyping*-developing a program quickly, with little regards for details.\nThat is what we have done so far in this book: concentrated on getting a working algorithm.\nUnfortunately, when a prototype is to be turned into a production-quality program, details can no longer be ignored.\nMost \"real\" AI programs deal with large amounts of data, and with large search spaces.\nThus, efficiency considerations become very important.\n\nHowever, this does not mean that writing an efficient program is fundamentaly different from writing a working program.\nIdeally, developing an efficient program should be a three-step process.\nFirst, develop a working program, using proper abstractions so that the program will be easy to change if necessary.\nSecond, *instrument* the program to determine where it is spending most of the time.\nThird, replace the slow parts with faster versions, while maintaining the program's correctness.\n\nThe term *efficiency* will be used primarily to talk about the *speed* or run time of a program.\nTo a lesser extent, *efficiency* is also used to refer to the *space* or amount of storage consumed by a program.\nWe will also talk about the cost of a program.\nThis is partly a use of the metaphor \"time is money,\" and partly rooted in actual monetary costs-if a critical program runs unacceptably slowly, you may need to buy a more expensive computer.\n\nLisp has been saddled with a reputation as an \"inefficient language.\" Strictly speaking, it makes no sense to call a *language* efficient or inefficient.\nRather, it is only a particular *implementation* of the language executing a particular program that can be measured for efficiency.\nSo saying Lisp is inefficient is partly a historical claim: some past implementations *have* been inefficient.\nIt is also partly a prediction: there are some reasons why future implementations are expected to suffer from inefficiencies.\nThese reasons mainly stem from Lisp's flexibility.\nLisp allows many decisions to be delayed until run time, and that can make the run time take longer.\nIn the past decade, the \"efficiency gap\" between Lisp and \"conventional languages\" like FORTRAN or C has narrowed.\nHere are the reasons-some deserved, some not-behind Lisp's reputation for inefficiency:\n\n*  Early implementations were interpreted rather than compiled, which made them inherently inefficient.\nCommon Lisp implementations have compilers, so this is no longer a problem.\nWhile Lisp is (primarily) no longer an interpreted language, it is still an *interactive* language, so it retains its flexibility.\n\n*  Lisp has often been used to write interpreters for embedded languages, thereby compounding the problem.\nConsider this quote from [Cooper and Wogrin's (1988)](B9780080571157500285.xhtml#bb0260) book on the rule-based programming language OPS5:\n\n> The efficiency of implementations that compile rules into executable code compares favorably to that of programs written in most sequential languages such as FORTRAN or Pascal Implementations that compile rules into data structures to be interpreted, as do many Lisp-based ones, could be noticeably slower.\n\nHere Lisp is guilty by association.\nThe fallacious chain of reasoning is: Lisp has been used to write interpreters; interpreters are slow; therefore Lisp is slow.\nWhile it is true that Lisp makes it very easy to write interpreters, it also makes it easy to write compilers.\nThis book is the first that concentrates on using Lisp as both the implementation and target language for compilers.\n\n*  Lisp encourages a style with lots of function calls, particularly recursive calls.\nIn some older systems, function calls were expensive.\nBut it is now understood that a function call can be compiled into a simple branch instruction, and that many recursive calls can be made no more expensive than an equivalent iterative loop (see [chapter 22](B9780080571157500224.xhtml)).\nIt is also possible to instruct a Common Lisp compiler to compile certain functions inline, so there is no calling overhead at all.\nOn the other hand, many Lisp systems require two fetches instead of one to find the code for a function, and thus will be slower.\nThis extra level of indirection is the price paid for the freedom of being able to redefine functions without reloading the whole program.\n\n*  Run-time type-checking is slow.\nLisp provides a repertoire of generic functions.\nFor example, we can write `(+ x y)` without bothering to declare if `x` and `y` are integers, floating point, bignums, complex numbers, rationals, or some combination of the above.\nThis is very convenient, but it means that type checks must be made at run time, so the generic + will be slower than, say, a 16-bit integer addition with no check for overflow.\nIf efficiency is important, Common Lisp allows the programmer to include declarations that can eliminate run-time checks.\nIn fact, once the proper declarations are added, Lisp can be as fast or faster than conventional languages.\n[Fateman (1973)](B9780080571157500285.xhtml#bb0375) compared the FORTRAN cube root routine on the PDP-10 to a MacLisp transliteration.\nThe MacLisp version produced almost identical numerical code, but was 18% faster overall, due to a superior function-calling sequence.[1](#fn0010)The epigraph at the beginning of this chapter is from this article.\n[Berlin and Weise (1990)](B9780080571157500285.xhtml#bb0085) show that with a special compilation technique called *partial evaluation*, speeds 7 to 90 times faster than conventionally compiled code can be achieved.\nOf course, partial evaluation could be used in any language, but it is very easy to do in Lisp.\nThe fact remains that Lisp objects must somehow represent their type, and even with declarations, not all of this overhead can be eliminated.\nMost Lisp implementations optimize access to lists and fixnums but pay the price for the other, less commonly used data types.\n\n*  Lisp automatically manages storage, and so it must periodically stop and collect the unused storage, or *garbage*.\nIn early systems, this was done by periodically sweeping through all of memory, resulting in an appreciable pause.\nModem systems tend to use incremental garbage-collection techniques, so pauses are shorter and usually unnoticed by the user (although the pauses may still be too long for real-time applications such as controlling a laboratory instrument).\nThe problem with automatic garbage collection these days is not that it is slow-in fact, the automatic systems do about as well as handcrafted storage allocation.\nThe problem is that they make it convenient for the programmer to generate a lot of garbage in the first place.\nProgrammers in conventional languages, who have to clean up their own garbage, tend to be more careful and use static rather than dynamic storage more often.\nIf garbage becomes a problem, the Lisp programmer can just adopt these static techniques.\n\n*  Lisp systems are big and leave little room for other programs.\nMost Lisp systems are designed to be complete environments, within which the programmer does all program development and execution.\nFor this kind of operation, it makes sense to have a large language like Common Lisp with a huge set of tools.\nHowever, it is becoming more common to use Lisp as just one component in a Computing environment that may include UNIX, X Windows, emacs, and other interacting programs.\nIn this kind of heterogeneous environment, it would be useful to be able to define and run small Lisp processes that do not include megabytes of unused tools.\nSome recent compilers support this option, but it is not widely available yet.\n\n*  Lisp is a complicated high-level language, and it can be difficult for the programmer to anticipate the costs of various operations.\nIn general, the problem is not that an efficient encoding is impossible but that it is difficult to arrive at that efficient encoding.\nIn a language like C, the experienced programmer has a pretty good idea how each statement will compile into assembly language instructions.\nBut in Lisp, very similar statements can compile into widely different assembly-level instructions, depending on subtle interactions between the declarations given and the capabilities of the compiler.\n[Page 318](B9780080571157500108.xhtml#p318) gives an example where adding a declaration speeds up a trivial function by 40 times.\nNonexperts do not understand when such declarations are necessary and are frustrated by the seeming inconsistencies.\nWith experience, the expert Lisp programmer eventually develops a good \"efficiency model,\" and the need for such declarations becomes obvious.\nRecent compilers such as CMU's Python provide feedback that eases this learning process.\n\nIn summary, Lisp makes it possible to write programs in a wide variety of styles, some efficient, some less so.\nThe programmer who writes Lisp programs in the same style as C programs will probably find Lisp to be of comparable speed, perhaps slightly slower.\nThe programmer who uses some of the more dynamic features of Lisp typically finds that it is much easier to develop a working program.\nThen, if the resulting program is not efficient enough, there will be more time to go back and improve critical sections.\nDeciding which parts of the program use the most resources is called *instrumentation*.\nIt is foolhardy to try to improve the efficiency of a program without first checking if the improvement will make a real difference.\n\nOne route to efficiency is to use the Lisp prototype as a specification and reimplement that specification in a lower-level language, such as C or C++.\nSome commercial AI vendors are taking this route.\nAn alternative is to use Lisp as the language for both the prototype and the final implementation.\nBy adding declarations and making minor changes to the original program, it is possible to end up with a Lisp program that is similar in efficiency to a C program.\n\nThere are four very general and language-independent techniques for speeding up an algorithm:\n\n*  *Caching* the results of computations for later reuse.\n\n*  *Compiling* so that less work is done at run time.\n\n*  *Delaying* the computation of partial results that may never be needed.\n\n*  *Indexing* a data structure for quicker retrieval.\n\nThis chapter covers each of the four techniques in order.\nIt then addresses the important problem of *instrumentation*.\nThe chapter concludes with a case study of the simplify program.\nThe techniques outlined here result in a 130-fold speed-up in this program.\n\n[Chapter 10](B9780080571157500108.xhtml) concentrates on lower-level \"tricks\" for improving efficiency further.\n\n## 9.1 Caching Results of Previous Computations: Memoization\n{:#s0010}\n{:.h1hd}\n\nWe start with a simple mathematical function to demonstrate the advantages of caching techniques.\nLater we will demonstrate more complex examples.\n\nThe Fibonacci sequence is defined as the numbers 1,1,2,3,5,8,... where each number is the sum of the two previous numbers.\nThe most straightforward function to compute the nth number in this sequence is as follows:\n\n```lisp\n(defun fib (n)\n  \"Compute the nth number in the Fibonacci sequence.\"\n (if (<= n 1) 1\n   (+ (fib (- n 1)) (fib (- n 2)))))\n```\n\nThe problem with this function is that it computes the same thing over and over again.\nTo compute (`fib 5`) means Computing (`fib 4`) and (`fib 3`), but (`fib 4`) also requires (`fib 3`), they both require (`fib 2`), and so on.\nThere are ways to rewrite the function to do less computation, but wouldn't it be nice to write the function as is, and have it automatically avoid redundant computation?\nAmazingly, there is a way to do just that.\nThe idea is to use the function `fib` to build a new function that remembers previously computed results and uses them, rather than recompute them.\nThis process is called *memoization*.\nThe function `memo` below is a higher-order function that takes a function as input and returns a new function that will compute the same results, but not do the same computation twice.\n\n```lisp\n(defun memo (fn)\n   \"Return a memo-function of fn.\"\n   (let ((table (make-hash-table)))\n     #'(lambda (x)\n         (multiple-value-bind (val found-p)\n           (gethash x table)\n       (if found-p\n              val\n              (setf (gethash x table) (funcall fn x)))))))\n```\n\nThe expression (`memo #'fib`) will produce a function that remembers its results between calls, so that, for example, if we apply it to 3 twice, the first call will do the computation of (`fib 3`), but the second will just look up the result in a hash table.\nWith `fib` traced, it would look like this:\n\n```lisp\n> (setf memo-fib (memo #'fib)) => # < CL0SURE - 67300731 >\n> (funcall memo-fib 3) =>\n(1 ENTER FIB: 3)\n  (2 ENTER FIB: 2)\n     (3 ENTER FIB: 1)\n     (3 EXIT FIB: 1)\n     (3 ENTER FIB: 0)\n     (3 EXIT FIB: 1)\n  (2 EXIT FIB: 2)\n  (2 ENTER FIB: 1)\n  (2 EXIT FIB: 1)\n(1 EXIT FIB: 3)\n3\n> (funcall memo-fib 3) = > 3\n```\n\nThe second time we call `memo-fib` with 3 as the argument, the answer is just retrieved rather than recomputed.\nBut the problem is that during the computation of (`fib 3`), we still compute (`fib 2`) multiple times.\nIt would be better if even the internal, recursive calls were memoized, but they are calls to fib, which is unchanged, not to `memo-fib`.\nWe can solve this problem easily enough with the function `memoize`:\n\n```lisp\n(defun memoize (fn-name)\n   \"Replace fn-name's global definition with a memoized version.\"\n   (setf (symbol-function fn-name) (memo (symbol-function fn-name))))\n```\n\nWhen passed a symbol that names a function, `memoize` changes the global definition of the function to a memo-function.\nThus, any recursive calls will go first to the memo-function, rather than to the original function.\nThis is just what we want.\nIn the following, we contrast the memoized and unmemoized versions of `fib`.\nFirst, a call to (`fib 5`) with `fib` traced:\n\n```lisp\n> (fib 5) =>\n(1 ENTER FIB: 5)\n   (2 ENTER FIB: 4)\n      (3 ENTER FIB: 3)\n         (4 ENTER FIB: 2)\n             (5 ENTER FIB: 1)\n             (5 EXIT FIB: 1)\n             (5 ENTER FIB: 0)\n             (5 EXIT FIB: 1)\n         (4 EXIT FIB: 2)\n         (4 ENTER FIB: 1)\n         (4 EXIT FIB: 1)\n      (3 EXIT FIB: 3)\n      (3 ENTER FIB: 2)\n         (4 ENTER FIB: 1)\n         (4 EXIT FIB: 1)\n         (4 ENTER FIB: 0)\n         (4 EXIT FIB: 1)\n      (3 EXIT FIB: 2)\n   (2 EXIT FIB: 5)\n   (2 ENTER FIB: 3)\n      (3 ENTER FIB: 2)\n         (4 ENTER FIB: 1)\n         (4 EXIT FIB: 1)\n         (4 ENTER FIB: 0)\n         (4 EXIT FIB: 1)\n      (3 EXIT FIB: 2)\n      (3 ENTER FIB: 1)\n      (3 EXIT FIB: 1)\n   (2 EXIT FIB: 3)\n(1 EXIT FIB: 8)\n8\n```\n\nWe see that (`fib 5`) and (`fib 4`) are each computed once, but (`fib 3`) is computed twice, (`fib 2`) three times,and (`fib 1`) five times.\nBelow we call (`memoize 'fib`) and repeat the calculation.\nThis time, each computation is done only once.\nFurthermore, when the computation of (`fib 5`) is repeated, the answer is returned immediately with no intermediate computation, and a further call to (`fib 6`) can make use of the value of (`fib 5`).\n\n```lisp\n> (memoize 'fib) => # < CL0SURE 76626607 >\n> (fib 5) =>\n(1 ENTER FIB: 5)\n  (2 ENTER FIB: 4)\n     (3 ENTER FIB: 3)\n        (4 ENTER FIB: 2)\n           (5 ENTER FIB: 1)\n           (5 EXIT FIB: 1)\n           (5 ENTER FIB: 0)\n           (5 EXIT FIB: 1)\n        (4 EXIT FIB: 2)\n     (3 EXIT FIB: 3)\n  (2 EXIT FIB: 5)\n(1 EXIT FIB: 8)\n8\n> (fib 5)  => 8\n> (fib 6) =>\n(1 ENTER FIB: 6)\n(1 EXIT FIB: 13)\n13\n```\n\nUnderstanding why this works requires a clear understanding of the distinction between functions and function names.\nThe original (`defun fib ...`) form does two things: builds a function and stores it as the `symbol - function` value of `fib`.\nWithin that function there are two references to `fib`; these are compiled (or interpreted) as instructions to fetch the `symbol - function` of `fib` and apply it to the argument.\n\nWhat `memoize` does is fetch the original function and transform it with `memo` to a function that, when called, will first look in the table to see if the answer is already known.\nIf not, the original function is called, and a new value is placed in the table.\nThe trick is that `memoize` takes this new function and makes it the `symbol - function` value of the function name.\nThis means that all the references in the original function will now go to the new function, and the table will be properly checked on each recursive call.\nOne further complication to `memo:` the function `gethash` returns both the value found in the table and an indicator of whether the key was present or not.\nWe use `multiple-value-bind` to capture both values, so that we can distinguish the case when `nil` is the value of the function stored in the table from the case where there is no stored value.\n\nIf you make a change to a memoized function, you need to recompile the original definition, and then redo the call to memoize.\nIn developing your program, rather than saying `(memoize 'f)`, it might be easier to wrap appropriate definitions in a `memoize` form as follows:\n\n```lisp\n(memoize\n  (defun f (x) ...)\n  )\n```\n\nOr define a macro that combines `defun` and `memoize`:\n\n```lisp\n(defmacro defun-memo (fn args &body body)\n   \"Define a memoized function.\"\n   '(memoize (defun ,fn ,args . ,body)))\n(defun-memo f (x) ...)\n```\n\nBoth of these approaches rely on the fact that `defun` returns the name of the function defined.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| *n* | `(fib *n*)` | unmemoized | memoized | memoized up to |\n| 25 | 121393 | 1.1 | .010 | 0 |\n| 26 | 196418 | 1.8 | .001 | 25 |\n| 27 | 317811 | 2.9 | .001 | 26 |\n| 28 | 514229 | 4.7 | .001 | 27 |\n| 29 | 832040 | 8.2 | .001 | 28 |\n| 30 | 1346269 | 12.4 | .001 | 29 |\n| 31 | 2178309 | 20.1 | .001 | 30 |\n| 32 | 3524578 | 32.4 | .001 | 31 |\n| 33 | 5702887 | 52.5 | .001 | 32 |\n| 34 | 9227465 | 81.5 | .001 | 33 |\n| 50 | 2.0el0 | - | .014 | 34 |\n| 100 | 5.7e20 | - | .031 | 50 |\n| 200 | 4.5e41 | - | .096 | 100 |\n| 500 | 2.2el04 | - | .270 | 200 |\n| 1000 | 7.0e208 | - | .596 | 500 |\n| 1000 | 7.0e208 | - | .001 | 1000 |\n| 1000 | 7.0e208 | - | .876 | 0 |\n\n![t0010](images/B9780080571157500091/t0010.png)\n\nNow we show a table giving the values of `(fib *n*)` for certain *n*, and the time in seconds to compute the value, before and after `(memoize 'fib)`.\nFor larger values of *n*, approximations are shown in the table, although `fib` actually returns an exact integer.\nWith the unmemoized version, I stopped at *n* = 34, because the times were getting too long.\nFor the memoized version, even *n* = 1000 took under a second.\n\nNote there are three entries for (`fib 1000`).\nThe first entry represents the incremental computation when the table contains the memoized values up to 500, the second entry shows the time for a table lookup when (`fib 1000`) is already computed, and the third entry is the time for a complete computation starting with an empty table.\n\nIt should be noted that there are two general approaches to discussing the efficiency of an algorithm.\nOne is to time the algorithm on representative inputs, as we did in this table.\nThe other is to analyze the *asymptotic complexity* of the algorithm.\nFor the `fib` problem, an asymptotic analysis considers how long it takes to compute `(fib *n*)` as *n* approaches infinity.\nThe notation *O*(*f*(*n*)) is used to describe the complexity.\nFor example, the memoized version `fib` is an *O*(*n*) algorithm because the computation time is bounded by some constant times *n*, for any value of *n*.\nThe unmemoized version, it turns out, is *O*(1.\n7*n*), meaning Computing `fib` of n + 1 can take up to 1.7 times as long as `fib` of *n*.\nIn simpler terms, the memoized version has *linear* complexity, while the unmemoized version has *exponential* complexity.\n[Exercise 9.4](B9780080571157500091.xhtml#p4655) ([Page 308](B9780080571157500091.xhtml#p308)) describes where the 1.7 comes from, and gives a tighter bound on the complexity.\n\nThe version of `memo` presented above is inflexible in several ways.\nFirst, it only works for functions of one argument.\nSecond, it only returns a stored value for arguments that are `eql`, because that is how hash tables work by default.\nFor some applications we want to retrieve the stored value for arguments that are `equal`.\nThird, there is no way to delete entries from the hash table.\nIn many applications there are times when it would be good to clear the hash table, either because it has grown too large or because we have finished a set of related problems and are moving on to a new problem.\n\nThe versions of `memo` and `memoize` below handle these three problems.\nThey are compatible with the previous version but add three new keywords for the extensions.\nThe `name` keyword stores the hash table on the property list of that name, so it can be accessed by `clear-memoize`.\nThe `test` keyword tells what kind of hash table to create: `eq, eql, or equal`.\nFinally, the `key` keyword tells which arguments of the function to index under.\nThe default is the first argument (to be compatible with the previous version), but any combination of the arguments can be used.\nIf you want to use all the arguments, specify `identity` as the key.\nNote that if the key is a list of arguments, then you will have to use `equal` hash tables.\n\n```lisp\n(defun memo (fn name key test)\n   \"Return a memo-function of fn.\"\n   (let ((table (make-hash-table :test test)))\n     (setf (get name 'memo) table)\n     #'(lambda (&rest args)\n         (let ((k (funcall key args)))\n             (multiple-value-bind (val found-p)\n                (gethash k table)\n             (if found-p val\n                       (setf (gethash k table) (apply fn args))))))))\n(defun memoize (fn-name &key (key #'first) (test #'eql))\n   \"Replace fn-name's global definition with a memoized version.\"\n   (setf (symbol-function fn-name)\n         (memo (symbol-function fn-name) fn-name key test)))\n(defun clear-memoize (fn-name)\n   \"Clear the hash table from a memo function.\"\n   (let ((table (get fn-name 'memo)))\n         (when table (clrhash table))))\n```\n\n## 9.2 Compiling One Language into Another\n{:#s0015}\n{:.h1hd}\n\nIn [chapter 2](B9780080571157500029.xhtml) we defined a new language-the language of grammar rules-which was processed by an interpreter designed especially for that language.\nAn *interpreter* is a program that looks at some data structure representing a \"program\" or sequence of rules of some sort and interprets or evaluates those rules.\nThis is in contrast to a *compiler*, which translates some set of rules in one language into a program in another language.\n\nThe function `generate` was an interpreter for the \"language\" defined by the set of grammar rules.\nInterpreting these rules is straightforward, but the process is some-what inefficient, in that generate must continually search through the `*grammar*` to find the appropriate rule, then count the length of the right-hand side, and so on.\n\nA compiler for this rule-language would take each rule and translate it into a function.\nThese functions could then call each other with no need to search through the `*grammar*`.\nWe implement this approach with the function `compile-rule`.\nIt makes use of the auxiliary functions `one-of` and `rule-lhs` and `rule-rhs` from [Page 40](B9780080571157500029.xhtml#p40), repeated here:\n\n```lisp\n(defun rule-lhs (rule)\n \"The left-hand side of a rule.\"\n (first rule))\n(defun rule-rhs (rule)\n \"The right-hand side of a rule.\"\n (rest (rest rule)))\n(defun one-of (set)\n \"Pick one element of set, and make a list of it.\"\n (list (random-elt set)))\n(defun random-elt (choices)\n \"Choose an element from a list at random.\"\n (elt choices (random (length choices))))\n```\n\nThe function `compile-rule` turns a rule into a function definition by building up Lisp code that implements all the actions that generate would take in interpreting the rule.\nThere are three cases.\nIf every element of the right-hand side is an atom, then the rule is a lexical rule, which compiles into a call to `one-of` to pick a word at random.\nIf there is only one element of the right-hand side, then `build-code` is called to generate code for it.\nUsually, this will be a call to append to build up a list.\nFinally, if there are several elements in the right-hand side, they are each turned into code by `build-code`; are given a number by `build-cases`; and then a `case` statement is constructed to choose one of the cases.\n\n```lisp\n(defun compile-rule (rule)\n \"Translate a grammar rule into a LISP function definition.\"\n (let ((rhs (rule-rhs rule)))\n   '(defun ,(rule-lhs rule) ()\n    ,(cond ((every #'atom rhs) '(one-of ',rhs))\n       ((length =l rhs) (build-code (first rhs)))\n       (t '(case (random .(length rhs))\n         ,@(build-cases 0 rhs)))))))\n(defun build-cases (number choices)\n \"Return a list of case-clauses\"\n (when choices\n   (cons (list number (build-code (first choices)))\n       (build-cases (+ number 1) (rest choices)))))\n(defun build-code (choice)\n \"Append together multiple constituents\"\n (cond ((null choice) nil)\n       ((atom choice) (list choice))\n       ((length=1 choice) choice)\n       (t '(append ,@(mapcar #'build-code choice)))))\n(defun length=1 (x)\n \"Is X a list of length 1?\"\n (and (consp x) (null (rest x))))\n```\n\nThe Lisp code built by `compile-rule` must be compiled or interpreted to make it available to the Lisp system.\nWe can do that with one of the following forms.\nNormally we would want to call `compile`, but during debugging it may be easier not to.\n\n```lisp\n(dolist (rule *grammar*) (eval (compile-rule rule)))\n(dolist (rule *grammar*) (compile (eval (compile-rule rule))))\n```\n\nOne frequent way to use compilation is to define a macro that expands into the code generated by the compiler.\nThat way, we just type in calls to the macro and don't have to worry about making sure all the latest rules have been compiled.\nWe might implement this as follows:\n\n```lisp\n(defmacro defrule (&rest rule)\n  \"Define a grammar rule\"\n  (compile-rule rule))\n(defrule Sentence -> (NP VP))\n(defrule NP -> (Art Noun))\n(defrule VP -> (Verb NP))\n(defrule Art -> the a)\n(defrule Noun -> man bail woman table)\n(defrule Verb -> hit took saw liked)\n```\n\nActually, the choice of using one big list of rules (like `*grammar*`) versus using individual macros to define rules is independent of the choice of compiler versus interpreter.\nWe could just as easily define defrule simply to push the rule onto `*grammar*`.\nMacros like `defrule` are useful when you want to define rules in different places, perhaps in several separate files.\nThe `defparameter` method is appropriate when all the rules can be defined in one place.\n\nWe can see the Lisp code generated by `compile-rule` in two ways: by passing it a rule directly:\n\n```lisp\n> (compile-rule '(Sentence -> (NP VP)))\n(DEFUN SENTENCE ()\n   (APPEND (NP) (VP)))\n> (compile-rule '(Noun -> man bail woman table))\n(DEFUN NOUN ()\n   (ONE-OF '(MAN BALL WOMAN TABLE)))\n```\n\nor by macroexpanding a `defrule` expression.\nThe compiler was designed to produce the same code we were writing in our first approach to the generation problem (see [Page 35](B9780080571157500029.xhtml#p35)).\n\n```lisp\n> (macroexpand '(defrule Adj* -> () Adj (Adj Adj*)))\n(DEFUN ADJ* ()\n (CASE (RANDOM 3)\n   (0 NIL)\n   (1 (ADJ))\n   (2 (APPEND (ADJ) (ADJ*)))))\n```\n\nInterpreters are usually easier to write than compilers, although in this case, even the compiler was not too difficult.\nInterpreters are also inherently more flexible than compilers, because they put off making decisions until the last possible moment.\nFor example, our compiler considers the right-hand side of a rule to be a list of words only if every element is an atom.\nIn all other cases, the elements are treated as nonterminals.\nThis could cause problems if we extended the definition of `Noun` to include the compound noun \"chow chow\":\n\n```lisp\n(defrule Noun -> man ball woman table (chow chow))\n```\n\nThe rule would expand into the following code:\n\n```lisp\n(DEFUN NOUN ()\n (CASE (RANDOM 5)\n   (0 (MAN))\n   (1 (BALL))\n   (2 (WOMAN))\n   (3 (TABLE))\n   (4 (APPEND (CHOW) (CHOW)))))\n```\n\nThe problem is that `man` and `ball` and all the others are suddenly treated as functions, not as literal words.\nSo we would get a run-time error notifying us of undefined functions.\nThe equivalent rule would cause no trouble for the interpreter, which waits until it actually needs to generate a symbol to decide if it is a word or a nonterminal.\nThus, the semantics of rules are different for the interpreter and the compiler, and we as program implementors have to be very careful about how we specify the actual meaning of a rule.\nIn fact, this was probably a bug in the interpreter version, since it effectively prohibits words like \"noun\" and \"sentence\" from occurring as words if they are also the names of categories.\nOne possible resolution of the conflict is to say that an element of a right-hand side represents a word if it is an atom, and a list of categories if it is a list.\nIf we did indeed settle on that convention, then we could modify both the interpreter and the compiler to comply with the convention.\nAnother possibility would be to represent words as strings, and categories as symbols.\n\nThe flip side of losing run-time flexibility is gaining compile-time diagnostics.\nFor example, it turns out that on the Common Lisp system I am currently using, I get some useful error messages when I try to compile the buggy version of `Noun:`\n\n```lisp\n> (defrule Noun -> man bail woman table (chow chow))\nThe following functions were referenced but don't seem defined:\n CHOW referenced by NOUN\n TABLE referenced by NOUN\n WOMAN referenced by NOUN\n BALL referenced by NOUN\n MAN referenced by NOUN\nNOUN\n```\n\nAnother problem with the compilation scheme outlined here is the possibility of *name clashes*.\nUnder the interpretation scheme, the only names used were the function generate and the variable `*grammar*`.\nWith compilation, every left-hand side of a rule becomes the name of a function.\nThe grammar writer has to make sure he or she is not using the name of an existing Lisp function, and hence redefining it.\nEven worse, if more than one grammar is being developed at the same time, they cannot have any functions in common.\nIf they do, the user will have to recompile with every switch from one grammar to another.\nThis may make it difficult to compare grammars.\nThe best away around this problem is to use the Common Lisp idea of *packages*, but for small exercises name clashes can be avoided easily enough, so we will not explore packages until [section 24.1](B9780080571157500248.xhtml#s0010).\n\nThe major advantage of a compiler is speed of execution, when that makes a difference.\nFor identical grammars running in one particular implementation of Common Lisp on one machine, our interpreter generates about 75 sentences per second, while the compiled approach turns out about 200.\nThus, it is more than twice as fast, but the difference is negligible unless we need to generate many thousands of sentences.\nIn [section 9.6](#s0035) we will see another compiler with an even greater speed-up.\n\nThe need to optimize the code produced by your macros and compilers ultimately depends on the quality of the underlying Lisp compiler.\nFor example, consider the following code:\n\n```lisp\n(defun f1 (n l)\n   (let ((l1 (first l))\n         (l2 (second l)))\n        (expt (* 1 (+ n 0))\n       (- 4 (length (list l1 l2))))))\nF1\n> (defun f2 (n l) (* n n)) =>F2\n> (disassemble 'fl)\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `6 PUSH` | `ARGIO ; N` |\n| `7 MOVEM` | `PDL-PUSH` |\n| `8 *` | `PDL-POP` |\n| `9 RETURN` | `PDL-POP` |\n\n```lisp\nFl\n> (disassemble 'f2)\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `6 PUSH` | `ARGO ; N` |\n| `7 MOVEM` | `PDL-PUSH` |\n| `8 *` | `PDL-POP` |\n| `9 RETURN` | `PDL-POP` |\n\n```lisp\nF2\n```\n\nThis particular Lisp compiler generates the exact same code for `f1` and `f2`.\nBoth functions square the argument `n`, and the four machine instructions say, \"Take the 0th argument, make a copy of it, multiply those two numbers, and return the result.\" It's clear the compiler has some knowledge of the basic Lisp functions.\nIn the case of `f1`, it was smart enough to get rid of the local variables `l1` and `l2` (and their initialization), as well as the calls to `first, second, length,` and `list` and most of the arithmetic.\nThe compiler could do this because it has knowledge about the functions `length` and `list` and the arithmetic functions.\nSome of this knowledge might be in the form of simplification rules.\n\nAs a user of this compiler, there's no need for me to write clever macros or compilers that generate streamlined code as seen in `f2`; I can blindly generate code with possible inefficiencies like those in `f1`, and assume that the Lisp compiler will cover up for my laziness.\nWith another compiler that didn't know about such optimizations, I would have to be more careful about the code I generate.\n\n## 9.3 Delaying Computation\n{:#s0020}\n{:.h1hd}\n\nBack on [Page 45](B9780080571157500029.xhtml#p45), we saw a program to generate all strings derivable from a grammar.\nOne drawback of this program was that some grammars produce an infinite number of strings, so the program would not terminate on those grammars.\n\nIt turns out that we often want to deal with infinite sets.\nOf course, we can't enumerate all the elements of an infinite set, but we should be able to represent the set and pick elements out one at a time.\nIn other words, we want to be able to specify how a set (or other object) is constructed, but delay the actual construction, perhaps doing it incrementally over time.\nThis sounds like a job for closures: we can specify the set constructor as a function, and then call the function some time later.\nWe will implement this approach with the syntax used in Scheme-the macro `delay` builds a closure to be computed later, and the function `force` calls that function and caches away the value.\nWe use structures of type `delay` to implement this.\nA delay structure has two fields: the value and the function.\nInitially, the value field is undefined, and the function field holds the closure that will compute the value.\nThe first time the delay is forced, the function is called, and its result is stored in the value field.\nThe function field is then set to nil to indicate that there is no need to call the function again.\nThe function `force` checks if the function needs to be called, and returns the value.\nIf `force` is passed an argument that is not a delay, it just returns the argument.\n\n```lisp\n(defstruct delay (value nil) (function nil))\n(defmacro delay (&rest body)\n \"A computation that can be executed later by FORCE.\"\n '(make-delay :function #'(lambda () . ,body)))\n(defun force (x)\n \"Find the value of x, by Computing if it is a delay.\"\n (if (not (delay-p x))\n      x\n      (progn\n      (when (delay-function x)\n         (setf (delay-value x)\n             (funcall (delay-function x)))\n         (setf (delay-function x) nil))\n      (delay-value x))))\n```\n\nHere's an example of the use of `delay`.\nThe list `x` is constructed using a combination of normal evaluation and delayed evaluation.\nThus, the `1` is printed when `x` is created, `but` the `2` is not:\n\n```lisp\n(setf x (list (print 1) (delay (print 2)))) =>\n1\n(1 #S(DELAY .-FUNCTION (LAMBDA () (PRINT 2))))\n```\n\nThe second element is evaluated (and printed) when it is forced.\nBut then forcing it again just retrieves the cached value, rather than calling the function again:\n\n```lisp\n> (force (second x)) =>\n2\n2\n> x => (1 #S(DELAY : VALUE 2))\n> (force (second x)) => 2\n```\n\nNow let's see how delays can be used to build infinite sets.\nAn infinite set will be considered a special case of what we will call a *pipe*: a list with a `first` component that has been computed, and a `rest` component that is either a normal list or a delayed value.\nPipes have also been called delayed lists, generated lists, and (most commonly) streams.\nWe will use the term *pipe* because *stream* already has a meaning in Common Lisp.\nThe book *Artificial Intelligence Programming* ([Charniak et al.\n1987](B9780080571157500285.xhtml#bb0180)) also calls these structures pipes, reserving streams for delayed structures that do not cache computed results.\n\nTo distinguish pipes from lists, we will use the accessors `head` and `tail` instead of `first` and `rest`.\nWe will also use `empty-pipe` instead of `nil, make-pipe` instead of `cons`, and `pipe-elt` instead of `elt`.\nNote that `make-pipe` is a macro that delays evaluation of the tail.\n\n```lisp\n(defmacro make-pipe (head tail)\n \"Create a pipe by evaluating head and delaying tail.\"\n '(cons ,head (delay ,tail)))\n(defconstant empty-pipe nil)\n(defun head (pipe) (first pipe))\n(defun tail (pipe)(force (rest pipe)))\n(defun pipe-elt (pipe i)\n \"The i-th element of a pipe, 0-based\"\n (if (= i 0)\n   (head pipe)\n   (pipe-elt (tail pipe) (- i 1))))\n```\n\nHere's a function that can be used to make a large or infinite sequence of integers with delayed evaluation:\n\n```lisp\n(defun integers (&optional (start 0) end)\n \"A pipe of integers from START to END.\n If END is nil, this is an infinite pipe.\"\n (if (or (null end) (<= start end))\n   (make-pipe start (integers (+ start 1) end))\n   nil))\n```\n\nAnd here is an example of its use.\nThe pipe `c` represents the numbers from 0 to infinity.\nWhen it is created, only the zeroth element, 0, is evaluated.\nThe computation of the other elements is delayed.\n\n```lisp\n> (setf c (integers 0)) => (0 . #S(DELAY :FUNCTI0N # < CL0SURE - 77435477 >))\n> (pipe-elt c 0) =>  0\n```\n\nCalling `pipe-elt` to look at the third element causes the first through third elements to be evaluated.\nThe numbers 0 to 3 are cached in the correct positions, and further elements remain unevaluated.\nAnother call to `pipe-elt` with a larger index would force them by evaluating the delayed function.\n\n```lisp\n> (pipe-elt c 3) => 3\nc =>\n(0 . #S(DELAY\n        : VALUE\n        (1 . #S(DELAY\n                  : VALUE\n                  (2 . #S(DELAY\n                          : VALUE\n                          (3 . #S(DELAY\n                                   :FUNCTION\n                                   # < CLOSURE - 77432724 >))))))))\n```\n\nWhile this seems to work fine, there is a heavy price to pay.\nEvery delayed value must be stored in a two-element structure, where one of the elements is a closure.\nThus, there is some storage wasted.\nThere is also some time wasted, as `tail` or `pipe-elt` must traverse the structures.\n\nAn alternate representation for pipes is as (*value.\nclosure*) pairs, where the closure values are stored into the actual cons cells as they are computed.\nPreviously we needed structures of type delay to distinguish a delayed from a nondelayed object, but in a pipe we know the rest can be only one of three things: nil, a list, or a delayed value.\nThus, we can use the closures directly instead of using `delay` structures, if we have some way of distinguishing closures from lists.\nCompiled closures are atoms, so they can always be distinguished from lists.\nBut sometimes closures are implemented as lists beginning with `lambda` or some other implementation-dependent symbol.[2](#fn0015) The built-in function `functionp` is defined to be true of such lists, as well as of all symbols and all objects returned by `compile`.\nBut using `functionp` means that we cannot have a pipe that includes the symbol `lambda` as an element, because it will be confused for a closure:\n\n```lisp\n> (functionp (last '(theta iota kappa lambda))) => T\n```\n\nIf we consistently use compiled functions, then we could eliminate the problem by testing with the built-in predicate `compiled-function-p`.\nThe following definitions do not make this assumption:\n\n```lisp\n(defmacro make-pipe (head tai1)\n \"Create a pipe by evaluating head and delaying tail.\"\n '(cons ,head #'(lambda () ,tail)))\n(defun tail (pipe)\n \"Return tail of pipe or list, and destructively update\n the tail if it is a function.\"\n (if (functionp (rest pipe))\n   (setf (rest pipe) (funcall (rest pipe)))\n   (rest pipe)))\n```\n\nEverything else remains the same.\nIf we recompile `integers` (because it uses the `macro make-pipe`), we see the following behavior.\nFirst, creation of the infinite pipe `c` is similar:\n\n```lisp\n> (setf c (integers 0)) => (0 . # < CL0SURE 77350123 >)\n> (pipe-elt c 0) => 0\n```\n\nAccessing an element of the pipe forces evaluation of all the intervening elements, and as before leaves subsequent elements unevaluated:\n\n```lisp\n> (pipe-elt c 5) => 5\n> c => (0 1 2 3 4 5 . # < CL0SURE 77351636 >)\n```\n\nPipes can also be used for finite lists.\nHere we see a pipe of length 11:\n\n```lisp\n> (setf i (integers 0 10)) => (0 . # < CL0SURE 77375357 >)\n> (pipe-elt i 10) => 10\n> (pipe-elt i 11) => NIL\n> i => (0 1 2 3 4 5 6 7 8 9 10)\n```\n\nClearly, this version wastes less space and is much neater about cleaning up after itself.\nIn fact, a completely evaluated pipe turns itself into a list!\nThis efficiency was gained at the sacrifice of a general principle of program design.\nUsually we strive to build more complicated abstractions, like pipes, out of simpler ones, like delays.\nBut in this case, part of the functionality that delays were providing was duplicated by the cons cells that make up pipes, so the more efficient implementation of pipes does not use delays at all.\n\nHere are some more utility functions on pipes:\n\n```lisp\n(defun enumerate (pipe &key count key (result pipe))\n \"Go through all (or count) elements of pipe,\n possibly applying the KEY function. (Try PRINT.)\"\n ;; Returns RESULT, which defaults to the pipe itself.\n (if (or (eq pipe empty-pipe) (eql count 0))\n       result\n       (progn\n       (unless (null key) (funcall key (head pipe)))\n       (enumerate (tail pipe) :count (if count (- count 1))\n                        : key key : result result))))\n(defun filter (pred pipe)\n \"Keep only items in pipe satisfying pred.\"\n (if (funcall pred (head pipe))\n   (make-pipe (head pipe)\n                     (filter pred (tail pipe)))\n   (filter pred (tail pipe))))\n```\n\nAnd here's an application of pipes: generating prime numbers using the sieve of Eratosthenes algorithm:\n\n```lisp\n(defun sieve (pipe)\n (make-pipe (head pipe)\n       (filter #'(lambda (x) (/= (mod x (head pipe)) 0))\n                (sieve (tail pipe)))))\n(defvar *primes* (sieve (integers 2)))\n> *primes* => (2 . # < CL0SURE 3075345 >)\n> (enumerate *primes* :count 10) =>\n(2 3 5 7 11 13 17 19 23 29 31 . # < CL0SURE 5224472 >)\n```\n\nFinally, let's return to the problem of generating all strings in a grammar.\nFirst we're going to need some more utility functions:\n\n```lisp\n(defun map-pipe (fn pipe)\n \"Map fn over pipe, delaying all but the first fn call.\"\n (if (eq pipe empty-pipe)\n      empty-pipe\n      (make-pipe (funcall fn (head pipe))\n              (map-pipe fn (tail pipe)))))\n(defun append-pipes (x y)\n \"Return a pipe that appends the elements of x and y.\"\n (if (eq x empty-pipe)\n       y\n       (make-pipe (head x)\n                  (append-pipes (tail x) y))))\n(defun mappend-pipe (fn pipe)\n \"Lazily map fn over pipe, appending results.\"\n (if (eq pipe empty-pipe)\n          empty-pipe\n          (let ((x (funcall fn (head pipe))))\n            (make-pipe (head x)\n                    (append-pipes (tail x)\n                                (mappend-pipe\n                                            fn (tail pipe)))))))\n```\n\nNow we can rewrite `generate-all` and `combine-all` to use pipes instead of lists.\n\nEverything else is the same as on [Page 45](B9780080571157500029.xhtml#p45).\n\n```lisp\n(defun generate-all (phrase)\n \"Generate a random sentence or phrase\"\n (if (listp phrase)\n   (if (null phrase)\n       (list nil)\n       (combine-all-pipes\n          (generate-all (first phrase))\n          (generate-all (rest phrase))))\n   (let ((choices (rule-rhs (assoc phrase *grammar*))))\n    (if choices\n          (mappend-pipe #'generate-all choices)\n          (list (list phrase))))))\n(defun combine-all-pipes (xpipe ypipe)\n \"Return a pipe of pipes formed by appending a y to an x\"\n ;; In other words, form the cartesian product.\n (mappend-pipe\n   #'(lambda (y)\n         (map-pipe #'(lambda (x) (append-pipes x y))\n                          xpipe))\n   ypipe))\n```\n\nWith these definitions, here's the pipe of all sentences from `*grammar2*` (from [Page 43](B9780080571157500029.xhtml#p43)):\n\n```lisp\n> (setf ss (generate-all 'sentence)) =>\n((THE . # < CL0SURE 27265720 >) . # < CL0SURE 27266035>)\n> (enumerate ss :count 5) =>\n((THE . # < CLOSURE 27265720 >)\n(A . # < CLOSURE 27273143 >)\n(THE . # < CLOSURE 27402545 >)\n(A . # < CLOSURE 27404344 >)\n(THE . # < CLOSURE 27404527 >)\n(A . # < CLOSURE 27405473 >) . # < CLOSURE 27405600 >)\n> (enumerate ss .-count 5 :key #'enumerate) =>\n((THE MAN HIT THE MAN)\n(A MAN HIT THE MAN)\n(THE BIG MAN HIT THE MAN)\n(A BIG MAN HIT THE MAN)\n(THE LITTLE MAN HIT THE MAN)\n(THE . # < CLOSURE 27423236 >) . # < CLOSURE 27423343 >)\n> (enumerate (pipe-elt ss 200)) =>\n(THE ADIABATIC GREEN BLUE MAN HIT THE MAN)\n```\n\nWhile we were able to represent the infinite set of sentences and enumerate instances of it, we still haven't solved all the problems.\nFor one, this enumeration will never get to a sentence that does not have \"hit the man\" as the verb phrase.\nWe will see longer and longer lists of adjectives, but no other change.\nAnother problem is that left-recursive rules will still cause infinite loops.\nFor example, if the expansion for `Adj*` had been `(Adj* -> (Adj* Adj) ())` instead of `(Adj* -> () (Adj Adj*))`, then the enumeration would never terminate, because pipes need to generate a first element.\n\nWe have used delays and pipes for two main purposes: to put off until later computations that may not be needed at all, and to have an explicit representation of large or infinite sets.\nIt should be mentioned that the language Prolog has a different solution to the first problem (but not the second).\nAs we shall see in [chapter 11](B978008057115750011X.xhtml), Prolog generates solutions one at a time, automatically keeping track of possible backtrack points.\nWhere pipes allow us to represent an infinite number of alternatives in the data, Prolog allows us to represent those alternatives in the program itself.\n\n**Exercise 9.1 [h]** When given a function `f` and a pipe `p`, `mappend-pipe` returns a new pipe that will eventually enumerate all of `(f (first p))`, then all of `(f (second p))`, and so on.\nThis is deemed \"unfair\" if `(f (first p))` has an infinite number of elements.\nDefine a function that will fairly interleave elements, so that all of them are eventually enumerated.\nShow that the function works by changing `generate-all` to work with it.\n\n## 9.4 Indexing Data\n{:#s0025}\n{:.h1hd}\n\nLisp makes it very easy to use lists as the universal data structure.\nA list can represent a set or an ordered sequence, and a list with sublists can represent a tree or graph.\nFor rapid prototyping, it is often easiest to represent data in lists, but for efficiency this is not always the best idea.\nTo find an element in a list of length *n* will take *n*/2 steps on average.\nThis is true for a simple list, an association list, or a property list.\nIf *n* can be large, it is worth looking at other data structures, such as hash tables, vectors, property lists, and trees.\n\nPicking the right data structure and algorithm is as important in Lisp as it is in any other programming language.\nEven though Lisp offers a wide variety of data structures, it is often worthwhile to spend some effort on building just the right data structure for frequently used data.\nFor example, Lisp's hash tables are very general and thus can be inefficient.\nYou may want to build your own hash tables if, for example, you never need to delete elements, thus making open hashing an attractive possibility.\nWe will see an example of efficient indexing in [section 9.6](#s0035) ([Page 297](B9780080571157500091.xhtml#p297)).\n\n## 9.5 Instrumentation: Deciding What to Optimize\n{:#s0030}\n{:.h1hd}\n\nBecause Lisp is such a good rapid-prototyping language, we can expect to get a working implementation quickly.\nBefore we go about trying to improve the efficiency of the implementation, it is a good idea to see what parts are used most often.\nImproving little-used features is a waste of time.\n\nThe minimal support we need is to count the number of calls to selected functions, and then print out the totals.\nThis is called *profiling* the functions.[3](#fn0020) For each function to be profiled, we change the definition so that it increments a counter and then calls the original function.\n\nMost Lisp systems have some built-in profiling mechanism.\nIf your system has one, by all means use it.\nThe code in this section is provided for those who lack such a feature, and as an example of how functions can be manipulated.\nThe following is a simple profiling facility.\nFor each profiled function, it keeps a count of the number of times it is called under the `profile-count` property of the function's name.\n\n```lisp\n(defun profile1 (fn-name)\n \"Make the function count how often it is called\"\n ;; First save away the old, unprofiled function\n ;; Then make the name be a new function that increments\n ;; a counter and then calls the original function\n  (let ((fn (symbol-function fn-name)))\n     (setf (get fn-name 'unprofiled-fn) fn)\n   (setf (get fn-name 'profile-count) 0)\n   (setf (symbol-function fn-name)\n        (profiled-fn fn-name fn))\n   fn-name))\n(defun unprofile1 (fn-name)\n \"Make the function stop counting how often it is called.\"\n (setf (symbol-function fn-name) (get fn-name 'unprofiled-fn))\n fn-name)\n(defun profiled-fn (fn-name fn)\n \"Return a function that increments the count.\"\n #'(lambda (&rest args)\n   (incf (get fn-name 'profile-count))\n   (apply fn args)))\n(defun profile-count (fn-name) (get fn-name 'profile-count))\n (defun profile-report (fn-names &optional (key #'profile-count))\n \"Report profiling statistics on given functions.\"\n       (loop for name in (sort fn-names #'> :key key) do\n          (format t \"~& ~ 7D ~ A\" (profile-count name) name)))\n```\n\nThat's all we need for the bare-bones functionality.\nHowever, there are a few ways we could improve this.\nFirst, it would be nice to have macros that, like `trace` and `untrace`, allow the user to profile multiple functions at once and keep track of what has been profiled.\nSecond, it can be helpful to see the length of time spent in each function, as well as the number of calls.\n\nAlso, it is important to avoid profiling a function twice, since that would double the number of calls reported without alerting the user of any trouble.\nSuppose we entered the following sequence of commands:\n\n```lisp\n(defun f (x) (g x))\n(profile1 'f)\n(profile1 'f)\n```\n\nThen the definition of `f` would be roughly:\n\n```lisp\n(lambda (&rest args)\n   (incf (get 'f 'profile-count))\n   (apply #'(lambda (&rest args)\n      (incf (get 'f 'profile-count))\n      (apply #'(lambda (x) (g x))\n            args))\n        args))\n```\n\nThe result is that any call to `f` will eventually call the original `f`, but only after incrementing the count twice.\n\nAnother consideration is what happens when a profiled function is redefined by the user.\nThe only way we could ensure that a redefined function would continue profiling would be to change the definition of the macro defun to look for functions that should be profiled.\nChanging system functions like defun is a risky prospect, and in *Common Lisp the Language*, 2d edition, it is explicitly disallowed.\nInstead, we'll do the next best thing: ensure that the next call to `profile` will reprofile any functions that have been redefined.\nWe do this by keeping track of both the original unprofiled function and the profiled function.\nWe also keep a list of all functions that are currently profiled.\n\nIn addition, we will count the amount of time spent in each function.\nHowever, the user is cautioned not to trust the timing figures too much.\nFirst, they include the overhead cost of the profiling facility.\nThis can be significant, particularly because the facility conses, and thus can force garbage collections that would not otherwise have been done.\nSecond, the resolution of the system clock may not be fine enough to make accurate timings.\nFor functions that take about 1/10 of a second or more, the figures will be reliable, but for quick functions they may not be.\n\nHere is the basic code for `profile` and `unprofile:`\n\n```lisp\n(defvar *profiled-functions* nil\n \"Function names that are currently profiled\")\n(defmacro profile (&rest fn-names)\n \"Profile fn-names. With no args, list profiled functions.\"\n '(mapcar #'profile1\n       (setf *profiled-functions*\n      (union *profiled-functions* fn-names))))\n(defmacro unprofile (&rest fn-names)\n \"Stop profiling fn-names. With no args, stop all profiling.\"\n '(progn\n   (mapcar #'unprofile1\n         ,(if fn-names fn-names '*profiled-functions*))\n   (setf *profiled-functions*\n         ,(if (null fn-names)\n      nil\n         '(set-difference *profiled-functions*\n            ',fn-names)))))\n```\n\nThe idiom ' ',`fn-names` deserves comment, since it is common but can be confusing at first.\nIt may be easier to understand when written in the equivalent form '`(quote , fn-names)`.\nAs always, the backquote builds a structure with both constant and evaluated components.\nIn this case, the `quote` is constant and the variable `fn-names` is evaluated.\nIn MacLisp, the function `kwote` was defined to serve this purpose:\n\n```lisp\n(defun kwote (x) (list 'quote x))\n```\n\nNow we need to change `profile1` and `unprofile1` to do the additional bookkeeping: For `profile1`, there are two cases.\nIf the user does a `profile1` on the same function name twice in a row, then on the second time we will notice that the current function is the same as the functioned stored under the `profiled-fn` property, so nothing more needs to be done.\nOtherwise, we create the profiled function, store it as the current definition of the name under the `profiled-fn` property, save the unprofiled function, and initialize the counts.\n\n```lisp\n(defun profile1 (fn-name)\n \"Make the function count how often it is called\"\n ;; First save away the old, unprofiled function\n ;; Then make the name be a new function that increments\n ;; a counter and then calls the original function\n (let ((fn (symbol-function fn-name)))\n   (unless (eq fn (get fn-name 'profiled-fn))\n       (let ((new-fn (profiled-fn fn-name fn)))\n         (setf (symbol-function fn-name) new-fn\n               (get fn-name 'profiled-fn) new-fn\n               (get fn-name 'unprofiled-fn) fn\n               (get fn-name 'profile-time) 0\n               (get fn-name 'profile-count) 0))))\n    fn-name)\n(defun unprofile1 (fn-name)\n \"Make the function stop counting how often it is called.\"\n (setf (get fn-name 'profile-time) 0)\n (setf (get fn-name 'profile-count) 0)\n (when (eq (symbol-function fn-name) (get fn-name 'profiled-fn))\n   ;; normal case: restore unprofiled version\n   (setf (symbol-function fn-name)\n        (get fn-name 'unprofiled-fn)))\n fn-name)\n```\n\nNow we look into the question of timing.\nThere is a built-in Common Lisp function, `get-internal-real-time`, that returns the elapsed time since the Lisp session started.\nBecause this can quickly become a bignum, some implementations provide another timing function that wraps around rather than increasing forever, but which may have a higher resolution than `get-internal-real-time`.\nFor example, on TI Explorer Lisp Machines, `get-internal-real-time` measures 1/60-second intervals, while `time:microsecond-time` measures 1/1,000,000-second intervals, but the value returned wraps around to zero every hour or so.\nThe function `time:microsecond-time-difference` is used to compare two of these numbers with compensation for wraparound, as long as no more than one wraparound has occurred.\n\nIn the code below, I use the conditional read macro characters `#+`and `#-` to define the right behavior on both Explorer and non-Explorer machines.\nWe have seeen that `#` is a special character to the reader that takes different action depending on the following character.\nFor example, `#'fn` is read as `(function fn)`.\nThe character sequence `#+`is defined so that `#+`*feature expression* reads as *expression* if the *feature* is defined in the current implementation, and as nothing at all if it is not.\nThe sequence `#-` acts in just the opposite way.\nFor example, on a TI Explorer, we would get the following:\n\n```lisp\n>'(hi #+TI t #+Symbolics s #-Explorer e #-Mac m) => (HI T M)\n```\n\nThe conditional read macro characters are used in the following definitions:\n\n```lisp\n(defun get-fast-time ()\n \"Return the elapsed time. This may wrap around;\n use FAST-TIME-DIFFERENCE to compare.\"\n #+Explorer (time:microsecond-time) ; do this on an Explorer\n #-Explorer (get-internal-real-time)) ; do this on a non-Explorer\n(defun fast-time-difference (end start)\n \"Subtract two time points.\"\n #+Explorer (time:microsecond-time-difference end start)\n #-Explorer (- end start))\n(defun fast-time->seconds (time)\n \"Convert a fast-time interval into seconds.\"\n #+Explorer (/ time 1000000.0)\n #-Explorer (/ time internal-time-units-per-second))\n```\n\nThe next step is to update `profiled-fn` to keep track of the timing data.\nThe simplest way to do this would be to set a variable, say `start`, to the time when a function is entered, run the function, and then increment the function's time by the difference between the current time and `start`.\nThe problem with this approach is that every function in the call stack gets credit for the time of each called function.\nSuppose the function f calls itself recursively five times, with each call and return taking place a second apart, so that the whole computation takes nine seconds.\nThen f will be charged nine seconds for the outer call, seven seconds for the next call, and so on, for a total of 25 seconds, even though in reality it only took nine seconds for all of them together.\n\nA better algorithm would be to charge each function only for the time since the last call or return.\nThen `f` would only be charged the nine seconds.\nThe variable `*profile-call-stack*` is used to hold a stack of function name/entry time pairs.\nThis stack is manipulated by `profile-enter` and `profile-exit` to get the right timings.\n\nThe functions that are used on each call to a profiled function are declared `inline`.\nIn most cases, a call to a function compiles into machine instructions that set up the argument list and branch to the location of the function's definition.\nWith an `inline` function, the body of the function is compiled in line at the place of the function call.\nThus, there is no overhead for setting up the argument list and branching to the definition.\nAn `inline` declaration can appear anywhere any other declaration can appear.\nIn this case, the function `proclaim` is used to register a global declaration.\nInline declarations are discussed in more depth on [Page 317](B9780080571157500108.xhtml#p317).\n\n```lisp\n(proclaim '(inline profile-enter profile-exit inc-profile-time))\n(defun profiled-fn (fn-name fn)\n \"Return a function that increments the count, and times.\"\n #'(lambda (&rest args)\n     (profile-enter fn-name)\n     (multiple-value-progl\n        (apply fn args)\n        (profile-exit fn-name))))\n(defvar *profile-call-stack* nil)\n(defun profile-enter (fn-name)\n (incf (get fn-name 'profile-count))\n (unless (null *profile-call-stack*)\n   ;; Time charged against the calling function:\n   (inc-profile-time (first *profile-call-stack*)\n               (car (first *profile-call-stack*))))\n ;; Put a new entry on the stack\n (push (cons fn-name (get-fast-time))\n       *profile-call-stack*))\n(defun profile-exit (fn-name)\n ;; Time charged against the current function:\n (inc-profile-time (pop *profile-call-stack*)\n                     fn-name)\n ;; Change the top entry to reflect current time\n (unless (null *profile-call-stack*)\n   (setf (cdr (first *profile-call-stack*))\n       (get-fast-time))))\n(defun inc-profile-time (entry fn-name)\n (incf (get fn-name 'profile-time)\n            (fast-time-difference (get-fast-time) (cdr entry))))\n```\n\nFinally, we need to update `profile-report` to print the timing data as well as the counts.\nNote that the default `fn-names` is a copy of the global list.\nThat is because we pass `fn-names` to `sort`, which is a destructive function.\nWe don't want the global list to be modified as a result of this sort.\n\n```lisp\n(defun profile-report (&optional\n                      (fn-names (copy-list *profiled-functions*))\n                      (key #'profile-count))\n  \"Report profiling statistics on given functions.\"\n  (let ((total-time (reduce #' + (mapcar #'profile-time fn-names))))\n    (unless (null key)\n      (setf fn-names (sort fn-names #'> :key key)))\n    (format t \"~&Total elapsed time: ~d seconds.\"\n            (fast-time-> seconds total-time))\n    (format t Count Secs Time% Name\")\n    (loop for name in fn-names do\n         (format t \"~&~7D ~6,2F ~3d% ~A\"\n                (profile-count name)\n                (fast-time-> seconds (profile-time name))\n                (round (/ (profile-time name) total-time) .01)\n                name))))\n(defun profile-time (fn-name) (get fn-name 'profile-time))\n```\n\nThese functions can be used by calling `profile`, then doing some representative computation, then calling `profile-report`, and finally `unprofile`.\nIt can be convenient to provide a single macro for doing all of these at once:\n\n```lisp\n(defmacro with-profiling (fn-names &rest body)\n '(progn\n    (unprofile . ,fn-names)\n    (profile . ,fn-names)\n    (setf *profile-call-stack* nil)\n    (unwind-protect\n        (progn . ,body)\n      (profile-report ',fn-names)\n      (unprofile . ,fn-names))))\n```\n\nNote the use of `unwind-protect` to produce the report and call `unprofile` even if the computation is aborted.\n`unwind-protect` is a special form that takes any number of arguments.\nIt evaluates the first argument, and if all goes well it then evaluates the other arguments and returns the first one, just like `progl`.\nBut if an error occurs during the evaluation of the first argument and computation is aborted, then the subsequent arguments (called cleanup forms) are evaluated anyway.\n\n## 9.6 A Case Study in Efficiency: The SIMPLIFY Program\n{:#s0035}\n{:.h1hd}\n\nSuppose we wanted to speed up the `simplify` program of [chapter 8](B978008057115750008X.xhtml).\nThis section shows how a combination of general techniques-memoizing, indexing, and compiling-can be used to speed up the program by a factor of 130.\n[Chapter 15](B9780080571157500157.xhtml) will show another approach: replace the algorithm with an entirely different one.\n\nThe first step to a faster program is defining a *benchmark*, a test suite representing a typical work load.\nThe following is a short list of test problems (and their answers) that are typical of the `simplify` task.\n\n```lisp\n(defvar *test-data* (mapcar #'infix-> prefix\n '((d (a * x ^ 2 + b * x + c) / d x)\n   (d ((a * x ^ 2 + b * x + c) / x) / d x)\n   (d((a*x ^ 3 + b * x ^ 2 + c * x + d)/x ^ 5)/dx)\n   ((sin (x + x)) * (sin (2 * x)) + (cos (d (x ^ 2) / d x)) ^ 1)\n   (d (3 * x + (cos x) / x) / d x))))\n(defvar *answers* (mapcar #'simplify *test-data*))\n```\n\nThe function `test-it` runs through the test data, making sure that each answer is correct and optionally printing profiling data.\n\n```lisp\n(defun test-it (&optional (with-profiling t))\n  \"Time a test run. and make sure the answers are correct.\"\n  (let ((answers\n         (if with-profiling\n             (with-profiling (simplify simplify-exp pat-match\n                              match-variable variable-p)\n               (mapcar #'simplify *test-data*))\n             (time (mapcar #'simplify *test-data*)))))\n    (mapc #'assert-equal answers *answers*)\n    t))\n(defun assert-equal (x y)\n  \"If x is not equal to y, complain.\"\n  (assert (equal x y) (x y)\n          \"Expected ~a to be equal to ~a\" x y))\n```\n\nHere are the results of (`test-it`) with and without profiling:\n\n```lisp\n> (test-it nil)\nEvaluation of (MAPCAR #'SIMPLIFY *TEST-DATA*) took 6.612 seconds.\n> (test-it t)\nTotal elapsed time: 22.819614 seconds\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `Count` | `Secs` | `Time%` | `Name` |\n| `51690` | `11.57` | `51%` | `PAT-MATCH` |\n| `37908` | `8.75` | `38%` | `VARIABLE-P` |\n| `1393` | `0.32` | `1%` | `MATCH-VARIABLE` |\n| `906` | `0.20` | `1%` | `SIMPLIFY` |\n| `274` | `1.98` | `9%` | `SIMPLIFY-EXP` |\n\n![t10010](images/B9780080571157500091/t10010.png)\n\nRunning the test takes 6.6 seconds normally, although the time triples when the profiling overhead is added in.\nIt should be clear that to speed things up, we have to either speed up or cut down on the number of calls to `pat-match` or `variable-p`, since together they account for 89% of the calls (and 89% of the time as well).\nWe will look at three methods for achieving both those goals.\n\n#### Memoization\n{:#s0045}\n{:.h3hd}\n\nConsider the rule that transforms (`x + x`) into (`2 * x`).\nOnce this is done, we have to simplify the result, which involves resimplifying the components.\nIf `x` were some complex expression, this could be time-consuming, and it will certainly be wasteful, because `x` is already simplified and cannot change.\nWe have seen this type of problem before, and the solution is memoization: make `simplify` remember the work it has done, rather than repeating the work.\nWe can just say:\n\n```lisp\n(memoize 'simplify :test #'equal)\n```\n\nTwo questions are unclear: what kind of hash table to use, and whether we should clear the hash table between problems.\nThe simplifier was timed for all four combinations of `eq` or `equal` hash tables and resetting or nonresetting between problems.\nThe fastest result was `equal` hashing and nonresetting.\nNote that with `eq` hashing, the resetting version was faster, presumably because it couldn't take advantage of the common subexpressions between examples (since they aren't `eq`).\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| hashing | resetting | time |\n| none | - | 6.6 |\n| equal | yes | 3.8 |\n| equal | no | 3.0 |\n| eq | yes | 7.0 |\n| eq | no | 10.2 |\n\nThis approach makes the function `simplify` remember the work it has done, in a hash table.\nIf the overhead of hash table maintenance becomes too large, there is an alternative: make the data remember what simplify has done.\nThis approach was taken in MACSYMA !!!(span) {:.smallcaps} : it represented operators as lists rather than as atoms.\nThus, instead of `(* 2 x)`, MACSYMA !!!(span) {:.smallcaps} would use `((*) 2 x)`.\nThe simplification function would destructively insert a marker into the operator list.\nThus, the result of simplifying 2*x* would be `((* simp) 2 x)`.\nThen, when the simplifier was called recursively on this expression, it would notice the `simp` marker and return the expression as is.\n\nThe idea of associating memoization information with the data instead of with the function will be more efficient unless there are many functions that all want to place their marks on the same data.\nThe data-oriented approach has two drawbacks: it doesn't identify structures that are `equal` but not `eq`, and, because it requires explicitly altering the data, it requires every other operation that manipulates the data to know about the marker s.\nThe beauty of the hash table approach is that it is transparent; no code needs to know that memoization is taking place.\n\n#### Indexing\n{:#s0050}\n{:.h3hd}\n\nWe currently go through the entire list of rules one at a time, checking each rule.\nThis is inefficient because most of the rules could be trivially ruled out-if only they were indexed properly.\nThe simplest indexing scheme would be to have a separate list of rules indexed under each operator.\nInstead of having `simplify-exp` check each member of `*simplification-rules*`, it could look only at the smaller list of rules for the appropriate operator.\nHere's how:\n\n```lisp\n(defun simplify-exp (exp)\n  \"Simplify using a rule. or by doing arithmetic.\n  or by using the simp function supplied for this operator.\n  This version indexes simplification rules under the operator.\"\n  (cond ((simplify-by-fn exp))\n        ((rule-based-translator exp (rules-for (exp-op exp)) ;***\n           :rule-if #'exp-lhs :rule-then #'exp-rhs\n           :action #'(lambda (bindings response)\n                      (simplify (sublis bindings response)))))\n        ((evaluable exp) (eval exp))\n        (t exp)))\n(defvar *rules-for* (make-hash-table :test #'eq))\n(defun main-op (rule) (exp-op (exp-lhs rule)))\n(defun index-rules (rules)\n  \"Index all the rules under the main op.\"\n  (clrhash *rules-for*)\n  (dolist (rule rules)\n    ;; nconc instead of push to preserve the order of rules\n    (setf (gethash (main-op rule) *rules-for*)\n          (nconc (gethash (main-op rule) *rules-for*)\n                 (list rule)))))\n(defun rules-for (op) (gethash op *rules-for*))\n(index-rules *simplification-rules*)\n```\n\nTiming the memoized, indexed version gets us to .98 seconds, down from 6.6 seconds for the original code and 3 seconds for the memoized code.\nIf this hadn't helped, we could have considered more sophisticated indexing schemes.\nInstead, we move on to consider other means of gaining efficiency.\n\n**Exercise 9.2 [m]** The list of rules for each operator is stored in a hash table with the operator as key.\nAn alternative would be to store the rules on the property list of each operator, assuming operators must be symbols.\nImplement this alternative, and time it against the hash table approach.\nRemember that you need some way of clearing the old rules-trivial with a hash table, but not automatic with property lists.\n\n#### Compilation\n{:#s0055}\n{:.h3hd}\n\nYou can look at `simplify-exp` as an interpreter for the simplification rule language.\nOne proven technique for improving efficiency is to replace the interpreter with a compiler.\nFor example, the rule `(x + x = 2 * x)` could be compiled into something like:\n\n```lisp\n(lambda (exp)\n  (if (and (eq (exp-op exp) '+) (equal (exp-lhs exp) (exp-rhs exp)))\n      (make-exp :op '* :lhs 2 :rhs (exp-rhs exp))))\n```\n\nThis eliminates the need for consing up and passing around variable bindings, and should be faster than the general matching procedure.\nWhen used in conjunction with indexing, the individual rules can be simpler, because we already know we have the right operator.\nFor example, with the above rule indexed under \"+\", it could now be compiled as:\n\n```lisp\n(lambda (exp)\n  (if (equal (exp-lhs exp) (exp-rhs exp))\n      (make-exp :op '* :lhs 2 :rhs (exp-lhs exp))))\n```\n\nIt is important to note that when these functions return nil, it means that they have failed to simplify the expression, and we have to consider another means of simplification.\n\nAnother possibility is to compile a set of rules all at the same time, so that the indexing is in effect part of the compiled code.\nAs an example, I show here a small set of rules and a possible compilation of the rule set.\nThe generated function assumes that `x` is not an atom.\nThis is appropriate because we are replacing `simplify-exp`, not `simplify`.\nAlso, we will return nil to indicate that `x` is already simplified.\nI have chosen a slightly different format for the code; the main difference is the let to introduce variable names for subexpressions.\nThis is useful especially for deeply nested patterns.\nThe other difference is that I explicitly build up the answer with a call to `list`, rather than `make-exp`.\nThis is normally considered bad style, but since this is code generated by a compiler, I wanted it to be as efficient as possible.\nIf the representation of the exp data type changed, we could simply change the compiler; a much easier task than hunting down all the references spread throughout a human- written program.\nThe comments following were not generated by the compiler.\n\n```lisp\n(x * 1 = x)\n(1 * x = x)\n(x * 0 = 0)\n(0 * x = 0)\n(x * x = x ^ 2)\n(lambda (x)\n  (let ((xl (exp-lhs x))\n        (xr (exp-rhs x)))\n    (or (if (eql xr '1)    ; (x*1 = X)\n            xl)\n        (if (eql xl '1)    ; (1*x = X)\n            xr)\n        (if (eql xr '0)    ; (x*0 = 0)\n            '0)\n        (if (eql xl '0)    ; (0*x = 0)\n            '0)\n        (if (equal xr xl)  ; (x*x = x ^ 2)\n            (list '^ xl '2)))))\n```\n\nI chose this format for the code because I imagined (and later *show*) that it would be fairly easy to write the compiler for it.\n\n#### The Single-Rule Compiler\n{:#s0060}\n{:.h3hd}\n\nHere I show the complete single-rule compiler, to be followed by the indexed-rule-set compiler.\nThe single-rule compiler works like this:\n\n```lisp\n> (compile-rule '(= (+ x x) (* 2 x)))\n(LAMBDA (X)\n  (IF (OP? X '+)\n    (LET ((XL (EXP-LHS X))\n          (XR (EXP-RHS X)))\n     (IF (EQUAL XR XL)\n         (SIMPLIFY-EXP (LIST '* '2 XL))))))\n```\n\nGiven a rule, it generates code that first tests the pattern and then builds the right- hand side of the rule if the pattern matches.\nAs the code is generated, correspondences are built between variables in the pattern, like `x`, and variables in the generated code, like `xl`.\nThese are kept in the association list `*bindings*`.\nThe matching can be broken down into four cases: variables that haven't been seen before, variables that have been seen before, atoms, and lists.\nFor example, the first time we run across `x` in the rule above, no test is generated, since anything can match `x`.\nBut the entry `(x.xl)` is added to the `*bindings*` list to mark the equivalence.\nWhen the second `x` is encountered, the test `(equal xr xl)` is generated.\n\nOrganizing the compiler is a little tricky, because we have to do three things at once: return the generated code, keep track of the `*bindings*`, and keep track of what to do \"next\"-that is, when a test succeeds, we need to generate more code, either to test further, or to build the result.\nThis code needs to know about the bindings, so it can't be done *before* the first part of the test, but it also needs to know where it should be placed in the overall code, so it would be messy to do it *after* the first part of the test.\nThe answer is to pass in a function that will tell us what code to generate later.\nThis way, it gets done at the right time, and ends up in the right place as well.\nSuch a function is often called a *continuation*, because it tells us where to continue Computing.\nIn our compiler, the variable `consequent` is a continuation function.\n\nThe compiler is called `compile-rule`.\nIt takes a rule as an argument and returns a lambda expression that implements the rule.\n\n```lisp\n(defvar *bindings* nil\n  \"A list of bindings used by the rule compiler.\")\n(defun compile-rule (rule)\n  \"Compile a single rule.\"\n  (let ((*bindings* nil))\n    '(lambda (x)\n      ,(compile-exp 'x (exp-lhs rule) ; x is the lambda parameter\n                    (delay (build-exp (exp-rhs rule)\n                                               *bindings*))))))\n```\n\nAll the work is done by `compile-exp`, which takes three arguments: a variable that will represent the input in the generated code, a pattern that the input should be matched against, and a continuation for generating the code if the test passes.\nThere are five cases: (1) If the pattern is a variable in the list of bindings, then we generate an equality test.\n(2) If the pattern is a variable that we have not seen before, then we add it to the binding list, generate no test (because anything matches a variable) and then generate the consequent code.\n(3) If the pattern is an atom, then the match succeeds only if the input is `eql` to that atom.\n(4) If the pattern is a conditional like `(?is n numberp)`, then we generate the test `(numberp n)`.\nOther such patterns could be included here but have not been, since they have not been used.\nFinally, (5) if the pattern is a list, we check that it has the right operator and arguments.\n\n```lisp\n(defun compile-exp (var pattern consequent)\n  \"Compile code that tests the expression, and does consequent\n  if it matches. Assumes bindings in *bindings*.\"\n  (cond ((get-binding pattern *bindings*)\n         ;; Test a previously bound variable\n         '(if (equal .var .(lookup pattern *bindings*))\n              ,(force consequent)))\n        ((variable-p pattern)\n         ;; Add a new bindings; do type checking if needed.\n         (push (cons pattern var) *bindings*)\n         (force consequent))\n        ((atom pattern)\n         ;; Match a 1iteral atom\n         '(if (eql ,var '.pattern)\n              ,(force consequent)))\n        ((starts-with pattern '?is)\n         (push (cons (second pattern) var) *bindings*)\n         '(if (,(third pattern) ,var)\n              ,(force consequent)))\n         ;; So. far, only the ?is pattern is covered, because\n         ;; it is the only one used in simplification rules.\n         ;; Other patterns could be compiled by adding code here.\n         ;; Or we could switch to a data-driven approach.\n         (t ;; Check the operator and arguments\n          '(if (op? ,var ',(exp-op pattern))\n              ,(compile-args var pattern consequent)))))\n```\n\nThe function `compile-args` is used to check the arguments to a pattern.\nIt generates a `let` form binding one or two new variables (for a unary or binary expression), and then calls `compile-exp` to generate code that actually makes the tests.\nIt just passes along the continuation, `consequent`, to `compile-exp`.\n\n```lisp\n(defun compile-args (var pattern consequent)\n  \"Compile code that checks the arg or args, and does consequent\n  if the arg(s) match.\"\n  ;; First make up variable names for the arg(s).\n  (let ((L (symbol var 'L))\n        (R (symbol var 'R)))\n    (if (exp-rhs pattern)\n        ;; two arg case\n        '(let ((,L (exp-lhs ,var))\n               (,R (exp-rhs ,var)))\n           ,(compile-exp L (exp-lhs pattern)\n                         (delay\n                           (compile-exp R (exp-rhs pattern)\n                                        consequent))))\n        ;; one arg case\n        '(let ((,L (exp-lhs ,var)))\n           ,(compile-exp L (exp-lhs pattern) consequent)))))\n```\n\nThe remaining functions are simpler.\n`build-exp` generates code to build the right- hand side of a `rule, op?` tests if its first argument is an expression with a given operator, and `symbol` constructs a new symbol.\nAlso given is `new-symbol`, although it is not used in this program.\n\n```lisp\n(defun build-exp (exp bindings)\n  \"Compile code that will build the exp, given the bindings.\"\n  (cond ((assoc exp bindings) (rest (assoc exp bindings)))\n        ((variable-p exp)\n         (error \"Variable ~ a occurred on right-hand side,~\n                but not left.\" exp))\n        ((atom exp) \",exp)\n        (t (let ((new-exp (mapcar #'(lambda (x)\n                                     (build-exp x bindings))\n                                   exp)))\n             '(simplify-exp (list .,new-exp))))))\n(defun op? (exp op)\n  \"Does the exp have the given op as its operator?\"\n  (and (exp-p exp) (eq (exp-op exp) op)))\n(defun symbol (&rest args)\n  \"Concatenate symbols or strings to form an interned symbol\"\n  (intern (format nil \"~{~a~}\" args)))\n(defun new-symbol (&rest args)\n  \"Concatenate symbols or strings to form an uninterned symbol\"\n  (make-symbol (format nil \"~{~a~}\" args)))\n```\n\nHere are some examples of the compiler:\n\n```lisp\n> (compile-rule '(= (log (^ e x)) x))\n(LAMBDA (X)\n  (IF (OP? X 'LOG)\n    (LET ((XL (EXP-LHS X)))\n      (IF (OP? XL '^\n          (LET ((XLL (EXP-LHS XL))\n                (XLR (EXP-RHS XL)))\n           (IF (EQL XLL 'E)\n                XLR))))))\n> (compile-rule (simp-rule '(n * (m * x) = (n * m) * x)))\n(LAMBDA (X)\n  (IF (OP? X '*)\n    (LET ((XL (EXP-LHS X))\n          (XR (EXP-RHS X)))\n      (IF (NUMBERP XL)\n          (IF (OP? XR '*)\n            (LET ((XRL (EXP-LHS XR))\n                  (XRR (EXP-RHS XR)))\n              (IF (NUMBERP XRL)\n                (SIMPLIFY-EXP\n                  (LIST '*\n                        (SIMPLIFY-EXP (LIST '* XL XRL))\n                        XRR)))))))))\n```\n\n#### The Rule-Set Compiler\n{:#s0065}\n{:.h3hd}\n\nThe next step is to combine the code generated by this single-rule compiler to generate more compact code for sets of rules.\nWe'll divide up the complete set of rules into subsets based on the main operator (as we did with the `rules-for` function), and generate one big function for each operator.\nWe need to preserve the order of the rules, so only certain optimizations are possible, but if we make the assumption that no function has side effects (a safe assumption in this application), we can still do pretty well.\nWe'll use the `simp-fn` facility to install the one big function for each operator.\n\nThe function `compile-rule-set` takes an operator, finds all the rules for that operator, and compiles each rule individually.\n(It uses`compile-indexed-rule` rather than `compile-rule`, because it assumes we have already done the indexing for the main operator.) After each rule has been compiled, they are combined with `combine-rules`, which merges similar parts of rules and concatenates the different parts.\nThe result is wrapped in a `lambda` expression and compiled as the final simplification function for the operator.\n\n```lisp\n(defun compile-rule-set (op)\n  \"Compile all rules indexed under a given main op,\n  and make them into the simp-fn for that op.\"\n  (set-simp-fn op\n    (compile nil\n      '(lambda (x)\n        ,(reduce #'combine-rules\n                 (mapcar #'compile-indexed-rule\n                        (rules-for op)))))))\n(defun compile-indexed-rule (rule) .\n  \"Compile one rule into lambda-less code,\n  assuming indexing of main op.\"\n  (let ((*bindings* nil))\n    (compile-args\n      'x (exp-lhs rule)\n      (delay (build-exp (exp-rhs rule) *bindings*)))))\n```\n\nHere are two examples of what `compile-indexed-rule` generates:\n\n```lisp\n> (compile-indexed-rule '(= (log 1) 0))\n (LET ((XL (EXP-LHS X)))\n  (IF (EQL XL '1)\n      '0))\n> (compile-indexed-rule '(= (log (^ e x)) x))\n (LET ((XL (EXP-LHS X)))\n  (IF (OP? XL '^)\n      (LET ((XLL (EXP-LHS XL))\n            (XLR (EXP-RHS XL)))\n        (IF (EQL XLL 'E)\n             XLR))))\n```\n\nThe next step is to combine several of these rules into one.\nThe function `combine-rules` takes two rules and merges them together as much as possible.\n\n```lisp\n(defun combine-rules (a b)\n  \"Combine the code for two rules into one, maintaining order.\"\n  ;; In the default case, we generate the code (or a b),\n  ;; but we try to be cleverer and share common code,\n  ;; on the assumption that there are no side-effects.\n  (cond ((and (listp a) (listp b)\n              (= (length a) (length b) 3)\n              (equal (first a) (first b))\n              (equal (second a) (second b)))\n        ;; a = (f x y), b = (f x z) => (f x (combine-rules y z))\n        ;; This can apply when f=IF or f=LET\n        (list (first a) (second a)\n              (combine-rules (third a) (third b))))\n       ((matching-ifs a b)\n        (if ,(second a)\n            ,(combine-rules (third a) (third b))\n            ,(combine-rules (fourth a) (fourth b))))\n       ((starts-with a 'or)\n        ;;  a = (or ... (if p y)), b = (if p z) =>\n        ;;       (or ... (if p (combine-rules y z)))\n        ;; else\n        ;;  a = (or ...) b = > (or ... b)\n        (if (matching-ifs (lastl a) b)\n            (append (butlast a)\n                    (list (combine-rules (lastl a) b)))\n            (append a (list b))))\n        (t ; ; a. b = > (or a b)\n          '(or ,a ,b))))\n(defun matching-ifs (a b)\n  \"Are a and b if statements with the same predicate?\"\n  (and (starts-with a 'if) (starts-with b 'if)\n       (equal (second a) (second b))))\n(defun lastl (list)\n  \"Return the last element (not last cons cell) of list\"\n  (first (last list)))\n```\n\nHere is what `combine-rules` does with the two rules generated above:\n\n```lisp\n> (combine-rules\n    '(let ((xl (exp-lhs x))) (if (eql xl '1) '0))\n    '(let ((xl (exp-lhs x)))\n       (if (op? xl '^)\n           (let ((xl1 (exp-lhs xl))\n                (xlr (exp-rhs xl)))\n             (if (eql xll 'e) xlr)))))\n(LET ((XL (EXP-LHS X)))\n  (OR (IF (EQL XL '1) '0)\n      (IF (OP? XL '^)\n          (LET ((XLL (EXP-LHS XL))\n                (XLR (EXP-RHS XL)))\n            (IF (EQL XLL 'E) XLR)))))\n```\n\nNow we run the compiler by calling `compile-all-rules-indexed` and show the combined compiled simplification function for log.\nThe comments were entered by hand to show what simplification rules are compiled where.\n\n```lisp\n(defun compile-all-rules-indexed (rules)\n  \"Compile a separate fn for each operator, and store it\n  as the simp-fn of the operator.\"\n  (index-rules rules)\n  (let ((all-ops (delete-duplicates (mapcar #'main-op rules))))\n    (mapc #'compile-rule-set ail-ops)))\n> (compile-all-rules-indexed *simplification-rules*)\n(SIN COS LOG ^ * / - + D)\n> (simp-fn 'log)\n(LAMBDA (X)\n  (LET ((XL (EXP-LHS X)))\n    (OR (IF (EQL XL '1)\n            '0)                    ;*log 1 = 0*\n        (IF (EQL XL '0)\n            'UNDEFINED)            ;*log 0 = undefined*\n        (IF (EQL XL 'E)\n            '1)                    ;*log e = 1*\n        (IF (OP? XL '^)\n            (LET ((XLL (EXP-LHS XL))\n                  (XLR (EXP-RHS XL)))\n             (IF (EQL XLL 'E)\n                  XLR))))))       ;*log ex = x*\n```\n\nIf we want to bypass the rule-based simplifier altogether, we can change `simplify-exp` once again to eliminate the check for rules:\n\n```lisp\n(defun simplify-exp (exp)\n  \"Simplify by doing arithmetic, or by using the simp function\n  supplied for this operator. Do not use rules of any kind.\"\n  (cond ((simplify-by-fn exp))\n        ((evaluable exp) (eval exp))\n        (t exp)))\n```\n\nAt last, we are in a position to run the benchmark test on the new compiled code; the function `test-it` runs in about .15 seconds with memoization and .05 without.\nWhy would memoization, which helped before, now hurt us?\nProbably because there is a lot of overhead in accessing the hash table, and that overhead is only worth it when there is a lot of other computation to do.\n\nWe've seen a great improvement since the original code, as the following table summarizes.\nOverall, the various efficiency improvements have resulted in a 130- fold speed-up-we can do now in a minute what used to take two hours.\nOf course, one must keep in mind that the statistics are only good for this one particular set of test data on this one machine.\nIt is an open question what performance you will get on other problems and on other machines.\n\nThe following table summarizes the execution time and number of function calls on the test data:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | original | memo | memo + index | memo + comp | comp |\n| run time (secs) | 6.6 | 3.0 | .98 | .15 | .05 |\n| speed-up | - | 2 | 7 | 44 | 130 |\n| calls |\n| pat-match | 51690 | 20003 | 5159 | 0 | 0 |\n| variable-p | 37908 | 14694 | 4798 | 0 | 0 |\n| match-variable | 1393 | 551 | 551 | 0 | 0 |\n| simplify | 906 | 408 | 408 | 545 | 906 |\n| simplify-exp | 274 | 118 | 118 | 118 | 274 |\n\n![t0030](images/B9780080571157500091/t0030.png)\n\n## 9.7 History and References\n{:#s0070}\n{:.h1hd}\n\nThe idea of memoization was introduced by Donald Michie 1968.\nHe proposed using a list of values rather than a hash table, so the savings was not as great.\nIn mathematics, the field of dynamic programming is really just the study of how to compute values in the proper order so that partial results will already be cached away when needed.\n\nA large part of academic computer science covers compilation; [Aho and Ullman 1972](B9780080571157500285.xhtml#bb0015) is just one example.\nThe technique of compiling embedded languages (such as the language of pattern-matching rules) is one that has achieved much more attention in the Lisp community than in the rest of computer science.\nSee [Emanuelson and Haraldsson 1980](B9780080571157500285.xhtml#bb0365), for an example.\n\nChoosing the right data structure, indexing it properly, and defining algorithms to operate on it is another important branch of computer science; [Sedgewick 1988](B9780080571157500285.xhtml#bb1065) is one example, but there are many worthy texts.\n\nDelaying computation by packaging it up in a `lambda` expression is an idea that goes back to Algol's use of *thunks*-a mechanism to implement call-by-name parameters, essentially by passing functions of no arguments.\nThe name *thunk* comes from the fact that these functions can be compiled: the system does not have to think about them at run time, because the compiler has already thunk about them.\nPeter [Ingerman 1961](B9780080571157500285.xhtml#bb0570) describes thunks in detail.\n[Abelson and Sussman 1985](B9780080571157500285.xhtml#bb0010) cover delays nicely.\nThe idea of eliminating unneeded computation is so attractive that entire languages have built around the concept of *lazy evaluation*-don't evaluate an expression until its value is needed.\nSee [Hughes 1985](B9780080571157500285.xhtml#bb0565) or [Field and Harrison 1988](B9780080571157500285.xhtml#bb0400).\n\n## 9.8 Exercises\n{:#s0075}\n{:.h1hd}\n\n**Exercise 9.3 [d]** In this chapter we presented a compiler for `simplify`.\nIt is not too much harder to extend this compiler to handle the full power of `pat-match`.\nInstead of looking at expressions only, allow trees with variables in any position.\nExtend and generalize the definitions of `compile-rule` and `compile-rule-set` so that they can be used as a general tool for any application program that uses `pat-match` and/or `rule-based-translator`.\nMake sure that the compiler is data-driven, so that the programmer who adds a new kind of pattern to `pat-match` can also instruct the compiler how to deal with it.\nOne hard part will be accounting for segment variables.\nIt is worth spending a considerable amount of effort at compile time to make this efficient at run time.\n\n**Exercise 9.4 [m]** Define the time to compute (fib n) without memoization as *Tn*.\nWrite a formula to express *Tn*.\nGiven that *T*25 &asymp; 1.1 seconds, predict *T*100.\n\n**Exercise 9.5 [m]** Consider a version of the game of Nim played as follows: there is a pile of *n* tokens.\nTwo players alternate removing tokens from the pile; on each turn a player must take either one, two, or three tokens.\nWhoever takes the last token wins.\nWrite a program that, given *n*, returns the number of tokens to take to insure a win, if possible.\nAnalyze the execution times for your program, with and without memoization.\n\n**Exercise 9.6 [m]** A more complicated Nim-like game is known as Grundy's game.\nThe game starts with a single pile of *n* tokens.\nEach player must choose one pile and split it into two uneven piles.\nThe first player to be unable to move loses.\nWrite a program to play Grundy's game, and see how memoization helps.\n\n**Exercise 9.7 [h]** This exercise describes a more challenging one-person game.\nIn this game the player rolls a six-sided die eight times.\nThe player forms four two-digit decimal numbers such that the total of the four numbers is as high as possible, but not higher than 170.\nA total of 171 or more gets scored as zero.\n\nThe game would be deterministic and completely boring if not for the requirement that after each roll the player must immediately place the digit in either the ones or tens column of one of the four numbers.\n\nHere is a sample game.\nThe player first rolls a 3 and places it in the ones column of the first number, then rolls a 4 and places it in the tens column, and so on.\nOn the last roll the player rolls a 6 and ends up with a total of 180.\nSince this is over the limit of 170, the player's final score is 0.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| roll | 3 | 4 | 6 | 6 | 3 | 5 | 3 | 6 |\n| lst num. | -3 | 43 | 43 | 43 | 43 | 43 | 43 | 43 |\n| 2nd num. | - | - | -6 | -6 | 36 | 36 | 36 | 36 |\n| 3rd num. | - | - | - | -6 | -6 | -6 | 36 | 36 |\n| 4th num. | - | - | - | - | - | -5 | -5 | 65 |\n| total | 03 | 43 | 49 | 55 | 85 | 90 | 120 | 0 |\n\n![t0035](images/B9780080571157500091/t0035.png)\n\nWrite a function that allows you to play a game or a series of games.\nThe function should take as argument a function representing a strategy for playing the game.\n\n**Exercise 9.8 [h]** Define a good strategy for the dice game described above.\n(Hint: my strategy scores an average of 143.7.)\n\n**Exercise 9.9 [m]** One problem with playing games involving random numbers is the possibility that a player can cheat by figuring out what `random` is going to do next.\nRead the definition of the function `random` and describe how a player could cheat.\nThen describe a countermeasure.\n\n**Exercise 9.10 [m]** On [Page 292](B9780080571157500091.xhtml#p292) we saw the use of the read-time conditionals, #+and #-, where #+is the read-time equivalent of when, and #- is the read-time equivalent of unless.\nUnfortunately, there is no read-time equivalent of case.\nImplement one.\n\n**Exercise 9.11 [h]** Write a compiler for ELIZA !!!(span) {:.smallcaps} that compiles all the rules at once into a single function.\nHow much more efficient is the compiled version?\n\n**Exercise 9.12 [d]** Write some rules to simplify Lisp code.\nSome of the algebraic simplification rules will still be valid, but new ones will be needed to simplify nonalgebraic functions and special forms.\n(Since `nil` is a valid expression in this domain, you will have to deal with the semipredicate problem.) Here are some example rules (using prefix notation):\n\n```lisp\n(= (+ x 0) x)\n(= 'nil nil) (\n(= (car (cons x y)) x)\n(= (cdr (cons x y)) y)\n(= (if t x y) x)\n(= (if nil x y) y)\n(= (length nil) 0)\n(= (expt y (?if x numberp)) (expt (expt y (/ x 2)) 2))\n```\n\n**Exercise 9.13 [m]** Consider the following two versions of the sieve of Eratosthenes algorithm.\nThe second explicitly binds a local variable.\nIs this worth it?\n\n```lisp\n(defun sieve (pipe)\n  (make-pipe (head pipe)\n             (filter #'(lambda (x)(/= (mod x (headpipe)) 0))\n                    (sieve (tail pipe)))))\n(defun sieve (pipe)\n  (let ((first-num (head pipe)))\n    (make-pipe first-num\n               (filter #'(lambda (x) (/= (mod x first-num) 0))\n                      (sieve (tail pipe))))))\n```\n\n## 9.9 Answers\n{:#s0080}\n{:.h1hd}\n\n**Answer 9.4** Let *Fn* denote (`fib n`).\nThen the time to compute *Fn*, *Tn*, is a small constant for *n* &le; 1, and is roughly equal to *Tn-1* plus *Tn-2* for larger *n*.\nThus, *Tn* is roughly proportional to *Fn*:\n\nTn=FnTiFi\n\n![si1_e](images/B9780080571157500091/si1_e.gif)\n\nWe could use some small value of *Ti* to calculate *T*100 if we knew *F*100.\nFortunately, we can use the equation:\n\nFn&alpha;&Phi;n\n\n![si2_e](images/B9780080571157500091/si2_e.gif)\n\nWhere &phi; = (1 + &radic;(5))/2 &asymp; 1.618.\nThis equation was derived by de Moivre in 1718 (see Knuth, Donald E.\n*Fundamental Algorithms*, pp.\n78-83), but the number *&phi;* has a long interesting history.\nEuclid called it the \"extreme and mean ratio,\" because the ratio of *A* to *B* is the ratio of *A* + *B* to *A* if *A*/*B* is *&phi;*.\nIn the Renaissance it was called the \"divine proportion,\" and in the last century it has been known as the \"golden ratio,\" because a rectangle with sides in this ratio can be divided into two smaller rectangles that both have the same ratio between sides.\nIt is said to be a pleasing proportion when employed in paintings and architecture.\nPutting history aside, given *T*25 &asymp; 1.1 *sec* we can now calculate:\n\nT100&asymp;&Phi;1001.1sec&Phi;25&asymp;5x1015sec\n\n![si3_e](images/B9780080571157500091/si3_e.gif)\n\nwhich is roughly 150 million years.\nWe can also see that the timing data in the table fits the equation fairly well.\nHowever, we would expect some additional time for larger numbers because it takes longer to add and garbage collect bignums than fixnums.\n\n**Answer 9.5** First we'll define the notion of a forced win.\nThis occurs either when there are three or fewer tokens left or when you can make a move that gives your opponent a possible loss.\nA possible loss is any position that is not a forced win.\nIf you play perfectly, then a possible loss for your opponent will in fact be a win for you, since there are no ties.\nSee the functions `win` and `loss` below.\nNow your strategy should be to win the game outright if there are three or fewer tokens, or otherwise to choose the largest number resulting in a possible loss for your opponent.\nIf there is no such move available to you, take only one, on the grounds that your opponent is more likely to make a mistake with a larger pile to contend with.\nThis strategy is embodied in the function `nim` below.\n\n```lisp\n(defun win (n)\n  \"Is a pile of n tokens a win for the player to move?\"\n  (or (<= n 3)\n      (loss (- n 1))\n      (loss (- n 2))\n      (loss (- n 3))))\n(defun loss (n) (not (win n)))\n(defun nim (n)\n  \"Play Nim: a player must take 1-3; taking the last one wins.\n  (con ((<= n 3) n); an immediate win\n      ((loss (- n 3)) 3); an eventual win\n      ((loss (- n 2)) 2); an eventual win\n      ((loss (- n 1)) 1); an eventual win\n      (t 1))); a loss; the 1 is arbitrary\n(memoize 'loss)\n```\n\nFrom this we are able to produce a table of execution times (in seconds), with and without memoization.\nOnly `loss` need be memoized.\n(Why?) Do you have a good explanation of the times for the unmemoized version?\nWhat happens if you change the order of the loss clauses in `win` and/or `nim?`\n\n**Answer 9.6** We start by defining a function, `moves`, which generates all possible moves from a given position.\nThis is done by considering each pile of *n* tokens within a set of piles *s*.\nAny pile bigger than two tokens can be split.\nWe take care to elimina te duplicate positions by sorting each set of piles, and then removing the duplicates.\n\n```lisp\n(defun moves (s)\n  \"Return a list of all possible moves in Grundy's game\"\n  ;; S is a list of integers giving the sizes of the piles\n  (remove-duplicates\n    (loop for n in s append (make-moves n s))\n    :test #'equal))\n(defun make-moves (n s)\n  (when (> = n 2)\n    (let ((s/n (remove n s :count 1)))\n      (loop for i from 1 to (- (ceiling n 2) 1)\n            collect (sort* (list* i (- ni) s/n)\n                           #'>>))))\n(defun sort* (seq pred &key key)\n  \"Sort without altering the sequence\"\n  (sort (copy-seq seq) pred :key key))\n```\n\nThis time a loss is defined as a position from which you have no moves, or one from which your opponent can force a win no matter what you do.\nA winning position is one that is not a loss, and the strategy is to pick a move that is a loss for your opponent, or if you can't, just to play anything (here we arbitrarily pick the first move generated).\n\n```lisp\n(defun loss (s)\n  (let ((choices (moves s)))\n    (or (null choices)\n        (every #'win choices))))\n(defun win (s) (not (loss s)))\n(defun grundy (s)\n  (let ((choices (moves s)))\n    (or (find-if #'loss choices)\n        (first choices))))\n```\n\n**Answer 9.7** The answer assumes that a strategy function takes four arguments: the current die roll, the score so far, the number of remaining positions in the tens column, and the number of remaining positions in the ones column.\nThe strategy function should return 1 or 10.\n\n```lisp\n(defun play-games (&optional (n-games 10) (player 'make-move))\n  \"A driver for a simple dice game. In this game the player\n  rolls a six-sided die eight times. The player forms four\n  two-digit decimal numbers such that the total of the four\n  numbers is as high as possible, but not higher than 170.\n  A total of 171 or more gets scored as zero. After each die\n  is rolled, the player must decide where to put it.\n  This function returns the player's average score.\"\n  (/ (loop repeat n-games summing (play-game player 0 4 4))\n     (float n-games)))\n(defun play-game (player &optional (total 0) (tens 4) (ones 4))\n  (cond ((or (> total 170) (< tens 0) (< ones 0)) 0)\n        ((and (= tens 0) (= ones 0)) total)\n        (t (let ((die (roll-die)))\n            (case (funcall player die total tens ones)\n             (1 (play-game player (+ total die)\n                           tens (- ones 1)))\n             (10 (play-game player (+ total (* 10 die))\n                           (- tens 1) ones))\n             (t 0))))))\n(defun roll-die () (+ 1 (random 6)))\n```\n\nSo, the expression `(play-games 5 #'make-move)` would play five games with a strategy called `make-move`.\nThis returns only the average score of the games; if you want to see each move as it is played, use this function:\n\n```lisp\n(defun show (player)\n  \"Return a player that prints out each move it makes.\"\n  #'(lambda (die total tens ones)\n      (when (= total 0) (fresh-line))\n      (let ((move (funcall player die total tens ones)))\n        (incf total (* die move))\n        (format t \"~2d-> ~ 3d | ~ @[*~]\" (* move die) total (> total 170))\n         move)))\n```\n\nand call `(play-games 5 (show #'make-moves))`.\n\n**Answer 9.9** The expression `(random 6 (make-random-state))` returns the next number that `roll-die` will return.\nTo guard against this, we can make `roll-die` use a random state that is not accessible through a global variable:\n\n```lisp\n(let ((state (make-random-state t)))\n  (defun roll-die () (+ 1 (random 6 state))))\n```\n\n**Answer 9.10** Because this has to do with read-time evaluation, it must be implemented as a macro or read macro.\nHere's one way to do it:\n\n```lisp\n(defmacro read-time-case (first-case &rest other-cases)\n  \"Do the first case, where normally cases are\n  specified with #+or possibly #- marks.\"\n  (declare (ignore other-cases))\n  first-case)\n```\n\nA fanciful example, resurrecting a number of obsolete Lisps, follows:\n\n```lisp\n(defun get-fast-time ()\n  (read-time-case\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `#+Explorer` | `(time :microsecond-time)` |\n| `#+Franz` | `(sys:time)` |\n| `#+(or PSL UCI)` | `(time)` |\n| `#+YKT` | `(currenttime)` |\n| `#+MTS` | `(status 39)` |\n| `#+Interlisp` | `(clock 1)` |\n| `#+Lispl.5` | `(tempus-fugit)` |\n| `;; otherwise` | |\n| | `(get-internal-real-time)))` |\n\n**Answer 9.13** Yes.\nComputing (`head pipe`) may be a trivial computation, but it will be done many times.\nBinding the local variable makes sure that it is only done once.\nIn general, things that you expect to be done multiple times should be moved out of delayed functions, while things that may not be done at all should be moved inside a delay.\n\n----------------------\n\n[1](#xfn0010) One could say that the FORTRAN compiler was \"broken.\" This underscores the problem of defining the efficiency of a language-do we judge by the most popular compiler, by the best compiler available, or by the best compiler imaginable?\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) In KCL, the symbol `lambda-closure` is used, and in Allegro, it is `excl:.\n1exical-closure`\n!!!(p) {:.ftnote1}\n\n[3](#xfn0020) The terms *metering* and *monitoring* are sometimes used instead of profiling.\n!!!(p) {:.ftnote1}\n\n# Chapter 10\n## Low-Level Efficiency Issues\n{:.chaptitle}\n\n> There are only two qualities in the world: efficiency and inefficiency; and only two sorts of people: the efficient and the inefficient\n\n> -George Bernard Shaw\n\n> John Bull's Other Island (1904)\n\nThe efficiency techniques of the previous chapter all involved fairly significant changes to an algorithm.\nBut what happens when you already are using the best imaginable algorithms, and performance is still a problem?\nOne answer is to find what parts of the program are used most frequently and make micro-optimizations to those parts.\nThis chapter covers the following six optimization techniques.\nIf your programs all run quickly enough, then feel free to skip this chapter.\nBut if you would like your programs to run faster, the techniques described here can lead to speed-ups of 40 times or more.\n\n*  Use declarations.\n\n*  Avoid generic functions.\n\n*  Avoid complex argument lists.\n\n*  Provide compiler macros.\n\n*  Avoid unnecessary consing.\n\n*  Use the right data structure.\n\n## 10.1 Use Declarations\n{:#s0010}\n{:.h1hd}\n\nOn general-purpose computers running Lisp, much time is spent on type-checking.\nYou can gain efficiency at the cost of robustness by declaring, or promising, that certain variables will always be of a given type.\nFor example, consider the following function to compute the sum of the squares of a sequence of numbers:\n\n```lisp\n(defun sum-squares (seq)\n (let ((sum 0))\n  (dotimes (i (length seq))\n   (incf sum (square (elt seq i))))\n  sum))\n(defun square (x) (* x x))\n```\n\nIf this function will only be used to sum vectors of fixnums, we can make it a lot faster by adding declarations:\n\n```lisp\n(defun sum-squares (vect)\n (declare (type (simple-array fixnum *) vect)\n    (inline square) (optimize speed (safety 0)))\n (let ((sum 0))\n  (declare (fixnum sum))\n  (dotimes (i (length vect))\n   (declare (fixnum i))\n   (incf sum (the fixnum (square (svref vect i)))))))\n  sum))\n```\n\nThe fixnum declarations let the compiler use integer arithmetic directly, rather than checking the type of each addend.\nThe (`the fixnum`... ) special form is a promise that the argument is a fixnum.\nThe (`optimize speed (safety 0))` declaration tells the compiler to make the function run as fast as possible, at the possible expense of making the code less safe (by ignoring type checks and so on).\nOther quantities that can be optimized are `compilation-speed, space` and in ANSI Common Lisp only, `debug` (ease of debugging).\nQuantities can be given a number from 0 to 3 indicating how important they are; 3 is most important and is the default if the number is left out.\n\nThe (`inline square`) declaration allows the compiler to generate the multiplication specified by `square` right in the loop, without explicitly making a function call to square.\nThe compiler will create a local variable for (`svref vect i`) and will not execute the reference twice-inline functions do not have any of the problems associated with macros as discussed on [page 853](B9780080571157500248.xhtml#p853).\nHowever, there is one drawback: when you redefine an inline function, you may need to recompile all the functions that call it.\n\nYou should declare a function `inline` when it is short and the function-calling overhead will thus be a significant part of the total execution time.\nYou should not declare a function `inline` when the function is recursive, when its definition is likely to change, or when the function's definition is long and it is called from many places.\n\nIn the example at hand, declaring the function inline saves the overhead of a function call.\nIn some cases, further optimizations are possible.\nConsider the predicate `starts-with`:\n\n```lisp\n(defun starts-with (list x)\n \"Is this a list whose first element is x?\"\n (and (consp list) (eql (first list) x)))\n```\n\nSuppose we have a code fragment like the following:\n\n```lisp\n(if (consp list) (starts-with list x) ...)\n```\n\nIf `starts-with` is declared `inline` this will expand to:\n\n```lisp\n(if (consp list) (and (consp list) (eql (first list) x)) ...)\n```\n\nwhich many compilers will simplify to:\n\n```lisp\n(if (consp list) (eql (first list) x) ...)\n```\n\nVery few compilers do this kind of simplification across functions without the hint provided by `inline`.\n\nBesides eliminating run-time type checks, declarations also allow the compiler to choose the most efficient representation of data objects.\nMany compilers support both *boxed* and *unboxed* representations of data objects.\nA boxed representation includes enough information to determine the type of the object.\nAn unboxed representation is just the \"raw bits\" that the computer can deal with directly.\nConsider the following function, which is used to clear a 1024 x 1024 array of floating point numbers, setting each one to zero:\n\n```lisp\n(defun clear-m-array (array)\n (declare (optimize (speed 3) (safety 0)))\n (declare (type (simple-array single-float (1024 1024)) array))\n (dotimes (i 1024)\n  (dotimes (j 1024)\n   (setf (aref array i j) 0.0))))\n```\n\nIn Allegro Common Lisp on a Sun SPARCstation, this compiles into quite good code, comparable to that produced by the C compiler for an equivalent C program.\nIf the declarations are omitted, however, the performance is about 40 times worse.\n\nThe problem is that without the declarations, it is not safe to store the raw floating point representation of `0.0` in each location of the array.\nInstead, the program has to box the `0.0`, allocating storage for a typed pointer to the raw bits.\nThis is done inside the nested loops, so the result is that each call to the version of `clear-m-array` without declarations calls the floating-point-boxing function 1048567 times, allocating a megaword of storage.\nNeedless to say, this is to be avoided.\n\nNot all compilers heed all declarations; you should check before wasting time with declarations your compiler may ignore.\nThe function `disassemble` can be used to show what a function compiles into.\nFor example, consider the trivial function to add two numbers together.\nHere it is with and without declarations:\n\n```lisp\n(defun f (x y)\n (declare (fixnum x y) (optimize (safety 0) (speed 3)))\n (the fixnum (+ x y)))\n(defun g (x y) (+ x y))\n```\n\nHere is the disassembled code for f from Allegro Common Lisp for a Motorola 68000-series processor:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble 'f)` |\n| `;; disassembling #<Function f @ #x83ef79 >` |\n| `;; formals: x y` |\n| `;; code vector @ #x83ef44` |\n| `0:` | `link` | `a6.#0` |\n| `4:` | `move.l` | `a2,-(a7)` |\n| `6:` | `move.l` | `a5,-(a7)` |\n| `8:` | `move.l` | `7(a2),a5` |\n| `12:` | `move.l` | `8(a6).d4 ; y` |\n| `16:` | `add.l` | `12(a6),d4 ; x` |\n| `20:` | `move.l` | `#1,d1` |\n| `22:` | `move.l` | `-8(a6),a5` |\n| `26:` | `unlk` | `a6` |\n| `28:` | `rtd` | `#8` |\n\n![t0010](images/B9780080571157500108/t0010.png)\n\nThis may look intimidating at first glance, but you don't have to be an expert at 68000 assembler to gain some appreciation of what is going on here.\nThe instructions labeled 0-8 (labels are in the leftmost column) comprise the typical function preamble for the 68000.\nThey do subroutine linkage and store the new function object and constant vector into registers.\nSince f uses no constants, instructions 6, 8, and 22 are really unnecessary and could be omitted.\nInstructions 0,4, and 26 could also be omitted if you don't care about seeing this function in a stack trace during debugging.\nMore recent versions of the compiler will omit these instructions.\n\nThe heart of function `f` is the two-instruction sequence 12-16.\nInstruction 12 retrieves `y`, and 16 adds `y` to `x`, leaving the result in `d4`, which is the \"result\" register.\nInstruction 20 sets `dl`, the \"number of values returned\" register, to 1.\n\nContrast this to the code for `g`, which has no declarations and is compiled at default speed and safety settings:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble 'g)` `;; disassembling #<Function g @ #x83dbd1 >` `;; formals: x y` `;; code vector @ #x83db64` |\n| `0:` | `add.l` | `#8,31(a2)` | |\n| `4:` | `sub.w` | `#2,dl` | |\n| `6:` | `beq.s` | `12` | |\n| `8:` | `jmp` | `16(a4)` | `; wnaerr` |\n| `12:` | `link` | `a6,#0` | |\n| `16:` | `move.l` | `a2,-(a7)` | |\n| `18:` | `move.l` | `a5,-(a7)` | |\n| `20:` | `move.l` | `7(a2),a5` | |\n| `24:` | `tst.b` | `- 208(a4)` | `; signal-hit` |\n| `28` | `beq.s` | `34` | |\n| `30:` | `jsr` | `872(a4)` | `; process-sig` |\n| `34:` | `move.l` | `8(a6),d4` | `; y` |\n| `38:` | `move.l` | `12(a6),d0` | `; x` |\n| `42:` | `or.l` | `d4,d0` | |\n| `44:` | `and.b` | `#7,d0` | |\n| `48:` | `bne.s` | `62` | |\n| `50:` | `add.l` | `12(a6),d4 ;` | `x` |\n| `54:` | `bvc.s` | `76` | |\n| `56:` | `jsr` | `696(a4)` | `; add-overflow` |\n| `60:` | `bra.s` | `76` | |\n| `62:` | `move.l` | `12(a6),-(a7)` | `; x` |\n| `66:` | `move.l` | `d4,-(a7)` | |\n| `68:` | `move.l` | `#2,d1` | |\n| `70:` | `move.l` | `-304(a4),a0` | `; + _2op` |\n| `74:` | `jsr` | `(a4)` | |\n| `76:` | `move.l` | `#1,d1` | |\n| `78:` | `move.l` | `-8(a6),a5` | |\n| `82:` | `unlk` | `a6` | |\n| `84:` | `rtd` | `#8` | |\n\n![t0015](images/B9780080571157500108/t0015.png)\n\nSee how much more work is done.\nThe first four instructions ensure that the right number of arguments have been passed to `g`.\nIf not, there is a jump to `wnaerr` (wrong-number-of-arguments-error).\nInstructions 12-20 have the argument loading code that was at 0-8 in `f`.\nAt 24-30 there is a check for asynchronous signals, such as the user hitting the abort key.\nAfter `x` and `y` are loaded, there is a type check (42-48).\nIf the arguments are not both fixnums, then the code at instructions 62-74 sets up a call to `+ _2op`, which handles type coercion and non-fixnum addition.\nIf all goes well, we don't have to call this routine, and do the addition at instruction 50 instead.\nBut even then we are not done-just because the two arguments were fixnums does not mean the result will be.\nInstructions 54-56 check and branch to an overflow routine if needed.\nFinally, instructions 76-84 return the final value, just as in `f`.\n\nSome low-quality compilers ignore declarations altogether.\nOther compilers don't need certain declarations, because they can rely on special instructions in the underlying architecture.\nOn a Lisp Machine, both `f` and `g` compile into the same code:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `6 PUSH` | `ARG|0` | `; X` |\n| `7 +` | `ARG|1` | `; Y` |\n| `8 RETURN` | `PDL-POP` | |\n\nThe Lisp Machine has a microcoded + instruction that simultaneously does a fixnum add and checks for non-fixnum arguments, branching to a subroutine if either argument is not a fixnum.\nThe hardware does the work that the compiler has to do on a conventional processor.\nThis makes the Lisp Machine compiler simpler, so compiling a function is faster.\nHowever, on modem pipelined computers with instruction caches, there is little or no advantage to microcoding.\nThe current trend is away from microcode toward reduced instruction set computers (RISC).\n\nOn most computers, the following declarations are most likely to be helpful:\n\n*  `fixnum and float`.\nNumbers declared as fixnums or floating-point numbers can be handled directly by the host computer's arithmetic instructions.\nOn some systems, `float` by itself is not enough; you have to say `single-float` or `double-float`.\nOther numeric declarations will probably be ignored.\nFor example, declaring a variable as integer does not help the compiler much, because bignums are integers.\nThe code to add bignums is too complex to put inline, so the compiler will branch to a general-purpose routine (like `+ _2op` in Allegro), the same routine it would use if no declarations were given.\n\n*  `list and array`.\nMany Lisp systems provide separate functions for the list- and array- versions of commonly used sequence functions.\nFor example, `(delete x (the list 1 ))` compiles into `(sys: delete-list-eql x 1)` on a TI Explorer Lisp Machine.\nAnother function, `sys:delete-vector`, is used for arrays, and the generic function `delete` is used only when the compiler can't tell what type the sequence is.\nSo if you know that the argument to a generic function is either a `1ist` or an `array`, then declare it as such.\n\n*  `simple-vector and simple-array`.\nSimple vectors and arrays are those that do not share structure with other arrays, do not have fill pointers, and are not adjustable.\nIn many implementations it is faster to aref a `simple-vector` than a `vector`.\nIt is certainly much faster than taking an `elt` of a sequence of unknown type.\nDeclare your arrays to be simple (if they in fact are).\n\n*  `(array *type*)`.\nIt is often important to specialize the type of array elements.\nFor example, an `(array short-f1oat)` may take only half the storage of a general array, and such a declaration will usually allow computations to be done using the CPU's native floating-point instructions, rather than converting into and out of Common Lisp's representation of floating points.\nThis is very important because the conversion normally requires allocating storage, but the direct computation does not.\nThe specifiers `(simple-array *type*)` and `(vector *type*)` should be used instead of `(array *type*)` when appropriate.\nA very common mistake is to declare `(simple-vector *type*)`.\nThis is an error because Common Lisp expects `(simple-vector *size*)`-don't ask me why.\n\n*  `(array **dimensions*)`.\nThe full form of an array or `simple-array` type specifier is `(array *type dimensions*)`.\nSo, for example, `(array bit (* *))` is a two-dimensional bit array, and `(array bit (1024 1024))` is a 1024 x 1024 bit array.\nIt is very important to specify the number of dimensions when known, and less important to specify the exact size, although with multidimensional arrays, declaring the size is more important.\nThe format for a vector type specifier is `(vector *type size*)`.\n\nNote that several of these declarations can apply all at once.\nFor example, in\n\n```lisp\n(position # \\ . (the simple-string file-name))\n```\n\nthe variable `filename` has been declared to be a vector, a simple array, and a sequence of type `string-char`.\nAll three of these declarations are helpful.\nThe type `simple-string` is an abbreviation for `(simple-array string-char)`.\n\nThis guide applies to most Common Lisp systems, but you should look in the implementation notes for your particular system for more advice on how to fine-tune your code.\n\n## 10.2 Avoid Generic Functions\n{:#s0015}\n{:.h1hd}\n\nCommon Lisp provides functions with great generality, but someone must pay the price for this generality.\nFor example, if you write `(elt x 0)`, different machine instruction will be executed depending on if x is a list, string, or vector.\nWithout declarations, checks will have to be done at runtime.\nYou can either provide declarations, as in `(elt (the list x) 0)`, or use a more specific function, such as `(first x)` in the case of lists, `(char x 0)` for strings, `(aref x0)` for vectors, and `(svref x 0)` for simple vectors.\nOf course, generic functions are useful-I wrote `random-elt` as shown following to work on lists, when I could have written the more efficient `random-mem` instead.\nThe choice paid off when `I` wanted a function to choose a random character from a string-`random-elt` does the job unchanged, while `random-mem` does not.\n\n```lisp\n(defun random-elt (s) (elt s (random (length s))))\n(defun random-mem (l) (nth (random (length (the list l))) l))\n```\n\nThis example was simple, but in more complicated cases you can make your sequence functions more efficient by having them explicitly check if their arguments are lists or vectors.\nSee the definition of `map-into` on [page 857](B9780080571157500248.xhtml#p857).\n\n## 10.3 Avoid Complex Argument Lists\n{:#s0020}\n{:.h1hd}\n\nFunctions with keyword arguments suffer a large degree of overhead.\nThis may also be true for optional and rest arguments, although usually to a lesser degree.\nLet's look at some simple examples:\n\n```lisp\n(defun reg (a b c d) (list a b c d))\n(defun rst (abc &rest d) (list* a b c d))\n(defun opt (&optional a b (c 1) (d (sqrt a))) (list a b c d))\n(defun key (&key a b (c 1) (d (sqrt a))) (list a b c d))\n```\n\nWe can see what these compile into for the TI Explorer, but remember that your compiler may be quite different.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble 'reg)` |\n| `   8 PUSH` | `ARG|0` | `; A` |\n| `   9 PUSH` | `ARG|1` | `; B` |\n| `  10 PUSH` | `ARG|2` | `; C` |\n| `  11 PUSH` | `ARG|3` | `; D` |\n| `  12 TAIL-REC CALL-4` | `FEF|3` | `; #'LIST` |\n| `> (disassemble 'rst)` |\n| `   8 PUSH` | `ARG|0` | `; A` |\n| `   9 PUSH` | `ARG|1` | `; B` |\n| `  10 PUSH` | `ARG|2` | `; C` |\n| `  11 PUSH` | `LOCAL|0` | `; D` |\n| `  12 RETURN CALL-4` | `FEF|3` | `; #'LIST*` |\n\n![t0025](images/B9780080571157500108/t0025.png)\n\nWith the regular argument list, we just push the four variables on the argument stack and branch to the list function.\n([Chapter 22](B9780080571157500224.xhtml) explains why a tail-recursive call is just a branch statement.)\n\nWith a rest argument, things are almost as easy.\nIt turns out that on this machine, the microcode for the calling sequence automatically handles rest arguments, storing them in local variable 0.\nLet's compare with optional arguments:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(defun opt (&optional a b` (`c 1) (d (sqrt a))) (list a b c d))` `> (disassemble 'opt)` |\n| ` 24 DISPATCH` | `FEF|5` | `; [0`=>`25;1`=>`25;2`=>`25;3`=>`27;ELSE`=>`30]` |\n| ` 25 PUSH-NUMBER` | `1` | |\n| ` 26 POP` | `ARG|2` | ; `C` |\n| ` 27 PUSH` | `ARG|0` | ; `A` |\n| ` 28 PUSH CALL-1` | `FEF|3` | ; `#'SQRT` |\n| ` 29 POP` | `ARG|3` | ; `D` |\n| ` 30 PUSH` | `ARG|0` | ; `A` |\n| ` 31 PUSH` | `ARG|1` | ; `B` |\n| ` 32 PUSH` | `ARG|2` | ; `C` |\n| ` 33 PUSH` | `ARG|3` | ; `D` |\n| ` 34 TAIL-REC CALL-4` | `FEF|4` | ; `#'LIST` |\n\n![t0030](images/B9780080571157500108/t0030.png)\n\nAlthough this assembly language may be harder to read, it turns out that optional arguments are handled very efficiently.\nThe calling sequence stores the number of optional arguments on top of the stack, and the `DISPATCH` instruction uses this to index into a table stored at location `FEF|5` (an offset five words from the start of the function).\nThe result is that in one instruction the function branches to just the right place to initialize any unspecified arguments.\nThus, a function with optional arguments that are all supplied takes only one more instruction (the dispatch) than the \"regular\" case.\nUnfortunately, keyword arguments don't fare as well:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(defun key (&key a b` (`c 1`) `(d (sqrt a))) (list a b c d))` `> (disassemble 'key)` |\n| ` 14 PUSH-NUMBER` | `1` | |\n| ` 15 POP` | `LOCAL|3` | `; C` |\n| ` 16 PUSH` | `FEF|3` | `; SYS:-.KEYWORD-GARBAGE` |\n| ` 17 POP` | `LOCAL|4` | |\n| ` 18 TEST` | `LOCAL|0` | |\n| ` 19 BR-NULL` | `24` | |\n| ` 20 PUSH` | `FEF|4` | `; '(:A :B :C :D)` |\n| ` 21 SET-NIL` | `PDL-PUSH` | |\n| ` 22 PUSH-LOC` | `LOCAL|1` | `; A` |\n| ` 23 (AUX) %STORE-KEY-WORD-ARGS` | | |\n| ` 24 PUSH` | `LOCAL|1` | `; A` |\n| ` 25 PUSH` | `LOCAL|2` | `; B` |\n| ` 26 PUSH` | `LOCAL|3` | `; C` |\n| ` 27 PUSH` | `|4` | |\n| ` 28 EQ` | `FEF|3` | `; SYS::KEYW0RD-GARBAGE` |\n| ` 29 BR-NULL` | `33` | |\n| ` 30 PUSH` | `LOCAL|1` | `; A` |\n| ` 31 PUSH CALL-1` | `FEF|5` | `; #'SQRT` |\n| ` 32 RETURN CALL-4` | `FEF|6` | `; #'LIST` |\n| ` 33 PUSH` | `LOCAL|4` | |\n| ` 34 RETURN CALL-4` | `FEF|6` | ;`#'LIST` |\n\n![t0035](images/B9780080571157500108/t0035.png)\n\nIt is not important to be able to read all this assembly language.\nThe point is that there is considerable overhead, even though this architecture has a specific instruction `(%STORE-KEY-WORD-ARGS)` to help deal with keyword arguments.\n\nNow let's look at the results on another system, the Allegro compiler for the 68000.\nFirst, here's the assembly code for reg, to give you an idea of the minimal calling sequence:[1](#fn0015)\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble 'reg)` `;; disassembling #<Function reg @ #x83db59 >` `;; formals: a b c d` `;; code vector @ #x83dblc` |\n| `0:` | `link` | `a6,#0` | |\n| `4:` | `move.l` | `a2,-(a7)` | |\n| `6:` | `move.l` | `a5,-(a7)` | |\n| `8:` | `move.l` | `7(a2),a5` | |\n| `12:` | `move.l` | `20(a6),-(a7)` | `; a` |\n| `16:` | `move.l` | `16(a6).-(a7)` | `; b` |\n| `20:` | `move.l` | `12(a6),-(a7)` | `; c` |\n| `24:` | `move.l` | `8(a6),-(a7)` | `; d` |\n| `28:` | `move.l` | `#4,dl` | |\n| `30:` | `jsr` | `848(a4)` | `; list` |\n| `34:` | `move.l` | `- 8(a6),a5` | |\n| `38:` | `unlk` | `a6` | |\n| `40:` | `rtd` | `#10` | |\n\n![t0040](images/B9780080571157500108/t0040.png)\n\nNow we see that `&rest` arguments take a lot more code in this system:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble 'rst)` `;; disassembling #<Function rst @ #x83de89 >` `;; formals: a b c &rest d` `code vector @ #x83de34` |\n| `0:` | `sub.w` | `#3,dl` | |\n| `2:` | `bge.s` | `8` | |\n| `4:` | `jmp` | `16(a4)` | `; wnaerr` |\n| `8:` | `move.l` | `(a7)+,al` | |\n| `10`: | `move.l` | `d3,-(a7)` | `; nil` |\n| `12`: | `sub.w` | `#l,dl` | |\n| `14:` | `bit.s` | `38` | |\n| `16:` | `move.l` | `al, - 52(a4)` | `; c_protected-retaddr` |\n| `20:` | `jsr` | `40(a4)` | `; cons` |\n| `24:` | `move.l` | `d4,-(a7)` | |\n| `26:` | `dbra` | `dl,20` | |\n| `30:` | `move.l` | `- 52(a4),al` | `; c_protected-retaddr` |\n| `34:` | `clr.l` | `- 52(a4)` | `; c_protected-retaddr` |\n| `38:` | `move.l` | `al,` | `-(a7)` |\n| `40:` | `link` | `a6,#0` | |\n| `44:` | `move.l` | `a2,-(a7)` | |\n| `46:` | `move.l` | `a5,-(a7)` | |\n| `48:` | `move.l` | `7(a2),a5` | |\n| `52:` | `move.l` | `- 332(a4),a0` | `; list*` |\n| `56:` | `move.l` | `- 8(a6),a5` | |\n| `60:` | `unlk` | `a6` | |\n| `62`: | `move.l` | `#4,dl` | |\n| `64` | `jmp` | `(a4)` | |\n\n![t0045](images/B9780080571157500108/t0045.png)\n\nThe loop from 20-26 builds up the `&rest` list one cons at a time.\nPart of the difficulty is that cons could initiate a garbage collection at any time, so the list has to be built in a place that the garbage collector will know about.\nThe function with optional arguments is even worse, taking 34 instructions (104 bytes), and keywords are worst of all, weighing in at 71 instructions (178 bytes), and including a loop.\nThe overhead for optional arguments is proportional to the number of optional arguments, while for keywords it is proportional to the product of the number of parameters allowed and the number of arguments actually supplied.\n\nA good guideline to follow is to use keyword arguments primarily as an interface to infrequently used functions, and to provide versions of these functions without keywords that can be used in places where efficiency is important.\nConsider:\n\n```lisp\n(proclaim '(inline key))\n(defun key (&key a b (c 1) (d (sqrt a))) (*no-key a b c d))\n(defun *no-key (a b c d) (list a b c d))\n```\n\nHere the function `key` is used as an interface to the function `no-key`, which does the real work.\nThe inline proclamation should allow the compiler to compile a call to key as a call to `no-key` with the appropriate arguments:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble #'(lambda (x y) (key :b x :a y)))` |\n| ` 10 PUSH` | `ARG|1` | `; Y` |\n| ` 11 PUSH` | `ARG|0` | `; X` |\n| ` 12 PUSH-NUMBER` | `1` | |\n| ` 13 PUSH` | `ARG|1` | `; Y` |\n| ` 14 PUSH CALL-1` | `FEF|3` | `; #'SORT` |\n| ` 15 TAIL-REC CALL-4` | `FEF|4` | `; #'NO-KEY` |\n\n![t0050](images/B9780080571157500108/t0050.png)\n\nThe overhead only comes into play when the keywords are not known at compile time.\nIn the following example, the compiler is forced to call key, not `no-key`, because it doesn't know what the keyword `k` will be at run time:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble #'(lambda (k x y) (key k x :a y)))` |\n| ` 10 PUSH` | `ARG|0` | ; `K` |\n| ` 11 PUSH` | `ARG|1` | ; `X` |\n| ` 12 PUSH` | `FEF|3` | `; ':A` |\n| ` 13 PUSH` | `ARG|2` | ; `Y` |\n| ` 14 TAIL-REC CALL-4` | `FEF|4` | ; `#'KEY` |\n\n![t0055](images/B9780080571157500108/t0055.png)\n\nOf course, in this simple example I could have replaced `no-key` with `list`, but in general there will be some more complex processing.\nIf I had proclaimed `no-key` inline as well, then I would get the following:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (disassemble #'(lambda (x y) (key :b x :a y)))` |\n| ` 10 PUSH` | `ARG|1` | `; Y` |\n| ` 11 PUSH` | `ARG|0` | `; X` |\n| ` 12 PUSH-NUMBER` | `1` | |\n| ` 13 PUSH` | `ARG|1` | `; Y` |\n| ` 14 PUSH CALL-1` | `FEF|3` | `; #'SORT` |\n| ` 15 TAIL-REC CALL-4` | `FEF|4` | `; #'LIST` |\n\n![t0060](images/B9780080571157500108/t0060.png)\n\nIf you like, you can define a macro to automatically define the interface to the keyword-less function:\n\n```lisp\n(defmacro defun* (fn-name arg-list &rest body)\n \"Define two functions. one an interface to a &keyword-less\n version. Proclaim the interface function inline.\"\n (if (and (member '&key arg-list)\n    (not (member '&rest arg-list)))\n   (let ((no-key-fn-name (symbol fn-name '*no-key))\n    (args (mapcar #'first-or-self\n       (set-difference\n        arg-list\n        1ambda-list-keywords))))\n   '(progn\n    (proclaim '(inline ,fn-name))\n    (defun ,no-key-fn-name ,args\n     .,body)\n    (defun ,fn-name ,arg-list\n     (,no-key-fn-name .,args))))\n  '(defun ,fn-name ,arg-list\n   .,body)))\n>(macroexpand '(defun* key (&key a b (c 1) (d (sqrt a)))\n      (list a b c d)))\n(PROGN (PROCLAIM '(INLINE KEY))\n  (DEFUN KEY*NO-KEY (A B C D) (LIST A B C D))\n  (DEFUN KEY (&KEY A B (C 1) (D (SQRT A)))\n   (KEY*NO-KEY A B C D)))\n>(macroexpand '(defun* reg (a b c d) (list a b c d)))\n(DEFUN REG (A B C D) (LIST A B C D))\n```\n\nThere is one disadvantage to this approach: a user who wants to declare key inline or not inline does not get the expected result.\nThe user has to know that key is implemented with `key*no- key`, and declare `key*no- key` inline.\n\nAn alternative is just to proclaim the function that uses `&key` to be inline.\nRob MacLachlan provides an example.\nIn CMU Lisp, the function `member` has the following definition, which is proclaimed inline:\n\n```lisp\n(defun member (item list &key (key #'identity)\n        (test #'eql testp)(test-not nil notp))\n (do ((list list (cdr list)))\n   ((null list) nil)\n  (let ((car (car list)))\n   (if (cond\n    (testp\n     (funcall test item\n        (funcall key car)))\n    (notp\n     (not\n   (funcall test-not item\n      (funcall key car))))\n  (t\n   (funcall test item\n      (funcall key car))))\n (return list)))))\n```\n\nA call like `(member`[ch 1](B9780080571157500017.xhtml)`:key #'first-letter :test #'char =)` expands into the equivalent of the following code.\nUnfortunately, not all compilers are this clever with inline declarations.\n\n```lisp\n(do ((list list (cdr list)))\n   ((null list) nil)\n  (let ((car (car list)))\n   (if (char = ch (first-letter car))\n    (return list))))\n```\n\nThis chapter is concerned with efficiency and so has taken a stand against the use of keyword parameter s in frequently used functions.\nBut when maintainability is considered, keyword parameters look much better.\nWhen a program is being developed, and it is not clear if a function will eventually need additional arguments, keyword parameters may be the best choice.\n\n## 10.4 Avoid Unnecessary Consing\n{:#s0025}\n{:.h1hd}\n\nThe `cons` function may appear to execute quite quickly, but like all functions that allocate new storage, it has a hidden cost.\nWhen large amounts of storage are used, eventually the system must spend time garbage collecting.\nWe have not mentioned it earlier, but there are actually two relevant measures of the amount of space consumed by a program: the amount of storage allocated, and the amount of storage retained.\nThe difference is storage that is used temporarily but eventually freed.\nLisp guarantees that unused space will eventually be reclaimed by the garbage collector.\nThis happens automatically-the programmer need not and indeed can not explicitly free storage.\nThe problem is that the efficiency of garbage collection can vary widely.\nGarbage collection is particularly worrisome for real-time systems, because it can happen at any time.\n\nThe antidote to garbage woes is to avoid unnecessary copying of objects in often-used code.\nTry using destructive operations, like `nreverse, delete`, and `nconc`, rather than their nondestructive counterparts, (like reverse, remove, and append) whenever it is safe to do so.\nOr use vectors instead of lists, and reuse values rather than creating copies.\nAs usual, this gain in efficiency may lead to errors that can be difficult to debug.\nHowever, the most common kind of unnecessary copying can be eliminated by simple reorganization of your code.\nConsider the following version of `flatten`, which returns a list of all the atoms in its input, preserving order.\nUnlike the version in [chapter 5](B9780080571157500054.xhtml), this version returns a single list of atoms, with no embedded lists.\n\n```lisp\n(defun flatten (input)\n \"Return a flat list of the atoms in the input.\n Ex: (flatten '((a) (b (c) d))) => (a b c d).\"\n (cond ((null input) nil)\n   ((atom input) (list input))\n   (t (append (flatten (first input))\n      (flatten (rest input))))))\n```\n\nThis definition is quite simple, and it is easy to see that it is correct.\nHowever, each call to `append` requires copying the first argument, so this version can cons *O*(*n*2) cells on an input with *n* atoms.\nThe problem with this approach is that it computes the list of atoms in the `first` and `rest` of each subcomponent of the input.\nBut the `first` sublist by itself is not part of the final answer-that's why we have to call `append.` We could avoid generating garbage by replacing `append` with `nconc,` but even then we would still be wasting time, because `nconc` would have to scan through each sublist to find its end.\n\nThe version below makes use of an *accumulator* to keep track of the atoms that have been collected in the rest, and to add the atoms in the `first` one at a time with cons, rather than building up unnecessary sublists and appending them.\nThis way no garbage is generated, and no subcomponent is traversed more than once.\n\n```lisp\n(defun flatten (input &optional accumulator)\n \"Return a flat list of the atoms in the input.\n Ex: (flatten '((a) (b (c) d))) => (a b c d).\"\n (cond ((null input) accumulator)\n   ((atom input) (cons input accumulator))\n   (t (flatten (first input)\n      (flatten (rest input) accumulator)))))\n```\n\nThe version with the accumulator may be a little harder to understand, but it is far more efficient than the original version.\nExperienced Lisp programmers become quite skilled at replacing calls to `append` with accumulators.\n\nSome of the early Lisp machines had unreliable garbage-collection, so users just turned garbage collection off, used the machine for a few days, and rebooted when they ran out of space.\nWith a large virtual memory system this is a feasible approach, because virtual memory is a cheap resource.\nThe problem is that real memory is still an expensive resource.\nWhen each page contains mostly garbage and only a little live data, the system will spend a lot of time paging data in and out.\nCompacting garbage-collection algorithms can relocate live data, packing it into a minimum number of pages.\n\nSome garbage-collection algorithms have been optimized to deal particularly well with just this case.\nIf your system has an *ephemeral* or *generational* garbage collector, you need not be so concerned with short-lived objects.\nInstead, it will be the medium-aged objects that cause problems.\nThe other problem with such systems arises when an object in an old generation is changed to point to an object in a newer generation.\nThis is to be avoided, and it may be that reverse is actually faster than nreverse in such cases.\nTo decide what works best on your particular system, design some test cases and time them.\n\nAs an example of efficient use of storage, here is a version of `pat-match` that eliminates (almost) all consing.\nThe original version of `pat-match,` as used in ELIZA !!!(span) {:.smallcaps} ([page 180](B9780080571157500066.xhtml#p180)), used an association list of variable/value pairs to represent the binding list.\nThis version uses two sequences: a sequence of variables and a sequence of values.\nThe sequences are implemented as vectors instead of lists.\nIn general, vectors take half as much space as lists to store the same information, since half of every list is just pointing to the next element.\n\nIn this case, the savings are much more substantial than just half.\nInstead of building up small binding lists for each partial match and adding to them when the match is extended, we will allocate a sufficiently large vector of variables and values just once, and use them over and over for each partial match, and even for each invocation of `pat-match.` To do this, we need to know how many variables we are currently using.\nWe could initialize a counter variable to zero and increment it each time we found a new variable in the pattern.\nThe only difficulty would be when the counter variable exceeds the size of the vector.\nWe could just give up and print an error message, but there are more user-friendly alternatives.\nFor example, we could allocate a larger vector for the variables, copy over the existing ones, and then add in the new one.\n\nIt turns out that Common Lisp has a built-in facility to do just this.\nWhen a vector is created, it can be given a *fill pointer*.\nThis is a counter variable, but one that is conceptually stored inside the vector.\nVectors with fill pointers act like a cross between a vector and a stack.\nYou can push new elements onto the stack with the functions `vector - push` or `vector - push - extend`.\nThe latter will automatically allocate a larger vector and copy over elements if necessary.\nYou can remove elements with `vector - pop`, or you can explicitly look at the fill pointer with `fi1l - pointer`, or change it with a `setf`.\nHere are some examples (with `*print-array*` set to t so we can see the results):\n\n```lisp\n> (setf a (make-array 5 :fi11-pointer 0))`=> `#()\n> (vector-push 1 a)`=> `0\n> (vector-push 2 a)`=> `1\n> a`=> `#(1 2)\n> (vector-pop a)`=> `2\n> a`=> `#(1)\n> (dotimes (i 10) (vector-push-extend 'x a))`=> `NIL\n> a`=> `#(1 XXXXXXXXXX)\n> (fill- pointer a)`=> `11\n> (setf (fill-pointer a) 1)`=> `1\n> a`=> `#(1)\n```\n\n`> (find 'x a)`=> `NIL NIL ;`*FIND can't find past the fill pointer*\n\n`> (aref a 2)`=> `X` ; *But AREF can see beyond the fill pointer*\n\nUsing vectors with fill pointers in `pat-match,` the total storage for binding lists is just twice the number of variables in the largest pattern.\nI have arbitrarily picked 10 as the maximum number of variables, but even this is not a hard limit, because `vector-push-extend` can increase it.\nIn any case, the total storage is small, fixed in size, and amortized over all calls to `pat-match.` These are just the features that indicate a responsible use of storage.\n\nHowever, there is a grave danger with this approach: the value returned must be managed carefully.\nThe new `pat-match` returns the value of `success` when it matches.\n`success` is bound to a cons of the variable and value vectors.\nThese can be freely manipulated by the calling routine, but only up until the next call to `pat - match.` At that time, the contents of the two vectors can change.\nTherefore, if any calling function needs to hang on to the returned value after another call to `pat-match,` it should make a copy of the returned value.\nSo it is not quite right to say that this version of `pat-match` eliminates all consing.\nIt will cons when `vector-push-extend` runs out of space, or when the user needs to make a copy of a returned value.\n\nHere is the new definition of `pat-match.` It is implemented by closing the definition of `pat-match` and its two auxilliary functions inside a `let` that establishes the bindings of `vars, vals`, and `success`, but that is not crucial.\nThose three variables could have been implemented as global variables instead.\nNote that it does not support segment variables, or any of the other options implemented in the `pat-match` of [chapter 6](B9780080571157500066.xhtml).\n\n```lisp\n(let* ((vars (make-array 10 :fill-pointer 0 :adjustable t))\n   (vals (make-array 10 :fill-pointer 0 :adjustable t))\n   (success (cons vars vals)))\n(defun efficient-pat-match (pattern input)\n \"Match pattern against input.\"\n (setf (fill-pointer vars) 0)\n (setf (fill-pointer vals) 0)\n (pat-match-1 pattern input))\n(defun pat-match-1 (pattern input)\n (cond ((variable-p pattern) (match-var pattern input))\n   ((eql pattern input) success)\n   ((and (consp pattern) (consp input))\n    (and (pat-match-1 (first pattern) (first input))\n      (pat-match-1 (rest pattern) (rest input))))\n   (t fail)))\n(defun match-var (var input)\n \"Match a single variable against input.\"\n (let ((i (position var vars)))\n  (cond ((null i)\n     (vector-push-extend var vars)\n     (vector-push-extend input vals) success)\n   ((equal input (aref vals i)) success)\n   (t fail)))))\n```\n\nAn example of its use:\n\n```lisp\n>(efficient-pat-match '(?x + ?x = ?y . ?z)\n        '(2 + 2 = (3 + 1) is true))\n(#(?X ?Y ?Z) . #(2 (3 + 1) (IS TRUE)))\n```\n\nExtensible vectors with fill pointers are convenient, and much more efficient than consing up lists.\nHowever, there is some overhead involved in using them, and for those sections of code that must be most efficient, it is best to stick with simple vectors.\nThe following version of `efficient-pat-match` explicitly manages the size of the vectors and explicitly replaces them with new ones when the size is exceeded:\n\n```lisp\n(let* ((current-size 0)\n   (max-size 1)\n   (vars (make-array max-size))\n   (vals (make-array max-size))\n   (success (cons vars vals)))\n (declare (simple-vector vars vals)\n     (fixnum current-size max-size))\n(defun efficient-pat-match (pattern input)\n \"Match pattern against input.\"\n (setf current-size 0)\n (pat-match-1 pattern input))\n;; pat-match-1 is unchanged\n(defun match-var (var input)\n \"Match a single variable against input.\"\n (let ((i (position var vars)))\n  (cond\n   ((null i)\n    (when (= current-size max-size)\n     ;; Make new vectors when we run out of space\n     (setf max-size (* 2 max-size)\n       vars (replace (make-array max-size) vars)\n       vals (replace (make-array max-size) vals)\n       success (cons vars vals)))\n    ;; Store var and its value in vectors\n    (setf (aref vars current-size) var)\n    (setf (aref vals current-size) input)\n    (incf current-size)``    success)\n   ((equal input (aref vals i)) success)\n   (t fail)))))\n```\n\nIn conclusion, replacing lists with vectors can often save garbage.\nBut when you must use lists, it pays to use a version of cons that avoids consing when possible.\nThe following is such a version:\n\n```lisp\n(proclaim '(inline reuse-cons))\n(defun reuse-cons (x y x-y)\n \"Return (cons x y), or just x-y if it is equal to (cons x y).\"\n (if (and (eql x (car x-y)) (eql y (cdr x-y)))\n   x-y\n   (cons x y)))\n```\n\nThe trick is based on the definition of subst in Steele's *Common Lisp the Language*.\nHere is a definition for a version of `remove` that uses `reuse-cons`:\n\n```lisp\n(defun remq (item list)\n \"Like REMOVE, but uses EQ, and only works on lists.\"\n (cond ((null list) nil )\n   ((eq item (first list)) (remq item (rest list)))\n   (t (reuse-cons (first list)\n        (remq item (rest list))\n        list))))\n```\n\n### Avoid Consing: Unique Lists\n{:#s9000}\n{:.h2hd}\n\nOf course, `reuse-cons` only works when you have candidate cons cells around.\nThat is, (`reuse-cons a b c`) only saves space when `c` is (or might be) equal to (`cons a b`).\nFor some applications, it is useful to have a version of `cons` that returns a unique cons cell without needing `c` as a hint.\nWe will call this version `ucons` for \"unique cons.\" `ucons` maintains a double hash table: `*uniq - cons - table*` is a hash table whose keys are the `cars` of cons cells.\nThe value for each `car` is another hash table whose keys are the `cdrs` of cons cells.\nThe value of each `cdr` in this second table is the original cons cell.\nSo two different cons cells with the same `car` and `cdr` will retrieve the same value.\nHere is an implementation of `ucons`:\n\n```lisp\n(defvar *uniq-cons-table* (make-hash-table :test #'eq))\n(defun ucons (x y)\n \"Return a cons s.t. (eq (ucons x y) (ucons x y)) is true.\"\n (let ((car-table (or (gethash x *uniq-cons-table*)\n        (setf (gethash x *uniq-cons-table*)\n          (make-hash-table :test #'eq)))))\n  (or (gethash y car-table)\n    (setf (gethash y car-table) (cons x y)))))\n```\n\n`ucons`, unlike `cons`, is a true function: it will always return the same value, given the same arguments, where \"same\" is measured by eq.\nHowever, if `ucons` is given arguments that are equal but not eq, it will not return a unique result.\nFor that we need the function unique.\nIt has the property that `(unique x)` is eq to `(unique y)` whenever `x` and `y` are equal.\n`unique` uses a hash table for atoms in addition to the double hash table for conses.\nThis is necessary because strings and arrays can be equal without being eq.\nBesides `unique`, we also define `ulist` and uappend for convenience.\n\n```lisp\n(defvar *uniq-atom-table* (make-hash-table :test #'equal))\n (defun unique (exp)\n  \"Return a canonical representation that is EQUAL to exp,\n  such that (equal x y) implies (eq (unique x) (unique y)).\"\n  (typecase exp\n   (symbol exp)\n   (fixnum exp) ;; Remove if fixnums are not eq in your Lisp\n   (atom (or (gethash exp *uniq-atom-table*)\n        (setf (gethash exp *uniq-atom-table*) exp)))\n   (cons (unique-cons (car exp) (cdr exp)))))\n (defun unique-cons (x y)\n  \"Return a cons s.t. (eq (ucons x y) (ucons x2 y2)) is true\n  whenever (equal x x2) and (equal y y2) are true.\"\n  (ucons (unique x) (unique y)))\n (defun ulist (&rest args)\n  \"A uni qui fied list.\"\n  (unique args))\n (defun uappend (x y)\n  \"A unique list equal to (append x y).\"\n  (if (null x)\n    (unique y)\n    (ucons (first x) (uappend (rest x) y))))\n```\n\nThe above code works, but it can be improved.\nThe problem is that when `unique` is applied to a tree, it always traverses the tree all the way to the leaves.\nThe function `unique-cons` is like `ucons,` except that `unique-cons` assumes its arguments are not yet unique.\nWe can modify `unique - cons` so that it first checks to see if its arguments are unique, by looking in the appropriate hash tables:\n\n```lisp\n(defun unique-cons (x y)\n \"Return a cons s.t. (eq (ucons x y) (ucons x2 y2)) is true\n whenever (equal x x2) and (equal y y2) are true.\"\n (let ((ux) (uy)) ; unique x and y\n  (let ((car-table\n     (or (gethash x *uniq-cons-table*)\n      (gethash (setf ux (unique x)) *uniq-cons-table*)\n      (setf (gethash ux *uniq-cons-table*)\n        (make-hash-table :test #'eq)))))\n   (or (gethash y car-table)\n    (gethash (setf uy (unique y)) car-table)\n    (setf (gethash uy car-table)\n      (cons ux uy))))))\n```\n\nAnother advantage of `unique` is that it can help in indexing.\nIf lists are unique, then they can be stored in an `eq` hash table instead of a equal hash table.\nThis can lead to significant savings when the list structures are large.\nAn `eq` hash table for lists is almost as good as a property list on symbols.\n\n### Avoid Consing: Multiple Values\n{:#s9005}\n{:.h2hd}\n\nParameters and multiple values can also be used to pass around values, rather than building up lists.\nFor example, instead of :\n\n```lisp\n(defstruct point \"A point in 3-D cartesian space.\" x y z)\n(defun scale-point (k pt)\n \"Multiply a point by a constant, K.\"\n (make-point :x (* k (point-x pt))\n         :y (* k (point-y pt))\n         :z (* k (point-z pt))))\n```\n\none could use the following approach, which doesn't generate structures:\n\n```lisp\n(defun scale-point (k x y z)\n \"Multiply the point (x,y,z) by a constant, K.\"\n (values (* k x) (* k y) (* k z)))\n```\n\n### Avoid Consing: Resources\n{:#s9010}\n{:.h2hd}\n\nSometimes it pays to manage explicitly the storage of instances of some data type.\nA pool of these instances may be called a *resource*.\nExplicit management of a resource is appropriate when: (1) instances are frequently created, and are needed only temporarily; (2) it is easy/possible to be sure when instances are no longer needed; and (3) instances are fairly large structures or take a long time to initialize, so that it is worth reusing them instead of creating new ones.\nCondition (2) is the crucial one: If you deallocate an instance that is still being used, that instance will mysteriously be altered when it is reallocated.\nConversely, if you fail to deallocate unneeded instances, then you are wasting valuable memory space.\n(The memory management scheme is said to leak in this case.)\n\nThe beauty of using Lisp's built-in memory management is that it is guaranteed never to leak and never to deallocate structures that are in use.\nThis eliminates two potential bug sources.\nThe penalty you pay for this guarantee is some inefficiency of the general-purpose memory management as compared to a custom user-supplied management scheme.\nBut beware: modem garbage-collection techniques are highly optimized.\nIn particular, the so-called *generation scavenging* or *ephemeral* garbage collectors look more often at recently allocated storage, on the grounds that recently made objects are more likely to become garbage.\nIf you hold on to garbage in your own data structures, you may end up with worse performance.\n\nWith all these warnings in mind, here is some code to manage resources:\n\n```lisp\n(defmacro defresource (name &key constructor (initial-copies 0)\n         (size (max initial-copies 10)))\n (let ((resource (symbol name '-resource))\n   (deallocate (symbol 'deallocate- name))\n   (allocate (symbol 'allocate- name)))\n  '(let ((.resource (make-array ,size :fill-pointer 0)))\n   (defun ,allocate ()\n    \"Get an element from the resource pool, or make one.\"\n    (if (= (fill-pointer ,resource) 0)\n      ,constructor\n      (vector-pop ,resource)))\n   (defun ,deallocate (.name)\n    \"Place a no-longer-needed element back in the pool.\"\n    (vector-push-extend ,name ,resource))\n   .(if (> initial-copies 0)\n      '(mapc #',deallocate (loop repeat ,initial-copies\n             collect (,allocate))))\n   ',name)))\n```\n\nLet's say we had some structure called a buffer which we were constantly making instances of and then discarding.\nFurthermore, suppose that buffers are fairly complex objects to build, that we know we'll need at least 10 of them at a time, and that we probably won't ever need more than 100 at a time.\nWe might use the buffer resource as follows:\n\n```lisp\n(defresource buffer :constructor (make-buffer)\n      :size 100 : initial-copies 10)\n```\n\nThis expands into the following code:\n\n```lisp\n(let ((buffer-resource (make-array 100 :fil1-pointer 0)))\n (defun allocate-buffer ()\n  \"Get an element from the resource pool, or make one.\"\n  (if (= (fill-pointer buffer-resource) 0)\n   (make-buffer)\n   (vector-pop buffer-resource)))\n (defun deallocate-buffer (buffer)\n  \"Place a no-longer-needed element back in the pool.\"\n  (vector-push-extend buffer buffer-resource))\n (mapc #'deallocate-buffer\n    (loop repeat 10 collect (allocate-buffer)))\n 'buffer)\n```\n\nWe could then use:\n\n```lisp\n(let ((b (allocate-buffer)))\n ...\n (process b)\n ...\n (deallocate-buffer b)))\n```\n\nThe important thing to remember is that this works only if the buffer `b` really can be deallocated.\nIf the function `process` stored away a pointer to `b` somewhere, then it would be a mistake to deallocate `b,` because a subsequent allocation could unpredictably alter the stored buffer.\nOf course, if `process` stored a *copy* of `b,` then everything is alright.\nThis pattern of allocation and deallocation is so common that we can provide a macro for it:\n\n```lisp\n(defmacro with-resource ((var resource &optional protect) &rest body)\n \"Execute body with VAR bound to an instance of RESOURCE.\"\n (let ((allocate (symbol 'allocate- resource))\n   (deallocate (symbol 'deallocate- resource)))\n  (if protect\n   '(let ((,var nil))\n    (unwind-protect\n     (progn (setf ,var (,allocate)) ,@body)\n     (unless (null ,var) (,deallocate ,var))))\n   '(let ((,var (,allocate)))\n    ,@body\n    (,deallocate ,var)))))\n```\n\nThe macro allows for an optional argument that sets up an `unwind` - protect environment, so that the buffer gets deallocated even when the body is abnormally exited.\nThe following expansions should make this clearer:\n\n```lisp\n>(macroexpand '(with-resource (b buffer)\n        \"...\" (process b) \"...\"))\n(let ((b (allocate-buffer)))\n \"...\"\n (process b)\n \"...\"\n (deallocate-buffer b))\n> (macroexpand '(with-resource (b buffer t)\n        \"...\" \"...\" (process b) \"...\"))\n(let ((b nil))\n (unwind-protect\n   (progn (setf b (allocate-buffer))\n     \"...\"\n        (process b)\n        \"...\")\n      (unless (null b)\n      (deallocate-buffer b))))\n```\n\nAn alternative to full resources is to just save a single data object.\nSuch an approach is simpler because there is no need to index into a vector of objects, but it is sufficient for some applications, such as a tail-recursive function call that only uses one object at a time.\n\nAnother possibility is to make the system slower but safer by having the `deal1ocate` function check that its argument is indeed an object of the correct type.\n\nKeep in mind that using resources may put you at odds with the Lisp system's own storage management scheme.\nIn particular, you should be concerned with paging performance on virtual memory systems.\nA common problem is to have only a few live objects on each page, thus forcing the system to do a lot of paging to get any work done.\nCompacting garbage collectors can collect live objects onto the same page, but using resources may interfere with this.\n\n## 10.5 Use the Right Data Structures\n{:#s0030}\n{:.h1hd}\n\nIt is important to implement key data types with the most efficient implementation.\nThis can vary from machine to machine, but there are a few techniques that are universal.\nHere we consider three case studies.\n\n### The Right Data Structure: Variables\n{:#s9015}\n{:.h2hd}\n\nAs an example, consider the implementation of pattern-matching variables.\nWe saw from the instrumentation of `simplify` that `variable-p` was one of the most frequently used functions.\nIn compiling the matching expressions, I did away with all calls to `variable-p`, but let's suppose we had an application that required run-time use of variables.\nThe specification of the data type `variable` will include two operators, the recognizer `variable-p`, and the constructor `make-variable`, which gives a new, previously unused variable.\n(This was not needed in the pattern matchers shown so far, but will be needed for unification with backward chaining.) One implementation of variables is as symbols that begin with the character #\\?:\n\n```lisp\n(defun variable-p (x)\n \"Is x a variable (a symbol beginning with '?')?\"\n (and (symbolp x) (equal (elt (symbol-name x) 0) #\\?)))\n(defun make-variable O \"Generate a new variable\" (gentemp \"?\"))\n```\n\nWe could try to speed things up by changing the implementation of variables to be keywords and making the functions inline:\n\n```lisp\n(proclaim '(inline variable-p make-variable))\n(defun variable-p (x) \"Is x a variable?\" (keywordp x))\n(defun make-variable O (gentemp \"X\" #.(find-package \"KEYWORD\")))\n```\n\n(The reader character sequence #.\nmeans to evaluate at read time, rather than at execution time.) On my machine, this implementation is pretty fast, and I accepted it as a viable compromise.\nHowever, other implementations were also considered.\nOne was to have variables as structures, and provide a read macro and print function:\n\n```lisp\n(defstruct (variable (:print-function print-variable)) name)\n(defvar *vars* (make-hash-table))\n(set-macro-character #\\?\n #'(lambda (stream char)\n   ;; Find an old var, or make a new one with the given name\n   (declare (ignore char))\n   (let ((name (read stream t nil t)))\n    (or (gethash name *vars*)\n     (setf (gethash name *vars*) (make-variable :name name))))))\n(defun print-variable (var stream depth)\n (declare (ignore depth))\n (format stream \"?~a\" (var-name var)))\n```\n\nIt turned out that, on all three Lisps tested, structures were slower than keywords or symbols.\nAnother alternative is to have the ? read macro return a cons whose first is, say, `:var`.\nThis requires a special output routine to translate back to the ? notation.\nYet another alternative, which turned out to be the fastest of all, was to implement variables as negative integers.\nOf course, this means that the user cannot use negative integers elsewhere in patterns, but that turned out to be acceptable for the application at hand.\nThe moral is to know which features are done well in your particular implementation and to go out of your way to use them in critical situations, but to stick with the most straightforward implementation in noncritical sections.\n\nLisp makes it easy to rely on lists, but one must avoid the temptation to overuse lists; to use them where another data structure is more appropriate.\nFor example, if you need to access elements of a sequence in arbitrary order, then a vector is more appropriate than list.\nIf the sequence can grow, use an adjustable vector.\nConsider the problem of maintaining information about a set of people, and searching that set.\nA naive implementation might look like this:\n\n```lisp\n(defvar *people* nil \"Will hold a list of people\")\n(defstruct person name address id-number)\n(defun person-with-id (id)\n (find id *people* :key #'person-id-number))\n```\n\nIn a traditional language like C, the natural solution is to include in the person structure a pointer to the next person, and to write a loop to follow these pointers.\nOf course, we can do that in Lisp too:\n\n```lisp\n(defstruct person name address id-number next)\n(defun person-with-id (id)\n (loop for person = *people* then (person-next person)\n   until (null person)\n   do (when (eql id (person-id-number person))\n     (RETURN person))))\n```\n\nThis solution takes less space and is probably faster, because it requires less memory accesses: one for each person rather than one for each person plus one for each cons cell.\nSo there is a small price to pay for using lists.\nBut Lisp programmers feel that price is worth it, because of the convenience and ease of coding and debugging afforded by general-purpose functions like `find`.\n\nIn any case, if there are going to be a large number of people, the list is definitely the wrong data structure.\nFortunately, Lisp makes it easy to switch to more efficient data structures, for example:\n\n```lisp\n(defun person-with-id (id)\n (gethash id *people*))\n```\n\n### The Right Data Structure: Queues\n{:#s9020}\n{:.h2hd}\n\nA *queue* is a data structure where one can add elements at the rear and remove them from the front.\nThis is almost like a stack, except that in a stack, elements are both added and removed at the same end.\n\nLists can be used to implement stacks, but there is a problem in using lists to implement queues: adding an element to the rear requires traversing the entire list.\nSo collecting *n* elements would be *O*(*n2*) instead of *O*(*n*).\n\nAn alternative implementation of queues is as a cons of two pointers: one to the list of elements of the queue (the contents), and one to the last cons cell in the list.\nInitially, both pointers would be nil.\nThis implementation in fact existed in BBN Lisp and UCI Lisp under the function name `tconc`:\n\n```lisp\n;;; A queue is a (contents . last) pair\n(defun tconc (item q)\n \"Insert item at the end of the queue.\"\n (setf (cdr q)\n   (if (null (cdr q))\n     (setf (car q) (cons item nil))\n     (setf (rest (cdr q))\n       (cons item nil)))))\n```\n\nThe `tconc` implementation has the disadvantage that adding the first element to the contents is different from adding subsequent elements, so an `if` statement is required to decide which action to take.\nThe definition of queues given below avoids this disadvantage with a clever trick.\nFirst, the order of the two fields is reversed.\nThe `car` of the cons cell is the last element, and the `cdr` is the contents.\nSecond, the empty queue is a cons cell where the `cdr` (the contents field) is nil, and the `car` (the last field) is the cons itself.\nIn the definitions below, we change the name `tconc` to the more standard `enqueue`, and provide the other queue functions as well:\n\n```lisp\n;;; A queue is a (last . contents) pair\n(proclaim '(inline queue-contents make-queue enqueue dequeue\n        front empty-queue-p queue-nconc))\n(defun queue-contents (q) (cdr q))\n(defun make-queue ()\n \"Build a new queue, with no elements.\"\n (let ((q (cons nil nil)))\n  (setf (car q) q)))\n(defun enqueue (item q)\n \"Insert item at the end of the queue.\"\n (setf (car q)\n     (setf (rest (car q))\n      (cons item nil)))\n q)\n(defun dequeue (q)\n \"Remove an item from the front of the queue.\"\n (pop (cdr q))\n (if (null (cdr q)) (setf (car q) q))\n q)\n(defun front (q) (first (queue-contents q)))\n(defun empty-queue-p (q) (null (queue-contents q)))\n(defun queue-nconc (q list)\n \"Add the elements of LIST to the end of the queue.\"\n (setf (car q)\n     (last (setf (rest (car q)) list))))\n```\n\n### The Right Data Structure: Tables\n{:#s9030}\n{:.h2hd}\n\nA *table* is a data structure to which one can insert a key and associate it with a value, and later use the key to look up the value.\nTables may have other operations, like counting the number of keys, clearing out all keys, or mapping a function over each key/value pair.\n\nLisp provides a wide variety of choices to implement tables.\nAn association list is perhaps the simplest: it is just a list of key/value pairs.\nIt is appropriate for small tables, up to a few dozen pairs.\nThe hash table is designed to be efficient for large tables, but may have significant overhead for small ones.\nIf the keys are symbols, property lists can be used.\nIf the keys are integers in a narrow range (or can be mapped into them), then a vector may be the most efficient choice.\n\nHere we implement an alternative data structure, the *trie*.\nA trie implements a table for keys that are composed of a finite sequence of components.\nFor example, if we were implementing a dictionary as a trie, each key would be a word, and each letter of the word would be a component.\nThe value of the key would be the word's definition.\nAt the top of the dictionary trie is a multiway branch, one for each possible first letter.\nEach second-level node has a branch for every possible second letter, and so on.\nTo find an *n*-letter word requires *n* reads.\nThis kind of organization is especially good when the information is stored on secondary storage, because a single read can bring in a node with all its possible branches.\n\nIf the keys can be arbitrary list structures, rather than a simple sequence of letters, we need to regularize the keys, transforming them into a simple sequence.\nOne way to do that makes use of the fact that any tree can be written as a linear sequence of atoms and cons operations, in prefix form.\nThus, we would make the following transformation:\n\n```lisp\n(a (b c) d) =\n```\n\n`(cons a (cons (cons b (cons c nil)) (cons d nil)))`=\n\n```lisp\n(cons a cons cons b cons c nil cons d nil)\n```\n\nIn the implementation of tries below, this transformation is done on the fly: The four user-level functions are `make-trie` to create a new trie, `put-trie` and `get-trie` to add and retrieve key/value pairs, and `delete-trie` to remove them.\n\nNotice that we use a distinguished value to mark deleted elements, and that `get-trie` returns two values: the actual value found, and a flag saying if anything was found or not.\nThis is consistent with the interface to `gethash` and `find`, and allows us to store null values in the trie.\nIt is an inobtrusive choice, because the programmer who decides not to store null values can just ignore the second value, and everything will work properly.\n\n```lisp\n(defstruct trie (value nil) (arcs nil))\n(defconstant trie-deleted \"deleted\")\n(defun put-trie (key trie value)\n \"Set the value of key in trie.\"\n (setf (trie-value (find-trie key t trie)) value))\n(defun get-trie (key trie)\n \"Return the value for a key in a trie, and t/nil if found.\"\n (let* ((key-trie (find-trie key nil trie))\n    (val (if key-trie (trie-value key-trie))))\n  (if (or (null key-trie) (eq val trie-deleted))\n    (values nil nil )\n    (values val t))))\n(defun delete-trie (key trie)\n \"Remove a key from a trie.\"\n (put-trie key trie trie-deleted))\n(defun find-trie (key extend? trie)\n \"Find the trie node for this key.\n If EXTEND? is true, make a new node if need be.\"\n (cond ((null trie) nil )\n    ((atom key)\n     (follow-arc key extend? trie))\n    (t (find-trie\n       (cdr key) extend?\n       (find-trie\n        (car key) extend?\n       (find-trie\n        \".\" extend? trie))))))\n(defun follow-arc (component extend? trie)\n \"Find the trie node for this component of the key.\n If EXTEND? is true, make a new node if need be.\"\n (let ((arc (assoc component (trie-arcs trie))))\n  (cond ((not (null arc)) (cdr arc))\n     ((not extend?) nil)\n     (t (let ((new-trie (make-trie)))\n       (push (cons component new-trie)\n         (trie-arcs trie))\n       new-trie)))))\n```\n\nThere are a few subtleties in the implementation.\nFirst, we test for deleted entries with an `eq` comparison to a distinguished marker, the string `trie-deleted`.\nNo other object will be `eq` to this string except `trie-deleted` itself, so this is a good test.\nWe also use a distinguished marker, the string \".\" to mark cons cells.\nComponents are implicitly compared against this marker with an `eql` test by the `associn fol1ow - arc`.\nMaintaining the identity of this string is crucial; if, for example, you recompiled the definition of `find-trie` (without changing the definition at all), then you could no longer find keys that were indexed in an existing trie, because the \".\n\" used by `find-trie` would be a different one from the \".\n\" in the existing trie.\n\n*Artificial Intelligence Programming* ([Charniak et al.\n1987](B9780080571157500285.xhtml#bb0180)) discusses variations on the trie, particularly in the indexing scheme.\nIf we always use proper lists (no non-null `cdrs`), then a more efficient encoding is possible.\nAs usual, the best type of indexing depends on the data to be indexed.\nIt should be noted that Charniak et al.\ncall the trie a *discrimination net*.\nIn general, that term refers to any tree with tests at the nodes.\n\nA trie is, of course, a kind of tree, but there are cases where it pays to convert a trie into a *dag*-a directed acyclic graph.\nA dag is a tree where some of the subtrees are shared.\nImagine you have a spelling corrector program with a list of some 50,000 or so words.\nYou could put them into a trie, each word with the value t.\nBut there would be many subtrees repeated in this trie.\nFor example, given a word list containing *look*, *looks*, *looked*, and *looking* as well as *show*, *shows*, *showed*, and *showing*, there would be repetition of the subtree containing -s, - *ed* and -*ing*.\nAfter the trie is built, we could pass the whole trie to un i que, and it would collapse the shared subtrees, saving storage.\nOf course, you can no longer add or delete keys from the dag without risking unintended side effects.\n\nThis process was carried out for a 56,000 word list.\nThe trie took up 3.2Mbytes, while the dag was 1 .IMbytes.\nThis was still deemed unacceptable, so a more compact encoding of the dag was created, using a .2Mbytes vector.\nEncoding the same word list in a hash table took twice this space, even with a special format for encoding suffixes.\n\nTries work best when neither the indexing key nor the retrieval key contains variables.\nThey work reasonably well when the variables are near the end of the sequence.\nConsider looking up the pattern `\"yello?\n\"` in the dictionary, where the \" ? \" character indicates a match of any letter.\nFollowing the branches for `\"yel1o\"` leads quickly to the only possible match, `\"yel1ow\"`.\nIn contrast, fetching with the pattern `\"??llow\"` is much less efficient.\nThe table lookup function would have to search all 26 top-level branches, and for each of those consider all possible second letters, and for each of those consider the path `\"llow\"`.\nQuite a bit of searching is required before arriving at the complete set of matches: bellow, billow, fallow, fellow, follow, hallow, hollow, mallow, mellow, pillow, sallow, tallow, wallow, willow, and yellow.\n\nWe will return to the problem of discrimination nets with variables in [section 14.8](B9780080571157500145.xhtml#s0040), [page 472](B9780080571157500145.xhtml#p472).\n\n## 10.6 Exercises\n{:#s0035}\n{:.h1hd}\n\n**Exercise 10.1 [h]** Define the macro `deftable,` such that `(deftable person assoc`) will act much like a `defstruct-`it will define a set of functions for manipulating a table of people: `get-person, put-person, clear-person,` and `map-person.` The table should be implemented as an association list.\nLater on, you can change the representation of the table simply by changing the form to (`deftable person hash` ), without having to change anything else in your code.\nOther implementation options include property lists and vectors.\n`deftable` should also take three keyword arguments: `inline`, `size` and `test`.\nHere is a possible macroexpansion:\n\n`>(macroexpand '(deftableperson hash :-inline t :size 100))`=\n\n```lisp\n (progn\n (proclaim '(inline get-person put-person map-person))\n (defparameter *person-table*\n  (make-hash-table :test #eql :size 100))\n (defun get-person (x &optional default)\n  (gethash x *person-table* default))\n (defun put-person (x value)\n  (setf (gethash x *person-table*) value))\n (defun clear-person () (clrhash *person-table*))\n (defun map-person (fn) (maphash fn *person-table*))\n (defsetf get-person put-person)\n 'person)\n```\n\n**Exercise 10.2 [m]** We can use the :`type` option to `defstruct` to define structures implemented as lists.\nHowever, often we have a two-field structure that we would like to implement as a cons cell rather than a two-element list, thereby cutting storage in half.\nSince `defstruct` does not allow this, define a new macro that does.\n\n**Exercise 10.3 [m]** Use `reuse - cons` to write a version of `f1atten` (see [page 329](B9780080571157500108.xhtml#p329)) that shares as much of its input with its output as possible.\n\n**Exercise 10.4 [h]** Consider the data type *set*.\nA set has two main operations: adjoin an element and test for membership.\nIt is convenient to also add a map-over-elements operation.\nWith these primitive operations it is possible to build up more complex operations like union and intersection.\n\nAs mentioned in [section 3.9](B9780080571157500030.xhtml#s0095), Common Lisp provides several implementations of sets.\nThe simplest uses lists as the underlying representation, and provides the functions `adjoin, member, union, intersection`, and `set-difference`.\nAnother uses bit vectors, and a similar one uses integers viewed as bit sequences.\nAnalyze the time complexity of each implementation for each operation.\n\nNext, show how *sorted lists* can be used to implement sets, and compare the operations on sorted lists to their counterparts on unsorted lists.\n\n## 10.7 Answers\n{:#s0040}\n{:.h1hd}\n\n**Answer 10.2**\n\n```lisp\n(defmacro def-cons-struct (cons car cdr &optional inline?)\n \"Define aliases for cons, car and cdr.\"\n '(progn (proclaim '(,(if inline? 'inline 'notinline)\n         ,car ,cdr ,cons))\n     (defun ,car (x) (car x))\n     (defun ,cdr (x) (cdr x))\n     (defsetf ,car (x) (val) '(setf (car ,x) ,val))\n     (defsetf ,cdr (x) (val) '(setf (cdr ,x) ,val))\n     (defun ,cons (x y) (cons x y))))\n```\n\n**Answer 10.3**\n\n```lisp\n(defun flatten (exp &optional (so-far nil) last-cons)\n \"Return a flat list of the atoms in the input.\n Ex: (flatten '((a) (b (c) d))) => (a b c d).\"\n (cond ((null exp) so-far)\n    ((atom exp) (reuse-cons exp so-far last-cons))\n    (t (flatten (first exp)\n         (flatten (rest exp) so-far exp)\n         exp))))\n```\n\n----------------------\n\n[1](#xfn0015) These are all done with safety 0 and speed 3.\n!!!(p) {:.ftnote1}\n\n# Chapter 11\n## Logic Programming\n{:.chaptitle}\n\n> A language that doesn't affect the way you think about programming is not worth knowing.\n\n> -Alan Perlis\n\nLisp is the major language for AI work, but it is by no means the only one.\nThe other strong contender is Prolog, whose name derives from \"programming in logic.\"[1](#fn0015) The idea behind logic programming is that the programmer should state the relationships that describe a problem and its solution.\nThese relationships act as constraints on the algorithms that can solve the problem, but the system itself, rather than the programmer, is responsible for the details of the algorithm.\nThe tension between the \"programming\" and \"logic\" will be covered in [chapter 14](B9780080571157500145.xhtml), but for now it is safe to say that Prolog is an approximation to the ideal goal of logic programming.\nProlog has arrived at a comfortable niche between a traditional programming language and a logical specification language.\nIt relies on three important ideas:\n\n*  Prolog encourages the use of a single *uniform data base.* Good compilers provide efficient access to this data base, reducing the need for vectors, hash tables, property lists, and other data structures that the Lisp programmer must deal with in detail.\nBecause it is based on the idea of a data base, Prolog is *relational,* while Lisp (and most languages) are *functional.* In Prolog we would represent a fact like \"the population of San Francisco is 750,000\" as a relation.\nIn Lisp, we would be inclined to write a function, `population,` which takes a city as input and returns a number.\nRelations are more flexible; they can be used not only to find the population of San Francisco but also, say, to find the cities with populations over 500,000.\n\n*  Prolog provides *logic variables* instead of \"normal\" variables.\nA logic variable is bound by *unification* rather than by assignment.\nOnce bound, a logic variable can never change.\nThus, they are more like the variables of mathematics.\nThe existence of logic variables and unification allow the logic programmer to state equations that constrain the problem (as in mathematics), without having to state an order of evaluation (as with assignment statements).\n\n*  Prolog provides *automatic backtracking.* In Lisp each function call returns a single value (unless the programmer makes special arrangements to have it return multiple values, or a list of values).\nIn Prolog, each query leads to a search for relations in the data base that satisfy the query.\nIf there are several, they are considered one at a time.\nIf a query involves multiple relations, as in \"what city has a population over 500,000 and is a state capital?,\" Prolog will go through the population relation to find a city with a population over 500,000.\nFor each one it finds, it then checks the `capital` relation to see if the city is a capital.\nIf it is, Prolog prints the city; otherwise it *backtracks,* trying to find another city in the `population` relation.\nSo Prolog frees the programmer from worrying about both how data is stored and how it is searched.\nFor some problems, the naive automatic search will be too inefficient, and the programmer will have to restate the problem.\nBut the ideal is that Prolog programs state constraints on the solution, without spelling out in detail how the solutions are achieved.\n\nThis chapter serves two purposes: it alerts the reader to the possibility of writing certain programs in Prolog rather than Lisp, and it presents implementations of the three important Prolog ideas, so that they may be used (independently or together) within Lisp programs.\nProlog represents an interesting, different way of looking at the programming process.\nFor that reason it is worth knowing.\nIn subsequent chapters we will see several useful applications of the Prolog approach.\n\n## 11.1 Idea 1: A Uniform Data Base\n{:#s0010}\n{:.h1hd}\n\nThe first important Prolog idea should be familiar to readers of this book: manipulating a stored data base of assertions.\nIn Prolog the assertions are called *clauses,* and they can be divided into two types: *facts,* which state a relationship that holds between some objects, and *rules,* which are used to state contingent facts.\nHere are representations of two facts about the population of San Francisco and the capital of California.\nThe relations are `population` and `capital,` and the objects that participate in these relations are `SF, 750000`, `Sacramento,` and `CA`:\n\n```lisp\n(population SF 750000)\n(capital Sacramento CA)\n```\n\nWe are using Lisp syntax, because we want a Prolog interpreter that can be imbedded in Lisp.\nThe actual Prolog notation would be `population` (`sf, 750000`).\nHere are some facts pertaining to the `likes` relation:\n\n```lisp\n(likes Kim Robin)\n(likes Sandy Lee)\n(likes Sandy Kim)\n(likes Robin cats)\n```\n\nThese facts could be interpreted as meaning that Kim likes Robin, Sandy likes both Lee and Kim, and Robin likes cats.\nWe need some way of telling Lisp that these are to be interpreted as Prolog facts, not a Lisp function call.\nWe will use the macro <- to mark facts.\nThink of this as an assignment arrow which adds a fact to the data base:\n\n```lisp\n(<- (likes Kim Robin))\n(<- (likes Sandy Lee))\n(<- (likes Sandy Kim))\n(<- (likes Robin cats))\n```\n\nOne of the major differences between Prolog and Lisp hinges on the difference between relations and functions.\nIn Lisp, we would define a function `likes`, so that (`likes 'Sandy`) would return the list (`Lee Kim`).\nIf we wanted to access the information the other way, we would define another function, say, `likers-of`, so that (`likers-of 'Lee`) returns (`Sandy`).\nIn Prolog, we have a single `likes` relation instead of multiple functions.\nThis single relation can be used as if it were multiple functions by posing different queries.\nFor example, the query (`likes Sandy ?who`) succeeds with `?who` bound to `Lee or Kim`, and the query (`likes ?who Lee`) succeeds with `?who` bound to `Sandy.`\n\nThe second type of clause in a Prolog data base is the *rule.* Rules state contingent facts.\nFor example, we can represent the rule that Sandy likes anyone who likes cats as follows:\n\n```lisp\n(<- (likes Sandy ?x) (likes ?x cats))\n```\n\nThis can be read in two ways.\nViewed as a logical assertion, it is read, \"For any x, Sandy likes x if x likes cats.\" This is a *declarative* interpretation.\nViewed as a piece of a Prolog program, it is read, \"If you ever want to show that Sandy likes some x, one way to do it is to show that x likes cats.\" This is a *procedural* interpretation.\nIt is called a *backward-chaining* interpretation, because one reasons backward from the goal (Sandy likes x) to the premises (x likes cats).\nThe symbol <- is appropriate for both interpretations: it is an arrow indicating logical implication, and it points backwards to indicate backward chaining.\n\nIt is possible to give more than one procedural interpretation to a declarative form.\n(We did that in [chapter 1](B9780080571157500017.xhtml), where grammar rules were used to generate both strings of words and parse trees.) The rule above could have been interpreted procedurally as \"If you ever find out that some `x` likes cats, then conclude that Sandy likes `x`.\" This would be *forward chaining:* reasoning from a premise to a conclusion.\nIt turns out that Prolog does backward chaining exclusively.\nMany expert systems use forward chaining exclusively, and some systems use a mixture of the two.\n\nThe leftmost expression in a clause is called the *head*, and the remaining ones are called the *body.* In this view, a fact is just a rule that has no body; that is, a fact is true no matter what.\nIn general, then, the form of a clause is:\n\n(<- *head body*...)\n\nA clause asserts that the head is true only if all the goals in the body are true.\nFor example, the following clause says that Kim likes anyone who likes both Lee and Kim:\n\n```lisp\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n```\n\nThis can be read as:\n\n*For any* x, *deduce that*`Kim likes x`\n\n*if it can be proved that*`x likes Lee`*and* x `likes Kim.`\n\n## 11.2 Idea 2: Unification of Logic Variables\n{:#s0015}\n{:.h1hd}\n\nUnification is a straightforward extension of the idea of pattern matching.\nThe pattern-matching functions we have seen so far have always matched a pattern (an expression containing variables) against a constant expression (one with no variables).\nIn unification, two patterns, each of which can contain variables, are matched against each other.\nHere's an example of the difference between pattern matching and unification:\n\n```lisp\n> (pat-match '(?x + ?y) '(2 + 1))`=> `((?Y . 1) (?X . 2))\n> (unify '(?x + 1) '(2 + ?y))`=> `((?Y . 1) (?X . 2))\n```\n\nWithin the unification framework, variables (such as `?x` and `?y` above) are called *logic variables.* Like normal variables, a logic variable can be assigned a value, or it can be unbound.\nThe difference is that a logic variable can never be altered.\nOnce it is assigned a value, it keeps that value.\nAny attempt to unify it with a different value leads to failure.\nIt is possible to unify a variable with the same value more than once, just as it was possible to do a pattern match of `(?x + ?x`) with (`2 + 2`).\n\nThe difference between simple pattern matching and unification is that unification allows two variables to be matched against each other.\nThe two variables remain unbound, but they become equivalent.\nIf either variable is subsequently bound to a value, then both variables adopt that value.\nThe following example equates the variables `?x` and `?y` by binding `?x` to `?y`:\n\n```lisp\n> (unify '(f ?x) '(f ?y))`=> `((?X . ?Y))\n```\n\nUnification can be used to do some sophisticated reasoning.\nFor example, if we have two equations, *a* + *a* = 0 and *x* + *y* = *y,* and if we know that these two equations unify, then we can conclude that *a*, *x,* and *y* are all 0.\nThe version of `unify` we will define shows this result by binding `?y` to `0`, `?x` to `?y`, and `?a` to `?x`.\nWe will also define the function `unifier`, which shows the structure that results from unifying two structures.\n\n`> (unify '(?a + ?a = 0) '(?x + ?y = ?y))`=>\n\n```lisp\n((?Y . 0) (?X . ?Y) (?A . ?X))\n> (unifier '(?a + ?a = 0) '(?x + ?y = ?y))`=> `(0 + 0 = 0)\n```\n\nTo avoid getting carried away by the power of unification, it is a good idea to take stock of exactly what unification provides.\nIt *does* provide a way of stating that variables are equal to other variables or expressions.\nIt does *not* provide a way of automatically solving equations or applying constraints other than equality.\nThe following example makes it clear that unification treats the symbol + only as an uninterpreted atom, not as the addition operator:\n\n```lisp\n> (unifier '(?a + ?a = 2) '(?x + ?y = ?y))`=> `(2 + 2 = 2)\n```\n\nBefore developing the code for `unify`, we repeat here the code taken from the pattern-matching utility ([chapter 6](B9780080571157500066.xhtml)):\n\n```lisp\n(defconstant fail nil \"Indicates pat-match failure\")\n(defconstant no-bindings '((t . t))\n \"Indicates pat-match success, with no variables.\")\n(defun variable-p (x)\n \"Is x a variable (a symbol beginning with '?')?\"\n (and (symbolp x) (equal (char (symbol-name x) 0) #\\?)))\n(defun get-binding (var bindings)\n \"Find a (variable . value) pair in a binding list.\"\n (assoc var bindings))\n(defun binding-val (binding)\n \"Get the value part of a single binding.\"\n (cdr binding))\n(defun lookup (var bindings)\n \"Get the value part (for var) from a binding list.\"\n (binding-val (get-binding var bindings)))\n(defun extend-bindings (var val bindings)\n \"Add a (var . value) pair to a binding list.\"\n (cons (cons var val)\n       ;; Once we add a \"real\" binding,\n       ;; we can get rid of the dummy no-bindings\n       (if (and (eq bindings no-bindings))\n           nil\n           bindings)))\n(defun match-variable (var input bindings)\n \"Does VAR match input? Uses (or updates) and returns bindings.\"\n (let ((binding (get-binding var bindings)))\n (cond ((not binding) (extend-bindings var input bindings))\n       ((equal input (binding-val binding)) bindings)\n       (t fail))))\n```\n\nThe `unify` function follows; it is identical to `pat-match` (as defined on page 180) except for the addition of the line marked `***`.\nThe function `unify-variable` also follows `match-variable` closely:\n\n```lisp\n(defun unify (x y &optional (bindings no-bindings))\n \"See if x and y match with given bindings.\"\n (cond ((eq bindings fail) fail)\n       ((variable-p x) (unify-variable x y bindings))\n       ((variable-p y) (unify-variable y x bindings)) ;***\n       ((eql x y) bindings)\n       ((and (consp x) (consp y))\n        (unify (rest x) (rest y)\n               (unify (first x) (first y) bindings)))\n       (t fail)))\n(defun unify-variable (var x bindings)\n \"Unify var with x, using (and maybe extending) bindings.\"\n ;; Warning - buggy version\n (if (get-binding var bindings)\n  (unify (lookup var bindings) x bindings)\n  (extend-bindings var x bindings)))\n```\n\nUnfortunately, this definition is not quite right.\nIt handles simple examples:\n\n```lisp\n> (unify '(?x + 1) '(2 + ?y))`=> `((?Y . 1) (?X . 2))\n> (unify '?x '?y)`=> `((?X . ?Y))\n> (unify '(?x ?x) '(?y ?y))`=> `((?Y . ?Y) (?X . ?Y))\n```\n\nbut there are several pathological cases that it can't contend with:\n\n```lisp\n> (unify '(?x ?x ?x) '(?y ?y ?y))\n>>Trap #043622 (PDL-OVERFLOW REGULAR)\nThe regular push-down list has overflowed.\nWhile in the function GET-BINDING`<= `UNIFY-VARIABLE`<= `UNIFY\n```\n\nThe problem here is that once `?y` gets bound to itself, the call to `unify` inside `unify-variable` leads to an infinite loop.\nBut matching `?y` against itself must always succeed, so we can move the equality test in `unify` before the variable test.\nThis assumes that equal variables are `eql`, a valid assumption for variables implemented as symbols (but be careful if you ever decide to implement variables some other way).\n\n```lisp\n(defun unify (x y &optional (bindings no-bindings))\n \"See if x and y match with given bindings.\"\n (cond ((eq bindings fail) fail)\n  ((eql x y) bindings) ;*** moved this line\n  ((variable-p x) (unify-variable x y bindings))\n  ((variable-p y) (unify-variable y x bindings))\n  ((and (consp x) (consp y))\n  (unify (rest x) (rest y)\n      (unify (first x) (first y) bindings)))\n   (t fail)))\n```\n\nHere are some test cases:\n\n```lisp\n> (unify '(?x ?x) '(?y ?y))`=> `((?X . ?Y))\n> (unify '(?x ?x ?x) '(?y ?y ?y))`=> `((?X . ?Y))\n> (unify '(?x ?y) '(?y ?x))`=> `((?Y . ?X) (?X . ?Y))\n> (unify '(?x ?y a) '(?y ?x ?x))\n>>Trap #043622 (PDL-OVERFLOW REGULAR)\nThe regular push-down list has overflowed.\nWhile in the function GET-BINDING`<= `UNIFY-VARIABLE`<= `UNIFY\n```\n\nWe have pushed off the problem but not solved it.\nAllowing both `(?Y . ?X`) and (`?X . ?Y`) in the same binding list is as bad as allowing (`?Y . ?Y`).\nTo avoid the problem, the policy should be never to deal with bound variables, but rather with their values, as specified in the binding list.\nThe function `unify-variable` fails to implement this policy.\nIt does have a check that gets the binding for var when it is a bound variable, but it should also have a check that gets the value of `x`, when `x` is a bound variable:\n\n```lisp\n(defun unify-variable (var x bindings)\n \"Unify var with x, using (and maybe extending) bindings.\"\n (cond ((get-binding var bindings)\n   (unify (lookup var bindings) x bindings))\n  ((and (variable-p x) (get-binding x bindings)) ;***\n   (unify var (lookup x bindings) bindings)) ;***\n  (t (extend-bindings var x bindings))))\n```\n\nHere are some more test cases:\n\n```lisp\n> (unify '(?x ?y) '(?y ?x))`=> `((?X . ?Y))\n> (unify '(?x ?y a) '(?y ?x ?x))`=> `((?Y . A) (?X . ?Y))\n```\n\nIt seems the problem is solved.\nNow let's try a new problem:\n\n```lisp\n> (unify '?x '(f ?x))`=> `((?X F ?X))\n```\n\nHere `((?X F ?X))` really means `((?X . ((F ?X))))`, so `?X` is bound to (`F ?X`).\nThis represents a circular, infinite unification.\nSome versions of Prolog, notably Prolog II ([Giannesini et al.\n1986](B9780080571157500285.xhtml#bb0460)), provide an interpretation for such structures, but it is tricky to define the semantics of infinite structures.\n\nThe easiest way to deal with such infinite structures is just to ban them.\nThis ban can be realized by modifying the unifier so that it fails whenever there is an attempt to unify a variable with a structure containing that variable.\nThis is known in unification circles as the *occurs check.* In practice the problem rarely shows up, and since it can add a lot of computational complexity, most Prolog systems have ignored the occurs check.\nThis means that these systems can potentially produce unsound answers.\nIn the final version of `unify` following, a variable is provided to allow the user to turn occurs checking on or off.\n\n```lisp\n(defparameter *occurs-check* t \"Should we do the occurs check?\")\n(defun unify (x y &optional (bindings no-bindings))\n \"See if x and y match with given bindings.\"\n (cond ((eq bindings fail) fail)\n       ((eql x y) bindings)\n       ((variable-p x) (unify-variable x y bindings))\n       ((variable-p y) (unify-variable y x bindings))\n       ((and (consp x) (consp y))\n        (unify (rest x) (rest y)\n               (unify (first x) (first y) bindings)))\n       (t fail)))\n(defun unify-variable (var x bindings)\n \"Unify var with x, using (and maybe extending) bindings.\"\n (cond ((get-binding var bindings)\n     (unify (lookup var bindings) x bindings))\n     ((and (variable-p x) (get-binding x bindings))\n     (unify var (lookup x bindings) bindings))\n     ((and *occurs-check* (occurs-check var x bindings)) fail)\n     (t (extend-bindings var x bindings))))\n(defun occurs-check (var x bindings)\n \"Does var occur anywhere inside x?\"\n (cond ((eq var x) t)\n     ((and (variable-p x) (get-binding x bindings))\n     (occurs-check var (lookup x bindings) bindings))\n     ((consp x) (or (occurs-check var (first x) bindings)\n         (occurs-check var (rest x) bindings)))\n     (t nil)))\n```\n\nNow we consider how `unify` will be used.\nIn particular, one thing we want is a function for substituting a binding list into an expression.\nWe originally chose association lists as the implementation of bindings because of the availability of the function `sublis`.\nIronically, `sublis` won't work any more, because variables can be bound to other variables, which are in turn bound to expressions.\nThe `function subst-bindings` acts like `sublis`, except that it substitutes recursive bindings.\n\n```lisp\n(defun subst-bindings (bindings x)\n \"Substitute the value of variables in bindings into x,\n taking recursively bound variables into account.\"\n (cond ((eq bindings fail) fail)\n     ((eq bindings no-bindings) x)\n     ((and (variable-p x) (get-binding x bindings))\n     (subst-bindings bindings (lookup x bindings)))\n     ((atom x) x)\n     (t (reuse-cons (subst-bindings bindings (car x))\n            (subst-bindings bindings (cdr x))\n            x))))\n```\n\nNow let's try `unify` on some examples:\n\n```lisp\n> (unify '(?x ?y a) '(?y ?x ?x))`=> `((?Y . A) (?X . ?Y))\n> (unify '?x '(f ?x))`=> `NIL\n> (unify '(?x ?y) '((f ?y) (f ?x)))`=> `NIL\n> (unify '(?x ?y ?z) '((?y ?z) (?x ?z) (?x ?y)))`=> `NIL\n> (unify 'a 'a)`=> `((T . T))\n```\n\nFinally, the function `unifier` calls `unify` and substitutes the resulting binding list into one of the arguments.\nThe choice of `x` is arbitrary; an equal result would come from substituting the binding list into `y`.\n\n```lisp\n(defun unifier (x y)\n \"Return something that unifies with both x and y (or fail).\"\n (subst-bindings (unify x y) x))\n```\n\nHere are some examples of `unifier`:\n\n```lisp\n> (unifier '(?x ?y a) '(?y ?x ?x))`=> `(A A A)\n> (unifier '((?a * ?x ^ 2) + (?b * ?x) + ?c)\n```\n\n`        '(?z + (4 * 5) + 3))`=>\n\n```lisp\n((?A * 5 ^ 2) + (4 * 5) + 3)\n```\n\nWhen *`occurs-check`* is false, we get the following answers:\n\n```lisp\n> (unify '?x '(f ?x))`=> `((?X F ?X))\n> (unify '(?x ?y) '((f ?y) (f ?x)))`=> `((?Y F ?X) (?X F ?Y))\n> (unify '(?x ?y ?z) '((?y ?z) (?x ?z) (?x ?y))) => ((?Z ?X ?Y) (?Y ?X ?Z) (?X ?Y ?Z))\n```\n\n### Programming with Prolog\n{:#s0020}\n{:.h2hd}\n\nThe amazing thing about Prolog clauses is that they can be used to express relations that we would normally think of as \"programs,\" not \"data.\" For example, we can define the `member` relation, which holds between an item and a list that contains that item.\nMore precisely, an item is a member of a list if it is either the first element of the list or a member of the rest of the list.\nThis definition can be translated into Prolog almost Verbatim:\n\n```lisp\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ?rest)) (member ?item ?rest))\n```\n\nOf course, we can write a similar definition in Lisp.\nThe most visible difference is that Prolog allows us to put patterns in the head of a clause, so we don't need recognizers like `consp` or accessors like `first` and `rest`.\nOtherwise, the Lisp definition is similar:[2](#fn0020)\n\n```lisp\n(defun lisp-member (item list)\n (and (consp list)\n (or (eql item (first list))\n  (lisp-member item (rest list)))))\n```\n\nIf we wrote the Prolog code without taking advantage of the pattern feature, it would look more like the Lisp version:\n\n```lisp\n(<- (member ?item ?list)\n (= ?list (?item . ?rest)))\n(<- (member ?item ?list)\n (= ?list (?x . ?rest))\n (member ?item ?rest))\n```\n\nIf we define or in Prolog, we would write a version that is clearly just a syntactic variant of the Lisp version.\n\n```lisp\n(<- (member ?item ?list)\n (= ?list (?first . ?rest))\n (or (= ?item ?first)\n (member ?item ?rest)))\n```\n\nLet's see how the Prolog version of `member` works.\nImagine that we have a Prolog interpreter that can be given a query using the macro ?-, and that the definition of `member` has been entered.\nThen we would see:\n\n```lisp\n> (?- (member 2 (1 2 3)))\nYes;\n> (?- (member 2 (1 2 3 2 1)))\nYes;\nYes;\n```\n\nThe answer to the first query is \"yes\" because 2 is a member of the rest of the list.\nIn the second query the answer is \"yes\" twice, because 2 appears in the list twice.\nThis is a little surprising to Lisp programmers, but there still seems to be a fairly close correspondence between Prolog's and Lisp's `member.` However, there are things that the Prolog `member` can do that Lisp cannot:\n\n```lisp\n> (?- (member ?x (1 2 3)))\n?X = 1;\n?X = 2;\n?X = 3;\n```\n\nHere `member` is used not as a predicate but as a generator of elements in a list.\nWhile Lisp functions always map from a specified input (or inputs) to a specified output, Prolog relations can be used in several ways.\nFor `member,` we see that the first argument, `?x`, can be either an input or an output, depending on the goal that is specified.\nThis power to use a single specification as a function going in several different directions is a very flexible feature of Prolog.\n(Unfortunately, while it works very well for simple relations like `member,` in practice it does not work well for large programs.\nIt is very difficult to, say, design a compiler and automatically have it work as a disassembler as well.)\n\nNow we turn to the implementation of the Prolog interpreter, as summarized in [figure 11.1](#f0010).\nThe first implementation choice is the representation of rules and facts.\nWe will build a single uniform data base of clauses, without distinguishing rules from facts.\nThe simplest representation of clauses is as a cons cell holding the head and the body.\nFor facts, the body will be empty.\n\n![f11-01-9780080571157](images/B978008057115750011X/f11-01-9780080571157.jpg)     \nFigure 11.1\n!!!(span) {:.fignum}\nGlossary for the Prolog Interpreter\n```lisp\n;; Clauses are represented as (head . body) cons cells\n(defun clause-head (clause) (first clause))\n(defun clause-body (clause) (rest clause))\n```\n\nThe next question is how to index the clauses.\nRecall the procedural interpretation of a clause: when we want to prove the head, we can do it by proving the body.\nThis suggests that clauses should be indexed in terms of their heads.\nEach clause will be stored on the property list of the predicate of the head of the clause.\nSince the data base is now distributed across the property list of various symbols, we represent the entire data base as a list of symbols stored as the value of `*db-predicates*`.\n\n```lisp\n;; Clauses are stored on the predicate's plist\n(defun get-clauses (pred) (get pred 'clauses))\n(defun predicate (relation) (first relation))\n(defvar *db-predicates* nil\n \"A list of all predicates stored in the database.\")\n```\n\nNow we need a way of adding a new clause.\nThe work is split up into the macro <-, which provides the user interface, and a function, add-clause, that does the work.\nIt is worth defining a macro to add clauses because in effect we are defining a new language: Prolog-In-Lisp.\nThis language has only two syntactic constructs: the <- macro to add clauses, and the ?- macro to make queries.\n\n```lisp\n(defmacro <- (&rest clause)\n \"Add a clause to the data base.\"\n '(add-clause '.clause))\n(defun add-clause (clause)\n \"Add a clause to the data base, indexed by head's predicate.\"\n ;; The predicate must be a non-variable symbol.\n (let ((pred (predicate (clause-head clause))))\n  (assert (and (symbolp pred) (not (variable-p pred))))\n  (pushnew pred *db-predicates*)\n  (setf (get pred 'clauses)\n   (nconc (get-clauses pred) (list clause)))\n  pred))\n```\n\nNow all we need is a way to remove clauses, and the data base will be complete.\n\n```lisp\n(defun clear-db ()\n \"Remove all clauses (for all predicates) from the data base.\"\n (mapc #'clear-predicate *db-predicates*))\n(defun clear-predicate (predicate)\n \"Remove the clauses for a single predicate.\"\n (setf (get predicate 'clauses) nil))\n```\n\nA data base is useless without a way of getting data out, as well as putting it in.\nThe function prove will be used to prove that a given goal either matches a fact that is in the data base directly or can be derived from the rules.\nTo prove a goal, first find all the candidate clauses for that goal.\nFor each candidate, check if the goal unifies with the head of the clause.\nIf it does, try to prove all the goals in the body of the clause.\nFor facts, there will be no goals in the body, so success will be immediate.\nFor rules, the goals in the body need to be proved one at a time, making sure that bindings from the previous step are maintained.\nThe implementation is straightforward:\n\n```lisp\n(defun prove (goal bindings)\n \"Return a list of possible solutions to goal.\"\n (mapcan #'(lambda (clause)\n  (let ((new-clause (rename-variables clause)))\n   (prove-all (clause-body new-clause)\n     (unify goal (clause-head new-clause) bindings))))\n (get-clauses (predicate goal))))\n(defun prove-all (goals bindings)\n \"Return a list of solutions to the conjunction of goals.'\"\n (cond ((eq bindings fail) fail)\n  ((null goals) (list bindings))\n  (t (mapcan #'(lambda (goall-solution)\n     (prove-all (rest goals) goall-solution))\n   (prove (first goals) bindings)))))\n```\n\nThe tricky part is that we need some way of distinguishing a variable `?x` in one clause from another variable `?x` in another clause.\nOtherwise, a variable used in two different clauses in the course of a proof would have to take on the same value in each clause, which would be a mistake.\nJust as arguments to a function can have different values in different recursive calls to the function, so the variables in a clause are allowed to take on different values in different recursive uses.\nThe easiest way to keep variables distinct is just to rename all variables in each clause before it is used.\nThe function `rename-variables` does this:[3](#fn0025)\n\n```lisp\n(defun rename-variables (x)\n \"Replace all variables in x with new ones.\"\n (sublis (mapcar #'(lambda (var) (cons var (gensym (string var))))\n  (variables-in x))\n x))\n```\n\n`Rename - variables` makes use of `gensym,` a function that generates a new symbol each time it is called.\nThe symbol is not interned in any package, which means that there is no danger of a programmer typing a symbol of the same name.\nThe predicate `variables-in` and its auxiliary function are defined here:\n\n```lisp\n(defun variables-in (exp)\n \"Return a list of all the variables in EXP.\"\n (unique-find-anywhere-if #'variable-p exp))\n(defun unique-find-anywhere-if (predicate tree\n                                &optional found-so-far)\n \"Return a list of leaves of tree satisfying predicate\n with duplicates removed.\"\n (if (atom tree)\n   (if (funcall predicate tree)\n       (adjoin tree found-so-far)\n       found-so-far)\n   (unique-find-anywhere-if\n     predicate\n     (first tree)\n     (unique-find-anywhere-if predicate (rest tree)\n                              found-so-far))))\n```\n\nFinally, we need a nice interface to the proving functions.\nWe will use `?-` as a macro to introduce a query.\nThe query might as well allow a conjunction of goals, so `?-` will call `prove-all`.\nTogether, `<-` and `?-` define the complete syntax of our Prolog-In-Lisp language.\n\n```lisp\n(defmacro ?- (&rest goals) '(prove-all ',goals no-bindings))\n```\n\nNow we can enter all the clauses given in the prior example:\n\n```lisp\n(<- (likes Kim Robin))\n(<- (likes Sandy Lee))\n(<- (likes Sandy Kim))\n(<- (likes Robin cats))\n(<- (likes Sandy ?x) (likes ?x cats))\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n(<- (likes ?x ?x))\n```\n\nTo ask whom Sandy likes, we would use:\n\n```lisp\n> (?- (likes Sandy ?who))\n(((?WHO . LEE))\n ((?WHO . KIM))\n ((?X2856 . ROBIN) (?WHO .?X2856))\n ((?X2860 . CATS) (?X2857 CATS) (?X2856 . SANDAY) (?WHO ?X2856)\n ((?X2865 . CATS) (?X2856 ?X2865)((?WHO . ?X2856))\n (?WHO . SANDY) (?X2867 . SANDAY)))\n```\n\nPerhaps surprisingly, there are six answers.\nThe first two answers are Lee and Kim, because of the facts.\nThe next three stem from the clause that Sandy likes everyone who likes cats.\nFirst, Robin is an answer because of the fact that Robin likes cats.\nTo see that Robin is the answer, we have to unravel the bindings: `?who` is bound to `?x2856`, which is in turn bound to Robin.\n\nNow we're in for some surprises: Sandy is listed, because of the following reasoning: (1) Sandy likes anyone/thing who likes cats, (2) cats like cats because everyone likes themself, (3) therefore Sandy likes cats, and (4) therefore Sandy likes Sandy.\nCats is an answer because of step (2), and finally, Sandy is an answer again, because of the clause about liking oneself.\nNotice that the result of the query is a list of solutions, where each solution corresponds to a different way of proving the query true.\nSandy appears twice because there are two different ways of showing that Sandy likes Sandy.\nThe order in which solutions appear is determined by the order of the search.\nProlog searches for solutions in a top-down, left-to-right fashion.\nThe clauses are searched from the top down, so the first clauses entered are the first ones tried.\nWithin a clause, the body is searched left to right.\nIn using the (`likes Kim ?x`) clause, Prolog would first try to find an `x` who likes Lee, and then see if `x` likes Kim.\n\nThe output from `prove-all` is not very pretty.\nWe can fix that by defining a new function, `top-level-prove,` which calls `prove-all` as before, but then passes the list of solutions to `show-prolog-solutions,` which prints them in a more readable format.\nNote that `show-prolog-solutions` returns no values: `(values).` This means the read-eval-print loop will not print anything when `(values)` is the result of a top-level call.\n\n```lisp\n(defmacro ?- (&rest goals)\n '(top-level-prove ',goals))\n(defun top-level-prove (goals)\n \"Prove the goals, and print variables readably.\"\n (show-prolog-solutions\n   (variables-in goals)\n   (prove-all goals no-bindings)))\n(defun show-prolog-solutions (vars solutions)\n  \"Print the variables in each of the solutions.\"\n  (if (null solutions)\n    (format t \"~&No.\")\n    (mapc #'(lambda (solution) (show-prolog-vars vars solution))\n          solutions))\n  (values))\n(defun show-prolog-vars (vars bindings)\n  \"Print each variable with its binding.\"\n  (if (null vars)\n    (format t \"~&Yes\")\n    (dolist (var vars)\n      (format t \"~&~a = ~ a\" var\n              (subst-bindings bindings var))))\n  (princ \";\"))\n```\n\nNow let's try some queries:\n\n```lisp\n> (?- (likes Sandy ?who))\n?WHO = LEE;\n?WHO = KIM;\n?WHO = ROBIN;\n?WHO = SANDY;\n?WHO = CATS;\n?WHO = SANDY;\n> (?- (likes ?who Sandy))\n?WHO = SANDY;\n?WHO = KIM;\n?WHO = SANDY;\n> (?- (likes Robin Lee))\nNo.\n```\n\nThe first query asks again whom Sandy likes, and the second asks who likes Sandy.\nThe third asks for confirmation of a fact.\nThe answer is \"no,\" because there are no clauses or facts that say Robin likes Lee.\nHere's another example, a list of pairs of people who are in a mutual liking relation.\nThe last answer has an uninstantiated variable, indicating that everyone likes themselves.\n\n```lisp\n> (?- (likes ?x ?y) (likes ?y ?x))\n?Y = KIM\n?X = SANDY;\n?Y = SANDY\n?X = SANDY;\n?Y = SANDY\n?X = SANDY;\n?Y = SANDY\n?X = KIM;\n?Y = SANDY\n?X = SANDY;\n?Y = ?X3251\n?X = ?X3251;\n```\n\nIt makes sense in Prolog to ask open-ended queries like \"what lists is 2 a member of ?\" or even \"what items are elements of what lists?\"\n\n```lisp\n(?- (member 2 ?list))\n(?- (member ?item ?list))\n```\n\nThese queries are valid Prolog and will return solutions, but there will be an infinite number of them.\nSince our interpreter collects all the solutions into a single list before showing any of them, we will never get to see the solutions.\nThe next section shows how to write a new interpreter that fixes this problem.\n\n**Exercise 11.1 [m]** The representation of relations has been a list whose first element is a symbol.\nHowever, for relations with no arguments, some people prefer to write `(<- p q r)` rather than `(<- (p) (q) (r))`.\nMake changes so that either form is acceptable.\n\n**Exercise 11.2 [m]** Some people find the < - notation difficult to read.\nDefine macros `rule` and `fact` so that we can write:\n\n```lisp\n(fact (likes Robin cats))\n(rule (likes Sandy ?x) if (likes ?x cats))\n```\n\n## 11.3 Idea 3: Automatic Backtracking\n{:#s0025}\n{:.h1hd}\n\nThe Prolog interpreter implemented in the last section solves problems by returning a list of all possible solutions.\nWe'll call this a *batch* approach, because the answers are retrieved in one uninterrupted batch of processing.\nSometimes that is just what you want, but other times a single solution will do.\nIn real Prolog, solutions are presented one at a time, as they are found.\nAfter each solution is printed, the user has the option of asking for more solutions, or stopping.\nThis is an *incremental* approach.\nThe incremental approach will be faster when the desired solution is one of the first out of many alternatives.\nThe incremental approach will even work when there is an infinite number of solutions.\nAnd if that is not enough, the incremental approach can be implemented so that it searches depth-first.\nThis means that at any point it will require less storage space than the batch approach, which must keep all solutions in memory at once.\n\nIn this section we implement an incremental Prolog interpreter.\nOne approach would be to modify the interpreter of the last section to use pipes rather than lists.\nWith pipes, unnecessary computation is delayed, and even infinite lists can be expressed in a finite amount of time and space.\nWe could change to pipes simply by changing the `mapcan` in `prove` and `prove-all` to `mappend-pipe` (page 286).\nThe books by [Winston and Horn (1988)](B9780080571157500285.xhtml#bb1410) and by [Abelson and Sussman (1985)](B9780080571157500285.xhtml#bb0010) take this approach.\nWe take a different one.\n\nThe first step is a version of `prove` and `prove-all` that return a single solution rather than a list of all possible solutions.\nThis should be reminiscent of `achieve` and `achieve-all` from `gps` ([chapter 4](B9780080571157500042.xhtml)).\nUnlike `gps`, recursive subgoals and clobbered sibling goals are not checked for.\nHowever, `prove` is required to search systematically through all solutions, so it is passed an additional parameter: a list of other goals to achieve after achieving the first goal.\nThis is equivalent to passing a continuation to `prove`.\nThe result is that if `prove` ever succeeds, it means the entire top-level goal has succeeded.\nIf it fails, it just means the program is backtracking and trying another sequence of choices.\nNote that `prove` relies on the fact that `fail` is `nil`, because of the way it uses some.\n\n```lisp\n(defun prove-all (goals bindings)\n \"Find a solution to the conjunction of goals.\"\n (cond ((eq bindings fail) fail)\n       ((null goals) bindings)\n       (t (prove (first goals) bindings (rest goals)))))\n(defun prove (goal bindings other-goals)\n \"Return a list of possible solutions to goal.\"\n (some #'(lambda (clause)\n           (let ((new-clause (rename-variables clause)))\n             (prove-all\n               (append (clause-body new-clause) other-goals)\n           (unify goal (clause-head new-clause) bindings))))\n (get-clauses (predicate goal))))\n```\n\nIf `prove` does succeed, it means a solution has been found.\nIf we want more solutions, we need some way of making the process fail, so that it will backtrack and try again.\nOne way to do that is to extend every query with a goal that will print out the variables, and ask the user if the computation should be continued.\nIf the user says yes, then the goal *fails,* and backtracking starts.\nIf the user says no, the goal succeeds, and since it is the final goal, the computation ends.\nThis requires a brand new type of goal: one that is not matched against the data base, but rather causes some procedure to take action.\nIn Prolog, such procedures are called *primitives,* because they are built-in to the language, and new ones may not be defined by the user.\nThe user may, of course, define nonprimitive procedures that call upon the primitives.\n\nIn our implementation, primitives will be represented as Lisp functions.\nA predicate can be represented either as a list of clauses (as it has been so far) or as a single primitive.\nHere is a version of `prove` that calls primitives when appropriate:\n\n```lisp\n(defun prove (goal bindings other-goals)\n \"Return a list of possible solutions to goal.\"\n (let ((clauses (get-clauses (predicate goal))))\n   (if (listp clauses)\n       (some\n         #'(lambda (clause)\n             (let ((new-clause (rename-variables clause)))\n               (prove-all\n                (append (clause-body new-clause) other-goals)\n                (unify goal (clause-head new-clause) bindings))))\n         clauses)\n       ;; The predicate's \"clauses\" can be an atom:\n       ;; a primitive function to call\n       (funcall clauses (rest goal) bindings\n                other-goals))))\n```\n\nHere is the version of `top-level-prove` thatadds the primitive goal `show-prolog-vars` to the end of the list of goals.\nNote that this version need not call `show-prolog-solutions` itself, since the printing will be handled by the primitive for `show-prolog-vars`.\n\n```lisp\n(defun top-level-prove (goals)\n (prove-all '(,@goals (show-prolog-vars ,@(variables-in goals)))\n            no-bindings)\n (format t \"~&No.\")\n (values))\n```\n\nHere we define the primitive `show-prolog-vars`.\nAll primitives must be functions of three arguments: a list of arguments to the primitive relation (here a list of variables to show), a binding list for these arguments, and a list of pending goals.\nA primitive should either return `fail` or call `prove-all` to continue.\n\n```lisp\n(defun show-prolog-vars (vars bindings other-goals)\n \"Print each variable with its binding.\n Then ask the user if more solutions are desired.\"\n (if (null vars)\n     (format t \"~&Yes\")\n     (dolist (var vars)\n       (format t \"~&~a = ~a\" var\n               (subst-bindings bindings var))))\n (if (continue-p)\n     fail\n     (prove-all other-goals bindings)))\n```\n\nSince primitives are represented as entries on the `clauses` property of predicate symbols, we have to register `show- prolog - vars` as a primitive like this:\n\n```lisp\n(setf (get 'show-prolog-vars 'clauses) 'show-prolog-vars)\n```\n\nFinally, the Lisp predicate `continue-p` asks the user if he or she wants to see more solutions:\n\n```lisp\n(defun continue-p ()\n \"Ask user if we should continue looking for solutions.\"\n (case (read-char)\n  (#\\; t)\n  (#\\. nil)\n  (#\\newline (continue-p))\n  (otherwise\n   (format t \" Type ; to see more or . to stop\")\n   (continue-p))))\n```\n\nThis version works just as well as the previous version on finite problems.\nThe only difference is that the user, not the system, types the semicolons.\nThe advantage is that we can now use the system on infinite problems as well.\nFirst, we'll ask what lists 2 is a member of :\n\n```lisp\n> (?- (member 2 ?list))\n?LIST = (2 . ?REST3302);\n?LIST = (?X3303 2 . ?REST3307);\n?LIST = (?X3303 ?X3308 2 . ?REST3312);\n?LIST = (?X3303 ?X3308 ?X3313 2 . ?REST3317).\nNo.\n```\n\nThe answers mean that 2 is a member of any list that starts with 2, or whose second element is 2, or whose third element is 2, and so on.\nThe infinite computation was halted when the user typed a period rather than a semicolon.\nThe \"no\" now means that there are no more answers to be printed; it will appear if there are no answers at all, if the user types a period, or if all the answers have been printed.\n\nWe can ask even more abstract queries.\nThe answer to the next query says that an item is an element of a list when it is the the first element, or the second, or the third, or the fourth, and so on.\n\n```lisp\n> (?- (member ?item ?list))\n?ITEM = ?ITEM3318\n?LIST = (?ITEM3318 . ?REST3319);\n?ITEM = ?ITEM3323\n?LIST = (?X3320 ?ITEM3323 . ?REST3324);\n?ITEM = ?ITEM3328\n?LIST = (?X3320 ?X3325 ?ITEM3328 . ?REST3329);\n?ITEM = ?ITEM3333\n?LIST = (?X3320 ?X3325 ?X3330 ?ITEM3333 . ?REST3334).\nNo.\n```\n\nNow let's add the definition of the relation length:\n\n```lisp\n(<- (length () 0))\n(<- (length (?x . ?y) (1 + ?n)) (length ?y ?n))\n```\n\nHere are some queries showing that length can be used to find the second argument, the first, or both:\n\n```lisp\n> (?- (length (a b c d) ?n))\n?N = (1 + (1 + (1 + (1 + 0))));\nNo.\n> (?- (length ?list (1 + (1 + 0))))\n?LIST = (?X3869 ?X3872);\nNo.\n> (?- (length ?list ?n))\n?LIST = NIL\n?N = 0;\n?LIST = (?X3918)\n?N = (1 + 0);\n?LIST = (?X3918 ?X3921)\n?N = (1 + (1 + 0)).\nNo.\n```\n\nThe next two queries show the two lists of length two with a as a member.\nBoth queries give the correct answer, a two-element list that either starts or ends with a.\nHowever, the behavior after generating these two solutions is quite different.\n\n```lisp\n> (?- (length ?l (1 + (1 + 0))) (member a ?l))\n?L = (A ?X4057);\n?L = (?Y4061 A);\nNo.\n> (?- (member a ?l) (length ?l (1 + (1 + 0))))\n?L = (A ?X4081);\n?L = (?Y4085 A);[Abort]\n```\n\nIn the first query, length only generates one possible solution, the list with two unbound elements.\n`member` takes this solution and instantiates either the first or the second element to a.\n\nIn the second query, `member` keeps generating potential solutions.\nThe first two partial solutions, where a is the first or second member of a list of unknown length, are extended by `length` to yield the solutions where the list has length two.\nAfter that, `member` keeps generating longer and longer lists, which `length` keeps rejecting.\nIt is implicit in the definition of `member` that subsequent solutions will be longer, but because that is not explicitly known, they are all generated anyway and then explicitly tested and rejected by `length.`\n\nThis example reveals the limitations of Prolog as a pure logic-programming language.\nIt turns out the user must be concerned not only about the logic of the problem but also with the flow of control.\nProlog is smart enough to backtrack and find all solutions when the search space is small enough, but when it is infinite (or even very large), the programmer still has a responsibility to guide the flow of control.\nIt is possible to devise languages that do much more in terms of automatic flow of control.[4](#fn0030) Prolog is a convenient and efficient middle ground between imperative languages and pure logic.\n\n### Approaches to Backtracking\n{:#s0030}\n{:.h2hd}\n\nSuppose you are asked to make a \"small\" change to an existing program.\nThe problem is that some function, `f`, which was thought to be single-valued, is now known to return two or more valid answers in certain circumstances.\nIn other words, `f` is nondeterministic.\n(Perhaps `f` is `sqrt`, and we now want to deal with negative numbers).\nWhat are your alternatives as a programmer?\nFive possibilities can be identified:\n\n*  Guess.\nChoose one possibility and discard the others.\nThis requires a means of making the right guesses, or recovering from wrong guesses.\n\n*  Know.\nSometimes you can provide additional information that is enough to decide what the right choice is.\nThis means changing the calling function(s) to provide the additional information.\n\n*  Return a list.\nThis means that the calling function(s) must be changed to expect a list of replies.\n\n*  Return a *pipe,* as defined in [section 9.3](B9780080571157500091.xhtml#s0020).\nAgain, the calling function(s) must be changed to expect a pipe.\n\n*  Guess and save.\nChoose one possibility and return it, but record enough information to allow Computing the other possibilities later.\nThis requires saving the current state of the computation as well as some information on the remaining possibilities.\n\nThe last alternative is the most desirable.\nIt is efficient, because it doesn't require Computing answers that are never used.\nIt is unobtrusive, because it doesn't require changing the calling function (and the calling function's calling function) to expect a list or pipe of answers.\nUnfortunately, it does have one major difficulty: there has to be a way of packaging up the current state of the computation and saving it away so that it can be returned to when the first choice does not work.\nFor our Prolog interpreter, the current state is succinctly represented as a list of goals.\nIn other problems, it is not so easy to summarize the entire state.\n\nWe will see in [section 22.4](B9780080571157500224.xhtml#s0025) that the Scheme dialect of Lisp provides a function, `call-with-current-continuation`, that does exactly what we want: it packages the current state of the computation into a function, which can be stored away and invoked later.\nUnfortunately, there is no corresponding function in Common Lisp.\n\n### Anonymous Variables\n{:#s0035}\n{:.h2hd}\n\nBefore moving on, it is useful to introduce the notion of an *anonymous variable.* This is a variable that is distinct from all others in a clause or query, but which the programmer does not want to bother to name.\nIn real Prolog, the underscore is used for anonymous variables, but we will use a single question mark.\nThe definition of `member` that follows uses anonymous variables for positions within terms that are not needed within a clause:\n\n```lisp\n(<- (member ?item (?item . ?)))\n(<- (member ?item (? . ?rest)) (member ?item ?rest))\n```\n\nHowever, we also want to allow several anonymous variables in a clause but still be able to keep each anonymous variable distinct from all other variables.\nOne way to do that is to replace each anonymous variable with a unique variable.\nThe function `replace-?-vars` uses `gensym` to do just that.\nIt is installed in the top-level macros `<-` and `?-` so that all clauses and queries get the proper treatment.\n\n```lisp\n(defmacro <- (&rest clause)\n \"Add a clause to the data base.\"\n '(add-clause ',(replace-?-vars clause)))\n(defmacro ?- (&rest goals)\n \"Make a query and print answers.\"\n '(top-level-prove '.(replace-?-vars goals)))\n(defun replace-?-vars (exp)\n \"Replace any ? within exp with a var of the form ?123.\"\n (cond ((eq exp '?) (gensym \"?\"))\n       ((atom exp) exp)\n       (t (reuse-cons (replace-?-vars (first exp))\n                      (replace-?-vars (rest exp))\n                      exp))))\n```\n\nA named variable that is used only once in a clause can also be considered an anonymous variable.\nThis is addressed in a different way in [section 12.3](B9780080571157500121.xhtml#s0020).\n\n## 11.4 The Zebra Puzzle\n{:#s0040}\n{:.h1hd}\n\nHere is an example of something Prolog is very good at: a logic puzzle.\nThere are fifteen facts, or constraints, in the puzzle:\n\n1. There are five houses in a line, each with an owner, a pet, a cigarette, a drink, and a color.\n!!!(p) {:.numlist}\n\n2. The Englishman lives in the red house.\n!!!(p) {:.numlist}\n\n3. The Spaniard owns the dog.\n!!!(p) {:.numlist}\n\n4. Coffee is drunk in the green house.\n!!!(p) {:.numlist}\n\n5. The Ukrainian drinks tea.\n!!!(p) {:.numlist}\n\n6. The green house is immediately to the right of the ivory house.\n!!!(p) {:.numlist}\n\n7. The Winston smoker owns snails.\n!!!(p) {:.numlist}\n\n8. Kools are smoked in the yellow house.\n!!!(p) {:.numlist}\n\n9. Milk is drunk in the middle house.\n!!!(p) {:.numlist}\n\n10. The Norwegian lives in the first house on the left.\n!!!(p) {:.numlista}\n\n11. The man who smokes Chesterfields lives next to the man with the fox.\n!!!(p) {:.numlista}\n\n12. Kools are smoked in the house next to the house with the horse.\n!!!(p) {:.numlista}\n\n13. The Lucky Strike smoker drinks orange juice.\n!!!(p) {:.numlista}\n\n14. The Japanese smokes Parliaments.\n!!!(p) {:.numlista}\n\n15. The Norwegian lives next to the blue house.\n!!!(p) {:.numlista}\n\nThe questions to be answered are: who drinks water and who owns the zebra?\nTo solve this puzzle, we first define the relations `nextto` (for \"next to\") and `iright` (for \"immediately to the right of\").\nThey are closely related to `member,` which is repeated here.\n\n(<- `(member ?item (?item . ?rest)))`\n\n(<- `(member ?item (?x . ? rest)) (member ?item ?rest))`\n\n(<- `(nextto ?x ?y ?list) (iright ?x ?y ?list))`\n\n(<- `(nextto ?x ?y ?list) (iright ?y ?x ?list))`\n\n(<- `(iright ?left ?right (?left ?right . ?rest)))`\n\n(<- `(iright ?left ?right (?x . ?rest))`\n\n```lisp\n   (iright ?left ?right ?rest))\n```\n\n(<- `(= ?x ?x))`\n\nWe also defined the identity relation, =.\nIt has a single clause that says that any x is equal to itself.\nOne might think that this implements eq or equal.\nActually, since Prolog uses unification to see if the two arguments of a goal each unify with `?x`, this means that = is unification.\n\nNow we are ready to define the zebra puzzle with a single (long) clause.\nThe variable `?h` represents the list of five houses, and each house is represented by a term of the form (house *nationality pet cigarette drink color*).\nThe variable `?w` is the water drinker, and `?z` is the zebra owner.\nEach of the 15 constraints in the puzzle is listed in the `body` of `zebra,` although constraints 9 and 10 have been combined into the first one.\nConsider constraint 2, \"The Englishman lives in the `red` house.\" This is interpreted as \"there is a house whose nationality is Englishman and whose color is `red,` and which is a member of the list of houses\": in other words, `(member (house englishman ? ? ? red) ?h).` The other constraints are similarly straightforward.\n\n```lisp\n(<- (zebra ?h ?w ?z)\n ;; Each house is of the form:\n ;; (house nationality pet cigarette drink house-color)\n (= ?h ((house norwegian ? ? ? ?)                  ;1,10\n        ?\n        (house ? ? ? milk ?) ? ?))                 ; 9\n (member (house englishman ? ? ? red) ?h)          ; 2\n (member (house spaniard dog ? ? ?) ?h)            ; 3\n (member (house ? ? ? coffee green) ?h)            ; 4\n (member (house ukrainian ? ? tea ?) ?h)           ; 5\n (iright (house ? ? ? ? ivory)                     ; 6\n         (house 1111 green) ?h)\n (member (house ? snails winston ? ?) ?h)          ; 7\n (member (house ? ? kools ? yellow) ?h)            ; 8\n (nextto (house ? ? chesterfield ? ?)              ;11\n         (house ? fox ? ? ?) ?h)\n (nextto (house ? ? kools ? ?)                     ;12\n         (house ? horse ? ? ?) ?h)\n (member (house ? ? luckystrike orange-juice ?) ?h);13\n (member (house japanese ? parliaments ? ?) ?h)    ;14\n (nextto (house norwegian ? ? ? ?)                 ;15\n         (house ? ? ? ? blue) ?h)\n ;; Now for the questions:\n (member (house ?w ? ? water ?) ?h)                ;Q1\n (member (house ?z zebra ? ? ?) ?h))               ;Q2\n```\n\nHere's the query and solution to the puzzle:\n\n```lisp\n> (?- (zebra ?houses ?water-drinker ?zebra-owner))\n?HOUSES = ((HOUSE NORWEGIAN FOX KOOLS WATER YELLOW)\n           (HOUSE UKRAINIAN HORSE CHESTERFIELD TEA BLUE)\n           (HOUSE ENGLISHMAN SNAILS WINSTON MILK RED)\n           (HOUSE SPANIARD DOG LUCKYSTRIKE ORANGE-JUICE IVORY)\n           (HOUSE JAPANESE ZEBRA PARLIAMENTS COFFEE GREEN))\n?WATER-DRINKER = NORWEGIAN\n?ZEBRA-OWNER = JAPANESE.\nNo.\n```\n\nThis took 278 seconds, and profiling (see page 288) reveals that the function prove was called 12,825 times.\nA call to prove has been termed a *logical inference, so* our system is performing 12825/278 = 46 logical inferences per second, or LIPS.\nGood Prolog systems perform at 10,000 to 100,000 LIPS or more, so this is barely limping along.\n\nSmall changes to the problem can greatly affect the search time.\nFor example, the relation nextto holds when the first house is immediately right of the second, or when the second is immediately right of the first.\nIt is arbitrary in which order these clauses are listed, and one might think it would make no difference in which order they were listed.\nIn fact, if we reverse the order of these two clauses, the execution time is roughly cut in half.\n\n## 11.5 The Synergy of Backtracking and Unification\n{:#s0045}\n{:.h1hd}\n\nProlog's backward chaining with backtracking is a powerful technique for generating the possible solutions to a problem.\nIt makes it easy to implement a *generate-and-test* strategy, where possible solutions are considered one at a time, and when a candidate solution is rejected, the next is suggested.\nBut generate-and-test is only feasible when the space of possible solutions is small.\n\nIn the zebra puzzle, there are five attributes for each of the five houses.\nThus there are 5!5, or over 24 billion candidate solutions, far too many to test one at a time.\nIt is the concept of unification (with the corresponding notion of a logic variable) that makes generate-and-test feasible on this puzzle.\nInstead of enumerating complete candidate solutions, unification allows us to specify *partial* candidates.\nWe start out knowing that there are five houses, with the Norwegian living on the far left and the milk drinker in the middle.\nRather than generating all complete candidates that satisfy these two constraints, we leave the remaining information vague, by unifying the remaining houses and attributes with anonymous logic variables.\nThe next constraint (number 2) places the Englishman in the red house.\nBecause of the way `member` is written, this first tries to place the Englishman in the leftmost house.\nThis is rejected, because Englishman and Norwegian fail to unify, so the next possibility is considered, and the Englishman is placed in the second house.\nBut no other features of the second house are specified-we didn't have to make separate guesses for the Englishman's house being green, yellow, and so forth.\nThe search continues, filling in only as much as is necessary and backing up whenever a unification fails.\n\nFor this problem, unification serves the same purpose as the delay macro (page 281).\nIt allows us to delay deciding the value of some attribute as long as possible, but to immediately reject a solution that tries to give two different values to the same attribute.\nThat way, we save time if we end up backtracking before the computation is made, but we are still able to fill in the value later on.\n\nIt is possible to extend unification so that it is doing more work, and backtracking is doing less work.\nConsider the following computation:\n\n```lisp\n(?- (length ?l 4)\n    (member d ?l) (member a ?l) (member c ?l) (member b ?l)\n    (= ?l (a b c d)))\n```\n\nThe first two lines generate permutations of the list (`d a c b`), and the third line tests for a permutation equal to (`a b c d`).\nMost of the work is done by backtracking.\nAn alternative is to extend unification to deal with lists, as well as constants and variables.\nPredicates like `length` and `member` would be primitives that would have to know about the representation of lists.\nThen the first two lines of the above program would `set ?l` to something like `#s (list :length 4 :members (d a c d))`.\nThe third line would be a call to the extended unification procedure, which would further specify `?l` to be something like:\n\n```lisp\n#s(list :length 4 imembers (d a c d) :order (abc d))\n```\n\nBy making the unification procedure more complex, we eliminate the need for backtracking entirely.\n\n**Exercise 11.3 [s]** Would a unification algorithm that delayed `member` tests be a good idea or a bad idea for the zebra puzzle?\n\n## 11.6 Destructive Unification\n{:#s0050}\n{:.h1hd}\n\nAs we saw in [section 11.2](#s0015), keeping track of a binding list of variables is a little tricky.\nIt is also prone to inefficiency if the binding list grows large, because the list must be searched linearly, and because space must be allocated to hold the binding list.\nAn alternative implementation is to change `unify` to a destructive operation.\nIn this approach, there are no binding lists.\nInstead, each variable is represented as a structure that includes a field for its binding.\nWhen the variable is unified with another expression, the variable's binding field is modified to point to the expression.\nSuch variables will be called `vars` to distinguish them from the implementation of variables as symbols starting with a question mark, `vars` are defined with the following code:\n\n```lisp\n(defconstant unbound \"Unbound\")\n(defstruct var name (binding unbound))\n(defun bound-p (var) (not (eq (var-binding var) unbound)))\n```\n\nThe macro deref gets at the binding of a variable, returning its argument when it is an unbound variable or a nonvariable expression.\nIt includes a loop because a variable can be bound to another variable, which in turn is bound to the ultimate value.\n\nNormally, it would be considered bad practice to implement deref as a macro, since it could be implemented as an inline function, provided the caller was willing to write `(setf x (deref x))` instead of `(deref x)`.\nHowever, deref will appear in code generated by some versions of the Prolog compiler that will be presented in the next section.\nTherefore, to make the generated code look neater, I have allowed myself the luxury of the `deref` macro.\n\n```lisp\n(defmacro deref (exp)\n \"Follow pointers for bound variables.\"\n '(progn (loop while (and (var-p ,exp) (bound-p ,exp))\n            do (setf ,exp (var-binding ,exp)))\n         ,exp))\n```\n\nThe function `unify!` below is the destructive version of `unify`.\nIt is a predicate that returns true for success and false for failure, and has the side effect of altering variable bindings.\n\n```lisp\n(defun unify! (x y)\n \"Destructively unify two expressions\"\n (cond ((eql (deref x) (deref y)) t)\n       ((var-p x) (set-binding! x y))\n       ((var-p y) (set-binding! y x))\n       ((and (consp x) (consp y))\n       (and (unify! (first x) (first y))\n            (unify! (rest x) (rest y))))\n       (t nil)))\n(defun set-binding! (var value)\n \"Set var's binding to value. Always succeeds (returns t).\"\n (setf (var-binding var) value)\n t)\n```\n\nTo make `vars` easier to read, we can install a :`print-function`:\n\n```lisp\n(defstruct (var (:print-function print-var))\n   name (binding unbound))\n (defun print-var (var stream depth)\n   (if (or (and (numberp *print-level*)\n            (>= depth *print-level*))\n       (var-p (deref var)))\n    (format stream \"?~a\" (var-name var))\n    (write var :stream stream)))\n```\n\nThisis the first example of a carefully crafted : `print-function`.\nThere are three things to notice about it.\nFirst, it explicitly writes to the stream passed as the argument.\nIt does not write to a default stream.\nSecond, it checks the variable `depth` against `*print-level*`, and prints just the variable name when the depth is exceeded.\nThird, it uses `write` to print the bindings.\nThis is because write pays attention to the current values of `*print-escape*, *print-pretty*`, and `soon`.\nOther printing functions such as `prinl` or `print` do not pay attention to these variables.\n\nNow, for backtracking purposes, we want to make `set-binding!` keep track of the bindings that were made, so they can be undone later:\n\n```lisp\n(defvar *trall* (make-array 200 :fill-pointer 0 :adjustable t))\n(defun set-binding! (var value)\n \"Set var's binding to value, after saving the variable\n in the trail. Always returns t.\"\n (unless (eq var value)\n   (vector-push-extend var *trail*)\n   (setf (var-binding var) value))\n t)\n(defun undo-bindings! (old-trail)\n \"Undo all bindings back to a given point in the trail.\"\n (loop until (= (fill-pointer *trail*) old-trail)\n   do (setf (var-binding (vector-pop *trail*)) unbound)))\n```\n\nNow we need a way of making new variables, where each one is distinct.\nThat could be done by `gensym-ing` a new name for each variable, but a quicker solution is just to increment a counter.\nThe constructor function ? is defined to generate a new variable with a name that is a new integer.\nThis is not strictly necessary; we could have just used the automatically provided constructor `make-var`.\nHowever, I thought that the operation of providing new anonymous variable was different enough from providing a named variable that it deserved its own function.\nBesides, `make-var` may be less efficient, because it has to process the keyword arguments.\nThe function ? has no arguments; it just assigns the default values specified in the slots of the `var` structure.\n\n```lisp\n(defvar *var-counter* 0)\n(defstruct (var (:constructor ? ())\n           (:print-function print-var))\n (name (incf *var-counter*))\n (binding unbound))\n```\n\nA reasonable next step would be to use destructive unification to make a more efficient interpreter.\nThis is left as an exercise, however, and instead we put the interpreter aside, and in the next chapter develop a compiler.\n\n## 11.7 Prolog in Prolog\n{:#s0055}\n{:.h1hd}\n\nAs stated at the start of this chapter, Prolog has many of the same features that make Lisp attractive for program development.\nJust as it is easy to write a Lisp interpreter in Lisp, it is easy to write a Prolog interpreter in Prolog.\nThe following Prolog metainterpreter has three main relations.\nThe relation clause is used to store clauses that make up the rules and facts that are to be interpreted.\nThe relation `prove` is used to prove a goal.\nIt calls `prove`-`all`, which attempts to prove a list of goals, `prove`-`all` succeeds in two ways: (1) if the list is empty, or (2) if there is some clause whose head matches the first goal, and if we can prove the body of that clause, followed by the remaining goals:\n\n```lisp\n(<- (prove ?goal) (prove-all (?goal)))\n(<- (prove-all nil))\n(<- (prove-all (?goal . !!!(char) îgoals))\n    (clause (<- ?goal . ?body))\n    (concat ?body ?goals ?new-goals)\n    (prove-all ?new-goals))\n```\n\nNow we add two clauses to the data base to define the member relation:\n\n```lisp\n(<- (clause (<- (mem ?x (?x . ?y)))))\n(<- (clause (<- (mem ?x (? . ?z)) (mem ?x ?z))))\n```\n\nFinally, we can prove a goal using our interpreter:\n\n```lisp\n(?- (prove (mem ?x (1 2 3))))\n?X = 1;\n?X = 2;\n?X = 3;\nNo.\n```\n\n## 11.8 Prolog Compared to Lisp\n{:#s0060}\n{:.h1hd}\n\nMany of the features that make Prolog a succesful language for AI (and for program development in general) are the same as Lisp's features.\nLet's reconsider the list of features that make Lisp different from conventional languages (see page 25) and see what Prolog has to offer:\n\n*  *Built-in Support for Lists (and other data types).* New data types can be created easily using lists or structures (structures are preferred).\nSupport for reading, printing, and accessing components is provided automatically.\nNumbers, symbols, and characters are also supported.\nHowever, because logic variables cannot be altered, certain data structures and operations are not provided.\nFor example, there is no way to update an element of a vector in Prolog.\n\n*  *Automatic Storage Management.* The programmer can allocate new objects without worrying about reclaiming them.\nReclaiming is usually faster in Prolog than in Lisp, because most data can be stack-allocated instead of heap-allocated.\n\n*  *Dynamic Typing.* Declarations are not required.\nIndeed, there is no standard way to make type declarations, although some implementations allow for them.\nSome Prolog systems provide only fixnums, so that eliminates the need for a large class of declarations.\n\n*  *First-Class Functions.* Prolog has no equivalent of `lambda,` but the built-in predicate `call` allows a term-a piece of data-to be called as a goal.\nAlthough backtracking choice points are not first-class objects, they can be used in a way very similar to continuations in Lisp.\n\n*  *Uniform Syntax.* Like Lisp, Prolog has a uniform syntax for both programs and data.\nThis makes it easy to write interpreters and compilers in Prolog.\nWhile Lisp's prefix-operator list notation is more uniform, Prolog allows infix and postfix operators, which may be more natural for some applications.\n\n*  *Interactive Environment.* Expressions can be immediately evaluated.\nHigh-quality Prolog systems offer both a compiler and interpreter, along with a host of debugging tools.\n\n*  *Extensibility.* Prolog syntax is extensible.\nBecause programs and data share the same format, it is possible to write the equivalent of macros in Prolog and to define embedded languages.\nHowever, it can be harder to ensure that the resulting code will be compiled efficiently.\nThe details of Prolog compilation are implementation-dependent.\n\nTo put things in perspective, consider that Lisp is at once one of the highest-level languages available and a universal assembly language.\nIt is a high-level language because it can easily capture data, functional, and control abstractions.\nIt is a good assembly language because it is possible to write Lisp in a style that directly reflects the operations available on modem computers.\n\nProlog is generally not as efficient as an assembly language, but it can be more concise as a specification language, at least for some problems.\nThe user writes specifications: lists of axioms that describe the relationships that can hold in the problem domain.\nIf these specifications are in the right form, Prolog's automatic backtracking can find a solution, even though the programmer does not provide an explicit algorithm.\nFor other problems, the search space will be too large or infinite, or Prolog's simple depth-first search with backup will be too inflexible.\nIn this case, Prolog must be used as a programming language rather than a specification language.\nThe programmer must be aware of Prolog's search strategy, using it to implement an appropriate algorithm for the problem at hand.\n\nProlog, like Lisp, has suffered unfairly from some common myths.\nIt has been thought to be an inefficient language because early implementations were interpreted, and because it has been used to write interpreters.\nBut modern compiled Prolog can be quite efficient (see [Warren et al.\n1977](B9780080571157500285.xhtml#bb1335) and Van Roy 1990).\nThere is a temptation to see Prolog as a solution in itself rather than as a programming language.\nThose who take that view object that Prolog's depth-first search strategy and basis in predicate calculus is too inflexible.\nThis objection is countered by Prolog programmers who use the facilities provided by the language to build more powerful search strategies and representations, just as one would do in Lisp or any other language.\n\n## 11.9 History and References\n{:#s0065}\n{:.h1hd}\n\nCordell [Green (1968)](B9780080571157500285.xhtml#bb0490) was the first to articulate the view that mathematical results on theorem proving could be used to make deductions and thereby answer queries.\nHowever, the major technique in use at the time, resolution theorem proving (see [Robinson 1965](B9780080571157500285.xhtml#bb0995)), did not adequately constrain search, and thus was not practical.\nThe idea of goal-directed Computing was developed in Carl Hewitt's work (1971) on the planner !!!(span) {:.smallcaps} language for robot problem solving.\nHe suggested that the user provide explicit hints on how to control deduction.\n\nAt about the same time and independently, Alain Colmerauer was developing a system to perform natural language analysis.\nHis approach was to weaken the logical language so that computationally complex statements (such as logical dis-junctions) could not be made.\nColmerauer and his group implemented the first Prolog interpreter using Algol-W in the summer of 1972 (see [Roussel 1975](B9780080571157500285.xhtml#bb1005)).\nIt was Roussel's wife, Jacqueline, who came up with the name Prolog as an abbreviation for \"programmation en logique.\" The first large Prolog program was their natural language system, also completed that year ([Colmerauer et al.\n1973](B9780080571157500285.xhtml#bb0255)).\nFor those who read English better than French, [Colmerauer (1985)](B9780080571157500285.xhtml#bb0245) presents an overview of Prolog.\nRobert Kowalski is generally considered the coinventer of Prolog.\nHis 1974 article outlines his approach, and his 1988 article is a historical review on the early logic programming work.\n\nThere are now dozens of text books on Prolog.\nIn my mind, six of these stand out.\nClocksin and Mellish's *Programming in Prolog* (1987) was the first and remains one of the best.\nSterling and Shapiro's *The Art of Prolog* (1986) has more substantial examples but is not as complete as a reference.\nAn excellent overview from a slightly more mathematical perspective is Pereira and Shieber's *Prolog and Natural-Language Analysis* (1987).\nThe book is worthwhile for its coverage of Prolog alone, and it also provides a good introduction to the use of logic programming for language under-standing (see part V for more on this subject).\nO'Keefe's *The Craft of Prolog* (1990) shows a number of advanced techinques.\nO'Keefe is certainly one of the most influ-ential voices in the Prolog community.\nHe has definite views on what makes for good and bad coding style and is not shy about sharing his opinions.\nThe reader is warned that this book evolved from a set of notes on the Clocksin and Mellish book, and the lack of organization shows in places.\nHowever, it contains advanced material that can be found nowhere else.\nAnother collection of notes that has been organized into a book is Coelho and Cotta's *Prolog by Example.* Published in 1988, this is an update of their 1980 book, *How to Solve it in Prolog.* The earlier book was an underground classic in the field, serving to educate a generation of Prolog programmers.\nBoth versions include a wealth of examples, unfortunately with little documentation and many typos.\nFinally, Ivan Bratko's *Prolog Programming for Artificial Intelligence* (1990) covers some introductory AI material from the Prolog perspective.\n\nMaier and Warren's *Computing with Logic* (1988) is the best reference for those interested in implementing Prolog.\nIt starts with a simple interpreter for a variable-free version of Prolog, and then moves up to the full language, adding improvements to the interpreter along the way.\n(Note that the second author, David S.\nWarren of Stonybrook, is different from David H.\nD.\nWarren, formerly at Edinburgh and now at Bristol.\nBoth are experts on Prolog.)\n\nLloyd's *Foundations of Logic Programming* (1987) provides a theoretical explanation of the formal semantics of Prolog and related languages.\n[Lassez et al.\n(1988)](B9780080571157500285.xhtml#bb0705) and [Knight (1989)](B9780080571157500285.xhtml#bb0625) provide overviews of unification.\n\nThere have been many attempts to extend Prolog to be closer to the ideal of Logic Programming.\nThe language MU-Prolog and NU-Prolog ([Naish 1986](B9780080571157500285.xhtml#bb0890)) and Prolog III ([Colmerauer 1990](B9780080571157500285.xhtml#bb0250)) are particularly interesting.\nThe latter includes a systematic treatment of the &ne; relation and an interpretation of infinite trees.\n\n## 11.10 Exercises\n{:#s0070}\n{:.h1hd}\n\n**Exercise 11.4 [m]** It is somewhat confusing to see \"no\" printed after one or more valid answers have appeared.\nModify the program to print \"no\" only when there are no answers at all, and \"no more\" in other cases.\n\n**Exercise 11.5 [h]** At least six books (Abelson and Sussman 1985, [Charniak and McDermott 1985](B9780080571157500285.xhtml#bb0175), Charniak et al.\n1986, [Hennessey 1989](B9780080571157500285.xhtml#bb0530), [Wilensky 1986](B9780080571157500285.xhtml#bb1390), and [Winston and Horn 1988](B9780080571157500285.xhtml#bb1410)) present unification algorithms with a common error.\nThey all have problems unifying (`?x ?y a`) with (`?y ?x ?x`).\nSome of these texts assume that `unify`will be called in a context where no variables are shared between the two arguments.\nHowever, they are still suspect to the bug, as the following example points out:\n\n```lisp\n> (unify '(f (?x ?y a) (?y ?x ?x)) '(f ?z ?z))\n((?Y . A) (?X . ?Y) (?Z ?X ?Y A))\n```\n\nDespite this subtle bug, I highly recommend each of the books to the reader.\nIt is interesting to compare different implementations of the same algorithm.\nIt turns out there are more similarities than differences.\nThis indicates two things: (1) there is a generally agreed-upon style for writing these functions, and (2) good programmers sometimes take advantage of opportunities to look at other's code.\n\nThe question is : Can you give an informal proof of the correctness of the algorithm presented in this chapter?\nStart by making a clear statement of the specification.\nApply that to the other algorithms, and show where they go wrong.\nThen see if you can prove that the `unify` function in this chapter is correct.\nFailing a complete proof, can you at least prove that the algorithm will always terminate?\nSee [Norvig 1991](B9780080571157500285.xhtml#bb0915) for more on this problem.\n\n**Exercise 11.6 [h]** Since logic variables are so basic to Prolog, we would like them to be efficient.\nIn most implementations, structures are not the best choice for small objects.\nNote that variables only have two slots: the name and the binding.\nThe binding is crucial, but the name is only needed for printing and is arbitrary for most variables.\nThis suggests an alternative implementation.\nEach variable will be a cons cell of the variable's binding and an arbitrary marker to indicate the type.\nThis marker would be checked by `variable-p`.\nVariable names can be stored in a hash table that is cleared before each query.\nImplement this representation for variables and compare it to the structure representation.\n\n**Exercise 11.7 [m]** Consider the following alternative implementation for anonymous variables: Leave the macros <- and ?- alone, so that anonymous variables are allowed in assertions and queries.\nInstead, change `unify` so that it lets anything match against an anonymous variable:\n\n```lisp\n(defun unify (x y &optional (bindings no-bindings))\n \"See if x and y match with given bindings.\"\n (cond ((eq bindings fail) fail)\n       ((eql x y) bindings)\n       ((or (eq x '?) (eq y '?)) bindings)   ;***\n       ((variable-p x) (unify-variable x y bindings))\n       ((variable-p y) (unify-variable y x bindings))\n       ((and (consp x) (consp y))\n        (unify (rest x) (rest y)\n             (unify (first x) (first y) bindings)))\n       (t fail)))\n```\n\nIs this alternative correct?\nIf so, give an informal proof.\nIf not, give a counterexample.\n\n**Exercise 11.8 [h]** Write a version of the Prolog interpreter that uses destructive unification instead of binding lists.\n\n**Exercise 11.9 [m]** Write Prolog rules to express the terms father, mother, son, daughter, and grand- versions of each of them.\nAlso define parent, child, wife, husband, brother, sister, uncle, and aunt.\nYou will need to decide which relations are primitive (stored in the Prolog data base) and which are derived by rules.\n\nFor example, here's a definition of grandfather that says that G is the grandfather of C if G is the father of some P, who is the parent of C:\n\n```lisp\n(<- (grandfather ?g ?c)\n    (father ?g ?p)\n    (parent ?p ?c))\n```\n\n**Exercise 11.10 [m]** The following problem is presented in [Wirth 1976](B9780080571157500285.xhtml#bb1415):\n\n*I married a widow (let's call her W) who has a grown-up daughter (call her D).\nMy father (F), who visited us often, fell in love with my step-daughter and married her.\nHence my father became my son-in-law and my step-daughter became my mother.\nSome months later, my wife gave birth to a son (S1), who became the brother-in-law of my father, as well as my uncle.\nThe wife of my father, that is, my step-daughter, also had a son (S2).*\n\nRepresent this situation using the predicates defined in the previous exercise, verify its conclusions, and prove that the narrator of this tale is his own grandfather.\n\n**Exercise 11.11 [d]** Recall the example:\n\n```lisp\n> (?- (length (a b` c `d) ?n))\n?N = (1 + (1 + (1 + (1 + 0))));\n```\n\nIt is possible to produce 4 instead of `(1+ (1+ (1+ (1+ 0))))` by extending the notion of unification.\n[A&iuml;t-Kaci et al.\n1987](B9780080571157500285.xhtml#bb0025) might give you some ideas how to do this.\n\n**Exercise 11.12 [h]** The function `rename-variables` was necessary to avoid confusion between the variables in the first argument to `unify` and those in the second argument.\nAn alternative is to change the `unify` so that it takes two binding lists, one for each argument, and keeps them separate.\nImplement this alternative.\n\n## 11.11 Answers\n{:#s0075}\n{:.h1hd}\n\n**Answer 11.9** We will choose as primitives the unary predicates `male` and `female` and the binary predicates `child` and `married`.\nThe former takes the child first; the latter takes the husband first.\nGiven these primitives, we can make the following definitions:\n\n```lisp\n(<- (father ?f ?e)  (male ?f) (parent ?f ?c))\n(<- (mother ?m ?c)  (female ?m) (parent ?m c))\n(<- (son ?s ?p)   (male ?s) (parent ?p ?s))\n(<- (daughter ?s ?p)  (male ?s) (parent ?p ?s))\n(<- (grandfather ?g ?c) (father ?g ?p) (parent ?p ?c))\n(<- (grandmother ?g ?c) (mother ?g ?p) (parent ?p ?c))\n(<- (grandson ?gs ?gp) (son ?gs ?p) (parent ?gp ?p))\n(<- (granddaughter ?gd ?gp) (daughter ?gd ?p) (parent ?gp ?p))\n(<- (parent ?p ?c)  (child ?c ?p))\n(<- (wife ?w ?h)   (married ?h ?w))\n(<- (husband ?h ?w)  (married ?h ?w))\n(<- (sibling ?x ?y)  (parent ?p ?x) (parent ?p ?y))\n(<- (brother ?b ?x)   (male ?b) (sibling ?b ?x))\n(<- (sister ?s ?x)    (female ?s) (sibling ?s ?x))\n(<- (uncle ?u ?n)    (brother ?u ?p) (parent ?p ?n))\n(<- (aunt ?a ?n)    (sister ?a ?p) (parent ?p ?n ))\n```\n\nNote that there is no way in Prolog to express a *true* definition.\nWe would like to say that \"P is the parent of C if and only if C is the child of P,\" but Prolog makes us express the biconditional in one direction only.\n\n**Answer 11.10** Because we haven't considered step-relations in the prior definitions, we have to extend the notion of parent to include step-parents.\nThe definitions have to be written very carefully to avoid infinite loops.\nThe strategy is to structure the defined terms into a strict hierarchy: the four primitives are at the bottom, then pa rent is defined in terms of the primitives, then the other terms are defined in terms of parent and the primitives.\n\nWe also provide a definition for son-in-law:\n\n```lisp\n(<- (parent ?p ?c) (married ?p ?w) (child ?c ?w))\n(<- (parent ?p ?c) (married ?h ?p) (child ?c ?w))\n(<- (son-in-law ?s ?p) (parent ?p ?w) (married ?s ?w))\n```\n\nNow we add the information from the story.\nNote that we only use the four primitives male, female, married, and child:\n\n```lisp\n(<- (male I)) (<- (male F)) (<- (male S1)) (<- (male S2))\n(<- (female W)) (<- (female D))\n(<- (married I W))\n(<- (married F D))\n(<- (child D W))\n(<- (child I F))\n(<- (child S1 I))\n(<- (child S2 F))\n```\n\nNow we are ready to make the queries:\n\n```lisp\n> (?- (son-in-law F I)) Yes.\n> (?- (mother D I)) Yes.\n> (?- (uncle S1 I)) Yes.\n> (?- (grandfather I I)) Yes.\n```\n\n----------------------\n\n[1](#xfn0015) Actually, *programmation en logique*, since it was invented by a French group (see page 382).\n!!!(p) {:.ftnote1}\n\n[2](#xfn0020) Actually, this is more like the Lisp `find` than the Lisp `member`.\nIn this chapter we have adopted the traditional Prolog definition of `member`.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0025) See exercise 11.12 for an alternative approach.\n!!!(p) {:.ftnote1}\n\n[4](#xfn0030) See the MU-Prolog and NU-Prolog languages ([Naish 1986](B9780080571157500285.xhtml#bb0890)).\n!!!(p) {:.ftnote1}\n\n# Chapter 12\n## Compiling Logic Programs\n{:.chaptitle}\n\nThe end of [chapter 11](B978008057115750011X.xhtml) introduced a new, more efficient representation for logic variables.\nIt would be reasonable to build a new version of the Prolog interpreter incorporating this representation.\nHowever, [chapter 9](B9780080571157500091.xhtml) has taught us that compilers run faster than interpreters and are not that much harder to build.\nThus, this chapter will present a Prolog compiler that translates from Prolog to Lisp.\n\nEach Prolog predicate will be translated into a Lisp function, and we will adopt the convention that a predicate called with a different number of arguments is a different predicate.\nIf the symbol `p` can be called with either one or two arguments, we will need two Lisp functions to implement the two predicates.\nFollowing Prolog tradition, these will be called `p/1` and `p/2`.\n\nThe next step is to decide what the generated Lisp code should look like.\nIt must unify the head of each clause against the arguments, and if the unification succeeds, it must call the predicates in the body.\nThe difficult part is that the choice points have to be remembered.\nIf a call to a predicate in the first clause fails, we must be able to return to the second clause and try again.\n\nThis can be done by passing in a *success continuation* as an extra argument to every predicate.\nThis continuation represents the goals that remain unsolved, the `other-goals` argument of `prove`.\nFor each clause in the predicate, if all the goals in a clause succeed, then we should call the success continuation.\nIf a goal fails, we don't do anything special; we just go on to the next clause.\nThere is one complication: after failing we have to undo any bindings made by `unify!`.\nConsider an example.\nThe clauses\n\n```lisp\n(<- (likes Robin cats))\n(<- (likes Sandy ?x) (likes ?x cats))\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n```\n\ncould be compiled into this:\n\n```lisp\n(defun likes/2 (?arg1 ?arg2 cont)\n ;; First clause:\n (if (and (unify! ?arg1 'Robin) (unify! ?arg2 'cats))\n   (funcall cont))\n (undo-bindings)\n ;; Second clause:\n (if (unify! ?argl 'Sandy)\n   (likes/2 ?arg2 'cats cont))\n (undo-bindings)\n ;; Third clause:\n (if (unify! ?argl 'Kim)\n   (likes/2 ?arg2 'Lee\n     #'(lambda () (likes/2 ?arg2 'Kim cont))))))\n```\n\nIn the first clause, we just check the two arguments and, if the unifications succeed, call the continuation directly, because the first clause has no body.\nIn the second clause, `likes/2` is called recursively, to see if `?arg2` likes `cats`.\nIf this succeeds, then the original goal succeeds, and the continuation `cont` is called.\nIn the third clause, we have to call `likes/2` recursively again, this time requesting that it check if `?arg2` likes `Lee`.\nIf this check succeeds, then the continuation will be called.\nIn this case, the continuation involves another call to `likes/2`, to check if `?arg2` likes `Kim`.\nIf this succeeds, then the original continuation, `cont`, will finally be called.\n\nRecall that in the Prolog interpreter, we had to append the list of pending goals, `other-goals`, to the goals in the body of the clause.\nIn the compiler, there is no need to do an `append.` Instead, the continuation cont represents the other-goals, and the body of the clause is represented by explicit calls to functions.\n\nNote that the code for `likes/2` given before has eliminated some unnecessary calls to `unify!`.\nThe most obvious implementation would have one call to `unify!` for each argument.\nThus, for the second clause, we would have the code:\n\n```lisp\n(if (and (unify! ?argl 'Sandy) (unify! ?arg2 ?x))\n (likes/2 ?x 'cats cont))\n```\n\nwhere we would need a suitable let binding for the variable `?x`.\n\n## 12.1 A Prolog Compiler\n{:#s0010}\n{:.h1hd}\n\nThis section presents the compiler summarized in [figure 12.1](#f0010).\nAt the top level is the function `prolog-compile`, which takes a symbol, looks at the clauses defined for that symbol, and groups the clauses by arity.\nEach symbol/arity is compiled into a separate Lisp function by `compile-predicate`.\n\n![f12-01-9780080571157](images/B9780080571157500121/f12-01-9780080571157.jpg)     \nFigure 12.1\n!!!(span) {:.fignum}\nGlossary for the Prolog Compiler\n```lisp\n(defun prolog-compile (symbol &optional\n      (clauses (get-clauses symbol)))\n \"Compile a symbol; make a separate function for each arity.\"\n (unless (null clauses)\n  (let ((arity (relation-arity (clause-head (first clauses)))))\n   ;; Compile the clauses with this arity\n   (compile-predicate\n    symbol arity (clauses-with-arity clauses #'= arity))\n   ;; Compile all the clauses with any other arity\n   (prolog-compile\n    symbol (clauses-with-arity clauses #'/= arity)))))\n```\n\nThree utility functions are included here:\n\n```lisp\n(defun clauses-with-arity (clauses test arity)\n \"Return all clauses whose head has given arity.\"\n (find-all arity clauses\n     :key #'(lambda (clause)\n        (relation-arity (clause-head clause)))\n     :test test))\n(defun relation-arity (relation)\n \"The number of arguments to a relation.\n Example: (relation-arity '(p a b c)) => 3\"\n (length (args relation)))\n(defun args (x) \"The arguments of a relation\" (rest x))\n```\n\nThe next step is to compile the clauses for a given predicate with a fixed arity into a Lisp function.\nFor now, that will be done by compiling each clause indepently and wrapping them in a `lambda` with the right parameter list.\n\n```lisp\n(defun compile-predicate (symbol arity clauses)\n \"Compile all the clauses for a given symbol/arity\n into a single LISP function.\"\n (let ((predicate (make-predicate symbol arity))\n    (parameters (make-parameters arity!!!(char) °)))\n  (compile\n   (eval\n    '(defun ,predicate (,@parameters cont)\n      ..(mapcar #'(lambda (clause)\n            (compile-clause parameters clause 'cont))\n       clauses))))))\n(defun make-parameters (arity)\n \"Return the list (?arg1 ?arg2 ... ?arg-arity)\"\n (loop for i from 1 to arity\n    collect (new-symbol '?arg i)))\n(defun make-predicate (symbol arity)\n \"Return the symbol: symbol/arity\"\n (symbol symbol '/ arity))\n```\n\nNow for the hard part: we must actually generate the code for a clause.\nHere again is an example of the code desired for one clause.\nWe'll start by setting as a target the simple code:\n\n```lisp\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n(defun likes/2 (?arg1 ?arg2 cont)\n ...\n (if (and (unify! ?argl 'Kim) (unify! ?arg2 ?x)\n   (likes/2 ?arg2 'Lee\n      #'(lambda () (likes/2 ?x 'Kim))))\n```\n\n ...)\n\nbut we'll also consider the possibility of upgrading to the improved code:\n\n```lisp\n(defun likes/2 (?arg1 ?arg2 cont)\n ...\n (if (unify! ?arg1 'Kim)\n   (likes/2 ?arg2 'Lee\n      #'(lambda () (likes/2 ?arg2 'Kim))))\n```\n\n ...)\n\nOne approach would be to write two functions, `compile-head` and `compile-body`, and then combine them into the code (if *head body*).\nThis approach could easily generate the prior code.\nHowever, let's allow ourselves to think ahead a little.\nIf we eventually want to generate the improved code, we will need some communication between the head and the body.\nWe will have to know that the head decided not to compile the unification of `?arg2` and `?x`, but because of this, the body will have to substitute `?arg2` for `?x`.\nThat means that the `compile-head` function conceptually returns two values: the code for the head, and an indication of substitutions to perform in the body.\nThis could be handled by explicitly manipulating multiple values, but it seems complicated.\n\nAn alternate approach is to eliminate `compile-head` and just write `compile-body`.\nThis is possible if we in effect do a source-code transformation on the clause.\nInstead of treating the clause as:\n\n```lisp\n(<- (likes Kim ?x)\n (likes ?x Lee) (likes ?x Kim))\n```\n\nwe transform it to the equivalent:\n\n```lisp\n(<- (likes ?arg1 ?arg2)\n (= ?arg1 Kim) (= ?arg2 ?x) (likes ?x Lee) (likes ?x Kim))\n```\n\nNow the arguments in the head of the clause match the arguments in the function `likes/2`, so there is no need to generate any code for the head.\nThis makes things simpler by eliminating `compile-head`, and it is a better decomposition for another reason: instead of adding optimizations to `compile-head`, we will add them to the code in `compile`-`body` that handles =.\nThat way, we can optimize calls that the user makes to =, in addition to the calls introduced by the source-code transformation.\n\nTo get an overview, the calling sequence of functions will turn out to be as follows:\n\n```lisp\nprolog-compile\n compile-predicate\n  compile-clause\n   compile-body\n    compile-call\n    compile-arg\n    compile-unify\n      compile-arg\n```\n\nwhere each function calls the ones below it that are indented one level.\nWe have already defined the first two functions.\nHere then is our first version of `compile-clause`:\n\n```lisp\n(defun compile-clause (parms clause cont)\n \"Transform away the head. and compile the resulting body.\"\n (compile-body\n  (nconc\n   (mapcar #'make-= parms (args (clause-head clause)))\n   (clause-body clause))\n  cont))\n(defun make-= (x y) '(= .x .y))\n```\n\nThe bulk of the work is in `compile-body`, which is a little more complicated.\nThere are three cases.\nIf there is no body, we just call the continuation.\nIf the body starts with a call to =, we compile a call to `unify!`.\nOtherwise, we compile a call to a function, passing in the appropriate continuation.\n\nHowever, it is worthwhile to think ahead at this point.\nIf we want to treat = specially now, we will probably want to treat other goals specially later.\nSo instead of explicitly checking for =, we will do a data-driven dispatch, looking for any predicate that has a `prolog-compiler-macro` property attached to it.\nLike Lisp compiler macros, the macro can decline to handle the goal.\nWe will adopt the convention that returning `:pass` means the macro decided not to handle i t, and thus it should be compiled as a normal goal.\n\n```lisp\n(defun compile-body (body cont)\n \"Compile the body of a clause.\"\n (if (null body)\n  '(funcall ,cont)\n  (let* ((goal (first body))\n    (macro (prolog-compiler-macro (predicate goal)))\n    (macro-val (if macro\n        (funcall macro goal (rest body) cont))))\n  (if (and macro (not (eq macro-val :pass)))\n    macro-val\n    (compile-call\n     (make-predicate (predicate goal)\n        (relation-arity goal))\n     (mapcar #'(lambda (arg) (compile-arg arg))\n      (args goal))\n     (if (null (rest body))\n       cont\n       '#'(lambda ()\n        ,(compile-body (rest body) cont))))))))\n(defun compile-call (predicate args cont)\n \"Compile a call to a prolog predicate.\"\n '(,predicate ,@args ,cont))\n(defun prolog-compiler-macro (name)\n \"Fetch the compiler macro for a Prolog predicate.\"\n ;; Note NAME is the raw name, not the name/arity\n (get name 'prolog-compiler-macro))\n(defmacro def-prolog-compiler-macro (name arglist &body body)\n \"Define a compiler macro for Prolog.\"\n '(setf (get '.name 'prolog-compiler-macro)\n    #'(lambda .arglist .,body)))\n(def-prolog-compiler-macro = (goal body cont)\n (let ((args (args goal)))\n  (if (/= (length args) 2)\n    :pass\n    '(if ,(compile-unify (first args) (second args))\n      ,(compile-body body cont)))))\n(defun compile-unify (x y)\n \"Return code that tests if var and term unify.\"\n '(unify! ,(compile-arg x) ,(compile-arg y)))\n```\n\nAll that remains is `compile-arg`, a function to compile the arguments to goals in the body.\nThere are three cases to consider, as shown in the compilation to the argument of `q` below:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `1 (<- (p ?x) (q ?x))` | `(q/1 ?x cont)` |\n| `2 (<- (p ?x) (q (f a b)))` | `(q/1 '(f a b) cont)` |\n| `3 (<- (p ?x) (q (f ?x b)))` | `(q/1 (list 'f ?x 'b) cont)` |\n\nIn case 1, the argument is a variable, and it is compiled as is.\nIn case 2, the argument is a constant expression (one without any variables) that compiles into a quoted expression.\nIn case 3, the argument contains a variable, so we have to generate code that builds up the expression.\nCase 3 is actually split into two in the list below: one compiles into a call to `list`, and the other a call to `cons`.\nIt is important to remember that the goal `(q (f ?x b))` does *not* involve a call to the function `f`.\nRather, it involves the term `(f ?x b)`, which is just a list of three elements.\n\n```lisp\n(defun compile-arg (arg)\n \"Generate code for an argument to a goal in the body.\"\n (cond ((variable-p arg) arg)\n    ((not (has-variable-p arg)) \".arg)\n    ((proper-listp arg)\n      '(list .,(mapcar #'compile-arg arg)))\n    (t '(cons ,(compile-arg (first arg))\n        ,(compile-arg (rest arg))))))\n(defun has-variable-p (x)\n \"Is there a variable anywhere in the expression x?\"\n (find-if-anywhere #'variable-p x))\n(defun proper-listp (x)\n \"Is x a proper (non-dotted) list?\"\n (or (null x)\n  (and (consp x) (proper-listp (rest x)))))\n```\n\nLet's see how it works.\nWe will consider the following clauses:\n\n```lisp\n(<- (likes Robin cats))\n(<- (likes Sandy ?x) (likes ?x cats))\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ?rest)) (member ?item ?rest))\n```\n\nHere's what `prolog-compile` gives us:\n\n```lisp\n(DEFUN LIKES/2 (?ARG1 ?ARG2 CONT)\n (IF (UNIFY! ?ARG1 'ROBIN)\n  (IF (UNIFY! ?ARG2 'CATS)\n   (FUNCALL CONT)))\n (IF (UNIFY! ?ARG1 'SANDY)\n  (IF (UNIFY! ?ARG2 ?X)\n   (LIKES/2 ?X 'CATS CONT)))\n (IF (UNIFY! ?ARG1 'KIM)\n  (IF (UNIFY! ?ARG2 ?X)\n   (LIKES/2 ?X 'LEE (LAMBDA ()\n      (LIKES/2 ?X 'KIM CONT))))))\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (IF (UNIFY! ?ARG1 ?ITEM)\n  (IF (UNIFY! ?ARG2 (CONS ?ITEM ?REST))\n   (FUNCALL CONT)))\n (IF (UNIFY! ?ARG1 ?ITEM)\n  (IF (UNIFY! ?ARG2 (CONS ?X ?REST))\n   (MEMBER/2 ?ITEM ?REST CONT))))\n```\n\n## 12.2 Fixing the Errors in the Compiler\n{:#s0015}\n{:.h1hd}\n\nThere are some problems in this version of the compiler:\n\n*  We forgot to undo the bindings after each call to `unify!`.\n\n*  The definition of `undo-bindings` ! defined previously requires as an argument an index into the `*trail*` array.\nSo we will have to save the current top of the trail when we enter each function.\n\n*  Local variables, such as `?x`, were used without being introduced.\nThey should be bound to new variables.\n\nUndoing the bindings is simple: we add a single line to `compile-predicate,` a call to the function `maybe-add-undo-bindings.` This function inserts a call to `undo-bindings!` after every failure.\nIf there is only one clause, no undoing is necessary, because the predicate higher up in the calling sequence will do it when it fails.\nIf there are multiple clauses, the function wraps the whole function body in a let that captures the initial value of the trail's fill pointer, so that the bindings can be undone to the right point.\nSimilarly, we can handle the unbound-variable problem by wrapping a call to `bind-unbound-vars` around each compiled clause:\n\n```lisp\n(defun compile-predicate (symbol arity clauses)\n \"Compile all the clauses for a given symbol/arity\n into a single LISP function.\"\n (let ((predicate (make-predicate symbol arity))\n    (parameters (make-parameters arity)))\n  (compile\n   (eval\n    '(defun .predicate (.@parameters cont)\n     .,(maybe-add-undo-bindings       ;***\n       (mapcar #'(lambda (clause)\n            (compile-clause parameters\n                  clause 'cont))\n            clauses)))))))\n(defun compile-clause (parms clause cont)\n \"Transform away the head, and compile the resulting body.\"\n (bind-unbound-vars      ;***\n  parms      ;***\n  (compile-body\n   (nconc\n    (mapcar #'make-= parms (args (clause-head clause)))\n    (clause-body clause))\n   cont)))\n(defun maybe-add-undo-bindings (compiled-exps)\n \"Undo any bindings that need undoing.\n If there are any, bind the trail before we start.\"\n (if (length=1 compiled-exps)\n  compiled-exps\n  '((let ((old-trail (fill-pointer *trail*)))\n    ,(first compiled-exps)\n    ,@(loop for exp in (rest compiled-exps)\n      collect '(undo-bindings! old-trail)\n      collect exp)))))\n(defun bind-unbound-vars (parameters exp)\n \"If there are any variables in exp (besides the parameters)\n then bind them to new vars.\"\n (let ((exp-vars (set-difference (variables-in exp)\n        parameters)))\n  (if exp-vars\n   '(let ,(mapcar #'(lambda (var) '(.var (?)))\n      exp-vars)\n     ,exp)\n   exp)))\n```\n\nWith these improvements, here's the code we get for `likes` and `member`:\n\n```lisp\n(DEFUN LIKES/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (IF (UNIFY! ?ARG1 'ROBIN)\n   (IF (UNIFY! ?ARG2 'CATS)\n      (FUNCALL CONT)))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?X (?)))\n   (IF (UNIFY! ?ARG1 'SANDY)\n    (IF (UNIFY! ?ARG2 ?X)\n      (LIKES/2 ?X 'CATS CONT))))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?X (?)))\n   (IF (UNIFY! ?ARG1 'KIM)\n    (IF (UNIFY! ?ARG2 ?X)\n      (LIKES/2 ?X 'LEE (LAMBDA ()\n          (LIKES/2 ?X 'KIM CONT))))))))\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (LET ((?ITEM (?))\n      (?REST (?)))\n   (IF (UNIFY! ?ARG1 ?ITEM)\n      (IF (UNIFY! ?ARG2 (CONS ?ITEM ?REST))\n            (FUNCALL CONT))))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?X (?))\n      (? ITEM (?))\n      (?REST (?)))\n  (IF (UNIFY! ?ARG1 ?ITEM)\n   (IF (UNIFY! ?ARG2 (CONS ?X ?REST))\n            (MEMBER/2 ?ITEM ?REST CONT))))))\n```\n\n## 12.3 Improving the Compiler\n{:#s0020}\n{:.h1hd}\n\nThis is fairly good, although there is still room for improvement.\nOne minor improvement is to eliminate unneeded variables.\nFor example, `?rest` in the first clause of `member` and `?x` in the second clause are bound to new variables-the result of the (?) call-and then only used once.\nThe generated code could be made a little tighter by just putting (?) inline, rather than binding it to a variable and then referencing that variable.\nThere are two parts to this change: updating `compile-arg` to compile an anonymous variable inline, and changing the <- macro so that it converts all variables that only appear once in a clause into anonymous variables:\n\n```lisp\n(defmacro <- (&rest clause)\n \"Add a clause to the data base.\"\n '(add-clause ',(make-anonymous clause)))\n(defun compile-arg (arg)\n \"Generate code for an argument to a goal in the body.\"\n (cond ((eq arg '?) '(?))      ;***\n   ((variable-p arg) arg)\n   ((not (has-variable-p arg)) '',arg)\n   ((proper-listp arg)\n   '(list (mapcar #'compile-arg arg)))\n   (t '(cons ,(compile-arg (first arg))\n          ,(compile-arg (rest arg))))))\n(defun make-anonymous (exp &optional\n             (anon-vars (anonymous-variables-in exp)))\n \"Replace variables that are only used once with ?.\"\n (cond ((consp exp)\n   (reuse-cons (make-anonymous (first exp) anon-vars)\n     (make-anonymous (rest exp) anon-vars)\n     exp))\n((member exp anon-vars) '?)\n(t exp)))\n```\n\nFinding anonymous variables is tricky.\nThe following function keeps two lists: the variables that have been seen once, and the variables that have been seen twice or more.\nThe local function `walk` is then used to walk over the tree, recursively considering the components of each cons cell and updating the two lists as each variable is encountered.\nThis use of local functions should be remembered, as well as an alternative discussed in [exercise 12.23](#p4625) on [page 428](#p428).\n\n```lisp\n(defun anonymous-variables-in (tree)\n \"Return a list of all variables that occur only once in tree.\"\n (let ((seen-once nil)\n      (seen-more nil))\n  (labels ((walk (x)\n      (cond\n        ((variable-p x)\n          (cond ((member x seen-once)\n               (setf seen-once (delete x seen-once))\n               (push x seen-more))\n            ((member x seen-more) nil)\n            (t (push x seen-once))))\n        ((consp x)\n          (walk (first x))\n          (walk (rest x))))))\n   (walk tree)\n   seen-once)))\n```\n\nNow `member` compiles into this:\n\n```lisp\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (LET ((?ITEM (?)))\n   (IF (UNIFY! ?ARG1 ?ITEM)\n    (IF (UNIFY! ?ARG2 (CONS ?ITEM (?)))\n        (FUNCALL CONT))))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?ITEM (?))\n    (?REST (?)))\n   (IF (UNIFY! ?ARG1 ?ITEM)\n    (IF (UNIFY! ?ARG2 (CONS (?) ?REST))\n      (MEMBER/2 ?ITEM ?REST CONT))))))\n```\n\n## 12.4 Improving the Compilation of Unification\n{:#s0025}\n{:.h1hd}\n\nNow we turn to the improvement of `compile-unify`.\nRecall that we want to elimina te certain calls to `unify!` so that, for example, the first clause of `member:`\n\n```lisp\n(<- (member ?item (?item . ?rest)))\n```\n\ncompiles into:\n\n```lisp\n(LET ((?ITEM (?)))\n (IF (UNIFY! ?ARG1 ?ITEM)\n  (IF (UNIFY! ?ARG2 (CONS ?ITEM (?)))\n    (FUNCALL CONT))))\n```\n\nwhen it could compile to the more efficient:\n\n```lisp\n(IF (UNIFY! ?ARG2 (CONS ?ARG1 (?)))\n  (FUNCALL CONT))\n```\n\nEliminating the unification in one goal has repercussions in other goals later on, so we will need to keep track of expressions that have been unified together.\nWe have a design choice.\nEither `compile-unify` can modify a global state variable, or it can return multiple values.\nOn the grounds that global variables are messy, we make the second choice: `compile-unify` will take a binding list as an extra argument and will return two values, the actual code and an updated binding list.\nWe will expect that other related functions will have to be modified to deal with these multiple values.\n\nWhen `compile-unify` is first called in our example clause, it is asked to unify `?argl` and `?item`.\nWe want it to return no code (or more precisely, the trivially true test, t).\nFor the second value, it should return a new binding list, with `?item` bound to `?arg1.` That binding will be used to replace `?item` with `?arg1` in subsequent code.\n\nHow do we know to bind `?item` to `?arg1` rather than the other way around?\nBecause `?arg1` is already bound to something-the value passed in to `member.` We don't know what this value is, but we can't ignore it.\nThus, the initial binding list will have to indicate that the parameters are bound to something.\nA simple convention is to bind the parameters to themselves.\nThus, the initial binding list will be:\n\n```lisp\n((?arg1 .?arg1) (?arg2 . ?arg2))\n```\n\nWe saw in the previous chapter ([page 354](B978008057115750011X.xhtml#p354)) that binding a variable to itself can lead to problems; we will have to be careful.\n\nBesides eliminating unifications of new variables against parameters, there are quite a few other improvements that can be made.\nFor example, unifications involving only constants can be done at compile time.\nThe call `(= (f a) (f a ))` always succeeds, while `(= 3 4)` always fails.\nIn addition, unification of two cons cells can be broken into components at compile time: `(= (f ?x) (f a))` reduces to `(= ?x a)` and `(= f f)`, where the latter trivially succeeds.\nWe can even do some occurs checking at compile time: `(= ?x (f ?x))` should fail.\n\nThe following table lists these improvements, along with a breakdown for the cases of unifying a bound `(?arg1)` or unbound `(?x)` variable agains another expression.\nThe first column is the unification call, the second is the generated code, and the third is the bindings that will be added as a resuit of the call:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | Unification | Code | Bindings |\n| 1 | `(= 3 3)` | `t` | `-` |\n| 2 | `(= 3 4)` | `nil` | `-` |\n| 3 | `(= (f ?x) (?p 3))` | `t` | `(?x . 3) (?p . f)` |\n| 4 | `(= ?arg1 ?y)` | `t` | `(?y . ?arg1)` |\n| 5 | `(= ?arg1 ?arg2)` | `(unify! ?arg1 ?arg2)` | `(?arg1 . ?arg2)` |\n| 6 | `(= ?arg1 3)` | `(unify! ?arg1 3)` | `(?arg1 . 3)` |\n| 7 | `(= ?arg1 (f ? y))` | `(unify! ?arg1 . . . )` | `(?y . ?y)` |\n| 8 | `(= ?x ?y)` | `t` | `(?y . ?y)` |\n| 9 | `(= ?x 3)` | `t` | `(?x . 3)` |\n| 10 | `(= ?x (f ? y))` | `(unify! ?x . . . )` | `(?y . ?y)` |\n| 11 | `(= ?x (f ? x))` | `nil` | `-` |\n| 12 | `(= ?x ?)` | `t` | `-` |\n\n![t0015](images/B9780080571157500121/t0015.png)\n\nFrom this table we can craft our new version of `compile-unify`.\nThe first part is fairly easy.\nIt takes care of the first three cases in this table and makes sure that `compile-unify-variable` is called with a variable as the first argument for the other cases.\n\n```lisp\n(defun compile-unify (x y bindings)\n \"Return 2 values: code to test if x and y unify,\n and a new binding list.\"\n (cond\n  ;; Unify constants and conses:          ; Case\n  ((not (or (has-variable-p x) (has-variable-p y)))          ; 1.2\n   (values (equal x y) bindings))\n  ((and (consp x) (consp y))          ; 3\n   (multiple-value-bind (code1 bindings1)\n     (compile-unify (first x) (first y) bindings)\n    (multiple-value-bind (code2 bindings2)\n      (compile-unify (rest x) (rest y) bindings1)\n     (values (compile-if code1 code2) bindings2))))\n  ;; Here x or y is a variable. Pick the right one:\n  ((variable-p x) (compile-unify-variable x y bindings))\n  (t      (compile-unify-variable y x bindings))))\n(defun compile-if (pred then-part)\n \"Compile a Lisp IF form. No else-part allowed.\"\n (case pred\n  ((t) then-part)\n  ((nil) nil)\n  (otherwise '(if .pred .then-part))))\n```\n\nThe function `compile-unify-variable` following is one of the most complex we have seen.\nFor each argument, we see if it has a binding (the local variables `xb` and `yb`), and then use the bindings to get the value of each argument (`x1` and `y1`).\nNote that for either an unbound variable or one bound to itself, `x` will equal `x1` (and the same for `y` and `y1`).\nIf either of the pairs of values is not equal, we should use the new ones (`x1` or `y1`), and the clause commented deref does that.\nAfter that point, we just go through the cases, one at a time.\nIt turns out that it was easier to change the order slightly from the preceding table, but each clause is commented with the corresponding number:\n\n```lisp\n(defun compile-unify-variable (x y bindings)\n \"X is a variable, and Y may be.\"\n (let* ((xb (follow-binding x bindings))\n   (x1 (if xb (cdr xb) x))\n   (yb (if (variable-p y) (follow-binding y bindings)))\n   (y1 (if yb (cdr yb) y)))\n (cond       ; Case:\n  ((or (eq x '?) (eq y '?)) (values t bindings))      ; 12\n  ((not (and (equal x x1) (equal y y1)))      ; deref\n    (compile-unify x1 y1 bindings))\n  ((find-anywhere x1 y1) (values nil bindings))      ; 11\n  ((consp y1)      ; 7.10\n  (values '(unify! ,xl ,(compile-arg y1 bindings))\n      (bind-variables-in y1 bindings)))\n  ((not (null xb))\n  ;; i.e. x is an ?arg variable\n  (if (and (variable-p y1) (null yb))\n   (values 't (extend-bindings y1 x1 bindings))      ; 4\n   (values '(unify! ,xl .(compile-arg y1 bindings))\n      (extend-bindings x1 y1 bindings))))      ; 5.6\n  ((not (null yb))\n   (compile-unify-variable y1 x1 bindings))\n  (t (values 't (extend-bindings x1 y1 bindings))))))      ; 8.9\n```\n\nTake some time to understand just how this function works.\nThen go on to the following auxiliary functions:\n\n```lisp\n(defun bind-variables-in (exp bindings)\n \"Bind all variables in exp to themselves. and add that to\n bindings (except for variables already bound).\"\n (dolist (var (variables-in exp))\n  (unless (get-binding var bindings)\n   (setf bindings (extend-bindings var var bindings))))\n bindings)\n(defun follow-binding (var bindings)\n \"Get the ultimate binding of var according to bindings.\"\n (let ((b (get-binding var bindings)))\n  (if (eq (car b) (cdr b)) b\n    b\n      (or (follow-binding (cdr b) bindings)\n          b))))\n```\n\nNow we need to integrate the new `compile-unify` into the rest of the compiler.\nThe problem is that the new version takes an extra argument and returns an extra value, so all the functions that call it need to be changed.\nLet's look again at the calling sequence:\n\n```lisp\nprolog-compile\n compile-predicate\n  compile-clause\n   compile-body\n    compile-call\n    compile-arg\n     compile-unify\n      compile-arg\n```\n\nFirst, going downward, we see that `compile-arg` needs to take a binding list as an argument, so that it can look up and substitute in the appropriate values.\nBut it will not alter the binding list, so it still returns one value:\n\n```lisp\n(defun compile-arg (arg bindings)\n \"Generate code for an argument to a goal in the body.\"\n (cond ((eq arg '?) '(?))\n   ((variable-p arg)\n    (let ((binding (get-binding arg bindings)))\n      (if (and (not (null binding))\n        (not (eq arg (binding-val binding))))\n       (compile-arg (binding-val binding) bindings)\n       arg)))\n    ((not (find-if-anywhere #'variable-p arg)) \",arg)\n    ((proper-listp arg)\n     '(1ist .,(mapcar #'(lambda (a) (compile-arg a bindings))\n          arg)))\n       (t '(cons ,(compile-arg (first arg) bindings)\n         ,(compile-arg (rest arg) bindings)))))\n```\n\nNow, going upward, `compile-body` needs to take a binding list and pass it on to various functions:\n\n```lisp\n(defun compile-body (body cont bindings)\n \"Compile the body of a clause.\"\n (cond\n  ((null body)\n   '(funcall .cont))\n  (t (let* ((goal (first body))\n     (macro (prolog-compiler-macro (predicate goal)))\n     (macro-val (if macro\n        (funcall macro goal (rest body)\n          cont bindings))))\n   (if (and macro (not (eq macro-val :pass)))\n     macro-val\n     (compile-call\n      (make-predicate (predicate goal)\n         (relation-arity goal))\n      (mapcar #'(lambda (arg)\n        (compile-arg arg bindings))\n       (args goal))\n      (if (null (rest body))\n       cont\n        '#'(lambda ()\n         .(compile-body\n           (rest body) cont\n           (bind-new-variables bindings goal))))))))))\n```\n\nThe function `bind-new-variables` takes any variables mentioned in the goal that have not been bound yet and binds these variables to themselves.\nThis is because the goal, whatever it is, may bind its arguments.\n\n```lisp\n(defun bind-new-variables (bindings goal)\n \"Extend bindings to include any unbound variables in goal.\"\n (let ((variables (remove-if #'(lambda (v) (assoc v bindings))\n          (variables-in goal))))\n   (nconc (mapcar #'self-cons variables) bindings)))\n(defun self-cons (x) (cons x x))\n```\n\nOne of the functions that needs to be changed to accept a binding list is the compiler macro for =:\n\n```lisp\n(def-prolog-compi1er-macro = (goal body cont bindings)\n \"Compile a goal which is a call to =.\"\n (let ((args (args goal)))\n  (if (/= (length args) 2)\n    :pass ;; decline to handle this goal\n    (multiple-value-bind (code1 bindings1)\n      (compile-unify (first args) (second args) bindings)\n     (compile-if\n      code1\n      (compile-body body cont bindings1))))))\n```\n\nThe last step upward is to change `compile-clause` so that it starts everything off by passing in to `compile-body` a binding list with all the parameters bound to themselves:\n\n```lisp\n(defun compile-clause (parms clause cont)\n \"Transform away the head, and compile the resulting body.\"\n (bind-unbound-vars\n  parms\n  (compile-body\n    (nconc\n      (mapcar #'make-= parms (args (clause-head clause)))\n      (clause-body clause))\n    cont\n    (mapcar #'self-cons parms)))) ;***\n```\n\nFinally, we can see the fruits of our efforts:\n\n```lisp\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (IF (UNIFY! ?ARG2 (CONS ?ARG1 (?)))\n      (FUNCALL CONT))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?REST (?)))\n    (IF (UNIFY! ?ARG2 (CONS (?) ?REST))\n        (MEMBER/2 ?ARG1 ?REST CONT)))))\n (DEFUN LIKES/2 (?ARG1 ?ARG2 CONT)\n  (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n    (IF (UNIFY! ?ARG1 'ROBIN)\n        (IF (UNIFY! ?ARG2 'CATS)\n          (FUNCALL CONT)))\n    (UNDO-BINDINGS! OLD-TRAIL)\n    (IF (UNIFY! ?ARG1 'SANDY)\n      (LIKES/2 ?ARG2 'CATS CONT))\n    (UNDO-BINDINGS! OLD-TRAIL)\n    (IF (UNIFY! ?ARG1 'KIM)\n      (LIKES/2 ?ARG2 'LEE (LAMBDA ()\n            (LIKES/2 ?ARG2 'KIM CONT))))))\n```\n\n## 12.5 Further Improvements to Unification\n{:#s0030}\n{:.h1hd}\n\nCould `compile-unify` be improved yet again?\nIf we insist that it call `unify!,` it seems that it can't be made much better.\nHowever, we could improve it by in effect compiling `unify!.` This is a key idea in the Warren Abstract Machine, or WAM, which is the most commonly used model for Prolog compilers.\n\nWe call `unify!` in four cases (5, 6, 7, and 10), and in each case the first argument is a variable, and we know something about the second argument.\nBut the first thing `unify!` does is redundantly test if the first argument is a variable.\nWe could eliminate unnecessary tests by calling more specialized functions rather than the general-purpose function `unify!`.\nConsider this call:\n\n```lisp\n(unify! ?arg2 (cons ?arg1 (?)))\n```\n\nIf `?arg2` is an unbound variable, this code is appropriate.\nBut if `?arg2` is a constant atom, we should fail immediately, without allowing `cons` and `?` to generate garbage.\nWe could change the test to:\n\n```lisp\n(and (consp-or-variable-p ?arg2)\n  (unify-first! ?arg2 ?arg1)\n  (unify-rest! ?arg2 (?)))\n```\n\nwith suitable definitions for the functions referenced here.\nThis change should speed execution time and limit the amount of garbage generated.\nOf course, it makes the generated code longer, so that could slow things down if the program ends up spending too much time bringing the code to the processor.\n\n**Exercise 12.1 [h]** Write definitions for `consp-or-variable-p, unify-first!,` and `unify-rest!`, and change the compiler to generate code like that outlined previously.\nYou might want to look at the function `compile-rule` in [section 9.6](B9780080571157500091.xhtml#s0035), starting on [page 300](B9780080571157500091.xhtml#p300).\nThis function compiled a call to `pat-match` into individual tests; now we want to do the same thing to `unify!`.\nRun some benchmarks to compare the altered compiler to the original version.\n\n**Exercise 12.2 [h]** We can gain some more efficiency by keeping track of which variables have been dereferenced and calling an appropriate unification function: either one that dereferences the argument or one that assumes the argument has already been dereferenced.\nImplement this approach.\n\n**Exercise 12.3 [m]** What code is generated for `(= (f (g ?x) ?y) (f ?y (?p a)))?`What more efficient code represents the same unification?\nHow easy is it to change the compiler to get this more efficient result?\n\n**Exercise 12.4 [h]** In retrospect, it seems that binding variables to themselves, as in `(?argl . ?argl`), was not such a good idea.\nIt complicates the meaning of bindings, and prohibits us from using existing tools.\nFor example, I had to use `find-anywhere` instead of `occur-check` for case 11, because `occur-check` expects a noncircular binding list.\nBut find-anywhere does not do as complete a job as `occur-check`.\nWrite a version of `compile-unify` that returns three values: the code, a noncircular binding list, and a list of variables that are bound to unknown values.\n\n**Exercise 12.5 [h]** An alternative to the previous exercise is not to use binding lists at ail.\nInstead, we could pass in a list of equivalence classes-that is, a list of lists, where each sublist contains one or more elements that have been unified.\nIn this approach, the initial equivalence class list would be `((?arg1) (?arg2))`.\nAfter unifying `?arg1` with `?x`, `?arg2` with `?y`, and `?x` with 4, the list would be ( `(4 ?arg1 ?x) (?arg2 ?y))`.\nThis assumes the convention that the canonical member of an equivalence class (the one that will be substituted for all others) cornes first.\nImplement this approach.\nWhat advantages and disadvantages does it have?\n\n## 12.6 The User Interface to the Compiler\n{:#s0035}\n{:.h1hd}\n\nThe compiler can translate Prolog to Lisp, but that does us no good unless we can conveniently arrange to compile the right Prolog relations and call the right Lisp functions.\nIn other words, we have to integrate the compiler with the `<-` and `?` macros.\nSurprisingly, we don't need to change these macros at all.\nRather, we will change the functions these macros call.\nWhen a new clause is entered, we will enter the clause's predicate in the list `*uncompiled*`.\nThis is a one-line addition to `add-clause:`\n\n```lisp\n(defvar *uncompiled* nil\n      \"Prolog symbols that have not been compiled.\")\n(defun add-clause (clause)\n \"Add a clause to the data base, indexed by head's predicate.\"\n ;; The predicate must be a non-variable symbol.\n (let ((pred (predicate (clause-head clause))))\n   (assert (and (symbolp pred) (not (variable-p pred))))\n   (pushnew pred *db-predicates*)\n   (pushnew pred *uncompiled*)      ;***\n   (setf (get pred 'clauses)\n       (nconc (get-clauses pred) (list clause)))\n     pred))\n```\n\nNow when a query is made, the ?- macro expands into a call to `top-level-prove.` The list of goals in the query, along with the `show-prolog-vars` goal, is added as the sole clause for the relation `top-level-query.` Next, that query, along with any others that are on the uncompiled list, are compiled.\nFinally, the newly compiled top-level query function is called.\n\n```lisp\n(defun top-level-prove (goals)\n \"Prove the list of goals by compiling and calling it.\"\n ;; First redefine top-level-query\n (clear-predicate 'top-level-query)\n (let ((vars (delete '? (variables-in goals))))\n  (add-clause '((top-level-query)\n        ,@goals\n       (show-prolog-vars ,(mapcar #'symbol-name vars)\n          ,vars))))\n ;; Now run it\n (run-prolog 'top-level-query/0 #'ignore)\n (format t \"~&No.\")\n (values))\n(defun run-prolog (procedure cont)\n \"Run a 0-ary prolog procedure with a given continuation.\"\n ;; First compile anything else that needs it\n (prolog-compi1e-symbols)\n ;; Reset the trail and the new variable counter\n (setf (fill-pointer *trail*) 0)\n (setf *var-counter* 0)\n ;; Finally. call the query\n (catch 'top-level-prove\n   (funcall procedure cont)))\n(defun prolog-compile-symbols &optional (symbols *uncompiled*))\n \"Compile a list of Prolog symbols.\n By default. the list is all symbols that need it.\"\n (mapc #'prolog-compile symbols)\n (setf *uncompiled* (set-difference *uncompiled* symbols)))\n(defun ignore (&rest args)\n (declare (ignore args))\n nil)\n```\n\nNote that at the top level, we don't need the continuation to do anything.\nArbitrarily, we chose to pass in the function `ignore`, which is defined to ignore its arguments.\nThis function is useful in a variety of places; some programmers will proclaim it inline and then use a call to `ignore` in place of an ignore declaration:\n\n```lisp\n(defun third-arg (x y z)\n (ignore x y)\n z)\n```\n\nThe compiler's calling convention is different from the interpreter, so the primitives need to be redefined.\nThe old definition of the primitive `show-prolog-vars` had three parameters: the list of arguments to the goal, a binding list, and a list of pending goals.\nThe new definition of `show-prolog-vars/2` also has three parameters, but that is just a coincidence.\nThe first two parameters are the two separate arguments to the goal: a list of variable names and a list of variable values.\nThe last parameter is a continuation function.\nTo continue, we call that function, but to fail, we throw to the catch point set up in `top-level-prove`.\n\n```lisp\n(defun show-prolog-vars/2 (var-names vars cont)\n \"Display the variables, and prompt the user to see\n if we should continue. If not, return to the top level.\"\n (if (null vars)\n  (format t \"~&Yes\")\n  (loop for name in var-names\n    for var in vars do\n    (format t \"~&~a = \"a\" name (deref-exp var))))\n (if (continue-p)\n  (funcall cont)\n  (throw 'top-level-prove nil)))\n(defun deref-exp (exp)\n \"Build something equivalent to EXP with variables dereferenced.\"\n (if (atom (deref exp))\n  exp\n  (reuse-cons\n   (deref-exp (first exp))\n   (deref-exp (rest exp))\n   exp)))\n```\n\nWith these definitions in place, we can invoke the compiler automatically just by making a query with the ? - macro.\n\n**Exercise 12.6 [m]** Suppose you define a predicate `p`, which calls `q`, and then define `q`.\nIn some implementations of Lisp, when you make a query like `(?\n- (p ?x))`, you may get a warning message like `\"function q/1 undefined\"` before getting the correct answer.\nThe problem is that each function is compiled separately, so warnings detected during the compilation of `p/1` will be printed right away, even if the function `q/1` will be defined later.\nIn ANSI Common Lisp there is a way to delay the printing of warnings until a series of compilations are done: wrap the compilation with the macro `with-compi`l`ation-unit.` Even if your implementation does not provide this macro, it may provide the same functionality under a different name.\nFind out if `with-compilation-unit` is already defined in your implementation, or if it can be defined.\n\n## 12.7 Benchmarking the Compiler\n{:#s0040}\n{:.h1hd}\n\nOur compiled Prolog code runs the zebra puzzle in 17.4 seconds, a 16-fold speed-up over the interpreted version, for a rate of 740 LIPS.\n\nAnother popular benchmark is Lisp's reverse function, which we can code as the rev relation:\n\n```lisp\n(<- (rev () ()))\n(<- (rev (?x . ?a) ?b) (rev ?a ?c) (concat ?c (?x) ?b))\n(<- (concat () ?1 ?1)\n(<- (concat (?x . ?a) ?b (?x . ?c)) (concat ?a ?b ?c))\n```\n\nrev uses the relation concat, which stands for concatenation, (`concat ?a ?b ?c`)is true when `?a` concatenated to `?b` yields `?c`.\nThis relationlike name is preferred over more procedural names like append.\nBut `rev` is very similar to the following Lisp definitions:\n\n```lisp\n(defun rev (1)\n (if (null 1)\n  nil\n  (app (rev (rest 1 ))\n    (list (first 1)))))\n(defun app (x y)\n (if (null x)\n  y\n   (cons (first x)\n    (app (rest x) y))))\n```\n\nBoth versions are inefficient.\nIt is possible to write an iterative version of `reverse` that does no extra consing and is tail-recursive:\n\n```lisp\n(<- (irev ?l ?r) (irev3 ?l () ?r))\n(<- (irev3 (?x . ?l) ?so-far ?r) (irev3 ?l (?x . ?so-far) ?r))\n(<- (irev3 () ?r ?r))\n```\n\nThe Prolog `irev` is equivalent to this Lisp program:\n\n```lisp\n(defun irev (list) (irev2 list nil))\n(defun irev2 (list so-far)\n (if (consp list)\n   (irev2 (rest list) (cons (first list) so-far))\n   so-far))\n```\n\nThe following table shows times in seconds to execute these routines on lists of length 20 and 100, for both Prolog and Lisp, both interpreted and compiled.\n(Only compiled Lisp could execute rev on a 100-element list without running out of stack space.) Times for the zebra puzzle are also included, although there is no Lisp version of this program.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Problem | Interp. Prolog | Comp. Prolog | Speed-up | Interp. Lisp | Comp. Lisp |\n| `zebra` | 278.000 | 17.241 | 16 | - | - |\n| `rev 20` | 4.24 | .208 | 20 | .241 | .0023 |\n| `rev 100` | - | - | - | - | .0614 |\n| `irev 20` | .22 | .010 | 22 | .028 | .0005 |\n| `irev 100` | 9.81 | .054 | 181 | .139 | .0014 |\n\n![t0020](images/B9780080571157500121/t0020.png)\n\nThis benchmark is too small to be conclusive, but on these examples the Prolog compiler is 16 to 181 times faster than the Prolog interpreter, slightly faster than interpreted Lisp, but still 17 to 90 times slower than compiled Lisp.\nThis suggests that the Prolog interpreter cannot be used as a practical programming tool, but the Prolog compiler can.\n\nBefore moving on, it is interesting to note that Prolog provides for optional arguments automatically.\nAlthough there is no special syntax for optional arguments, an often-used convention is to have two versions of a relation, one with *n* arguments and one with *n -* 1.\nA single clause for the *n -* 1 case provides the missing, and therefore \"optional,\" argument.\nIn the following example, `irev/2` can be considered as a version of `irev/3` where the missing optional argument is ().\n\n```lisp\n(<- (irev ?l ?r) (irev ?l () ?r))\n(<- (irev (?x . ?l ) ?so-far ?r) (irev ?l (?x . ?so-far) ?r))\n(<- (irev () ?r ?r))\n```\n\nThis is roughly equivalent to the following Lisp verison:\n\n```lisp\n(defun irev (list &optional (so-far nil))\n (if (consp list)\n   (irev (rest list) (cons (first list) so-far))\n   so-far))\n```\n\n## 12.8 Adding More Primitives\n{:#s0045}\n{:.h1hd}\n\nJust as a Lisp compiler needs machine instructions to do input/output, arithmetic, and the like, so our Prolog system needs to be able to perform certain primitive actions.\nFor the Prolog interpreter, primitives were implemented by function symbols.\nWhen the interpreter went to fetch a list of clauses, if it got a function instead, it called that function, passing it the arguments to the current relation, the current bindings, and a list of unsatisfied goals.\nFor the Prolog compiler, primitives can be installed simply by writing a Lisp function that respects the convention of taking a continuation as the final argument and has a name of the form *symbol/arity.* For example, here's an easy way to handle input and output:\n\n```lisp\n(defun read/1 (exp cont)\n (if (unify! exp (read))\n   (funcall cont)))\n(defun write/1 (exp cont)\n (write (deref-exp exp) :pretty t)\n (funcall cont))\n```\n\nCalling `(write ?x)` will always succeed, so the continuation will always be called.\nSimilarly, one could use `(read ?x)` to read a value and unify it with `?x`.\nIf `?x` is unbound, this is the same as assigning the value.\nHowever, it is also possible to make a call like `(read (?x + ?y))`, which succeeds only if the input is a three-element list with + in the middle.\nIt is an easy extension to define `read/2` and `write/2` as relations that indicate what stream to use.\nTo make this useful, one would need to define `open/2` as a relation that takes a pathname as one argument and gives a stream back as the other.\nOther optional arguments could also be supported, if desired.\n\nThe primitive nl outputs a newline:\n\n```lisp\n(defun nl/0 (cont) (terpri) (funcall cont))\n```\n\nWe provided special support for the unification predicate, =.\nHowever, we could have simplified the compiler greatly by having a simple definition for `=/2`:\n\n```lisp\n(defun =/2 (?arg1 ?arg2 cont)\n (if (unify! ?arg1 ?arg2)\n  (funcall cont)))\n```\n\nIn fact, if we give our compiler the single clause:\n\n(<- (= ?x `?x))`\n\nit produces just this code for the definition of `=/ 2`.\nThere are other equality predicates to worry about.\nThe predicate `= =/2` is more like equal in Lisp.\nIt does no unification, but instead tests if two structures are equal with regard to their elements.\nA variable is considered equal only to itself.\nHere's an implementation:\n\n```lisp\n(defun =/2 (?arg1 ?arg2 cont)\n \"Are the two arguments EQUAL with no unification,\n but with dereferencing? If so, succeed.\"\n (if (deref-equal ?arg1 ?arg2)\n  (funcall cont)))\n(defun deref-equal (x y)\n \"Are the two arguments EQUAL with no unification,\n but with dereferencing?\"\n (or (eql (deref x) (deref y))\n  (and (consp x)\n   (consp y)\n   (deref-equal (first x) (first y))\n   (deref-equal (rest x) (rest y)))))\n```\n\nOne of the most important primitives is `call`.\nLike `funcall` in Lisp, `call` allows us to build up a goal and then try to prove it.\n\n```lisp\n(defun call/1 (goal cont)\n \"Try to prove goal by calling it.\"\n (deref goal)\n (apply (make-predicate (first goal)\n     (length (args goal)))\n   (append (args goal) (list cont))))\n```\n\nThis version of `call` will give a run-time error if the goal is not instantiated to a list whose first element is a properly defined predicate; one might want to check for that, and fail silently if there is no defined predicate.\nHere's an example of `call` where the goal is legal:\n\n```lisp\n> (?- (= ?p member) (call (?p ?x (a b c))))\n?P = MEMBER\n?X = A;\n?P = MEMBER\n?X = B;\n?P = MEMBER\n?X = C;\nNo.\n```\n\nNow that we have `call`, a lot of new things can be implemented.\nHere are the logical connectives and and or:\n\n```lisp\n(<- (or ?a ?b) (call ?a))\n(<- (or ?a ?b) (call ?b))\n(<- (and ?a ?b) (call ?a) (call ?b))\n```\n\nNote that these are only binary connectives, not the *n*-ary special forms used in Lisp.\nAlso, this definition negates most of the advantage of compilation.\nThe goals inside an and or or will be interpreted by `call`, rather than being compiled.\n\nWe can also define `not,` or at least the normal Prolog `not,` which is quite distinct from the logical `not.` In fact, in some dialects, `not` is written \\+, which is supposed to be ![u12-07-9780080571157](images/B9780080571157500121/u12-07-9780080571157.jpg) , that is, \"can not be derived.\" The interpretation is that if goal G can not be proved, then (`not G` ) is true.\nLogically, there is a difference between (`not G` ) being true and being unknown, but ignoring that difference makes Prolog a more practical programming language.\nSee [Lloyd 1987](B9780080571157500285.xhtml#bb0745) for more on the formal semantics of negation in Prolog.\n\nHere's an implementation of `not/1`.\nSince it has to manipulate the trail, and we may have other predicates that will want to do the same, we'll package up what was done in `maybe-add-undo-bindings` into the macro `with-undo-bindings:`\n\n```lisp\n(defmacro with-undo-bindings (&body body)\n \"Undo bindings after each expression in body except the last.\"\n (if (length=1 body)\n  (first body)\n  '(let ((old-trail (fill-pointer *trail*)))\n   ,(first body)\n    ,@(loop for exp in (rest body)\n        collect '(undo-bindings! old-trail)\n        collect exp))))\n(defun not/1 (relation cont)\n \"Negation by failure: If you can't prove G. then (not G) true.\"\n ;; Either way, undo the bindings.\n (with-undo-bindings\n  (call/1 relation #'(lambda () (return-from not/1 nil)))\n  (funcall cont)))\n```\n\nHere's an example where `not` works fine:\n\n```lisp\n> (?- (member ?x (a b c)) (not (= ?x b)))\n?X = A;\n?X = C;\nNo.\n```\n\nNow see what happens when we simply reverse the order of the two goals:\n\n```lisp\n> (?- (not (= ?x b)) (member ?x (a b c)))\nNo.\n```\n\nThe first example succeeds unless `?x` is bound to `b.` In the second example, `?x` is unbound at the start, so `(= ?x b )` succeeds, the not fails, and the `member` goal is never reached.\nSo our implementation of `not` has a consistent procedural interpretation, but it is not equivalent to the declarative interpretation usually given to logical negation.\nNormally, one would expect that `a` and `c` would be valid solutions to the query, regardless of the order of the goals.\n\nOne of the fundamental differences between Prolog and Lisp is that Prolog is relational: you can easily express individual relations.\nLisp, on the other hand, is good at expressing collections of things as lists.\nSo far we don't have any way of forming a collection of objects that satisfy a relation in Prolog.\nWe can easily iterate over the objects; we just can't gather them together.\nThe primitive `bagof` is one way of doing the collection.\nIn general, `(bagof ?x (p ?x) ?bag)` unifies `?bag` with a list of all `?x's` that satisfy `(p ?x)`.\nIf there are no such `?x's`, then the call to `bagof` fails.\nA *bag* is an unordered collection with duplicates allowed.\nFor example, the bag {*a*, *b, a*} is the same as the bag {*a*, *a*, *b*}, but different from {*a*, *b*}.\nBags stands in contrast to *sets,* which are unordered collections with no duplicates.\nThe set {*a*, *b*} is the same as the set {*b*, *a*}.\nHere is an implementation of `bagof:`\n\n```lisp\n(defun bagof/3 (exp goal resuit cont)\n \"Find all solutions to GOAL, and for each solution,\n collect the value of EXP into the list RESULT.\"\n ;; Ex: Assume (p 1) (p 2) (p 3). Then:\n ;: (bagof ?x (p ?x) ?1) => ?1 = (1 2 3)\n (let ((answers nil))\n (call/1 goal #'(lambda ()\n   (push (deref-copy exp) answers)))\n (if (and (not (null answers))\n  (unify! resuit (nreverse answers)))\n (funcall cont))))\n (defun deref-copy (exp)\n \"Copy the expression, replacing variables with new ones.\n The part without variables can be returned as is.\"\n (sublis (mapcar #'(lambda (var) (cons (deref var) (?))\n  (unique-find-anywhere-if #'var-p exp))\n exp))\n```\n\nBelow we use `bagof` to collect a list of everyone Sandy likes.\nNote that the result is a bag, not a set: Sandy appears more than once.\n\n```lisp\n> (?- (bagof ?who (likes Sandy ?who) ?bag))\n?WHO = SANDY\n?BAG = (LEE KIM ROBIN SANDY CATS SANDY);\nNo.\n```\n\nIn the next example, we form the bag of every list of length three that has `A` and `B` as members:\n\n```lisp\n> (?- (bagof ?l (and (length ?l (1 + (1 + (1 + 0))))\n   (and (member a ?l) (member b ?l)))\n  ?bag))\n?L = (?5 ?8 ?11 ?68 ?66)\n?BAG = ((A B ?17) (A ?21 B) (B A ?31) (?38 A B) (B ?48 A) (?52 B A))\nNo.\n```\n\nThose who are disappointed with a bag containing multiple versions of the same answer may prefer the primitive `setof`, which does the same computation as `bagof` but then discards the duplicates.\n\n```lisp\n(defun setof/3 (exp goal resuit cont)\n \"Find all unique solutions to GOAL, and for each solution,\n collect the value of EXP into the list RESULT.\"\n ;; Ex: Assume (p 1) (p 2) (p 3). Then:\n ;; (setof ?x (p ?x) ?l ) => ?l = (1 2 3)\n (let ((answers nil))\n (call/1 goal #'(lambda ()\n   (push (deref-copy exp) answers)))\n (if (and (not (null answers))\n  (unify! resuit (delete-duplicates\n    answers\n    :test #'deref-equal)))\n (funcall cont))))\n```\n\nProlog supports arithmetic with the operator `is`.\nFor example, `(is ?x (+ ?y 1))` unifies `?x` with the value of `?y` plus one.\nThis expression fails if `?y` is unbound, and it gives a run-time error if `?y` is not a number.\nFor our version of Prolog, we can support not just arithmetic but any Lisp expression:\n\n```lisp\n(defun is/2 (var exp cont)\n ;; Example: (is ?x (+ 3 (* ?y (+ ?z 4))))\n ;; Or even: (is (?x ?y ?x) (cons (first ?z) ?l))\n (if (and (not (find-if-anywhere #'unbound-var-p exp))\n  (unify! var (eval (deref-exp exp))))\n (funcall cont)))\n(defun unbound-var-p (exp)\n \"Is EXP an unbound var?\"\n (and (var-p exp) (not (bound-p exp))))\n```\n\nAs an aside, we might as well give the Prolog programmer access to the function `unbound-var-p`.\nThe standard name for this predicate is `var/1`:\n\n```lisp\n(defun var/1 (?arg1 cont)\n \"Succeeds if ?arg1 is an uninstantiated variable.\"\n (if (unbound-var-p ?arg1)\n (funcall cont)))\n```\n\nThe is primitive fails if any part of the second argument is unbound.\nHowever, there are expressions with variables that can be solved, although not with a direct call to `eval`.\nFor example, the following goal could be solved by binding `?x` to `2`:\n\n```lisp\n(solve (= 12 (* (+ ?x 1) 4)))\n```\n\nWe might want to have more direct access to Lisp from Prolog.\nThe problem with `is` is that it requires a check for unbound variables, and it calls `eval` to evaluate arguments recursively.\nIn some cases, we just want to get at Lisp's `apply`, without going through the safety net provided by is.\nThe primitive `lisp` does that.\nNeedless to say, `lisp` is not a part of standard Prolog.\n\n```lisp\n(defun lisp/2 (?result exp cont)\n \"Apply (first exp) to (rest exp), and return the result.\"\n (if (and (consp (deref exp))\n  (unify! ?result (apply (first exp) (rest exp))))\n (funcall cont)))\n```\n\n**Exercise 12.7 [m]** Define the primitive `solve/1`, which works like the function `solve` used in student ([page 225](B9780080571157500078.xhtml#p225)).\nDecide if it should take a single equation as argument or a list of equations.\n\n**Exercise 12.8 [h]** Assume we had a goal of the form `(solve (= 12 (* (+ ?x 1) 4)))`.\nRather than manipulate the equation when `solve/1` is called at run time, we might prefer to do part of the work at compile time, treating the call as if it were `(solve (= ?x 2))`.\nWrite a Prolog compiler macro for `solve`.\nNotice that even when you have defined a compiler macro, you still need the underlying primitive, because the predicate might be invoked through a `call/1`.\nThe same thing happens in Lisp: even when you supply a compiler macro, you still need the actual function, in case of a `funcall` or `apply`.\n\n**Exercise 12.9 [h]** Which of the predicates `call`, and, `or`, `not`, or `repeat` could benefit from compiler macros?\nWrite compiler macros for those predicates that could use one.\n\n**Exercise 12.10 [m]** You might have noticed that `call/1` is inefficient in two important ways.\nFirst, it calls `make-predicate`, which must build a symbol by appending strings and then look the string up in the Lisp symbol table.\nAlter `make-predicate` to store the predicate symbol the first time it is created, so it can do a faster lookup on subsequent calls.\nThe second inefficiency is the call to append.\nChange the whole compiler so that the continuation argument comes first, not last, thus eliminating the need for append in `call`.\n\n**Exercise 12.11 [s]** The primitive `true/0` always succeeds, and `fail/0` always fails.\nDefine these primitives.\nHint: the first corresponds to a Common Lisp function, and the second is a function already defined in this chapter.\n\n**Exercise 12.12 [s]** Would it be possible to write `= =/2` as a list of clauses rather than as a primitive?\n\n**Exercise 12.13 [m]** Write a version of `deref-copy` that traverses the argument expression only once.\n\n## 12.9 The Cut\n{:#s0050}\n{:.h1hd}\n\nIn Lisp, it is possible to write programs that backtrack explicitly, although it can be awkward when there are more than one or two backtrack points.\nIn Prolog, backtracking is automatic and implicit, but we don't yet know of any way to *avoid* backtracking.\nThere are two reasons why a Prolog programmer might want to disable backtracking.\nFirst, keeping track of the backtrack points takes up time and space.\nA programmer who knows that a certain problem has only one solution should be able to speed up the computation by telling the program not to consider the other possible branches.\nSecond, sometimes a simple logical specification of a problem will yield redundant solutions, or even some unintended solutions.\nIt may be that simply pruning the search space to eliminate some backtracking will yield only the desired answers, while restructuring the program to give all and only the right answers would be more difficult.\nHere's an example.\nSuppose we wanted to define a predicate, `max/3`, which holds when the third argument is the maximum of the first two arguments, where the first two arguments will always be instantiated to numbers.\nThe straightforward definition is:\n\n```lisp\n(<- (max ?x ?y ?x) (>= ?x ?y))\n(<- (max ?x ?y ?y) (< ?x ?y))\n```\n\nDeclaratively, this is correct, but procedurally it is a waste of time to compute the < relation if the >= has succeeded: in that case the < can never succeed.\nThe cut symbol, written !, can be used to stop the wasteful computation.\nWe could write:\n\n```lisp\n(<- (max ?x ?y ?x) (>= ?x ?y) !)\n(<- (max ?x ?y ?y))\n```\n\nThe cut in the first clause says that if the first clause succeeds, then no other clauses will be considered.\nSo now the second clause can not be interpreted on its own.\nRather, it is interpreted as \"if the first clause fails, then the `max` of two numbers is the second one.\"\n\nIn general, a cut can occur anywhere in the body of a clause, not just at the end.\nThere is no good declarative interpretation of a cut, but the procedural interpretation is two-fold.\nFirst, when a cut is \"executed\" as a goal, it always succeeds.\nBut in addition to succeeding, it sets up a fence that cannot be crossed by subsequent backtracking.\nThe cut serves to cut off backtracking both from goals to the right of the cut (in the same clause) and from clauses below the cut (in the same predicate).\nLet's look at a more abstract example:\n\n```lisp\n(<- (p) (q) (r) ! (s) (t))\n(<- (p) (s))\n```\n\nIn processing the first clause of `p`, backtracking can occur freely while attempting to solve `q` and `r`.\nOnce `r` is solved, the cut is encountered.\nFrom that point on, backtracking can occur freely while solving `s` and `t`, but Prolog will never backtrack past the cut into `r`, nor will the second clause be considered.\nOn the other hand, if `q` or `r` failed (before the cut is encountered), then Prolog would go on to the second clause.\n\nNow that the intent of the cut is clear, let's think of how it should be implemented.\nWe'll look at a slightly more complex predicate, one with variables and multiple cuts:\n\n```lisp\n(<- (p ?x a) ! (q ?x))\n(<- (p ?x b) (r ?x) ! (s ?x))\n```\n\nWe have to arrange it so that as soon as we backtrack into a cut, no more goals are considered.\nIn the first clause, when `q/1` fails, we want to return from `p/2` immediately, rather than considering the second clause.\nSimilarly, the first time `s/1` fails, we want to return from `p/2`, rather than going on to consider other solutions to `r/1`.\nThus, we want code that looks something like this:\n\n```lisp\n(defun p/2 (argl arg2 cont)\n (let ((old-trail (fill-pointer *trail*)))\n  (if (unify! arg2 'a)\n   (progn (q/1 argl cont)\n     (return-from p/2 nil)))\n  (undo-bindings! old-trail)\n  (if (unify! arg2 'b)\n   (r/1 argl #'(lambda ()\n       (progn (s/1 argl cont)\n        (return-from p/2 nil)))))))\n```\n\nWe can get this code by making a single change to `compile-body:` when the first goal in a body (or what remains of the body) is the cut symbol, then we should generate a `progn` that contains the code for the rest of the body, followed by a `return-from` the predicate being compiled.\nUnfortunately, the name of the predicate is not available to `compile-body.` We could change `compile-clause` and `compile-body` to take the predicate name as an extra argument, or we could bind the predicate as a special variable in `compile-predicate`.\nI choose the latter:\n\n```lisp\n(defvar *predicate* nil\n \"The Prolog predicate currently being compiled\")\n(defun compile-predicate (symbol arity clauses)\n \"Compile all the clauses for a given symbol/arity\n into a single LISP function.\"\n (let ((*predicate* (make-predicate symbol arity)) ;***\n   (parameters (make-parameters arity)))\n (compile\n  (eval\n   '(defun ,*predicate* (,@parameters cont) ;***\n    .,(maybe-add-undo-bindings\n     (mapcar #'(lambda (clause)\n        (compile-clause parameters\n          clause 'cont))\n       clauses)))))))\n(defun compile-body (body cont bindings)\n \"Compile the body of a clause.\"\n (cond\n ((null body)\n  '(funcall ,cont))\n ((eq (first body) '!) ;***\n  '(progn ,(compile-body (rest body) cont bindings) ;***\n    (return-from ,*predicate* nil))) ;***\n (t (let* ((goal (first body))\n    (macro (prolog-compiler-macro (predicate goal)))\n    (macro-val (if macro\n        (funcall macro goal (rest body)\n          contbindings))))\n   (if (and macro (not (eq macro-val :pass)))\n    macro-val\n    '(,(make-predicate (predicate goal)\n        (relation-arity goal))\n      ,@(mapcar #'(lambda (arg)\n       (compile-arg arg bindings))\n      (args goal))\n      , (if (null (rest body))\n      cont\n      '#'(lambda ()\n        ,(compile-body\n        (rest body) cont\n        (bind-new-variables bindings goal))))))))))\n```\n\n**Exercise 12.14 [m]** Given the definitions below, figure out what a call to `test-cut` will do, and what it will write:\n\n```lisp\n(<- (test-cut) (p a) (p b) ! (p c) (p d))\n(<- (test-cut) (p e))\n(<- (p ?x) (write (?x 1)))\n(<- (p ?x) (write (?x 2)))\n```\n\nAnother way to use the cut is in a *repeat/fail* loop.\nThe predicate repeat is defined with the following two clauses:\n\n```lisp\n(<- (repeat))\n(<- (repeat) (repeat))\n```\n\nAn alterna te definition as a primitive is:\n\n```lisp\n(defun repeat/0 (cont)\n (loop (funcall cont)))\n```\n\nUnfortunately, `repeat` is one of the most abused predicates.\nSeveral Prolog books present programs like this:\n\n```lisp\n(<- (main)\n (write \"Hello.\")\n (repeat)\n (write \"Command: \")\n (read ?command)\n (process ?command)\n (= ?command exit)\n (write \"Good bye.\"))\n```\n\nThe intent is that commands are read one at a time, and then processed.\nFor each command except `exit, process` takes the appropriate action and then fails.\nThis causes a backtrack to the repeat goal, and a new command is read and processed.\nWhen the command is `exit`, the procedure returns.\n\nThere are two reasons why this is a poor program.\nFirst, it violates the principle of referential transparency.\nThings that look alike are supposed to be alike, regardless of the context in which they are used.\nBut here there is no way to tell that four of the six goals in the body comprise a loop, and the other goals are outside the loop.\nSecond, it violates the principle of abstraction.\nA predicate should be understandable as a separate unit.\nBut here the predicate process can only be understood by considering the context in which it is called: a context that requires it to fail after processing each command.\nAs [Richard O'Keefe 1990](B9780080571157500285.xhtml#bb0925) points out, the correct way to write this clause is as follows:\n\n```lisp\n(<- (main)\n (write \"Hello.\")\n (repeat)\n   (write \"Command: \")\n   (read ?command)\n   (process ?command)\n   (or (= ?command exit) (fail))\n !\n (write \"Good bye.\"))\n```\n\nThe indentation clearly indicates the limits of the repeat loop.\nThe loop is terminated by an explicit test and is followed by a cut, so that a calling program won't accidently backtrack into the loop after it has exited.\nPersonally, I prefer a language like Lisp, where the parentheses make constructs like loops explicit and indentation can be done automatically.\nBut O'Keefe shows that well-structured readable programs can be written in Prolog.\n\nThe if-then and if-then-else constructions can easily be written as clauses.\nNote that the if-then-else uses a cut to commit to the `then` part if the test is satisfied.\n\n```lisp\n(<- (if ?test ?then) (if ?then ?else (fail)))\n(<- (if ?test ?then ?else)\n (call ?test)\n !\n (call ?then))\n(<- (if ?test ?then ?else)\n (call ?else))\n```\n\nThe cut can be used to implement the nonlogical `not`.\nThe following two clauses are often given before as the definition of `not`.\nOur compiler succesfully turns these two clauses into exactly the same code as was given before for the primitive `not/1`:\n\n```lisp\n(<- (not ?p) (call ?p) ! (fail))\n(<- (not ?p))\n```\n\n## 12.10 \"Real\" Prolog\n{:#s0055}\n{:.h1hd}\n\nThe Prolog-In-Lisp system developed in this chapter uses Lisp syntax because it is intended to be embedded in a Lisp system.\nOther Prolog implementations using Lisp syntax include micro-Prolog, Symbolics Prolog, and LMI Prolog.\n\nHowever, the majority of Prolog systems use a syntax closer to traditional mathematical notation.\nThe following table compares the syntax of \"standard\" Prolog to the syntax of Prolog-In-Lisp.\nWhile there is currently an international committee working on standardizing Prolog, the final report has not yet been released, so different dialects may have slightly different syntax.\nHowever, most implementations follow the notation summarized here.\nThey derive from the Prolog developed at the University of Edinburgh for the DEC-10 by David H.\nD.\nWarren and his colleagues.\nThe names for the primitives in the last section are also taken from Edinburgh Prolog.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | Prolog | Prolog-In-Lisp |\n| atom | `lower` | `const` |\n| variable | `Upper` | `?var` |\n| anonymous | `-` | `?` |\n| goal | `p(Var,const)` | `(p ?var const)` |\n| rule | `p(X) :- q(X).` | `(<- (p ?x) (q ?x))` |\n| fact | `p(a).` | `(<- (p a))` |\n| query | `?- p(X).` | `(?- (p ?x))` |\n| list | `[a,b,c]` | `(a b c)` |\n| cons | `[a| Rest]` | `(a . ?rest)` |\n| nil | `[]` | `()` |\n| and | `p(X). q(X)` | `(and (p ?x) (q ?x)>` |\n| or | `P(X): q(X)` | `(or (p ?x) (q ?x))` |\n| not | `\\+ p(X)` | `(not (p ?x))` |\n\nWe have adopted Lisp's bias toward lists; terms are built out of atoms, variables, and conses of other terms.\nIn real Prolog cons cells are provided, but terms are usually built out of *structures*, not lists.\nThe Prolog term `p(a,b)` corresponds to the Lisp vector `#(p/2 a b)`, not the list `(p a b)`.\nA minority of Prolog implementations use *structure sharing.* In this approach, every non-atomic term is represented by a skeleton that contains place holders for variables and a header that points to the skeleton and also contains the variables that will fill the place holders.\nWith structure sharing, making a copy is easy: just copy the header, regardless of the size of the skeleton.\nHowever, manipulating terms is complicated by the need to keep track of both skeleton and header.\nSee [Boyer and Moore 1972](B9780080571157500285.xhtml#bb0110) for more on structure sharing.\n\nAnother major difference is that real Prolog uses the equivalent of failure continuations, not success continuations.\nNo actual continuation, in the sense of a closure, is built.\nInstead, when a choice is made, the address of the code for the next choice is pushed on a stack.\nUpon failure, the next choice is popped off the stack.\nThis is reminiscent of the backtracking approach using Scheme's `call/cc` facility outlined on [page 772](B9780080571157500224.xhtml#p772).\n\n**Exercise 12.15 [m]** Assuming an approach using a stack of failure continuations instead of success continuations, show what the code for `p` and `member` would look like.\nNote that you need not pass failure continuations around; you can just push them onto a stack that `top-level-prove` will invoke.\nHow would the cut be implemented?\nDid we make the right choice in implementing our compiler with success continuations, or would failure continuations have been better?\n\n## 12.11 History and References\n{:#s0060}\n{:.h1hd}\n\nAs described in [chapter 11](B978008057115750011X.xhtml), the idea of logic programming was fairly well understood by the mid-1970s.\nBut because the implementations of that time were slow, logic programming did not catch on.\nIt was the Prolog compiler for the DEC-10 that made logic programming a serious alternative to Lisp and other general-purpose languages.\nThe compiler was developed in 1977 by David H.\nD.\nWarren with Fernando Pereira and Luis Pereira.\nSee the paper by [Warren (1979)](B9780080571157500285.xhtml#bb1325) and by all three (1977).\n\nUnfortunately, David H.\nD.\nWarren's pioneering work on compiling Prolog has never been published in a widely accessible form.\nHis main contribution was the description of the Warren Abstract Machine (WAM), an instruction set for compiled Prolog.\nMost existing compilers use this instruction set, or a slight modification of it.\nThis can be done either through byte-code interpretation or through macroexpansion to native machine instructions.\n[A&iuml;t-Kaci 1991](B9780080571157500285.xhtml#bb0020) provides a good tutorial on the WAM, much less terse than the original ([Warren 1983](B9780080571157500285.xhtml#bb1330)).\nThe compiler presented in this chapter does not use the WAM.\nInstead, it is modeled after Mark [Stickel's (1988)](B9780080571157500285.xhtml#bb1200) theorem prover.\nA similar compiler is briefly sketched by Jacques [Cohen 1985](B9780080571157500285.xhtml#bb0225).\n\n## 12.12 Exercises\n{:#s0065}\n{:.h1hd}\n\n**Exercise 12.16 [m]** Change the Prolog compiler to allow implicit `calls`.\nThat is, if a goal is not a cons cell headed by a predicate, compile it as if it were a `call`.\nThe clause:\n\n```lisp\n(<- (p ?x ?y) (?x c) ?y)\n```\n\nshould be compiled as if it were:\n\n```lisp\n(<- (p ?x ?y) (call (?x c)) (call ?y))\n```\n\n**Exercise 12.17 [h]** Here are some standard Prolog primitives:\n\n*  `get/1` Read a single character and unify it with the argument.\n\n*  `put/1` Print a single character.\n\n*  `nonvar/1, /=, /==` The opposites of `var, = and = =` , respectively.\n\n*  `integer/1` True if the argument is an integer.\n\n*  `atom/1` True if the argument is a symbol (like Lisp's `symbol p`).\n\n*  `atomic/1` True if the argument is a number or symbol (like Lisp's `atom`).\n\n*  <,>,=<,>= Arithmetic comparison; succeeds when the arguments are both instantiated to numbers and the comparison is true.\n\n*  `listing/0` Print out the clauses for all defined predicates.\n\n*  `listing/1` Print out the clauses for the argument predicate.\n\nImplement these predicates.\nIn each case, decide if the predicate should be implemented as a primitive or a list of clauses, and if it should have a compiler macro.\n\nThere are some naming conflicts that need to be resolved.\nTerms like `atom` have one meaning in Prolog and another in Lisp.\nAlso, in Prolog the normal notation is \\= and \\==, not /= and /==.\nFor Prolog-In-Lisp, you need to decide which notations to use: Prolog's or Lisp's.\n\n**Exercise 12.18 [s]** In Lisp, we are used to writing n-ary calls like `(< 1 n 10 ) or (= x y z )`.\nWrite compiler macros that expand n-ary calls into a series of binary calls.\nFor example, `(< 1 n 10)` should expand into `(and (< 1 n) (< n 10))`.\n\n**Exercise 12.19 [m]** One feature of Lisp that is absent in Prolog is the `quote` mechanism.\nIs there a use for `quote?` If so, implement it; if not, explain why it is not needed.\n\n**Exercise 12.20 [h]** Write a tracing mechanism for Prolog.\nAdd procedures `p-trace` and `p-untrace` to trace and untrace Prolog predicates.\nAdd code to the compiler to generate calls to a printing procedure for goals that are traced.\nIn Lisp, we have to trace procedures when they are called and when they return.\nIn Prolog, there are four cases to consider: the call, successful completion, backtrack into subsequent clauses, and failure with no more clauses.\nWe will call these four `cases call`, `exit`, `redo,` and `fail`, respectively.\nIf we traced `member,` we would expect tracing output to look something like this:\n\n```lisp\n> (?- (member ?x (a b c d)) (fail))\n CALL MEMBER: ?1 (A B C D)\n EXIT MEMBER: A (A B C D)\n REDO MEMBER: ?1 (A B C D)\n  CALL MEMBER: ?1 (B C D)\n  EXIT MEMBER: B (B C D)\n  REDO MEMBER: ?1 (B C D)\n   CALL MEMBER: ?1 (C D)\n   EXIT MEMBER: C (C D)\n   REDO MEMBER: ?1 (C D)\n    CALL MEMBER: ?1 (D)\n    EXIT MEMBER: D (D)\n    REDO MEMBER: ?1 (D)\n     CALL MEMBER: ?1 NIL\n     REDO MEMBER: ?1 NIL\n     FAIL MEMBER: ?1 NIL\n    FAIL MEMBER: ?1 (D)\n   FAIL MEMBER: ?1 (C D)\n  FAIL MEMBER: ?1 (B C D)\n FAIL MEMBER: ?1 (A B C D)\nNo.\n```\n\n**Exercise 12.21 [m]** Some Lisp systems are very slow at compiling functions.\n`KCL` is an example; it compiles by translating to `C` and then calling the `C` compiler and assembler.\nIn `KCL` it is best to compile only code that is completely debugged, and run interpreted while developing a program.\n\nAlter the Prolog compiler so that calling the Lisp compiler is optional.\nIn all cases, Prolog functions are translated into Lisp, but they are only compiled to machine language when a variable is set.\n\n**Exercise 12.22 [d]** Some Prolog systems provide the predicate `freeze` to \"freeze\" a goal until its variables are instantiated.\nFor example, the goal `(freeze x (> x 0))` is interpreted as follows: if `x` is instantiated, then just evaluate the goal `(> x 0)`, and succeed or fail depending on the result.\nHowever, if `x` is unbound, then succeed and continue the computation, but remember the goal `(> x 0)` and evaluate it as soon as `x` becomes instantiated.\nImplement freeze.\n\n**Exercise 12.23 [m]** Write a recursive version of `anonymous-variables-in` that does not use a local function.\n\n## 12.13 Answers\n{:#s0070}\n{:.h1hd}\n\n**Answer 12.6** Here's a version that works for Texas Instruments and Lucid implementations:\n\n```lisp\n(defmacro with-compilation-unit (options &body body)\n \"Do the body, but delay compiler warnings until the end.\"\n ;; This is defined in Common Lisp the Language, 2nd ed.\n '(,(read-time-case\n  #+TI 'compi1er:compi1er-warnings-context-bind\n  #+Lucid 'with-deferred-warnings\n    'progn)\n  .,body))\n(defun prolog-compile-symbols (&optional (symbols *uncompiled*))\n \"Compile a list of Prolog symbols.\n By default, the list is all symbols that need it.\"\n (with-compilation-unit ()\n (mapc #'prolog-compile symbols)\n (setf *uncompiled* (set-difference *uncompiled* symbols))))\n```\n\n**Answer 12.9** Macros for `and` and `or` are very important, since these are commonly used.\nThe macro for `and` is trivial:\n\n```lisp\n(def-prolog-compiler-macro and (goal body cont bindings)\n (compile-body (append (args goal) body) cont bindings))\n```\n\nThe macro for or is trickier:\n\n```lisp\n(def-prolog-compiler-macro or (goal body cont bindings)\n (let ((disjuncts (args goal)))\n  (case (length disjuncts)\n   (0 fail)\n   (1 (compile-body (cons (first disjuncts) body) cont bindings))\n   (t (let ((fn (gensym \"F\")))\n    '(fl&egrave;t ((,fn () ,(compile-body body cont bindings)))\n     .,(maybe-add-undo-bindings\n      (loop for g in disjuncts collect\n       (compile-body (list g) '#',fn\n        bindings)))))))))\n```\n\n**Answer 12.11**`true/0` is `funcall` : when a goal succeeds, we call the continuation, `fail/0` is `ignore`: when a goal fails, we ignore the continuation.\nWe could also define compiler macros for these primitives:\n\n```lisp\n(def-prolog-compiler-macro true (goal body cont bindings)\n (compile-body body cont bindings))\n(def-prolog-compiler-macro fail (goal body cont bindings)\n (declare (ignore goal body cont bindings))\n nil)\n```\n\n**Answer 12.13**\n\n```lisp\n(defun deref-copy (exp)\n \"Build a copy of the expression, which may have variables.\n The part without variables can be returned as is.\"\n (let ((var-alist nil ))\n  (labels\n   ((walk (exp)\n    (deref exp)\n    (cond ((consp exp)\n     (reuse-cons (walk (first exp))\n       (walk (rest exp))\n       exp))\n     ((var-p exp)\n     (let ((entry (assoc exp var-alist)))\n      (if (not (null entry))\n      (cdr entry)\n      (let ((var-copy (?)))\n        (push (cons exp var-copy) var-alist)\n        var-copy))))\n     (t exp))))\n  (walk exp))))\n```\n\n**Answer 12.14** In the first clause of `test-cut`, all four calls to `p` will succeed via the first clause of `p`.\nThen backtracking will occur over the calls to `(p c)` and `(p d)`.\nAll four combinations of `1` and `2` succeed.\nAfter that, backtracking would normally go back to the call to `(p b)`.\nBut the cut prevents this, and the whole `(test-cut)` goal fails, without ever considering the second clause.\nHere's the actual output:\n\n```lisp\n(?- (test-cut))\n(A 1)(B 1)(C 1) (D 1)\nYes;\n(D 2)\nYes;\n(C 2)(D 1)\nYes;\n(D 2)\nYes;\nNo.\n```\n\n**Answer 12.17** For example:\n\n```lisp\n(defun >/2 (x y cont)\n (if (and (numberp (deref x)) (numberp (deref y)) (> x y))\n  (funcall cont)))\n(defun numberp/1 (x cont)\n (if (numberp (deref x))\n  (funcall cont)))\n```\n\n**Answer 12.19** Lisp uses quote in two ways: to distinguish a symbol from the value of the variable represented by that symbol, and to distinguish a literal list from the value that would be returned by evaluating a function call.\nThe first distinction Prolog makes by a lexical convention: variables begin with a question mark in our Prolog, and they are capitalized in real Prolog.\nThe second distinction is not necessary because Prolog is relational rather than functional.\nAn expression is a goal if it is a member of the body of a clause, and is a literal if it is an argument to a goal.\n\n**Answer 12.20** Hint: Here's how `member` could be augmented with calls to a procedure, `prolog-trace`, which will print information about the four kinds of tracing events:\n\n```lisp\n(defun member/2 (?arg1 ?arg2 cont)\n (let ((old-trail (fill-pointer *tra1l*))\n   (exit-cont #'(lambda ()\n     (prolog-trace 'exit 'member ?arg1 ?arg2 )\n     (funcall cont))))\n  (prolog-trace 'call 'member ?arg1 ?arg2)\n  (if (unify! ?arg2 (cons ?arg1 (?)))\n   (funcall exit-cont))\n  (undo-bindings! old-trail)\n  (prolog-trace 'redo 'member ?arg1 ?arg2)\n  (let ((?rest (?)))\n   (if (unify! ?arg2 (cons (?) ?rest))\n   (member/2 ?arg1 ?rest exit-cont)))\n  (prolog-trace 'fail 'member ?arg1 ?arg2)))\n```\n\nThe definition of `prolog-trace` is:\n\n```lisp\n(defvar *prolog-trace-indent* 0)\n(defun prolog-trace (kind predicate &rest args)\n (if (member kind '(call redo))\n (incf *prolog-trace-indent* 3))\n (format t \"~&~VT~a ~ a:~{ ~ a ~}\"\n   *prolog-trace-indent* kind predicate args)\n (if (member kind '(fail exit))\n (decf *prolog-trace-indent* 3)))\n```\n\n**Answer 12.23**\n\n```lisp\n(defun anonymous-variables-in (tree)\n \"Return a list of all variables that occur only once in tree.\"\n (values (anon-vars-in tree nil nil)))\n(defun anon-vars-in (tree seen-once seen-more)\n \"Walk the data structure TREE, returning a list of variables\n seen once, and a list of variables seen more than once.\"\n (cond\n  ((consp tree)\n  (multiple-value-bind (new-seen-once new-seen-more)\n   (anon-vars-in (first tree) seen-once seen-more)\n   (anon-vars-in (rest tree) new-seen-once new-seen-more)))\n  ((not (variable-p tree)) (values seen-once seen-more))\n  ((member tree seen-once)\n  (values (delete tree seen-once) (cons tree seen-more)))\n  ((member tree seen-more)\n  (values seen-once seen-more))\n  (t (values (cons tree seen-once) seen-more))))\n```\n\n# Chapter 13\n## Object-Oriented Programming\n{:.chaptitle}\n\nThe programs in this book cover a wide range of problems.\nIt is only natural that a wide range of programming styles have been introduced to attack these problems.\nOne style not yet covered that has gained popularity in recent years is called *object-oriented programming*.\nTo understand what object-oriented programming entails, we need to place it in the context of other styles.\n\nHistorically, the first computer programs were written in an *imperative programming* style.\nA program was construed as a series of instructions, where each instruction performs some action: changing the value of a memory location, printing a result, and so forth.\nAssembly language is an example of an imperative language.\n\nAs experience (and ambition) grew, programmers looked for ways of controlling the complexity of programs.\nThe invention of subroutines marked the *algorithmic* or *procedural programming* style, a subclass of the imperative style.\nSubroutines are helpful for two reasons: breaking up the problem into small pieces makes each piece easier to understand, and it also makes it possible to reuse pieces.\nExamples of procedural languages are FORTRAN, C, Pascal, and Lisp with `setf`.\n\nSubroutines are still dependent on global state, so they are not completely separate pieces.\nThe use of a large number of global variables has been criticized as a factor that makes it difficult to develop and maintain large programs.\nTo eliminate this problem, the *functional programming* style insists that functions access only the parameters that are passed to them, and always return the same result for the same inputs.\nFunctional programs have the advantage of being mathematically clean-it is easy to prove properties about them.\nHowever, some applications are more naturally seen as taking action rather than calculating functional values, and are therefore unnatural to program in a functional style.\nExamples of functional languages are FP and Lisp without `setf`.\n\nIn contrast to imperative languages are *declarative* languages, which attempt to express \"what to do\" rather than \"how to do it.\" One type of declarative programming is *rule-based* programming, where a set of rules states how to transform a problem into a solution.\nExamples of rule-based systems are ELIZA !!!(span) {:.smallcaps} and STUDENT !!!(span) {:.smallcaps} .\n\nAn important kind of declarative programming is *logic programming*, where axioms are used to describe constraints, and computation is done by a constructive proof of a goal.\nAn example of logic language is Prolog.\n\n*Object-oriented programming* is another way to tame the problem of global state.\nInstead of prohibiting global state (as functional programming does), object-oriented programming breaks up the unruly mass of global state and encapsulates it into small, manageable pieces, or objects.\nThis chapter covers the object-oriented approach.\n\n## 13.1 Object-Oriented Programming\n{:#s0010}\n{:.h1hd}\n\nObject-oriented programming turns the world of Computing on its side: instead of viewing a program primarily as a set of actions which manipulate objects, it is viewed as a set of objects that are manipulated by actions.\nThe state of each object and the actions that manipulate that state are defined once and for all when the object is created.\nThis can lead to modular, robust systems that are easy to use and extend.\nIt also can make systems correspond more closely to the \"real world,\" which we humans perceive more easily as being made up of objects rather than actions.\nExamples of object-oriented languages are Simula, C++, and CLOS, the Common Lisp Object System.\nThis chapter will first introduce object-oriented programming in general, and then concentrate on the Common Lisp Object System.\n\nMany people are promoting object-oriented programming as the solution to the software development problem, but it is hard to get people to agree on just what object-orientation means.\n[Peter Wegner 1987](B9780080571157500285.xhtml#bb1355) proposes the following formula as a definition:\n\n*Object-orientation = Objects + Classes + Inheritance*\n\nBriefly, *objects* are modules that encapsulate some data and operations on that data.\nThe idea of *information hiding*-insulating the representation of that data from operations outside of the object-is an important part of this concept.\n*Classes* are groups of similar objects with identical behavior.\nObjects are said to be instances of classes.\n*Inheritance* is a means of defining new classes as variants of existing classes.\nThe new class inherits the behavior of the parent class, and the programmer need only specify how the new class is different.\n\nThe object-oriented style brings with it a new vocabulary, which is summarized in the following glossary.\nEach term will be explained in more detail when it comes up.\n\n*class:* A group of similar objects with identical behavior.\n\n*class variable:* A variable shared by all members of a class.\n\n*delegation:* Passing a message from an object to one of its components.\n\n*generic function:* A function that accepts different types or classes of arguments.\n\n*inheritance:* A means of defining new classes as variants of existing classes.\n\n*instance:* An instance of a class is an object.\n\n*instance variable:* A variable encapsulated within an object.\n\n*message:* A name for an action.\nEquivalent to generic function.\n\n*method:* A means of handling a message for a particular class.\n\n*multimethod:* A method that depends on more than one argument.\n\n*multiple inheritance:* Inheritance from more than one parent class.\n\n*object:* An encapsulation of local state and behavior.\n\n## 13.2 Objects\n{:#s0015}\n{:.h1hd}\n\nObject-oriented programming, by definition, is concerned with *objects*.\nAny datum that can be stored in computer memory can be thought of as an object.\nThus, the number 3, the atom `x`, and the string `\"hello\"` are all objects.\nUsually, however, the term *object* is used to denote a more complex object, as we shall see.\n\nOf course, all programming is concerned with objects, and with procedures operating on those objects.\nWriting a program to solve a particular problem will necessarily involve writing definitions for both objects and procedures.\nWhat distinguishes object-oriented programming is that the primary way of decomposing the problem into modules is based on the objects rather than on the procedures.\nThe difference can best be seen with an example.\nHere is a simple program to create bank accounts and keep track of withdrawals, deposits, and accumulation of interest.\nFirst, the program is written in traditional procedural style:\n\n```lisp\n(defstruct account\n (name \"\") (balance 0.00) (interest-rate .06))\n(defun account-withdraw (account amt)\n \"Make a withdrawal from this account.\"\n (if (<= amt (account-balance account))\n    (decf (account-balance account) amt)\n    'insufficient-funds))\n(defun account-deposit (account amt)\n \"Make a deposit to this account.\"\n (incf (account-balance account) amt))\n(defun account-interest (account)\n \"Accumulate interest in this account.\"\n (incf (account-balance account)\n    (* (account-interest-rate account)\n (account-balance account))))\n```\n\nWe can create new bank accounts with `make-account` and modify them with `account-withdraw, account-deposit,` and `account-interest.` This is a simple problem, and this simple solution suffices.\nProblems appear when we change the specification of the problem, or when we envision ways that this implementation could be inadvertently used in error.\nFor example, suppose a programmer looks at the `account` structure and decides to use `(decf (account-balance account)`) directly instead of going through the `account-withdraw` function.\nThis could lead to negative account balances, which were not intended.\nOr suppose that we want to create a new kind of account, where only a certain maximum amount can be withdrawn at one time.\nThere would be no way to ensure that `account-withdraw` would not be applied to this new, limited account.\n\nThe problem is that once we have created an account, we have no control over what actions are applied to it.\nThe object-oriented style is designed to provide that control.\nHere is the same program written in object-oriented style (using plain Lisp):\n\n```lisp\n(defun new-account (name &optional (balance 0.00)\n             (interest-rate .06))\n \"Create a new account that knows the following messages:\"\n #'(lambda (message)\n   (case message\n    (withdraw #'(lambda (amt)\n              (if (<= amt balance)\n                (decf balance amt)\n                'insufficient-funds)))\n    (deposit #'(lambda (amt) (incf balance amt)))\n    (balance #'(lambda () balance))\n    (name #'(lambda () name))\n    (interest #'(lambda ()\n              (incf balance\n                (* interest-rate balance)))))))\n```\n\nThe function `new-account` creates account objects, which are implemented as closures that encapsulate three variables: the name, balance, and interest rate of the account.\nAn account object also encapsulates functions to handle the five messages to which the object can respond.\nAn account object can do only one thing: receive a message and return the appropriate function to execute that message.\nFor example, if you pass the message `withdraw` to an account object, it will return a function that, when applied to a single argument (the amount to withdraw), will perform the withdrawal action.\nThis function is called the *method* that implements the message.\nThe advantage of this approach is that account objects are completely encapsulated; the information corresponding to the name, balance, and interest rate is only accessible through the five messages.\nWe have a guarantee that no other code can manipulate the information in the account in any other way.[1](#fn0015)\n\nThe function `get-method` finds the method that implements a message for a given object.\nThe function send gets the method and applies it to a list of arguments.\nThe name send cornes from the Flavors object-oriented system, which is discussed in the history section ([page 456](#p456)).\n\n```lisp\n(defun get-method (object message)\n \"Return the method that implements message for this object.\"\n (funcall object message))\n(defun send (object message &rest args)\n \"Get the function to implement the message,\n and apply the function to the args.\"\n (apply (get-method object message) args))\n```\n\nHere is an example of the use of `new-account` and `send`:\n\n`> (setf acct (new-account \"J.\nRandom Customer\" 1000.00))`=>\n\n```lisp\n#<CL0SURE 23652465>\n> (send acct 'withdraw 500.00) => 500.0\n> (send acct 'deposit 123.45) => 623.45\n> (send acct 'name) => \"J. Random Customer\"\n> (send acct 'balance) => 623.45\n```\n\n## 13.3 Generic Functions\n{:#s0020}\n{:.h1hd}\n\nThe send syntax is awkward, as it is different from the normal Lisp function-calling syntax, and it doesn't fit in with the other Lisp tools.\nFor example, we might like to say (`mapcar 'ba1ance accounts`), but with messages we would have to write that as:\n\n```lisp\n(mapcar #'(lambda (acct) (send acct 'balance)) accounts)\n```\n\nWe can fix this problem by defining *generic* functions that find the right method to execute a message.\nFor example, we could define:\n\n```lisp\n(defun withdraw (object &rest args)\n \"Define withdraw as a generic function on objects.\"\n (apply (get-method object 'withdraw) args))\n```\n\nand then write `(withdraw acct x)` instead of `(send acct 'withdraw x)`.\nThe function `withdraw` is generic because it not only works on account objects but also works on any other class of object that handles the `withdraw` message.\nFor example, we might have a totally unrelated class, `army,` which also implements a `withdraw` method.\nThen we could say `(send 5th-army 'withdraw)` or `(withdraw 5th-army)` and have the correct method executed.\nSo object-oriented programming eliminates many problems with name clashes that arise in conventional programs.\n\nMany of the built-in Common Lisp functions can be considered generic functions, in that they operate on different types of data.\nFor example, `sqrt` does one thing when passed an integer and quite another when passed an imaginary number.\nThe sequence functions (like `find` or `delete`) operate on lists, vectors, or strings.\nThese functions are not implemented like `withdraw,` but they still act like generic functions.[2](#fn0020)\n\n## 13.4 Classes\n{:#s0025}\n{:.h1hd}\n\nIt is possible to write macros to make the object-oriented style easier to read and write.\nThe macro `define-class` defines a class with its associated message-handling methods.\nIt also defines a generic function for each message.\nFinally, it allows the programmer to make a distinction between variables that are associated with each object and those that are associated with a class and are shared by all member s of the class.\nFor example, you might want to have all instances of the class `account` share the same interest rate, but you wouldn't want them to share the same balance.\n\n```lisp\n(defmacro define-class (class inst-vars class-vars &body methods)\n \"Define a class for object-oriented programming.\"\n ;; Define constructor and generic functions for methods\n '(let ,class-vars\n    (mapcar #'ensure-generic-fn ',(mapcar #'first methods))\n    (defun .class ,inst-vars\n #'(lambda (message)\n        (case message\n          ,@(mapcar #'make-clause methods))))))\n(defun make-clause (clause)\n \"Translate a message from define-class into a case clause.\"\n '(,(first clause) #'(lambda ,(second clause) .,(rest2 clause))))\n(defun ensure-generic-fn (message)\n \"Define an object-oriented dispatch function for a message,\n unless it has already been defined as one.\"\n (unless (generic-fn-p message)\n   (let ((fn #'(lambda (object &rest args)\n          (apply (get-method object message) args))))\n    (setf (symbol-function message) fn)\n    (setf (get message 'generic-fn) fn))))\n(defun generic-fn-p (fn-name)\n \"Is this a generic function?\"\n (and (fboundp fn-name)\n    (eq (get fn-name 'generic-fn) (symbol-function fn-name))))\n```\n\nNow we define the class account with this macro.\nWe make `interest-rate` a class variable, one that is shared by all accounts:\n\n```lisp\n(define-class account (name &optional (balance 0.00))\n        ((interest-rate .06))\n (withdraw (amt) (if (<= amt balance)\n            (decf balance amt)\n            'insufficient-funds))\n (deposit (amt) (incf balance amt))\n (balance () balance)\n (name () name)\n (interest () (incf balance (* interest-rate balance))))\n```\n\nHere we use the generic functions defined by this macro:\n\n```lisp\n> (setf acct2 (account \"A. User\" 2000.00)) => #<CL0SURE 24003064>\n> (deposit acct2 42.00) => 2042.0\n> (interest acct2) => 2164.52\n> (balance acct2) => 2164.52\n> (balance acct) => 623.45\n```\n\nIn this last line, the generic function `balance` is applied to `acct,` an object that was created before we even defined the account class and the function `balance.` But `balance` still works properly on this object, because it obeys the message-passing protocol.\n\n## 13.5 Delegation\n{:#s0030}\n{:.h1hd}\n\nSuppose we want to create a new kind of account, one that requires a password for each action.\nWe can define a new class, `password-account,` that has two message clauses.\nThe first clause allows for changing the password (if you have the original password), and the second is an `otherwise` clause, which checks the password given and, if it is correct, passes the rest of the arguments on to the account that is being protected by the password.\n\nThe definition of `password-account` takes advantage of the internal details of `define-class` in two ways: it makes use of the fact that `otherwise` can be used as a catch-all clause in a `case` form, and it makes use of the fact that the dispatch variable is called `message.` Usually, it is not a good idea to rely on details about the implementation of a macro, and soon we will see cleaner ways of defining classes.\nBut for now, this simple approach works:\n\n```lisp\n(define-class password-account (password acct) ()\n (change-password (pass new-pass)\n       (if (equal pass password)\n        (setf password new-pass)\n        'wrong-password))\n (otherwise (pass &rest args)\n       (if (equal pass password)\n        (apply message acct args)\n        'wrong-password)))\n```\n\nNow we see how the class `password-account` can be used to provide protection for an existing account:\n\n```lisp\n(setf acct3 (password-account \"secret\" acct2)) => #<CL0SURE 33427277>\n> (balance acct3 \"secret\") => 2164.52\n> (withdraw acct3 \"guess\" 2000.00) => WRONG-PASSWORD\n> (withdraw acct3 \"secret\" 2000.00) => 164.52\n```\n\nNow let's try one more example.\nSuppose we want to have a new class of account where only a limited amount of money can be withdrawn at any time.\nWe could define the class `limited-account`:\n\n```lisp\n(define-class limited-account (limit acct) ()\n (withdraw (amt)\n       (if (> amt limit)\n          'over-limit\n          (withdraw acct amt)))\n (otherwise (&rest args)\n       (apply message acct args)))\n```\n\nThis definition redefines the `withdraw` message to check if the limit is exceeded before passing on the message, and it uses the `otherwise` clause simply to pass on all other messages unchanged.\nIn the following example, we set up an account with both a password and a limit:\n\n```lisp\n> (setf acct4 (password-account \"pass\"\n       (limited-account 100.00\n```\n\n        `(account \"A.\nThrifty Spender\" 500.00))))`=>\n\n```lisp\n#<CL0SURE 34136775>\n> (withdraw acct4 \"pass\" 200.00) => 0VER-LIMIT\n> (withdraw acct4 \"pass\" 20.00) => 480.0\n> (withdraw acct4 \"guess\" 20.00) => WR0NG-PASSWORD\n```\n\nNote that functions like `withdraw` are still simple generic functions that just find the right method and apply it to the arguments.\nThe trick is that each class defines a different way to handle the withdraw message.\nCalling `withdraw` with `acct4` as argument results in the following flow of control.\nFirst, the method in the `password-account` class checks that the password is correct.\nIf it is, it calls the method from the `limited-account` class.\nIf the limit is not exceeded, we finally call the method from the `account` class, which decrements the balance.\nPassing control to the method of a component is called *delegation*.\n\nThe advantage of the object-oriented style is that we can introduce a new class by writing one definition that is localized and does not require changing any existing code.\nIf we had written this in traditional procedural style, we would end up with functions like the following:\n\n```lisp\n(defun withdraw (acct amt &optional pass)\n (cond ((and (typep acct 'password-account)\n        (not (equal pass (account-password acct))))\n      'wrong-password)\n      ((and (typep acct 'limited-account)\n        (> amt (account-limit account)))\n      'over-limit)\n      ((> amt balance)\n      'insufficient-funds)\n      (t (decf balance amt))))\n```\n\nThere is nothing wrong with this, as an individual function.\nThe problem is that when the bank decides to offer a new kind of account, we will have to change this function, along with all the other functions that implement actions.\nThe \"definition\" of the new account is scattered rather than localized, and altering a bunch of existing functions is usually more error prone than writing a new class definition.\n\n## 13.6 Inheritance\n{:#s0035}\n{:.h1hd}\n\nIn the following table, data types (classes) are listed across the horizontal axis, and functions (messages) are listed up and down the vertical axis.\nA complete program needs to fill in all the boxes, but the question is how to organize the process of filling them in.\nIn the traditional procedural style, we write function definitions that fill in a row at a time.\nIn the object-oriented style, we write class definitions that fill in a column at a time.\nA third style, the *data-driven* or *generic* style, fills in only one box at a time.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | `account limited-account` | `password-account` | `...` |\n| `name` | | *object* | |\n| `deposit` | | *oriented* | |\n| `withdraw` | *function oriented* | | |\n| `balance` | | | |\n| `interest` | *generic* | | |\n| `...` | | | |\n\n![t0010](images/B9780080571157500133/t0010.png)\n\nIn this table there is no particular organization to either axis; both messages and classes are listed in random order.\nThis ignores the fact that classes are organized hierarchically: both limited-account and password-account are subclasses of account.\nThis was implicit in the definition of the classes, because both `limited-account` and `password-account` contain accounts as components and delegate messages to those components.\nBut it would be cleaner to make this relationship explicit.\n\nThe `defstruct` mechanism does allow for just this kind of explicit inheritance.\nIf we had defined `account` as a structure, then we could define `limited-account` with:\n\n```lisp\n(defstruct (limited-account (:include account)) limit)\n```\n\nTwo things are needed to provide an inheritance facility for classes.\nFirst, we should modify `define-class` so that it takes the name of the class to inherit from as the second argument.\nThis will signal that the new class will inherit all the instance variables, class variables, and methods from the parent class.\nThe new class can, of course, define new variables and methods, or it can shadow the parent's variables and methods.\nIn the form below, we define `limited-account` to be a subclass of `account` that adds a new instance variable, `1imit`, and redefines the `withdraw` method so that it checks for amounts that are over the limit.\nIf the amount is acceptable, then it uses the function `cal1-next-method` (not yet defined) to get at the `withdraw` method for the parent class, `account`.\n\n```lisp\n(define-class limited-account account (limit) ()\n (withdraw (amt)\n        (if (> amt limit)\n          'over-limit\n          (call-next-method))))\n```\n\nIf inheritance is a good thing, then multiple inheritance is an even better thing.\nFor example, assuming we have defined the classes `limited-account` and `password-account`, it is very convenient to define the following class, which inherits from both of them:\n\n```lisp\n(define-class limited-account-with-password\n           (password-account limited-account))\n```\n\nNotice that this new class adds no new variables or methods.\nAll it does is combine the functionality of two parent classes into one.\n\n**Exercise 13.1 [d]** Define a version of `define-class` that handles inheritance and `call-next-method`.\n\n**Exercise 13.2 [d]** Define a version of `define-class` that handles multiple inheritance.\n\n## 13.7 CLOS: The Common Lisp Object System\n{:#s0040}\n{:.h1hd}\n\nSo far, we have developed an object-oriented programming system using a macro, `define-class`, and a protocol for implementing objects as closures.\nThere have been many proposals for adding object-oriented features to Lisp, some similar to our approach, some quite different.\nRecently, one approach has been approved to become an official part of Common Lisp, so we will abandon our ad hoc approach and devote the rest of this chapter to CLOS, the Common Lisp Object System.\nThe correspondence between our system and CLOS is summarized here:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| our system | CLOS |\n| `define-class` | `defclass` |\n| *`methods defined in class`* | `defmethod` |\n| *`class-name`* | `make-instance` |\n| `call-next-method` | `call-next-method` |\n| `ensure-generic-fn` | `ensure-generic-function` |\n\nLike most object-oriented systems, CLOS is primarily concerned with defining classes and methods for them, and in creating instances of the classes.\nIn CLOS the macro `defclass` defines a class, `defmethod` defines a method, and `make-instance` creates an instance of a class-an object.\nThe general form of the macro `defclass` is:\n\n(`defclass`*class-name* (*superclass...*) (*slot-specifier...*) *optional-class-option...*)\n\nThe class-options are rarely used.\n`defclass` can be used to define the class `account`:\n\n```lisp\n(defclass account ()\n ((name :initarg :name ireader name)\n   (balance :initarg :balance :initform 0.00 :accessor balance)\n   (interest-rate :allocation :class :initform .06\n        :reader interest-rate)))\n```\n\nIn the definition of account, we see that the list of superclasses is empty, because account does not inherit from any classes.\nThere are three slot specifiers, for the `name`, `balance`, and `interest-rate` slots.\nEach slot name can be followed by optional keyword/value pairs defining how the slot is used.\nThe `name` slot has an `:initarg` option, which says that the name can be specified when a new account is created with `make-instance`.\nThe `:reader` slot creates a method called `name` to get at the current value of the slot.\n\nThe balance slot has three options: another `:initarg`, saying that the balance can be specified when a new account is made; an `:initform`, which says that if the balance is not specified, it defaults to `0.00`, and an `:accessor`, which creates a method for getting at the slot's value just as `:reader` does, and also creates a method for updating the slot with `setf`.\n\nThe `interest-rate` slot has an `:initform` option to give it a default value and an `:allocation` option to say that this slot is part of the class, not of each instance of the class.\n\nHere we see the creation of an object, and the application of the automatically defined methods to it.\n\n```lisp\n> (setf al (make-instance 'account :balance 5000.00\n             :name \"Fred\")) => #<ACC0UNT 26726272>\n> (name al) => \"Fred\"\n> (balance al) => 5000.0\n> (interest-rate al) => 0.06\n```\n\nCLOS differs from most object-oriented systems in that methods are defined separately from classes.\nTo define a method (besides the ones defined automatically by `:reader`, `:writer`, or `:accessor` options) we use the `defmethod` macro.\nIt is similar to defun in form:\n\n`(defmethod`*method-name* (*parameter...*) *body...*)\n\nRequired parameters to a `defmethod` can be of the form (*var class*), meaning that this is a method that applies only to arguments of that class.\nHere is the method for withdrawing from an account.\nNote that CLOS does not have a notion of instance variable, only instance slot.\nSo we have to use the method (`balance acct`) rather than the instance variable `balance`:\n\n```lisp\n(defmethod withdraw ((acct account) amt)\n (if (< amt (balance acct))\n  (decf (balance acct) amt)\n  'insufficient-funds))\n```\n\nWith CLOS it is easy to define a `limited-account` as a subclass of `account`, and to define the `withdraw` method for `limited-accounts`:\n\n```lisp\n(defclass limited-account (account)\n ((limit :initarg :limit :reader limit)))\n(defmethod withdraw ((acct limited-account) amt)\n (if (> amt (limit acct))\n     'over-1imit\n     (call-next-method)))\n```\n\nNote the use of `cal1-next-method` to invoke the `withdraw` method for the `account` class.\nAlso note that all the other methods for accounts automatically work on instances of the class limited-account, because it is defined to inherit from `account.` In the following example, we show that the `name` method is inherited, that the `withdraw` method for `limited-account` is invoked first, and that the `withdraw` method for `account` is invoked by the `call-next-method` function:\n\n```lisp\n> (setf a2 (make-instance 'limited-account\n            :name \"A. Thrifty Spender\"\n```\n\n            `:balance 500.00 :1imit 100.00))`=>\n\n```lisp\n#<LIMITED-ACCOUNT 24155343>\n> (name a2) => \"A. Thrifty Spender\"\n> (withdraw a2 200.00) => 0VER-LIMIT\n> (withdraw a2 20.00) => 480.0\n```\n\nIn general, there may be several methods appropriate to a given message.\nIn that case, all the appropriate methods are gathered together and sorted, most specific first.\nThe most specific method is then called.\nThat is why the method for `limited-account` is called first rather than the method for `account.` The function `cal1-next-method` can be used within the body of a method to call the next most specific method.\n\nThe complete story is actually even more complicated than this.\nAs one example of the complication, consider the class `audited-account`, which prints and keeps a trail of all deposits and withdrawals.\nIt could be defined as follows using a new feature of CLOS, `:before` and `:after` methods:\n\n```lisp\n(defclass audited-account (account)\n ((audit-trail :initform nil :accessor audit-trail)))\n(defmethod withdraw :before ((acct audited-account) amt)\n (push (print '(withdrawing ,amt))\n  (audit-trail acct)))\n(defmethod withdraw :after ((acct audited-account) amt)\n (push (print '(withdrawal (,amt) done))\n  (audit-trail acct)))\n```\n\nNow a call to `withdraw` with a `audited-account` as the first argument yields three applicable methods: the primary method from `account` and the :`before` and :`after` methods.\nIn general, there might be several of each kind of method.\nIn that case, all the :`before` methods are called in order, most specific first.\nThen the most specific primary method is called.\nIt may choose to invoke `cal1-next-method` to get at the other methods.\n(It is an error for a :`before` or :`after` method to use `cal1-next-method.)` Finally, all the :`after` methods are called, least specific first.\n\nThe values from the `:before` and `:after` methods are ignored, and the value from the primary method is returned.\nHere is an example:\n\n```lisp\n> (setf a3 (make-instance 'audited-account :balance 1000.00))\n#<AUDITED-ACCOUNT 33555607>\n> (withdraw a3 100.00)\n(WITHDRAWING 100.0)\n(WITHDRAWAL (100.0) DONE)\n900.0\n> (audit-trail a3)\n((WITHDRAWAL (100.0) DONE) (WITHDRAWING 100.0))\n> (setf (audit-trail a3) nil)\nNIL\n```\n\nThe last interaction shows the biggest flaw in CLOS: it fails to encapsulate information.\nIn order to make the `audit-trail` accessible to the `withdraw` methods, we had to give it accessor methods.\nWe would like to encapsulate the writer function for `audit-trail` so that it can only be used with deposit and `withdraw`.\nBut once the writer function is defined it can be used anywhere, so an unscrupulous outsider can destroy the audit trail, setting it to nil or anything else.\n\n## 13.8 A CLOS Example: Searching Tools\n{:#s0045}\n{:.h1hd}\n\nCLOS is most appropriate whenever there are several types that share related behavior.\nA good example of an application that fits this description is the set of searching tools defined in [section 6.4](B9780080571157500066.xhtml#s0025).\nThere we defined functions for breadth-first, depth-first, and best-first search, as well as tree- and graph-based search.\nWe also defined functions to search in particular domains, such as planning a route between cities.\n\nIf we had written the tools in a straightforward procedural style, we would have ended up with dozens of similar functions.\nInstead, we used higher-order functions to control the complexity.\nIn this section, we see how CLOS can be used to break up the complexity in a slightly different fashion.\n\nWe begin by defining the class of search problems.\nProblems will be classified according to their domain (route planning, etc.), their topology (tree or graph) and their search strategy (breadth-first or depth-first, etc.).\nEach combination of these features results in a new class of problem.\nThis makes it easy for the user to add a new class to represent a new domain, or a new search strategy.\nThe basic class, `problem`, contains a single-instance variable to hold the unexplored states of the problem.\n\n```lisp\n(defclass problem ()\n ((states :initarg :states :accessor problem-states)))\n```\n\nThe function searcher is similar to the function `tree-search` of [section 6.4](B9780080571157500066.xhtml#s0025).\nThe main difference is that searcher uses generic functions instead of passing around functional arguments.\n\n```lisp\n(defmethod searcher ((prob problem))\n \"Find a state that solves the search problem.\"\n (cond ((no-states-p prob) fail)\n  ((goal-p prob) (current-state prob))\n  (t (let ((current (pop-state prob)))\n       (setf (problem-states prob)\n         (problem-combiner\n          prob\n          (problem-successors prob current)\n          (problem-states prob))))\n      (searcher prob))))\n```\n\nsearcher does not assume that the problem states are organized in a list; rather, it uses the generic function `no-states-p` to test if there are any states, `pop-state` to remove and return the first state, and `current-state` to access the first state.\nFor the basic `problem` class, we will in fact implement the states as a list, but another class of problem is free to use another representation.\n\n```lisp\n(defmethod current-state ((prob problem))\n \"The current state is the first of the possible states.\"\n (first (problem-states prob)))\n(defmethod pop-state ((prob problem))\n \"Remove and return the current state.\"\n (pop (problem-states prob)))\n(defmethod no-states-p ((prob problem))\n \"Are there any more unexplored states?\"\n (null (problem-states prob)))\n```\n\nIn `tree-search`, we included a statement to print debugging information.\nWe can do that here, too, but we can hide it in a separate method so as not to clutter up the main definition of `searcher`.\nIt is a `:before` method because we want to see the output before carrying out the operation.\n\n```lisp\n(defmethod searcher :before ((prob problem))\n (dbg 'search \";; Search: ~a\" (problem-states prob)))\n```\n\nThe generic functions that remain to be defined are `goal-p, probl em-combiner,` and `problem-successors`.\nWe will address `goal-p` first, by recognizing that for many problems we will be searching for a state that is `eql` to a specified goal state.\nWe define the class `eql-problem` to refer to such problems, and specify `goal-p` for that class.\nNote that we make it possible to specify the goal when a problem is created, but not to change the goal:\n\n```lisp\n(defclass eql-problem (problem)\n ((goal rinitarg :goal :reader problem-goal)))\n(defmethod goal-p ((prob eql-problem))\n (eql (current-state prob) (problem-goal prob)))\n```\n\nNow we are ready to specify two search strategies: depth-first search and breadth-first search.\nWe define problem classes for each strategy and specify the `problem-combiner` function:\n\n```lisp\n(defclass dfs-problem (problem) ()\n (:documentation \"Depth-first search problem.\"))\n(defclass bfs-problem (problem) ()\n (:documentation \"Breadth-first search problem.\"))\n(defmethod problem-combiner ((prob dfs-problem) new old)\n \"Depth-first search looks at new states first.\"\n (append new old))\n(defmethod problem-combiner ((prob bfs-problem) new old)\n \"Depth-first search looks at old states first.\"\n (append old new))\n```\n\nWhile this code will be sufficient for our purposes, it is less than ideal, because it breaks an information-hiding barrier.\nIt treats the set of old states as a list, which is the default for the `problem` class but is not necessarily the implementation that every class will use.\nIt would have been cleaner to define generic functions `add-states-to-end` and `add-states-to-front` and then define them with `append` in the default class.\nBut Lisp provides such nice list-manipulation primitives that it is difficult to avoid the temptation of using them directly.\n\nOf course, the user who defines a new implementation for `problem-states` could just redefine `problem-combiner` for the offending classes, but this is precisely what object-oriented programming is designed to avoid: specializing one abstraction (states) should not force us to change anything in another abstraction (search strategy).\n\nThe last step is to define a class that represents a particular domain, and define `problem-successors` for that domain.\nAs the first example, consider the simple binary tree search from [section 6.4](B9780080571157500066.xhtml#s0025).\nNaturally, this gets represented as a class:\n\n```lisp\n(defclass binary-tree-problem (problem) ())\n(defmethod problem-successors ((prob binary-tree-problem) state)\n (let ((n (* 2 state)))\n   (list n (+ n 1))))\n```\n\nNow suppose we want to solve a binary-tree problem with breadth-first search, searching for a particular goal.\nSimply create a class that mixes in `binary-tree-problem, eql-problem` and `bfs-problem,` create an instance of that class, and call `searcher` on that instance:\n\n```lisp\n(defclass binary-tree-eql-bfs-problem\n      (binary-tree-problem eql-problem bfs-problem) ())\n> (setf pl (make-instance 'binary-tree-eql-bfs-problem\n             :states '(1) :goal 12))\n#<BINARY-TREE-EQL-BFS-PROBLEM 26725536>\n> (searcher pl)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 4 5)\n;; Search: (4 5 6 7)\n;; Search: (5 6 7 8 9)\n;; Search: (6 7 8 9 10 11)\n;; Search: (7 8 9 10 11 12 13)\n;; Search: (8 9 10 11 12 13 14 15)\n;; Search: (9 10 11 12 13 14 15 16 17)\n;; Search: (10 11 12 13 14 15 16 17 18 19)\n;; Search: (11 12 13 14 15 16 17 18 19 20 21)\n;; Search: (12 13 14 15 16 17 18 19 20 21 22 23)\n12\n```\n\n### Best-First Search\n{:#s0050}\n{:.h2hd}\n\nIt should be clear how to proceed to define best-first search: define a class to represent best-first search problems, and then define the necessary methods for that class.\nSince the search strategy only affects the order in which states are explored, the only method necessary will be for `problem-combiner`.\n\n```lisp\n(defclass best-problem (problem) ()\n (:documentation \"A Best-first search problem.\"))\n(defmethod problem-combiner ((prob best-problem) new old)\n \"Best-first search sorts new and old according to cost-fn.\"\n (sort (append new old) #'<\n      :key #'(lambda (state) (cost-fn prob state))))\n```\n\nThis introduces the new function `cost-fn`; naturally it will be a generic function.\nThe following is a `cost-fn` that is reasonable for any `eql-problem` dealing with numbers, but it is expected that most domains will specialize this function.\n\n```lisp\n(defmethod cost-fn ((prob eql-problem) state)\n (abs (- state (problem-goal prob))))\n```\n\nBeam search is a modification of best-first search where all but the best *b* states are thrown away on each iteration.\nA beam search problem is represented by a class where the instance variable `beam-width` holds the parameter *b*.\nIf this nil, then full best-first search is done.\nBeam search is implemented by an `:around` method on `problem-combiner`.\nIt calls the next method to get the list of states produced by best-first search, and then extracts the first *b* elements.\n\n```lisp\n(defclass beam-problem (problem)\n ((beam-width :initarg :beam-width :initform nil\n         :reader problem-beam-width)))\n(defmethod problem-combiner :around ((prob beam-problem) new old)\n (let ((combined (call-next-method)))\n   (subseq combined 0 (min (problem-beam-width prob)\n             (length combined)))))\n```\n\nNow we apply beam search to the binary-tree problem.\nAs usual, we have to make up another class to represent this type of problem:\n\n```lisp\n(defclass binary-tree-eql-best-beam-problem\n (binary-tree-problem eql-problem best-problem beam-problem)\n ())\n> (setf p3 (make-instance 'binary-tree-eql-best-beam-problem\n             :states '(1) :goal 12 :beam-width 3))\n#<BINARY-TREE-EQL-BEST-BEAM-PROBLEM 27523251>\n> (searcher p3)\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (14 15 6)\n;; Search: (15 6 28)\n;; Search: (6 28 30)\n;; Search: (12 13 28)\n12\n```\n\nSo far the case for CLOS has not been compelling.\nThe code in this section duplicates the functionality of code in [section 6.4](B9780080571157500066.xhtml#s0025), but the CLOS code tends to be more verbose, and it is somewhat disturbing that we had to make up so many long class names.\nHowever, this verbosity leads to flexibility, and it is easier to extend the CLOS code by adding new specialized classes.\nIt is useful to make a distinction between the systems programmer and the applications programmer.\nThe systems programmer would supply a library of classes like `dfs-problem` and generic functions like `searcher`.\nThe applications programmer then just picks what is needed from the library.\nFrom the following we see that it is not too difficult to pick out the right code to define a trip-planning searcher.\nCompare this with the definition of `trip` on page 198 to see if you prefer CLOS in this case.\nThe main difference is that here we say that the cost function is `air-distance` and the successors are the `neighbors` by defining methods; in `trip` we did it by passing parameters.\nThe latter is a little more succint, but the former may be more clear, especially as the number of parameters grows.\n\n```lisp\n(defclass trip-problem (binary-tree-eql-best-beam-problem)\n ((beam-width :initform 1)))\n(defmethod cost-fn ((prob trip-problem) city)\n (air-distance (problem-goal prob) city))\n(defmethod problem-successors ((prob trip-problem) city)\n (neighbors city))\n```\n\nWith the definitions in place, it is easy to use the searching tool:\n\n```lisp\n> (setf p4 (make-instance 'trip-problem\n            :states (list (city 'new-york))\n            :goal (city 'san-francisco)))\n#<TRIP-PROBLEM 31572426>\n> (searcher p4)\n;; Search: ((NEW-YORK 73.58 40.47))\n;; Search: ((PITTSBURG 79.57 40.27))\n;; Search: ((CHICAGO 87.37 41.5))\n;; Search: ((KANSAS-CITY 94.35 39.06))\n;; Search: ((DENVER 105.0 39.45))\n;; Search: ((FLAGSTAFF 111.41 35.13))\n;; Search: ((RENO 119.49 39.3))\n;; Search: ((SAN-FRANCISCO 122.26 37.47))\n(SAN-FRANCISCO 122.26 37.47)\n```\n\n## 13.9 Is CLOS Object-Oriented?\n{:#s0060}\n{:.h1hd}\n\nThere is some argument whether CLOS is really object-oriented at all.\nThe arguments are:\n\nCLOS *is* an object-oriented system because it provides all three of the main criteria for object-orientation: objects with internal state, classes of objects with specialized behavior for each class, and inheritance between classes.\n\nCLOS is *not* an object-oriented system because it does not provide modular objects with information-hiding.\nIn the `audited-account` example, we would like to encapsulate the `audit-trail` instance variable so that only the `withdraw` methods can change it.\nBut because methods are written separately from class definitions, we could not do that.\nInstead, we had to define an accessor for `audit-trail`.\nThat enabled us to write the `withdraw` methods, but it also made it possible for anyone else to alter the audit trail as well.\n\nCLOS is *more general than* an object-oriented system because it allows for methods that specialize on more than one argument.\nIn true object-oriented systems, methods are associated with objects of a particular class.\nThis association is lexically obvious (and the message-passing metaphor is clear) when we write the methods inside the definition of the class, as in our `define-class` macro.\nThe message-passing metaphor is still apparent when we write generic functions that dispatch on the class of their first argument, which is how we've been using CLOS so far.\n\nBut CLOS methods can dispatch on the class of any required argument, or any combination of them.\nConsider the following definition of `conc,` which is like `append` except that it works for vectors as well as lists.\nRather than writing `conc` using conditional statements, we can use the multimethod dispatch capabilities of CLOS to define the four cases: (1) the first argument is nil, (2) the second argument is nil, (3) both arguments are lists, and (4) both arguments are vectors.\nNotice that if one of the arguments is nil there will be two applicable methods, but the method for `null` will be used because the class `null` is more specific than the class `list.`\n\n```lisp\n(defmethod conc ((x null) y) y)\n(defmethod conc (x (y null)) x)\n(defmethod conc ((x list) (y list))\n (cons (first x) (conc (rest x) y)))\n(defmethod conc ((x vector) (y vector))\n (let ((vect (make-array (+ (length x) (length y)))))\n   (replace vect x)\n   (replace vect y :startl (length x))))\n```\n\nHere we see that this definition works:\n\n```lisp\n> (conc nil '(a b c)) => (A B C)\n> (conc '(a b c) nil) => (A B C)\n> (conc '(a b c) '(d e f)) => (A B C D E F)\n> (conc '#(a b c) '#(d e f))`=> `#(A B C D E F)\n```\n\nIt works, but one might well ask: where are the objects?\nThe metaphor of passing a message to an object does not apply here, unless we consider the object to be the list of arguments, rather than a single privileged argument.\n\nIt is striking that this style of method definition is very similar to the style used in Prolog.\nAs another example, compare the following two definitions of `len`, a relation/function to compute the length of a list:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `;; CLOS` | `%% Prolog` |\n| `(defmethod len ((x null)) 0)` | `len([],0).` |\n| `(defmethod len ((x cons))` | `len(CXIL].N1) :-` |\n|  `(+ 1 (len (rest x))))` |  `len(L.N). NI is N+1.` |\n\n## 13.10 Advantages of Object-Oriented Programming\n{:#s0065}\n{:.h1hd}\n\nBertrand Meyer, in his book on the object-oriented language Eiffel (1988), lists five qualities that contribute to software quality:\n\n*  *Correctness*.\nClearly, a correct program is of the upmost importance.\n\n*  *Robustness*.\nPrograms should continue to function in a reasonable manner even for input that is beyond the original specifications.\n\n*  *Extendability*.\nPrograms should be easy to modify when the specifications change.\n\n*  *Reusability*.\nProgram components should be easy to transport to new programs, thus amortizing the cost of software development over several projects.\n\n*  *Compatibility*.\nPrograms should interface well with other programs.\nFor example, a spreadsheet program should not only manipulate numbers correctly but also be compatible with word processing programs, so that spreadsheets can easily be included in documents.\n\nHere we list how the object-oriented approach in general and CLOS in particular can effect these measures of quality:\n\n*  *Correctness*.\nCorrectness is usually achieved in two stages: correctness of individual modules and correctness of the whole system.\nThe object-oriented approach makes it easier to prove correctness for modules, since they are clearly defined, and it may make it easier to analyze interactions between modules, since the interface is strictly limited.\nCLOS does not provide for information-hiding the way other systems do.\n\n*  *Robustness*.\nGeneric functions make it possible for a function to accept, at run time, a class of argument that the programmer did not anticipate at compile time.\nThis is particularly true in CLOS, because multiple inheritance makes it feasible to write default methods that can be used by a wide range of classes.\n\n*  *Extendability*.\nObject-oriented systems with inheritance make it easy to define new classes that are slight variants on existing ones.\nAgain, CLOS's multiple inheritance makes extensions even easier than in single-inheritance systems.\n\n*  *Reusability*.\nThis is the area where the object-oriented style makes the biggest contribution.\nInstead of writing each new program from scratch, object-oriented programmers can look over a library of classes, and either reuse existing classes as is, or specialize an existing class through inheritance.\nLarge libraries of CLOS classes have not emerged yet.\nPerhaps they will when the language is more established.\n\n*  *Compatibility*.\nThe more programs use standard components, the more they will be able to communicate with each other.\nThus, an object-oriented program will probably be compatible with other programs developed from the same library of classes.\n\n## 13.11 History and References\n{:#s0070}\n{:.h1hd}\n\nThe first object-oriented language was Simula, which was designed by Ole-Johan Dahl and Krysten Nygaard ([1966](B9780080571157500285.xhtml#bb0265), [Nygaard and Dahl 1981](B9780080571157500285.xhtml#bb0920)) as an extension of Algol 60.\nIt is still in use today, mostly in Norway and Sweden.\nSimula provides the ability to define classes with single inheritance.\nMethods can be inherited from a superclass or overridden by a subclass.\nIt also provides *coroutines*, class instances that execute continuously, saving local state in instance variables but periodically pausing to let other coroutines run.\nAlthough Simula is a general-purpose language, it provides special support for simulation, as the name implies.\nThe built-in class `simulation` allows a programmer to keep track of simulated time while running a set of processes as coroutines.\n\nIn 1969 Alan Kay was a graduate student at the University of Utah.\nHe became aware of Simula and realized that the object-oriented style was well suited to his research in graphies ([Kay 1969](B9780080571157500285.xhtml#bb0600)).\nA few years later, at Xerox, he joined with Adele Goldberg and Daniel Ingalls to develop the Smalltalk language (see [Goldberg and Robinson 1983](B9780080571157500285.xhtml#bb0475)).\nWhile Simula can be viewed as an attempt to add object-oriented features to strongly typed Algol 60, Smalltalk can be seen as an attempt to use the dynamic, loosely typed features of Lisp, but with methods and objects replacing functions and s-expressions.\nIn Simula, objects existed alongside traditional data types like numbers and strings; in Smalltalk, every datum is an object.\nThis gave Smalltalk the feel of an integra ted Lisp environment, where the user can inspect, copy, or edit any part of the environment.\nIn fact, it was not the object-oriented features of Smalltalk per se that have made a lasting impression but rather the then-innovative idea that every user would have a large graphical display and could interact with the system using a mouse and menus rather than by typing commands.\n\nGuy Steele's *LAMBDA: The Ultimate Declarative* (1976a and b) was perhaps the first paper to demonstrate how object-oriented programming can be done in Lisp.\nAs the title suggests, it was all done using `lambda,` in a similar way to our `define-class` example.\nSteele summarized the approach with the equation \"Actors = Closures (mod Syntax),\" refering to Cari Hewitt's \"Actors\" object-oriented formalism.\n\nIn 1979, the MIT Lisp Machine group developed the Flavors system based on this approach but offering considerable extensions ([Cannon 1980](B9780080571157500285.xhtml#bb0155), [Weinreb 1980](B9780080571157500285.xhtml#bb1360), [Moon et al.\n1983](B9780080571157500285.xhtml#bb0860)).\n\"Flavor\" was a popular jargon word for \"type\" or \"kind\" at MIT, so it was natural that it became the term for what we call classes.\n\nThe Flavor system was the first to support multiple inheritance.\nOther languages shunned multiple inheritance because it was too dynamic.\nWith single inheritance, each instance variable and method could be assigned a unique offset number, and looking up a variable or method was therefore trivial.\nBut with multiple inheritance, these computations had to be done at run time.\nThe Lisp tradition enabled programmers to accept this dynamic computation, when other languages would not.\nOnce it was accepted, the MIT group soon came to embrace it.\nThey developed complex protocols for combining different flavors into new ones.\nThe concept of *mix-ins* was developed by programmers who frequented Steve's Ice Cream parlor in nearby Davis Square.\nSteve's offered a list of ice cream flavors every day but also offered to create new flavors-dynamically-by mixing in various cookies, candies, or fruit, at the request of the individual customer.\nFor example, Steve's did not have chocolate-chip ice cream on the menu, but you could always order vanilla ice cream with chocolate chips mixed in.[3](#fn0025)\n\nThis kind of \"flavor hacking\" appealed to the MIT Lisp Machine group, who adopted the metaphor for their object-oriented programming system.\nAll flavors inherited from the top-mostflavor in the hierarchy: vanilla.\nIn the window system, for example, the flavor `basic-window` was defined to support the minimal functionality of all windows, and then new flavors of window were defined by combining mix-in flavors such as `scrol1-bar-mixin`, `label-mixin`, and `border-mixin`.\nThese mix-in flavors were used only to define other flavors.\nJust as you couldn't go into Steve's and order \"crushed Heath bars, hold the ice cream,\" there was a mechanism to prohibit instantiation of mix-ins.\n\nA complicated repetoire of *method combinations* was developed.\nThe default method combination on Flavors was similar to CLOS: first do all the :`before` methods, then the most specific primary method, then the `:after` methods.\nBut it was possible to combine methods in other ways as well.\nFor example, consider the `inside-width` method, which returns the width in pixels of the usuable portion of a window.\nA programmer could specify that the combined method for `inside-width` was to be computed by calling all applicable methods and summing them.\nThen an `inside-width` method for the `basic-window` flavor would be defined to return the width of the full window, and each mix-in would have a simple method to say how much of the width it consumed.\nFor example, if borders are 8 pixels wide and scroll bars are 12 pixels wide, then the `inside-width` method for `border-mixin` returns `-8` and `scroll-bar-mixin` returns `- 12`.\nThen any window, no matter how many mix-ins it is composed of, automatically computes the proper inside width.\n\nIn 1981, Symbolics came out with a more efficient implementation of Flavors.\nObjects were no longer just closures.\nThey were still funcallable, but there was additional hardware support that distinguished them from other functions.\nAfter a few years Symbolics abandoned the (send *object message*) syntax in favor of a new syntax based on generic functions.\nThis system was known as New Flavors.\nIt had a strong influence on the eventual CLOS design.\n\nThe other strong influence on CLOS was the CommonLoops system developed at Xerox PARC.\n(See [Bobrow 1982](B9780080571157500285.xhtml#bb0095), [Bobrow et al.\n1986](B9780080571157500285.xhtml#bb0105), [Stefik and Bobrow 1986](B9780080571157500285.xhtml#bb1185).) CommonLoops continued the New Flavors trend away from message passing by introducing *multimethods*: methods that specialize on more than one argument.\n\nAs of summer 1991, CLOS itself is in a state of limbo.\nIt was legitimitized by its appearance in *Common Lisp the Language*, 2d edition, but it is not yet official, and an important part, the metaobject protocol, is not yet complete.\nA tutorial on CLOS is [Keene 1989](B9780080571157500285.xhtml#bb0620).\n\nWe have seen how easy it is to build an object-oriented system on top of Lisp, using `lambda` as the primary tool.\nAn interesting alternative is to build Lisp on top of an object-oriented system.\nThat is the approach taken in the Oaklisp system of [Lang and Perlmutter (1988)](B9780080571157500285.xhtml#bb0695).\nInstead of defining methods using `lambda` as the primitive, Oaklisp has `add-method` as a primitive and defines `lambda` as a macro that adds a method to an anonymous, empty operation.\n\nOf course, object-oriented systems are thriving outside the Lisp world.\nWith the success of UNIX-based workstations, C has become one of the most widely available programming languages.\nC is a fairly low-level language, so there have been several attempts to use it as a kind of portable assembly language.\nThe most succesful of these attempts is C++, a language developed by Bjarne Stroustrup of AT&T Bell Labs ([Stroustrup 1986](B9780080571157500285.xhtml#bb1210)).\nC++ provides a number of extensions, including the ability to define classes.\nHowever, as an add-on to an existing language, it does not provide as many features as the other languages discussed here.\nCrucially, it does not provide garbage collection, nor does it support fully generic functions.\n\nEiffel ([Meyer 1988](B9780080571157500285.xhtml#bb0830)) is an attempt to define an object-oriented system from the ground up rather than tacking it on to an existing language.\nEiffel supports multiple inheritance and garbage collection and a limited amount of dynamic dispatching.\n\nSo-called modem languages like Ada and Modula support information-hiding through generic functions and classes, but they do not provide inheritance, and thus can not be classified as true object-oriented languages.\n\nDespite these other languages, the Lisp-based object-oriented systems are the only ones since Smalltalk to introduce important new concepts: multiple inheritance and method combination from Flavors, and multimethods from CommonLoops.\n\n## 13.12 Exercises\n{:#s0075}\n{:.h1hd}\n\n**Exercise 13.3 [m]** Implement `deposit` and `interest` methods for the `account` class using CLOS.\n\n**Exercise 13.4 [m]** Implement the `password-account` class using CLOS.\nCan it be done as cleanly with inheritance as it was done with delegation?\nOr should you use delegation within CLOS?\n\n**Exercise 13.5 [h]** Implement graph searching, search paths, and A* searching as classes in CLOS.\n\n**Exercise 13.6 [h]** Implement a priority queue to hold the states of a problem.\nInstead of a list, the `problem-states` will be a vector of lists, each initially null.\nEach new state will have a priority (determined by the generic function `priority`) which must be an integer between zero and the length of the vector, where zero indicates the highest priority.\nA new state with priority *p* is pushed onto element *p* of the vector, and the state to be explored next is the first state in the first nonempty position.\nAs stated in the text, some of the previously defined methods made the unwarranted assumption that `problem-states` would always hold a list.\nChange these methods.\n\n----------------------\n\n[1](#xfn0015) More accurately, we have a guarantee that there is no way to get at the inside of a closure using portable Common Lisp code.\nParticular implementations may provide debugging tools for getting at this hidden information, such as `inspect`.\nSo closures are not perfect at hiding information from these tools.\nOf course, no information-hiding method will be guaranteed against such covert channels-even with the most sophisticated software security measures, it is always possible to, say, wipe a magnet over the computer's disks and alter sensitive data.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0020) There is a technical sense of \"generic function\" that is used within CLOS.\nThese functions are not generic according to this technical sense.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0025) Flavor fans will be happy to know that Steve's Ice Cream is now sold nationally in the United States.\nAlas, it is not possible to create flavors dynamically.\nAlso, be warned that Steve's was bought out by his Teal Square rival, Joey's.\nThe original Steve retired from the business for years, then came back with a new line of stores under his last name, Harrell.\n!!!(p) {:.ftnote1}\n\n# Chapter 14\n## Knowledge Representation and Reasoning\n{:.chaptitle}\n\n> Knowledge itself is power.\n\n> -Francis Bacon (1561-1626)\n\n> The power resides in the knowledge.\n\n> -Edward Feigenbaum\n\n> Stanford University Heuristic Programming Project\n\n> Knowledge is Knowledge, and vice versa.\n\n> -Tee shirt\n\n> Stanford University Heuristic Programming Project\n\nIn the 1960s, much of AI concentrated on search techniques.\nIn particular, a lot of work was concerned with *theorem proving:* stating a problem as a small set of axioms and searching for a proof of the problem.\nThe implicit assumption was that the power resided in the inference mechanism-if we could just find the right search technique, then all our problems would be solved, and all our theorems would be proved.\n\nStarting in the 1970s, this began to change.\nThe theorem-proving approach falled to live up to its promise.\nAI workers slowly began to realize that they were not going to solve NP-hard problems by coming up with a clever inference algorithm.\nThe general inferencing mechanisms that worked on toy examples just did not scale up when the problem size went into the thousands (or sometimes even into the dozens).\n\nThe *expert-system* approach offered an alternative.\nThe key to solving hard problems was seen to be the acquisition of special-case rules to break the problem into easier problems.\nAccording to Feigenbaum, the lesson learned from expert systems like MYCIN !!!(span) {:.smallcaps} (which we will see in [chapter 16](B9780080571157500169.xhtml)) is that the choice of inferencing mechanism is not as important as having the right knowledge.\nIn this view it doesn't matter very much if MYCIN !!!(span) {:.smallcaps} uses forward- or backward-chaining, or if it uses certainty factors, probabilities, or fuzzy set theory.\nWhat matters crucially is that we know pseudomonas is a gram-negative, rod-shaped organism that can infect patients with compromised immune systems.\nIn other words, the key problem is acquiring and representing knowledge.\n\nWhile the expert system approach had some successes, it also had fallures, and researchers were interested in learning the limits of this new technology and understanding exactly how it works.\nMany found it troublesome that the meaning of the knowledge used in some systems was never clearly defined.\nFor example, does the assertion `(color apple red)` mean that a particular apple is red, that all apples are red, or that some/most apples are red?\nThe field of *knowledge representation* concentrated on providing clear semantics for such representations, as well as providing algorithms for manipulating the knowledge.\nMuch of the emphasis was on finding a good trade-off between *expressiveness* and *efficiency.* An efficient language is one for which all queries (or at least the average query) can be answered quickly.\nIf we want to guarantee that queries will be answered quickly, then we have to limit what can be expressed in the language.\n\nIn the late 1980s, a series of results shed doubt on the hopes of finding an efficient language with any reasonable degree of expressiveness at all.\nUsing mathematical techniques based on worst-case analysis, it was shown that even seemingly trivial languages were *intractable-*in the worst case, it would take an exponential amount of time to answer a simple query.\n\nThus, in the 1990s the emphasis has shifted to *knowledge representation and reasoning,* a field that encompasses both the expressiveness and efficiency of languages but recognizes that the average case is more important than the worst case.\nNo amount of knowledge can help solve an intractable problem in the worse case, but in practice the worst case rarely occurs.\n\n## 14.1 A Taxonomy of Representation Languages\n{:#s0010}\n{:.h1hd}\n\nAI researchers have investigated hundreds of knowledge representation languages, trying to find languages that are convenient, expressive, and efficient.\nThe languages can be classified into four groups, depending on what the basic unit of representation is.\nHere are the four categories, with some examples:\n\n*  *Logical Formulae* (Prolog)\n\n*  *Networks* (semantic nets, conceptual graphs)\n\n*  *Objects* (scripts, frames)\n\n*  *Procedures* (Lisp, production systems)\n\nWe have already dealt with *logic-based* languages like Prolog.\n\n*Network-based* languages can be seen as a syntactic variation on logical languages.\nA link *L* between nodes *A* and *B* is just another way of expressing the logical relation *L(A, B).* The difference is that network-based languages take their links more seriously: they are intended to be implemented directly by pointers in the computer, and inference is done by traversing these pointers.\nSo placing a link *L* between *A* and *B* not only asserts that *L(A, B)* is true, but it also says something about how the knowledge base is to be searched.\n\n*Object-oriented* languages can also be seen as syntactic variants of predicate calculus.\nHere is a statement in a typical slot-filler frame language:\n\n```lisp\n(a person\n (name = Jan)\n (age = 32))\n```\n\nThis is equivalent to the logical formula:\n\n&exist;p: person(p) ![images](images/B9780080571157500145/cap.png) name(p,Jan) ![images](images/B9780080571157500145/cap.png) age(p,32)\n\nThe frame notation has the advantage of being easier to read, in some people's opinion.\nHowever, the frame notation is less expressive.\nThere is no way to say that the person's name is either Jan or John, or that the person's age is not 34.\nIn predicate calculus, of course, such statements can be easily made.\n\nFinally, *procedural* languages are to be contrasted with representation languages: procedural languages compute answers without explicit representation of knowledge.\n\nThere are also hybrid representation languages that use different methods to encode different kinds of knowledge.\nThe KL-ONE family of languages uses both logical formulae and objects arranged into a network, for example.\nMany frame languages allow *procedural attachment,* a technique that uses arbitrary procedures to compute values for expressions that are inconvenient or impossible to express in the frame language itself.\n\n## 14.2 Predicate Calculus and its Problems\n{:#s0015}\n{:.h1hd}\n\nSo far, many of our representations have been based on predicate calculus, a notation with a distinguished position in AI: it serves as the universal standard by which other representations are defined and evaluated.\nThe previous section gave an example expression from a frame language.\nThe frame language may have many merits in terms of the ease of use of its syntax or the efficiency of its internal representation of data.\nHowever, to understand what expressions in the language mean, there must be a clear definition.\nMore often than not, that definition is given in terms of predicate calculus.\n\nA predicate calculus representation assumes a universe of individuals, with relations and functions on those individuals, and sentences formed by combining relations with the logical connectives `and`, `or`, and `not`.\nPhilosophers and psychologists will argue the question of how appropriate predicate calculus is as a model of human thought, but one point stands clear: predicate calculus is sufficient to represent anything that can be represented in a digital computer.\nThis is easy to show: assuming the computer's memory has *n* bits, and the equation *bi* = 1 means that bit *i* is on, then the entire state of the computer is represented by a conjunction such as:\n\nb0=0&and;b1=0&and;b2=1...&and;bn=0\n\n![si1_e](images/B9780080571157500145/si1_e.gif)\n\nOnce we can represent a state of the computer, it becomes possible to represent any computer program in predicate calculus as a set of axioms that map one state onto another.\nThus, predicate calculus is shown to be a *sufficient* langaage for representing anything that goes on inside a computer-it can be used as a tool for analyzing any program from the outside.\n\nThis does not prove that predicate calculus is an *appropriate* tool for all applications.\nThere are good reasons why we may want to represent knowledge in a form that is quite different from predicate calculus, and manipulate the knowledge with procedures that are quite different from logical inference.\nBut we should still be able to describe our system in terms of predicate calculus axioms, and prove theorems about it.\nTo do any less is to be sloppy.\nFor example, we may want to manipulate numbers inside the computer by using the arithmetic instructions that are built into the CPU rather than by manipulating predicate calculus axioms, but when we write a square-root routine, it had better satisfy the axiom:\n\nx=y=>yxy=x\n\n![si2_e](images/B9780080571157500145/si2_e.gif)\n\nPredicate calculus also serves another purpose: as a tool that can be used *by* a program rather than *on* a program.\nAll programs need to manipulate data, and some programs will manipulate data that is considered to be in predicate calculus notation.\nIt is this use that we will be concerned with.\n\nPredicate calculus makes it easy to start writing down facts about a domain.\nBut the most straightforward version of predicate calculus suffers from a number of serious limitations:\n\n*  *Decidability-*given a set of axioms and a goal, it may be that neither the goal nor its negation can be derived from the axioms.\n\n*  *Tractability-even* when a goal is provable, it may take too long to find the proof using the avallable inferencing mechanisms.\n\n*  *Uncertainty-*it can be inconvenient to deal with relations that are probable to a degree but not known to be definitely true or false.\n\n*  *Monotonicity-*in pure predicate calculus, once a theorem is proved, it is true forever.\nBut we would like a way to derive tentative theorems that rely on assumptions, and be able to retract them when the assumptions prove false.\n\n*  *Consistency-*pure predicate calculus admits no contradictions.\nIf by accident both *P* and &not;*P* are derived, then *any* theorem can be proved.\nIn effect, a single contradiction corrupts the entire data base.\n\n*  *Omniscience-*it can be difficult to distinguish what is provable from what should be proved.\nThis can lead to the unfounded assumption that an agent believes all the consequences of the facts it knows.\n\n*  *Expressiveness-*the first-order predicate calculus makes it awkward to talk about certain things, such as the relations and propositions of the language itself.\n\nThe view held predominantly today is that it is best to approach these problems with a dual attack that is both within and outside of predicate calculus.\nIt is considered a good idea to invent new notations to address the problems-both for convenience and to facilitate special-purpose reasoners that are more efficient than a general-purpose theorem prover.\nHowever, it is also important to define scrupulously the meaning of the new notation in terms of familiar predicate-calculus notation.\nAs Drew McDermott put it, \"No notation without denotation!\" (1978).\n\nIn this chapter we show how new notations (and their corresponding meanings) can be used to extend an existing representation and reasoning system.\nProlog is chosen as the language to extend.\nThis is not meant as an endorsement for Prolog as the ultimate knowledge representation language.\nRather, it is meant solely to give us a clear and familiar foundation from which to build.\n\n## 14.3 A Logical Language: Prolog\n{:#s0020}\n{:.h1hd}\n\nProlog has been proposed as the answer to the problem of programming in logic.\nWhy isn't it accepted as the universal representation language?\nProbably because Prolog is a compromise between a representation language and a programming language.\nGiven two specifications that are logically equivalent, one can be an efficient Prolog program, while the other is not.\nKowalski's famous equation \"*algorithm = logic + control\"* expresses the limits of logic alone: *logic = algorithm - control.* Many problems (especially in AI) have large or infinite search spaces, and if Prolog is not given some advice on how to search that space, it will not come up with the answer in any reasonable length of time.\n\nProlog's problems fall into three classes.\nFirst, in order to make the language efficient, its expressiveness was restricted.\nIt is not possible to assert that a person's name is either Jan or John in Prolog (although it is possible to *ask* if the person's name is one of those).\nSimilarly, it is not possible to assert that a fact is false; Prolog does not distinguish between false and unknown.\nSecond, Prolog's inference mechanism is neither sound nor complete.\nBecause it does not check for circular unification, it can give incorrect answers, and because it searches depth-first it can miss correct answers.\nThird, Prolog has no good way of adding control information to the underlying logic, making it inefficient on certain problems.\n\n## 14.4 Problems with Prolog's Expressiveness\n{:#s0025}\n{:.h1hd}\n\nIf Prolog is programming in logic, it is not the full predicate logic we are familiar with.\nThe main problem is that Prolog can't express certain kinds of indefinite facts.\nIt can represent definite facts: the capital of Rhode Island is Providence.\nIt can represent conjunctions of facts: the capital of Rhode Island is Providence and the capital of California is Sacramento.\nBut it can not represent disjunctions or negations: that the capital of California is *not* Los Angeles, or that the capital of New York is *either* New York City *or* Albany.\nWe could try this:\n\n```lisp\n(<- (not (capital LA CA)))\n(<- (or (capital Albany NY) (capital NYC NY)))\n```\n\nbut note that these last two facts concern the relation `not` and `or`, not the relation `capital`.\nThus, they will not be considered when we ask a query about `capital`.\nFortunately, the assertion \"Either NYC or Albany is the capital of NY\" can be rephrased as two assertions: \"Albany is the capital of NY if NYC is not\" and \"NYC is the capital of NY if Albany is not:\"\n\n```lisp\n(<- (capital Albany NY) (not (capital NYC NY)))\n(<- (capital NYC NY) (not (capital Albany NY)))\n```\n\nUnfortunately, Prolog's not is different from logic's `not`.\nWhen Prolog answers \"no\" to a query, it means the query cannot be proven from the known facts.\nIf everything is known, then the query must be false, but if there are facts that are not known, the query may in fact be true.\nThis is hardly surprising; we can't expect a program to come up with answers using knowledge it doesn't have.\nBut in this case, it causes problems.\nGiven the previous two clauses and the query `(capital ?c NY)`, Prolog will go into an infinite loop.\nIf we remove the first clause, Prolog would fall to prove that Albany is the capital, and hence conclude that NYC is.\nIf we remove the second clause, the opposite conclusion would be drawn.\n\nThe problem is that Prolog equates \"not proven\" with \"false.\" Prolog makes what is called the *closed world assumption*-it assumes that it knows everything that is true.\nThe closed world assumption is reasonable for most programs, because the programmer does know all the relevant information.\nBut for knowledge representation in general, we would like a system that does not make the closed world assumption and has three ways to answer a query: \"yes,\" \"no,\" or \"unknown.\" In this example, we would not be able to conclude that the capital of NY is or is not NYC, hence we would not be able to conclude anything about Albany.\n\nAs another example, consider the clauses:\n\n```lisp\n(<- (damned) (do))\n(<- (damned) (not (do)))\n```\n\nWith these rules, the query `(?\n(damned))` should logically be answered \"yes.\" Furthermore, it should be possible to conclude `(damned)` without even investigating if `(do)` is provable or not.\nWhat Prolog does is first try to prove `(do)`.\nIf this succeeds, then `(damned)` is proved.\nEither way, Prolog then tries again to prove `(do)`, and this time if the proof falls, then `(damned)` is proved.\nSo Prolog is doing the same proof twice, when it is unnecessary to do the proof at all.\nIntroducing negation wrecks havoc on the simple Prolog evaluation scheme.\nIt is no longer sufficient to consider a single clause at a time.\nRather, multiple clauses must be considered together if we want to derive all the right answers.\n\nRobert [Moore 1982](B9780080571157500285.xhtml#bb0865) gives a good example of the power of disjunctive reasoning.\nHis problem concerned three colored blocks, but we will update it to deal with three countries.\nSuppose that a certain Eastern European country, *E*, has just decided if it will remain under communist rule or become a democracy, but we do not know the outcome of the decision.\n*E* is situated between the democracy *D* and the communist country *C*:\n\n![u14-02-9780080571157](images/B9780080571157500145/u14-02-9780080571157.jpg)     \n\nThe question is: Is there a communist country next to a democracy?\nMoore points out that the answer is \"yes,\" but discovering this requires reasoning by cases.\nIf *E* is a democracy then it is next to *C* and the answer is yes.\nBut if *E* is communist then it is next to *D* and the answer is still yes.\nSince those are the only two possibilities, the answer must be yes in any case.\nLogical reasoning gives us the right answer, but Prolog can not.\nWe can describe the problem with the following seven assertions and one query, but Prolog can not deal with the or in the final assertion.\n\n```lisp\n(<- (next-to D E))  (<- (next-to E D))\n(<- (next-to E C))  (<- (next-to C E))\n(<- (democracy D))  (<- (communist C))\n(<- (or (democracy E) (communist E)))\n(?- (next-to ?A ?B) (democracy ?A) (communist ?B))\n```\n\nWe have seen that Prolog is not very good at representing disjunctions and negations.\nIt also has difficulty representing existentials.\nConsider the following statement in English, logic, and Prolog:\n\nJan likes everyone.\n\n&forall; *x* person(*x*) => likes(Jan,*x*)\n\n```lisp\n(<- (likes Jan ?x) (person ?x))\n```\n\nThe Prolog translation is faithful.\nBut there is no good translation for \"Jan likes someone.\" The closest we can get is:\n\nJan likes someone.\n\n&exist; *x* person(x) => likes(Jan,x)\n\n```lisp\n(<- (likes Jan pl))\n(<- (person pl))\n```\n\nHere we have invented a new symbol, `p1`, to represent the unknown person that Jan likes, and have asserted that `p1` is a person.\nNotice that `p1` is a constant, not a variable.\nThis use of a constant to represent a specific but unknown entity is called a *Skolem constant,* after the logician Thoralf Skolem (1887-1963).\nThe intent is that `p1` may be equal to some other person that we know about.\nIf we find out that Adrian is the person Jan likes, then in logic we can just add the assertion p1 = Adrian.\nBut that does not work in Prolog, because Prolog implicitly uses the *unique name assumption-*all atoms represent distinct individuals.\n\nA Skolem constant is really just a special case of a *Skolem function-*an unknown entity that depends on one or more variable.\nFor example, to represent \"Everyone likes someone\" we could use:\n\nEveryone likes someone.\n\n&forall;*y*&exist; *x* person (*x*) => likes (*y, x*)\n\n```lisp\n(<- (likes ?y (p2 ?y)))\n(<- (person (p2 ?y)))\n```\n\nHere `p2` is a Skolem function that depends on the variable `?y`.\nIn other words, everyone likes some person, but not necessarily the same person.\n\n## 14.5 Problems with Predicate Calculus's Expressiveness\n{:#s0030}\n{:.h1hd}\n\nIn the previous section we saw that Prolog has traded some expressiveness for efficiency.\nThis section explores the limits of predicate calculus's expressiveness.\n\nSuppose we want to assert that lions, tigers, and bears are kinds of animais.\nIn predicate calculus or in Prolog we could write an implication for each case:\n\n```lisp\n(<- (animal ?x) (lion ?x))\n(<- (animal ?x) (tiger ?x))\n(<- (animal ?x) (bear ?x))\n```\n\nThese implications allow us to prove that any known lion, tiger, or bear is in fact an animal.\nHowever, they do not allow us to answer the question \"What kinds of animais are there?\" It is not hard to imagine extending Prolog so that the query\n\n```lisp\n(?- (<- (animal ?x) ?proposition))\n```\n\nwould be legal.\nHowever, this happens not to be valid Prolog, and it is not even valid first-order predicate calculus (or FOPC).\nIn FOPC the variables must range over constants in the language, not over relations or propositions.\nHigher-order predicate calculus removes this limitation, but it has a more complicated proof theory.\n\nIt is not even clear what the values of `?proposition` should be in the query above.\nSurely `(lion ?x)` would be a valid answer, but so would `(animal ?x), (or (tiger ?x) (bear ?x))`, and an infinite number of other propositions.\nPerhaps we should have two types of queries, one that asks about \"kinds,\" and another that asks about propositions.\n\nThere are other questions that we might want to ask about relations.\nJust as it is useful to declare the types of parameters to a Lisp function, it can be useful to declare the types of the parameters of a relation, and later query those types.\nFor example, we might say that the `likes` relation holds between a person and an object.\n\nIn general, a sentence in the predicate calculus that uses a relation or sentence as a term is called a higher-order sentence.\nThere are some quite subtle problems that come into play when we start to allow higher-order expressions.\nAllowing sentences in the calculus to talk about the truth of other sentences can lead to a paradox: is the sentence \"This sentence is false\" true or false?\n\nPredicate calculus is defined in terms of a universe of individuals and their properties and relations.\nThus it is well suited for a model of the world that picks out individuals and categorizes them-a person here, a building there, a sidewalk between them.\nBut how well does predicate calculus fare in a world of continuous substances?\nConsider a body of water consisting of an indefinite number of subconstituents that are all water, with some of the water evaporating into the air and rising to form clouds.\nIt is not at all obvious how to define the individuals here.\nHowever, Patrick Hayes has shown that when the proper choices are made, predicate calculus can describe this kind of situation quite well.\nThe detalls are in Hayes 1985.\n\nThe need to define categories is a more difficult problem.\nPredicate calculus works very well for crisp, mathematical categories: a; is a triangle if and only if *x* is a polygon with three sides.\nUnfortunately, most categories that humans deal with in everyday life are not defined so rigorously.\nThe category *friend* refers to someone you have mostly positive feelings for, whom you can usually trust, and so on.\nThis \"definition\" is not a set of necessary and sufficient conditions but rather is an open-ended list of ill-defined qualities that are highly correlated with the category *friend.* We have a prototype for what an ideal friend should be, but no clear-cut boundaries that separate *friend* from, say, *acquaintance.* Furthermore, the boundaries seem to vary from one situation to another: a person you describe as a good friend in your work place might be only an acquaintance in the context of your home life.\n\nThere are versions of predicate calculus that admit quantifiers like \"most\" in addition to \"for all\" and \"there exists,\" and there have been attempts to define prototypes and measure distances from them.\nHowever, there is no consensus on the way to approach this problem.\n\n## 14.6 Problems with Completeness\n{:#s0035}\n{:.h1hd}\n\nBecause Prolog searches depth-first, it can get caught in one branch of the search space and never examine the other branches.\nThis problem can show up, for example, in trying to define a commutative relation, like `sibling`:\n\n```lisp\n(<- (sibling lee kim))\n(<- (sibling ?x ?y) (sibling ?y ?x))\n```\n\nWith these clauses, we expect to be able to conclude that Lee is Kim's sibling, and Kim is Lee's.\nLet's see what happens:\n\n```lisp\n> (?- (sibling ?x ?y))\n?X = LEE\n?Y = KIM;\n?X = KIM\n?Y = LEE;\n?X = LEE\n?Y = KIM;\n?X = KIM\n?Y = LEE.\nNo.\n```\n\nWe get the expected conclusions, but they are deduced repeatedly, because the commutative clause for siblings is applied over and over again.\nThis is annoying, but not critical.\nFar worseis when we ask `(?- (sibling fred ?x))`.\nThis query loops forever.\nHappily, this particular type of example has an easy fix: just introduce two predicates, one for data-base level facts, and one at the level of axioms and queries:\n\n```lisp\n(<- (sibling-fact lee kim))\n(<- (sibling ?x ?y) (sibling-fact ?x ?y))\n(<- (sibling ?x ?y) (sibling-fact ?y ?x))\n```\n\nAnother fix would be to change the interpreter to fall when a repeated goal was detected.\nThis was the approach taken in GPS.\nHowever, even if we eliminated repeated goals, Prolog can still get stuck in one branch of a depth-first search.\nConsider the example:\n\n```lisp\n(<- (natural 0))\n(<- (natural (1 + ?n)) (natural ?n))\n```\n\nThese rules define the natural numbers (the non-negative integers).\nWe can use the rules either to confirm queries like `(natural (1 + (1 + (1 + 0))))` or to generate the natural numbers, as in the query `(natural ?n)`.\nSo far, everything is fine.\nBut suppose we wanted to define all the integers.\nOne approach would be this:\n\n```lisp\n(<- (integer 0))\n(<- (integer ?n) (integer (1 + ?n)))\n(<- (integer (1 + ?n)) (integer ?n))\n```\n\nThese rules say that 0 is an integer, and any *n* is an integer if *n* + 1 is, and *n* + 1 is if *n* is.\nWhile these rules are correct in a logical sense, they don't work as a Prolog program.\nAsking `(integer *x*)` will resuit in an endless series of ever-increasing queries: `(integer (1 + *x*)), (integer (1 + (1 + *x*)))`, and so on.\nEach goal is different, so no check can stop the recursion.\n\nThe occurs check may or may not introduce problems into Prolog, depending on your interpretation of infinite trees.\nMost Prolog systems do not do the occurs check.\nThe reasoning is that unifying a variable with some value is the Prolog equivalent of assigning a value to a variable, and programmers expect such a basic operation to be fast.\nWith the occurs check turned off, it will in fact be fast.\nWith checking on, it takes time proportional to the size of the value, which is deemed unacceptable.\n\nWith occurs checking off, the programmer gets the benefit of fast unification but can run into problems with circular structures.\nConsider the following clauses:\n\n```lisp\n(<- (parent ?x (mother-of ?x)))\n(<- (parent ?x (father-of ?x)))\n```\n\nThese clauses say that, for any person, the mother of that person and the father of that person are parents of that person.\nNow let us ask if there is a person who is his or her own parent:\n\n```lisp\n> (? (parent ?y ?y))\n?Y = [Abort]\n```\n\nThe system has found an answer, where `?y = (mother-of ?y).` The answer can't be printed, though, because `deref` (or `subst-bindings` in the interpreter) goes into an infinite loop trying to figure out what `?y` is.\nWithout the printing, there would be no infinite loop:\n\n```lisp\n(<- (self-parent) (parent ?y ?y))\n> (? (self-parent))\nYes;\nYes;\nNo.\n```\n\nThe `self-parent` query succeeds twice, once with the mother clause and once with the father clause.\nHas Prolog done the right thing here?\nIt depends on your interpretation of infinite circular trees.\nIf you accept them as valid objects, then the answer is consistent.\nIf you don't, then leaving out the occurs check makes Prolog *unsound:* it can come up with incorrect answers.\n\nThe same problem cornes up if we ask if there are any sets that include themselves as members.\nThe query `(member ?set ?set)` will succeed, but we will not be able to print the value of `?set`.\n\n## 14.7 Problems with Efficiency: Indexing\n{:#s0040}\n{:.h1hd}\n\nOur Prolog compiler is designed to handle \"programlike\" predicates-predicates with a small number of rules, perhaps with complex bodies.\nThe compiler does much worse on \"tablelike\" predicates-predicates with a large number of simple facts.\nConsider the predicate `pb`, which encodes phone-book facts in the form:\n\n```lisp\n(pb (name Jan Doe) (num 415 555 1212))\n```\n\nSuppose we have a few thousand entries of this kind.\nA typical query for this data base would be:\n\n```lisp\n(pb (name Jan Doe) ?num)\n```\n\nIt would be inefficient to search through the facts linearly, matching each one against the query.\nIt would also be inefficient to recompile the whole `pb/2` predicate every time a new entry is added.\nBut that is just what our compiler does.\n\nThe solutions to the three problems-expressiveness, completeness, and indexing-will be considered in reverse order, so that the most difficult one, expressiveness, will come last.\n\n## 14.8 A Solution to the Indexing Problem\n{:#s0045}\n{:.h1hd}\n\nA better solution to the phone-book problem is to index each phone-book entry in some kind of table that makes it easy to add, delete, and retrieve entries.\nThat is what we will do in this section.\nWe will develop an extension of the trie or discrimination tree data structure built in [section 10.5](B9780080571157500108.xhtml#s0030) ([page 344](B9780080571157500108.xhtml#p344)).\n\nMaking a discrimination tree for Prolog facts is complicated by the presence of variables in both the facts and the query.\nEither facts with variables in them will have to be indexed in several places, or queries with variables will have to look in several places, or both.\nWe also have to decide if the discrimination tree itself will handle variable binding, or if it will just return candidate matches which are then checked by some other process.\nIt is not clear what to store in the discrimination tree: copies of the fact, functions that can be passed continuations, or something else.\nMore design choices will come up as we proceed.\n\nIt is difficult to make design choices when we don't know exactly how the system will be used.\nWe don't know what typical facts will look like, nor typical queries.\nTherefore, we will design a fairly abstract tool, forgetting for the moment that it will be used to index Prolog facts.\n\nWe will address the problem of a discrimination tree where both the keys and queries are predicate structures with wild cards.\nA wild card is a variable, but with the understanding thatthere is no variable binding; each instance of a variable can match anything.\nA predicate structure is a list whose first element is a nonvariable symbol.\nThe discrimination tree supports three operations:\n\n*  `index`-add a key/value pair to the tree\n\n*  `fetch`-find all values that potentially match a given key\n\n*  `unindex`-remove all key/value pairs that match a given key\n\nTo appreciate the problems, we need an example.\nSuppose we have the following six keys to index.\nFor simplicity, the value of each key will be the key itself:\n\n```lisp\n1 (p a b)\n2 (p a c)\n3 (p a ?x)\n4 (p b c)\n5 (p b (f c))\n6 (p a (f . ?x))\n```\n\nNow assume the query `(p ?y c)`.\nThis should match keys 2, 3, and 4.\nHow could we efficiently arrive at this set?\nOne idea is to list the key/value pairs under every atom that they contain.\nThus, all six would be listed under the atom `p`, while 2, 4, and 5 would be listed under the atom c.\nA unification check could elimina te 5, but we still would be missing 3.\nKey 3 (and every key with a variable in it) could potentially contain the atom `c`.\nSo to get the right answers under this approach, we will need to index every key that contains a variable under every atom-not an appealing situation.\n\nAn alternative is to create indices based on both atoms and their position.\nSo now we would be retrieving all the keys that have a c in the second argument position: 2 and 4, plus the keys that have a variable as the second argument: 3.\nThis approach seems to work much better, at least for the example shown.\nTo create the index, we essentially superimpose the list structure of all the keys on top of each other, to arrive at one big discrimination tree.\nAt each position in the tree, we create an index of the keys that have either an atom or a variable at that position.\n[Figure 14.1](#f0010) shows the discrimination tree for the six keys.\n\n![f14-01-9780080571157](images/B9780080571157500145/f14-01-9780080571157.jpg)     \nFigure 14.1\n!!!(span) {:.fignum}\nDiscrimination Tree with Six Keys\nConsider the query `(p ?y c)`.\nEither the `p` or the `c` could be used as an index.\nThe `p` in the predicate position retrieves all six keys.\nBut the c in the second argument position retrieves only three keys: 2 and 4, which are indexed under c itself, and 3, which is indexed under the variable in that position.\n\nNow consider the query `(p ?y (f ?z))`.\nAgain, the `p` serves as an index to all six keys.\nThe `f` serves as an index to only three keys: the 5 and 6, which are indexed directly under f in that position, and 3, which is indexed under the variable in a position along the path that lead to f.\nIn general, all the keys indexed under variables along the path must be considered.\n\nThe retrieval mechanism can overretrieve.\nGiven the query `(p a (f ?x))`, the atom `p` will again retrieve all six keys, the atom a retrieves 1, 2, 3, and 6, and f again retrieves 5, 6, and 3.\nSo `f` retrieves the shortest list, and hence it will be used to determine the final resuit.\nBut key 5 is `(p b (f c))`, which does not match the query `(pa (f?x))`.\n\nWe could eliminate this problem by intersecting all the lists instead of just taking the shortest list.\nIt is perhaps feasible to do the intersection using bit vectors, but probably too slow and wasteful of space to do it using lists.\nEven if we did intersect keys, we would still overretrieve, for two reasons.\nFirst, we don't use ni1 as an index, so we are ignoring the difference between `(f ?x)` and `(f . ?x)`.\nSecond, we are using wild-card semantics, so the query `(p ?x ?x)` would retrieve all six keys, when it should only retrieve three.\nBecause of these problems, we make a design choice: we will first build a data base retrieval function that retrieves potential matches, and later worry about the unification process that will eliminate mismatches.\n\nWe are ready for a more complete specification of the indexing strategy:\n\n*  The value will be indexed under each non-nil nonvariable atom in the key, with a separate index for each position.\nFor example, given the preceding data base, the atom a in the first argument position would index values 1,2,3, and 6, while the atom b in the second argument position would index value 4 and 5.\nThe atom p in the predicate position would index all six values.\n\n*  In addition, we will maintain a separate index for variables at each position.\nFor example, value 3 would be stored under the index \"variable in second argument position.\"\n\n*  \"Position\" does not refer solely to the linear position in the top-level list.\nFor example, value 5 would be indexed under atom f in the caaddr position.\n\n*  It follows that a key with *n* atoms will be indexed in *n* different ways.\n\nFor retrieval, the strategy is:\n\n*  For each non-nil nonvariable atom in the retrieval key, generate a list of possible matches.\nChoose the shortest such list.\n\n*  Each list of possible matches will have to be augmented with the values indexed under a variable at every position \"above.\" For example, `f` in the `caaddr` position retrieves value 5, but it also must retrieve value 3, because the third key has a variable in the `caddr` position, and `caddr` is \"above\" `caaddr.`\n\n*  The discrimination tree may return values that are not valid matches.\nThe purpose of the discrimination tree is to reduce the number of values we will have to unify against, not to determine the exact set of matches.\n\nIt is important that the retrieval function execute quickly.\nIf it is slow, we might just as well match against every key in the table linearly.\nTherefore, we will take care to implement each part efficiently.\nNote that we will have to compare the length of lists to choose the shortest possibility.\nOf course, it is trivial to compare lengths using `length,` but `length` requires traversing the whole list.\nWe can do better if we store the length of the list explicitly.\nA list with its length will be called an `nlist`.\nIt will be implemented as a cons cell containing the number of elements and a list of the elements themselves.\nAn alternative would be to use extensible vectors with fill pointers.\n\n```lisp\n;; An nlist is implemented as a (count . elements) pair:\n(defun make-empty-nlist ()\n \"Create a new, empty nlist.\"\n (cons 0 nil))\n(defun nlist-n (x) \"The number of elements in an nlist.\" (carx))\n(defun nlist-list (x) \"The elements in an nlist.\" (cdr x))\n(defun nlist-push (item nlist)\n \"Add a new element to an nlist.\"\n (incf (car nlist))\n (push item (cdr nlist))\n nlist)\n```\n\nNow we need a place to store these nlists.\nWe will build the data base out of discrimination tree nodes called dtree nodes.\nEach dtree node has a field to hold the variable index, the atom indices, and pointers to two subnodes, one for the `first` and one for the `rest`.\nWe implement dtrees as vectors for efficiency, and because we will never need a `dtree-p` predicate.\n\n```lisp\n(defstruct (dtree (:type vector))\n (first nil) (rest nil) (atoms nil) (var (make-empty-nlist)))\n```\n\nA separate dtree will be stored for each predicate.\nSince the predicates must be symbols, it is possible to store the dtrees on the predicate's property list.\nIn most implementations, this will be faster than alternatives such as hash tables.\n\n```lisp\n(let ((predicates nil))\n (defun get-dtree (predicate)\n  \"Fetch (or make) the dtree for this predicate.\"\n  (cond ((get predicate 'dtree))\n   (t (push predicate predicates)\n    (setf (get predicate 'dtree) (make-dtree)))))\n (defun clear-dtrees ()\n  \"Remove all the dtrees for all the predicates.\"\n  (dolist (predicate predicates)\n   (setf (get predicate 'dtree) nil))\n  (setf predicates nil)))\n```\n\nThe function `index` takes a relation as key and stores it in the dtree for the predicate of the relation.\nIt calls `dtree-index` to do all the work of storing a value under the proper indices for the key in the proper dtree node.\n\nThe atom indices are stored in an association list.\nProperty lists would not work, because they are searched using eq and atoms can be numbers, which are not necessarily `eq`.\nAssociation lists are searched using `eql` by default.\nAn alternative would be to use hash tables for the index, or even to use a scheme that starts with association lists and switches to a hash table when the number of entries gets large.\nI use `lookup` to look up the value of a key in a property list.\nThis function, and its `setf` method, are defined on [page 896](B978008057115750025X.xhtml#p896).\n\n```lisp\n(defun index (key)\n \"Store key in a dtree node. Key must be (predicate . args);\n it is stored in the predicate's dtree.\"\n (dtree-index key key (get-dtree (predicate key))))\n(defun dtree-index (key value dtree)\n \"Index value under all atoms of key in dtree.\"\n (cond\n ((consp key)   ; index on both first and rest\n  (dtree-index (first key) value\n    (or (dtree-first dtree)\n     (setf (dtree-first dtree) (make-dtree))))\n  (dtree-index (rest key) value\n    (or (dtree-rest dtree)\n     (setf (dtree-rest dtree) (make-dtree)))))\n ((null key)) ; don't index on nil\n ((variable-p key) ; index a variable\n  (nlist-push value (dtree-var dtree)))\n (t ;; Make sure there is an nlist for this atom, and add to it\n  (nlist-push value (lookup-atom key dtree)))))\n(defun lookup-atom (atom dtree)\n \"Return (or create) the nlist for this atom in dtree.\"\n (or (lookup atom (dtree-atoms dtree))\n  (let ((new (make-empty-nlist)))\n   (push (cons atom new) (dtree-atoms dtree))\n   new)))\n```\n\nNow we define a function to test the indexing routine.\nCompare the output with [figure 14.1](#f0010).\n\n```lisp\n(defun test-index ()\n (let ((props '((p a b) (p a c) (p a ?x) (p b c)\n         (p b (f c)) (p a (f . ?x)))))\n (clear-dtrees)\n (mapc #'index props)\n (write (list props (get-dtree 'p))\n  :circle t :array t :pretty t)\n (values)))\n> (test-index)\n((#1=(P A B)\n #2=(P A C)\n #3=(P A ?X)\n #4=(P B C)\n #5=(P B (F C))\n #6=(P A (F . ?X)))\n #(#(NIL NIL (P (6 #6# #5# #4# #3# #2# #1#)) (0))\n #(#(NIL NIL (B (2 #5# #4#) A (4 #6# #3# #2# #1#)) (0))\n  #(#(#(NIL NIL (F (2 #6# #5#)) (0))\n   #(#(NIL NIL (C (1 #5#)) (0))\n    #(NIL NIL NIL (0)) NIL (1 #6#))\n   (C (2 #4# #2#) B (1 #1#))\n   (1 #3#))\n  #(NIL NIL NIL (0))\n  NIL (0))\n NIL (0))\n NIL (0)))\n```\n\nThe next step is to fetch matches from the dtree data base.\nThe function `fetch` takes a query, which must be a valid relation, as its argument, and returns a list of possible matches.\nIt calls `dtree-fetch` to do the work:\n\n```lisp\n(defun fetch (query)\n \"Return a list of buckets potentially matching the query,\n which must be a relation of form (predicate . args).\"\n (dtree-fetch query (get-dtree (predicate query))\n   nil 0 nil most-positive-fixnum))\n```\n\n`dtree-fetch` must be passed the query and the dtree, of course, but it is also passed four additional arguments.\nFirst, we have to accumulate matches indexed under variables as we are searching through the dtree.\nSo two arguments are used to pass the actual matches and a count of their total number.\nSecond, we want `dtree-fetch` to return the shortest possible index, so we pass it the shortest answer found so far, and the size of the shortest answer.\nThat way, as it is making its way down the tree, accumulating values indexed under variables, it can be continually comparing the size of the evolving answer with the best answer found so far.\n\nWe could use nlists to pass around count/values pairs, but nlists only support a push operation, where one new item is added.\nWe need to append together lists of values coming from the variable indices with values indexed under an atom.\nAppend is expensive, so instead we make a list-of-lists and keep the count in a separate variable.\nWhen we are done, `dtree-fetch` and hence `fetch` does a multiple-value return, yielding the list-of-lists and the total count.\n\nThere are four cases to consider in `dtree-fetch.` If the dtree is null or the query pattern is either null or a variable, then nothing will be indexed, so we should just return the best answer found so far.\nOtherwise, we bind `var-n` and `var-list` to the count and list-of-lists of variable matches found so far, including at the current node.\nIf the count `var-n` is greater than the best count so far, then there is no sense continuing, and we return the best answer found.\nOtherwise we look at the query pattern.\nIf it is an atom, we use `dtree-atom-fetch` to return either the current index (along with the accumulated variable index) or the accumulated best answer, whichever is shorter.\nIf the query is a cons, then we use `dtree-fetch` on the first part of the cons, yielding a new best answer, which is passed along to the call of `dtree-fetch` on the rest of the cons.\n\n```lisp\n(defun dtree-fetch (pat dtree var-list-in var-n-in best-list best-n)\n \"Return two values: a list-of-lists of possible matches to pat.\n and the number of elements in the list-of-lists.\"\n (if (or (null dtree) (null pat) (variable-p pat))\n  (values best-list best-n)\n  (let* ((var-nlist (dtree-var dtree))\n    (var-n (+ var-n-in (nlist-n var-nlist)))\n    (var-list (if (null (nlist-list var-nlist))\n       var-list-in\n       (cons (nlist-list var-nlist)\n        var-list-in))))\n   (cond\n   ((>= var-n best-n) (values best-list best-n))\n   ((atom pat) (dtree-atom-fetch pat dtree var-list var-n\n        best-list best-n))\n   (t (multiple-value-bind (listl n1)\n     (dtree-fetch (first pat) (dtree-first dtree)\n         var-list var-n best-list best-n)\n        (dtree-fetch (rest pat) (dtree-rest dtree)\n           var-list var-n listl ni)))))))\n(defun dtree-atom-fetch (atom dtree var-list var-n best-list best-n)\n \"Return the answers indexed at this atom (along with the vars),\n or return the previous best answer, if it is better.\"\n (let ((atom-nlist (lookup atom (dtree-atoms dtree))))\n  (cond\n   ((or (null atom-nlist) (null (nlist-list atom-nlist)))\n    (values var-list var-n))\n   ((and atom-nlist (< (incf var-n (nlist-n atom-nlist)) best-n))\n    (values (cons (nlist-list atom-nlist) var-list) var-n))\n   (t (values best-list best-n)))))\n```\n\nHere we see a call to `fetch` on the data base created by `test-index`.\nIt returns two values: a list-of-lists of facts, and the total number of facts, three.\n\n```lisp\n(fetch '(p ? c))\n(((P B C) (P A C))\n ((P A ?X)))\n3\n```\n\nNow let's stop and see what we have accomplished.\nThe functions `fetch and dtree-fetch` fulfill their contract of returning potential matches.\nHowever, we still need to integrate the dtree facility with Prolog.\nWe need to go through the potential matches and determine which candidates are actual matches.\nFor simplicity we will use the version of `unify` with binding lists defined in [section 11.2](B978008057115750011X.xhtml#s0020).\n(It is also possible to construct a more efficient version that uses the compiler and the destructive function `unify!`.)\n\nThe function `mapc-retrieve` calls `fetch` to get a list-of-lists of potential matches and then calls `unify` to see if the match is a true one.\nIf the match is true, it calls the supplied function with the binding list that represents the unification as the argument, `mapc-retrieve` is proclaimed `inline` so that functions passed to it can also be compiled in place.\n\n```lisp\n(proclaim '(inline mapc-retrieve))\n(defun mapc-retrieve (fn query)\n \"For every fact that matches the query.\n apply the function to the binding list.\"\n (dolist (bucket (fetch query))\n (dolist (answer bucket)\n  (let ((bindings (unify query answer)))\n   (unless (eq bindings fall)\n   (funcall fn bindings))))))\n```\n\nThere are many ways to use this retriever.\nThe function `retrieve` returns a list of the matching binding lists, and `retrieve-matches` substitutes each binding list into the original query so that the resuit is a list of expressions that unify with the query.\n\n```lisp\n(defun retrieve (query)\n \"Find all facts that match query. Return a list of bindings.\"\n (let ((answers nil))\n (mapc-retrieve #'(lambda (bindings) (push bindings answers))\n     query)\n answers))\n(defun retrieve-matches (query)\n \"Find all facts that match query.\n Return a list of expressions that match the query.\"\n (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n   (retrieve query)))\n```\n\nThere is one further complication to consider.\nRecall that in our original Prolog interpreter, the function prove had to rename the variables in each clause as it retrieved it from the data base.\nThis was to insure that there was no conflict between the variables in the query and the variables in the clause.\nWe could do that in `retrieve`.\nHowever, if we assume that the expressions indexed in discrimination trees are tablelike rather than rulelike and thus are not recursive, then we can get away with renaming the variables only once, when they are entered into the data base.\nThis is done by changing `index`:\n\n```lisp\n(defun index (key)\n \"Store key in a dtree node. Key must be (predicate . args);\n it is stored in the predicate's dtree.\"\n (dtree-index key (rename-variables key) ; store unique vars\n     (get-dtree (predicate key))))\n```\n\nWith the new `index` in place, and after calling `test-index` to rebuild the data base, we are now ready to test the retrieval mechanism:\n\n```lisp\n> (fetch '(p ?x c))\n(((P B C) (P A C))\n ((P A ?X3408)))\n3\n> (retrieve '(p ?x c))\n(((?X3408 . C) (?X . A))\n ((?X . A))\n ((?X . B)))\n> (retrieve-matches '(p ?x c))\n((P A C) (P A C) (P B C))\n> (retrieve-matches '(p ?x (?fn c)))\n((P A (?FN C)) (P A (F C)) (P B (F C)))\n```\n\nActually, it is better to use `mapc-retrieve` when possible, since it doesn't cons up answers the way `retrieve` and `retrieve-matches` do.\nThe macro `query-bind` is provided as a nice interface to `mapc-retrieve`.\nThe macro takes as arguments a list of variables to bind, a query, and one or more forms to apply to each retrieved answer.\nWithin this list of forms, the variables will be bound to the values that satisfy the query.\nThe syntax was chosen to be the same as `multiple-va1ue-bind`.\nHere we see a typical use of `query-bind`, its resuit, and its macro-expansion:\n\n```lisp\n> (query-bind (?x ?fn) '(p ?x (?fn c))\n```\n\n` (format t \"~&P holds between ~a and ~a of c.\" ?x ?fn))`=>\n\n```lisp\nP holds between B and F of c.\nP holds between A and F of c.\nP holds between A and ?FN of c.\nNIL\n= (mapc-retrieve\n #'(lambda (#:bindings6369)\n  (let ((?x (subst-bindings #:bindings6369 *?x))\n      (?fn (subst-bindings #:bindings6369 *?fn)))\n   (format t \"~&P holds between ~a and ~a of c.\" ?x ?fn)))\n '(p ?x (?fn c)))\n```\n\nHere is the implementation:\n\n```lisp\n(defmacro query-bind (variables query &body body)\n \"Execute the body for each match to the query.\n Within the body, bind each variable.\"\n (let* ((bindings (gensym \"BINDINGS\"))\n  (vars-and-vals\n   (mapcar\n    #'(lambda (var)\n     (list var '(subst-bindings ,bindings * ,var)))\n    variables)))\n '(mapc-retrieve\n  #'(lambda (,bindings)\n   (let ,vars-and-vals\n    ,@body))\n  ,query)))\n```\n\n## 14.9 A Solution to the Completeness Problem\n{:#s0050}\n{:.h1hd}\n\nWe saw in [chapter 6](B9780080571157500066.xhtml) that iterative deepening is an efficient way to cover a search space without falling into an infinite loop.\nIterative deepening can also be used to guide the search in Prolog.\nIt will insure that all valid answers are found eventually, but it won't turn an infinite search space into a finite one.\n\nIn the interpreter, iterative deepening is implemented by passing an extra argument to `prove` and `prove-all` to indicate the depth remaining to be searched.\nWhen that argument is zero, the search is eut off, and the proof falls.\nOn the next iteration the bounds will be increased and the proof may succeed.\nIf the search is never eut off by a depth bound, then there is no reason to go on to the next iteration, because all proofs have already been found.\nThe special variable `*search-cut-off*` keeps track of this.\n\n```lisp\n(defvar *search-cut-off* nil \"Has the search been stopped?\")\n(defun prove-all (goals bindings depth)\n \"Find a solution to the conjunction of goals.\"\n ;; This version just passes the depth on to PROVE.\n (cond ((eq bindings fail) fail)\n   ((null goals) bindings)\n   (t (prove (first goals) bindings (rest goals) depth))))\n(defun prove (goal bindings other-goals depth)\n \"Return a list of possible solutions to goal.\"\n ;; Check if the depth bound has been exceeded\n (if (= depth 0) ;***\n  (progn (setf *search-cut-off* t) ;***\n    fall) ;***\n  (let ((clauses (get-clauses (predicate goal))))\n   (if (listp clauses)\n    (some\n     #'(lambda (clause)\n      (let ((new-clause (rename-variables clause)))\n       (prove-all\n        (append (clause-body new-clause) other-goals)\n        (unify goal (clause-head new-clause) bindings)\n        (- depth 1)))) ;***\n     clauses)\n    ;; The predicate's \"clauses\" can be an atom:\n    ;; a primitive function to call\n    (funcall clauses (rest goal) bindings\n        other-goals depth))))) ;***\n```\n\n`prove` and `prove-all` now implement search cutoff, but we need something to control the iterative deepening of the search.\nFirst we define parameters to control the iteration: one for the initial depth, one for the maximum depth, and one for the increment between iterations.\nSetting the initial and increment values to one will make the results come out in strict breadth-first order, but will duplicate more effort than a slightly larger value.\n\n```lisp\n(defparameter *depth-start* 5\n \"The depth of the first round of iterative search.\")\n(defparameter *depth-incr* 5\n \"Increase each iteration of the search by this amount.\")\n(defparameter *depth-max* most-positive-fixnum\n \"The deepest we will ever search.\")\n```\n\nA new version of `top-level-prove` will be used to control the iteration.\nIt calls `prove-all` for all depths from the starting depth to the maximum depth, increasing by the increment.\nHowever, it only proceeds to the next iteration if the search was eut off at some point in the previous iteration.\n\n```lisp\n(defun top-level-prove (goals)\n (let ((all-goals\n   '(,@goals (show-prolog-vars ,@(variables-in goals)))))\n  (loop for depth from *depth-start* to *depth-max* by *depth-incr*\n   while (let ((*search-cut-off* nil))\n    (prove-all all-goals no-bindings depth)\n    *search-cut-off*)))\n (format t \"~&No.\")\n (values))\n```\n\nThere is one final complication.\nWhen we increase the depth of search, we may find some new proof s, but we will also find all the old proof s that were found on the previous iteration.\nWe can modify `show-prolog-vars` to only print proofs that are found with a depth less than the increment-that is, those that were not found on the previous iteration.\n\n```lisp\n(defun show-prolog-vars (vars bindings other-goals depth)\n \"Print each variable with its binding.\n Then ask the user if more solutions are desired.\"\n (if (> depth *depth-incr*)\n  fall\n  (progn\n   (if (null vars)\n    (format t \"~&Yes\")\n    (dolist (var vars)\n     (format t \"~&~a = ~a\" var\n      (subst-bindings bindings var))))\n   (if (continue-p)\n    fall\n    (prove-all other-goals bindings depth)))))\n```\n\nTo test that this works, try setting `*depth-max*` to 5 and running the following assertions and query.\nThe infinite loop is avoided, and the first four solutions are found.\n\n```lisp\n(<- (natural 0))\n(<- (natural (1 + ?n)) (natural ?n))\n> (?- (natural ?n))\n?N = 0;\n?N = (1 + 0);\n?N = (1 + (1 + 0));\n?N = (1 + (1 + (1 + 0)));\nNo.\n```\n\n## 14.10 Solutions to the Expressiveness Problems\n{:#s0055}\n{:.h1hd}\n\nIn this section we present solutions to three of the limitations described above:\n\n*  Treatment of (limited) higher-order predications.\n\n*  Introduction of a frame-based syntax.\n\n*  Support for possible worlds, negation, and disjunction.\n\nWe also introduce a way to attach functions to predicates to do forward-chaining and error detection, and we discuss ways to extend unification to handle Skolem constants and other problems.\n\n### Higher-Order Predications\n{:#s9055}\n{:.h2hd}\n\nFirst we will tackle the problem of answering questions like \"What kinds of animais are there?\" Paradoxically, the key to allowing more expressiveness in this case is to invent a new, more limited language and insist that all assertions and queries are made in that language.\nThat way, queries that would have been higher-order in the original language become first-order in the restricted language.\n\nThe language admits three types of objects: *categories, relations*, and *individuals.* A category corresponds to a one-place predicate, a relation to a two-place predicate, and an individual to constant, or zero-place predicate.\nStatements in the language must have one of five primitive operators: `sub, rel, ind, val`, and `and.` They have the following form:\n\n`(sub`*subcategory super category*)\n\n`(rel`*relation domain-category range-category*)\n\n`(ind`*individual category*)\n\n`(val`*relation individual value*)\n\n`(and`*assertion...*)\n\nThe following table gives some examples, along with English translations:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(sub dog animal)` | Dog is a kind of animal. |\n| `(rel birthday animal date)` | The birthday relation holds between each animal and some date. |\n| `(ind fido dog)` | The individual Fido is categorized as a dog. |\n| `(val birthday fido july-1)` | The birthday of Fido is July-1. |\n| `(and *AB*)` | Both *A* and *B* are true. |\n\nFor those who feel more comfortable with predicate calculus, the following table gives the formal definition of each primitive.\nThe most complicated definition is for rel.\nThe form (rel *R A B*) means that every *R* holds between an individual of *A* and an individual of *B,* and furthermore that every individual of *A* participates in at least one *R* relation.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(sub`*AB*) | &forall;*x:A*(*x*) &Superset; *B*(*x*) |\n| `(rel`*RAB*) | &forall;*x,y* : *R*(*x,y*) &Superset; *A*(*x*) A *B*(*y*) *^*&forall;*xA*(*x*) &Superset; &exist;*y* : *R*(*x, y*) |\n| `(ind`*IC)* | *C*(*I*) |\n| `(val`*RIV*) | *R*(*I, V*) |\n| `(and`*P Q...*) | *P ^ Q...* |\n\nQueries in the language, not surprisingly, have the same form as assertions, except that they may contain variables as well as constants.\nThus, to find out what kinds of animais there are, use the query `(sub ?kind animal)`.\nTo find out what individual animais there are, use the query `(ind ?x animal)`.\nTo find out what individual animais of what kinds there are, use:\n\n```lisp\n(and (sub ?kind animal) (ind ?x ?kind))\n```\n\nThe implemention of this new language can be based directly on the previous implementation of dtrees.\nEach assertion is stored as a fact in a dtree, except that the components of an and assertion are stored separately.\nThe function `add-fact` does this:\n\n```lisp\n(defun add-fact (fact)\n \"Add the fact to the data base.\"\n (if (eq (predicate fact) 'and)\n  (mapc #'add-fact (args fact))\n  (index fact)))\n```\n\nQuerying this new data base consists of querying the dtree just as before, but with a special case for conjunctive (and) queries.\nConceptually, the function to do this, `retrieve-fact`, should be as simple as the following:\n\n```lisp\n(defun retrieve-fact (query)\n \"Find all facts that match query. Return a list of bindings.\n Warning!! this version is incomplete.\"\n (if (eq (predicate query) 'and)\n  (retrieve-conjunction (args query))\n  (retrieve query bindings)))\n```\n\nUnfortunately, there are some complications.\nThink about what must be done in `retrieve-conjunction`.\nIt is passed a list of conjuncts and must return a list of binding lists, where each binding list satisfies the query.\nFor example, to find out what people were born on July Ist, we could use the query:\n\n```lisp\n(and (val birthday ?p july-1) (ind ?p person))\n```\n\n`retrieve-conjunction` could solve this problem by first calling `retrieve-fact` on `(val birthday ?p july-1)`.\nOnce that is done, there is only one conjunct remaining, but in general there could be several, so we need to call `retrieve-conjunction` recursively with two arguments: the remainingconjuncts, and the resultthat `retrieve-fact` gave for the first solution.\nSince `retrieve-fact` returns a list of binding lists, it will be easiest if `retrieve-conjunction` accepts such a list as its second argument.\nFurthermore, when it cornes time to call `retrieve-fact` on the second conjunct, we will want to respect the bindings set up by the first conjunct.\nSo `retrieve-fact` must accept a binding list as its second argument.\nThus we have:\n\n```lisp\n(defun retrieve-fact (query &optional (bindings no-bindings))\n \"Find all facts that match query. Return a list of bindings.\"\n (if (eq (predicate query) 'and)\n  (retrieve-conjunction (args query) (list bindings))\n  (retrieve query bindings)))\n(defun retrieve-conjunction (conjuncts bindings-1ists)\n \"Return a list of binding lists satisfying the conjuncts.\"\n (mapcan\n  #'(lambda (bindings)\n   (cond ((eq bindings fall) nil)\n    ((null conjuncts) (list bindings))\n    (t (retrieve-conjunction\n     (rest conjuncts)\n     (retrieve-fact\n      (subst-bindings bindings (first conjuncts))\n      bindings)))))\n  bindings-1ists))\n```\n\nNotice that `retrieve` and therefore `mapc-retrieve` now also must accept a binding list.\nThe changes to them are shown in the following.\nIn each case the extra argument is made optional so that previously written functions that call these functions without passing in the extra argument will still work.\n\n```lisp\n(defun mapc-retrieve (fn query &optional (bindings no-bindings))\n \"For every fact that matches the query,\n apply the function to the binding list.\"\n (dolist (bucket (fetch query))\n  (dolist (answer bucket)\n   (let ((new-bindings (unify query answer bindings)))\n    (unless (eq new-bindings fall)\n     (funcall fn new-bindings))))))\n(defun retrieve (query &optional (bindings no-bindings))\n \"Find all facts that match query. Return a list of bindings.\"\n (let ((answers nil))\n  (mapc-retrieve #'(lambda (bindings) (push bindings answers))\n       query bindings)\n  answers))\n```\n\nNow `add-fact` and `retrieve-fact` comprise all we need to implement the language.\nHere is a short example where `add-fact` is used to add facts about bears and dogs, both as individuals and as species:\n\n```lisp\n> (add-fact '(sub dog animal))`=> `T\n> (add-fact '(sub bear animal))`=> `T\n> (add-fact '(ind Fido dog))`=> `T\n> (add-fact '(ind Yogi bear))`=> `T\n> (add-fact '(val color Yogi brown))`=> `T\n> (add-fact '(val color Fido golden))`=> `T\n> (add-fact '(val latin-name bear ursidae))`=> `T\n> (add-fact '(val latin-name dog canis-familiaris))`=> `T\n```\n\nNow `retrieve-fact` is used to answer three questions: What kinds of animais are there?\nWhat are the Latin names of each kind of animal?\nand What are the colors of each individual bear?\n\n```lisp\n> (retrieve-fact '(sub ?kind animal))\n(((?KIND . DOG))\n((?KIND . BEAR)))\n> (retrieve-fact '(and (sub ?kind animal)\n     (val latin-name ?kind ?latin)))\n(((?LATIN . CANIS-FAMILIARIS) (?KIND . DOG))\n ((?LATIN . URSIDAE) (?KIND . BEAR)))\n> (retrieve-fact '(and (ind ?x bear) (val color ?x ?c)))\n(((?C . BROWN) (?X . YOGI)))\n```\n\n### Improvements\n{:#s9010}\n{:.h2hd}\n\nThere are quite a few improvements that can be made to this system.\nOne direction is to provide different kinds of answers to queries.\nThe following two functions are similar to `retrieve-matches` in that they return lists of solutions that match the query, rather than lists of possible bindings:\n\n```lisp\n(defun retrieve-bagof (query)\n \"Find all facts that match query.\n Return a list of queries with bindings filled in.\"\n (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n   (retrieve-fact query)))\n(defun retrieve-setof (query)\n \"Find all facts that match query.\n Return a list of unique queries with bindings filled in.\"\n (remove-duplicates (retrieve-bagof query) :test #'equal))\n```\n\nAnother direction to take is to provide better error checking.\nThe current system does not complain if a fact or query is ill-formed.\nIt also relies on the user to input all facts, even those that could be derived automatically from the semantics of existing facts.\nFor example, the semantics of `sub` imply that if `(sub bear animal)` and `(sub polar-bear bear)` are true, then `(sub polar-bear animal)` must also be true.\nThis kind of implication can be handled in two way s.\nThe typical Prolog approach would be to write rules that derive the additional `sub` facts by backward-chaining.\nThen every query would have to check if there were rules to run.\nThe alternative is to use a *forward-chaining* approach, which caches each new `sub` fact by adding it to the data base.\nThis latter alternative takes more storage, but because it avoids rederiving the same facts over and over again, it tends to be faster.\n\nThe following version of `add-fact` does error checking, and it automatically caches facts that can be derived from existing facts.\nBoth of these things are done by a set of functions that are attached to the primitive operators.\nIt is done in a data-driven style to make it easier to add new primitives, should that become necessary.\n\nThe function `add-fact` checks that each argument to a primitive relation is a nonvariable atom, and it also calls `fact-present-p` to check if the fact is already present in the data base.\nIf not, it indexes the fact and calls `run-attached-fn` to do additional checking and caching:\n\n```lisp\n(defparameter *primitives* '(and sub ind rel val))\n(defun add-fact (fact)\n \"Add the fact to the data base.\"\n (cond ((eq (predicate fact) 'and)\n   (mapc #'add-fact (args fact)))\n  ((or (not (every #'atom (args fact)))\n    (some #'variable-p (args fact))\n    (not (member (predicate fact) *primitives*)))\n   (error \"Ill-formed fact: ~a\" fact))\n  ((not (fact-present-p fact))\n   (index fact)\n   (run-attached-fn fact)))\n t)\n(defun fact-present-p (fact)\n \"Is this fact present in the data base?\"\n (retrieve fact))\n```\n\nThe attached functions are stored on the operator's property list under the indicator `attached-fn:`\n\n```lisp\n(defun run-attached-fn (fact)\n \"Run the function associated with the predicate of this fact.\"\n (apply (get (predicate fact) 'attached-fn) (args fact)))\n(defmacro def-attached-fn (pred args &body body)\n \"Define the attached function for a primitive.\"\n '(setf (get '.pred 'attached-fn)\n   #'(lambda .args ..body)))\n```\n\nThe attached functions for `ind` and `val` are fairly simple.\nIf we know `(sub bear animal)`, then when `(ind Yogi bear)` is asserted, we have to also assert `(ind Yogi animal)`.\nSimilarly, the values in a `val` assertion must be individuals of the categories in the relation's `rel` assertion.\nThat is, if `(rel birthday animal date)` is a fact and `(val birthday Lee july-1)` is added, then we can conclude `(ind Lee animal)` and `(ind july-1 date).` The following functions add the appropriate facts:\n\n```lisp\n(def-attached-fn ind (individual category)\n ;; Cache facts about inherited categories\n (query-bind (?super) '(sub .category ?super)\n  (add-fact '(ind .individual .?super))))\n(def-attached-fn val (relation indl ind2)\n ;; Make sure the individuals are the right kinds\n (query-bind (?cat1 ?cat2) '(rel .relation ?cat1 ?cat2)\n  (add-fact '(ind .ind1 .?cat1))\n  (add-fact '(ind .ind2 .?cat2))))\n```\n\nThe attached function for rel simply runs the attached function for any individual of the given relation.\nNormally one would make all `rel` assertions before `ind` assertions, so this will have no effect at all.\nBut we want to be sure the data base stays consistent even if facts are asserted in an unusual order.\n\n```lisp\n(def-attached-fn rel (relation cat1 cat2)\n ;; Run attached function for any IND's of this relation\n (query-bind (?a ?b) '(ind .relation ?a ?b)\n  (run-attached-fn '(ind .relation .?a .?b))))\n```\n\nThe most complicated attached function is for `sub`.\nAdding a fact such as `(sub bear animal)` causes the following to happen:\n\n*  All of `animal`'s supercategories (such as `living-thing)` become supercategories of all of `bear`'s subcategories (such as `polar-bear)`.\n\n*  `animal` itself becomes a supercategory all of `bear`'s subcategories.\n\n*  bear itself becomes a subcategory of all of `animal`'s supercategories.\n\n*  All of the individuals of bear become individuals of `animal` and its supercategories.\n\nThe following accomplishes these four tasks.\nIt does it with four calls to `index-new-fact`, which is used instead of `add-fact` because we don't need to run the attached function on the new facts.\nWe do, however, need to make sure that we aren't indexing the same fact twice.\n\n```lisp\n(def-attached-fn sub (subcat supercat)\n ;; Cache SUB facts\n (query-bind (?super-super) '(sub ,supercat ?super-super)\n  (index-new-fact '(sub ,subcat ,?super-super))\n  (query-bind (?sub-sub) '(sub ?sub-sub ,subcat)\n   (index-new-fact '(sub ,?sub-sub ,?super-super))))\n (query-bind (?sub-sub) '(sub ?sub-sub ,subcat)\n  (index-new-fact '(sub ,?sub-sub ,supercat)))\n ;; Cache IND facts\n (query-bind (?super-super) '(sub ,subcat ?super-super)\n  (query-bind (?sub-sub) '(sub ?sub-sub ,supercat)\n   (query-bind (?ind) '(ind ?ind ,?sub-sub)\n    (index-new-fact '(ind ,?ind ,?super-super))))))\n(defun index-new-fact (fact)\n \"Index the fact in the data base unless it is already there.\"\n (unless (fact-present-p fact)\n  (index fact)))\n```\n\nThe following function tests the attached functions.\nIt shows that adding the single fact `(sub bear animal)` to the given data base causes 18 new facts to be added.\n\n```lisp\n(defun test-bears ()\n (clear-dtrees)\n (mapc #'add-fact\n   '((sub animal living-thing)\n    (sub living-thing thing) (sub polar-bear bear)\n    (sub grizzly bear) (ind Yogi bear) (ind Lars polar-bear)\n    (ind Helga grizzly)))\n (trace index)\n (add-fact '(sub bear animal))\n (untrace index))\n>(test-bears)\n(1 ENTER INDEX: (SUB BEAR ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB BEAR THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB GRIZZLY THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB POLAR-BEAR THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB BEAR LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB GRIZZLY LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB POLAR-BEAR LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB GRIZZLY ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB POLAR-BEAR ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND LARS LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND HELGA LIVING-THING)\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND YOGI LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND LARS THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND HELGA THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND YOGI THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND LARS ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND HELGA ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND YOGI ANIMAL))\n(1 EXIT INDEX: T)\n(INDEX)\n```\n\n### A Frame Language\n{:#s9015}\n{:.h2hd}\n\nAnother direction we can take is to provide an alternative syntax that will be easier to read and write.\nMany representation languages are based on the idea of *frames,* and their syntax reflects this.\nA frame is an object with slots.\nWe will continue to use the same data base in the same format, but we will provide an alternative syntax that consider s the individuals and categories as frames, and the relations as slots.\n\nHere is an example of the frame syntax for individuals, which uses the operator a.\nNote that it is more compact than the equivalent notation using the primitives.\n\n```lisp\n(a person (name Joe) (age 27)) =\n(and (ind person1 person)\n (val name person1 Joe)\n (val age person1 27))\n```\n\nThe syntax also allows for nested expressions to appear as the values of slots.\nNotice that the Skolem constant `person1` was generated automatically; an alternative is to supply a constant for the individual after the category name.\nFor example, the following says that Joe is a person of age 27 whose best friend is a person named Fran who is 28 and whose best friend is Joe:\n\n```lisp\n(a person p1 (name Joe) (age 27)\n (best-friend (a person (name Fran) (age 28)\n     (best-friend pl)))) =\n(and (ind p1 person) (val name p1 joe) (val age p1 27)\n (ind person2 person) (val name person2 fran)\n (val age person2 28) (val best-friend person2 pl)\n (val best-friend p1 person2))\n```\n\nThe frame syntax for categories uses the operator `each`.\nFor example:\n\n```lisp\n(each person (isa animal) (name person-name) (age integer)) =\n(and (sub person animal)\n (rel name person person-name)\n (rel age person integer))\n```\n\nThe syntax for queries is the same as for assertions, except that variables are used instead of the Skolem constants.\nThis is true even when the Skolem constants are automatically generated, as in the following query:\n\n```lisp\n(a person (age 27)) = (AND (IND ?3 PERSON) (VAL AGE ?3 27))\n```\n\nTo support the frame notation, we define the macros `a` and `each` to make assertions and `??` to make queries.\n\n```lisp\n(defmacro a (&rest args)\n \"Define a new individual and assert facts about it in the data base.\"\n '(add-fact ',(translate-exp (cons 'a args))))\n(defmacro each (&rest args)\n \"Define a new category and assert facts about it in the data base.\"\n '(add-fact ',(transiate-exp (cons 'each args))))\n(defmacro ?? (&rest queries)\n \"Return a list of answers satisfying the query or queries.\"\n '(retrieve-setof\n  '.(translate-exp (maybe-add 'and (replace-?-vars queries))\n     :query)))\n```\n\nAll three of these macros call on `translate-exp` to translate from the frame syntax to the primitive syntax.\nNote that an `a` or `each` expression is Computing a conjunction of primitive relations, but it is also Computing a *term* when it is used as the nested value of a slot.\nIt would be possible to do this by returning multiple values, but it is easier to build `transiate-exp` as a set of local functions that construct facts and push them on the local variable `conjuncts`.\nAt the end, the list of `conjuncts` is returned as the value of the translation.\nThe local functions `transiate-a` and `transiate-each` return the atom that represents the term they are translating.\nThe local function `translate` translates any kind of expression, `transiate-siot` handles a slot, and `collect-fact` is responsible for pushing a fact onto the list of conjuncts.\nThe optional argument `query-mode-p` tells what to do if the individual is not provided in an `a` expression.\nIf `query-mode-p` is true, the individual will be represented by a variable; otherwise it will be a Skolem constant.\n\n```lisp\n(defun translate-exp (exp &optional query-mode-p)\n \"Translate exp into a conjunction of the four primitives.\"\n (let ((conjuncts nil))\n  (labels\n   ((collect-fact (&rest terms) (push terms conjuncts))\n    (translate (exp)\n     ;; Figure out what kind of expression this is\n     (cond\n      ((atom exp) exp)\n      ((eq (first exp) 'a) (translate-a (rest exp)))\n      ((eq (first exp) 'each) (translate-each (rest exp)))\n      (t (apply #'collect-fact exp) exp)))\n    (translate-a (args)\n     ;; translate (A category [ind] (rel filler)*)\n     (let* ((category (pop args))\n       (self (cond ((and args (atom (first args)))\n         (pop args))\n        (query-mode-p (gentemp \"?\"))\n        (t (gentemp (string category))))))\n      (collect-fact 'ind self category)\n      (dolist (slot args)\n       (translate-slot 'val self slot))\n      self))\n    (translate-each (args)\n     ;; translate (EACH category [(isa cat*)] (slot cat)*)\n     (let* ((category (pop args)))\n      (when (eq (predicate (first args)) 'isa)\n       (dolist (super (rest (pop args)))\n        (collect-fact 'sub category super)))\n      (dolist (slot args)\n       (translate-slot 'rel category slot))\n      category))\n    (translate-slot (primitive self slot)\n     ;; translate (relation value) into a REL or SUB\n     (assert (= (length slot) 2))\n     (collect-fact primitive (first slot) self\n         (translate (second slot)))))\n   ;; Body of translate-exp:\n   (translate exp) ;; Build up the list of conjuncts\n   (maybe-add 'and (nreverse conjuncts)))))\n```\n\nThe auxiliary functions `maybe-add` and `replace-?-vars` are shown in the following:\n\n```lisp\n(defun maybe-add (op exps &optional if-nil)\n \"For example, (maybe-add 'and exps t) returns\n t if exps is nil, (first exps) if there is only one,\n and (and expl exp2...) if there are several exps.\"\n (cond ((null exps) if-nil)\n  ((length=1 exps) (first exps))\n  (t (cons op exps))))\n(defun length=1 (x)\n \"Is x a list of length 1?\"\n (and (consp x) (null (cdr x))))\n(defun replace-?-vars (exp)\n \"Replace each ? in exp with a temporary var: ?123\"\n (cond ((eq exp '?) (gentemp \"?\"))\n  ((atom exp) exp)\n  (t (reuse-cons (replace-?-vars (first exp))\n     (replace-?-vars (rest exp))\n     exp))))\n```\n\n### Possible Worlds: Truth, Negation, and Disjunction\n{:#s19055}\n{:.h2hd}\n\nIn this section we address four problems: distinguishing `unknown` from `false`, representing negations, representing disjunctions, and representing multiple possible states of affairs.\nIt turns out that all four problems can be solved by introducing two new techniques: possible worlds and negated predicates.\nThe solution is not completely general, but it is practical in a wide variety of applications.\n\nThere are two basic ways to distinguish unknown from false.\nThe first possibility is to store a truth value-`true` or `false`-along with each proposition.\nThe second possibility is to include the truth value as part of the proposition.\nThere are several syntactic variations on this theme.\nThe following table shows the possibilities for the propositions \"Jan likes Dean is true\" and \"Jan likes Ian is false:\"\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Approach | True Prop. | False Prop. |\n| 1) | `(likes Jan Dean) -- true` | `(likes Jan Ian) -- false` |\n| (2a) | `(likes true Jan Dean)` | `(likes false Jan Ian)` |\n| (2b) | `(likes Jan Dean)` | `(not (likes Jan Dean))` |\n| (2c) | `(likes Jan Dean)` | `(~ likes Jan Dean)` |\n\nThe difference between (1) and (2) shows up when we want to make a query.\nWith (1), we make the single query `(likes Jan Dean)` (or perhaps `(likes Jan ?x))`, and the answers will tell us who Jan does and does not like.\nWith (2), we make one query to find out what liking relationships are true, and another to find out which ones are false.\nIn either approach, if there are no responses then the answer is truly unknown.\n\nApproach (1) is better for applications where most queries are of the form \"Is this sentence true or false?\" But applications that include backward-chaining rules are not like this.\nThe typical backward-chaining rule says \"Conclude X is true if Y is true.\" Thus, most queries will be of the type \"Is Y true?\" Therefore, some version of approach (2) is preferred.\n\nRepresenting true and false opens the door to a host of possible extensions.\nFirst, we could add multiple truth values beyond the simple \"true\" and \"false.\" These could be symbolic values like \"probably-true\" or \"false-by-default\" or they could be numeric values representing probabilities or certainty factors.\n\nSecond, we could introduce the idea of *possible worlds.* That is, the truth of a proposition could be unknown in the current world, but true if we assume *p*, and false if we assume *q.* In the possible world approach, this is handled by calling the current world *W*, and then creating a new world *W*1, which is just like *W* except that *p* is true, and *W*2, which is just like *W* except that *q* is true.\nBy doing reasoning in different worlds we can make predictions about the future, resolve ambiguitites about the current state, and do reasoning by cases.\n\nFor example, possible worlds allow us to solve Moore's communism/democracy problem ([page 466](#p466)).\nWe create two new possible worlds, one where *E* is a democracy and one where it is communist.\nIn each world it is easy to derive that there is a democracy next to a communist country.\nThe trick is to realize then that the two worlds form a partition, and that therefore the assertion holds in the original \"real\" world as well.\nThis requires an interaction between the Prolog-based tactical reasoning going on within a world and the planning-based strategie reasoning that decides which worlds to consider.\n\nWe could also add a *truth maintenance system* (or TMS) to keep track of the assumptions or justifications that lead to each fact being considered true.\nA truth maintenance system can lessen the need to backtrack in a search for a global solution.\nAlthough truth maintenance systems are an important part of AI programming, they will not be covered in this book.\n\nIn this section we extend the dtree facility ([section 14.8](#s0045)) to handle truth values and possible worlds.\nWith so many options, it is difficult to make design choices.\nWe will choose a fairly simple system, one that remains close to the simplicity and speed of Prolog but offers additional functionality when needed.\nWe will adopt approach (2c) to truth values, using negated predicates.\nFor example, the negated predicate of `likes` is `~likes`, which is pronounced \"not likes.\"\n\nWe will also provide minimal support for possible worlds.\nAssume that there is always a current world, *W,* and that there is a way to create alternative worlds and change the current world to an alternative one.\nAssertions and queries will always be made with respect to the current world.\nEach fact is indexed by the atoms it contains, just as before.\nThe difference is that the facts are also indexed by the current world.\nTo support this, we need to modify the notion of the numbered list, or `nlist`, to include a numbered association list, or `nalist`.\nThe following is an `nalist` showing six facts indexed under three different worlds: `W0, Wl`, and `W2`:\n\n```lisp\n(6 (W0 #1# #2# #3#) (Wl #4#) (W2 #5# #6#))\n```\n\nThe fetching routine will remain unchanged, but the postfetch processing will have to sort through the nalists to find only the facts in the current world.\nIt would also be possible for `fetch` to do this work, but the reasoning is that most facts will be indexed under the \"real world,\" and only a few facts will exist in alternative, hypothetical worlds.\nTherefore, we should delay the effort of sorting through the answers to elimina te those answers in the wrong world-it may be that the first answer fetched will suffice, and then it would have been a waste to go through and eliminate other answers.\nThe following changes to `index` and `dtree-index` add support for worlds:\n\n```lisp\n(defvar *world* 'W0 \"The current world used by index and fetch.\")\n(defun index (key &optional (world *world*))\n \"Store key in a dtree node. Key must be (predicate . args);\n it is stored in the dtree, indexed by the world.\"\n (dtree-index key key world (get-dtree (predicate key))))\n(defun dtree-index (key value world dtree)\n \"Index value under all atoms of key in dtree.\"\n (cond\n  ((consp key)  ; index on both first and rest\n   (dtree-index (first key) value world\n      (or (dtree-first dtree)\n       (setf (dtree-first dtree) (make-dtree))))\n   (dtree-index (rest key) value world\n      (or (dtree-rest dtree)\n       (setf (dtree-rest dtree) (make-dtree)))))\n  ((null key))  ; don't index on nil\n  ((variable-p key)  ; index a variable\n   (nalist-push world value (dtree-var dtree)))\n  (t ;; Make sure there is an nlist for this atom. and add to it\n   (nalist-push world value (lookup-atom key dtree)))))\n```\n\nThe new function `nalist-push` adds a value to an nalist, either by inserting the value in an existing key's list or by adding a new key/value list:\n\n```lisp\n(defun nalist-push (key val nalist)\n \"Index val under key in a numbered al ist.\"\n ;; An nalist is of the form (count (key val*)*)\n ;; Ex: (6 (nums 12 3) (letters a b c))\n (incf (car nalist))\n (let ((pair (assoc key (cdr nalist))))\n  (if pair\n   (push val (cdr pair))\n   (push (list key val) (cdr nalist)))))\n```\n\nIn the following, `fetch` is used on the same data base created by `test-index`, indexed under the world `W0`.\nThis time the resuit is a list-of-lists of world/values a-lists.\nThe count, 3, is the same as before.\n\n```lisp\n>(fetch '(p ?x c))\n(((W0 (P B C) (P A C)))\n ((W0 (P A ?X))))\n3\n```\n\nSo far, worlds have been represented as symbols, with the implication that different symbols represent completely distinct worlds.\nThat doesn't make worlds very easy to use.\nWe would like to be able to use worlds to explore alternatives-create a new hypothetical world, make some assumptions (by asserting them as facts in the hypothetical world), and see what can be derived in that world.\nIt would be tedious to have to copy all the facts from the real world into each hypothetical world.\n\nAn alternative is to establish an inheritance hierarchy among worlds.\nThen a fact is considered true if it is indexed in the current world or in any world that the current world inherits from.\n\nTo support inheritance, we will implement worlds as structures with a name field and a field for the list of parents the world inherits from.\nSearching through the inheritance lattice could become costly, so we will do it only once each time the user changes worlds, and mark all the current worlds by setting the `current` field on or off.\nHere is the definition for the world structure:\n\n```lisp\n(defstruct (world (:print-function print-world))\n name parents current)\n```\n\nWe will need a way to get from the name of a world to the world structure.\nAssuming names are symbols, we can store the structure on the name's property list.\nThe function `get-world` gets the structure for a name, or builds a new one and stores it.\n`get-world` can also be passed a world instead of a name, in which case it just returns the world.\nWe also include a definition of the default initial world.\n\n```lisp\n(defun get-world (name &optional current (parents (list *world*)))\n \"Look up or create the world with this name.\n If the world is new, give it the list of parents.\"\n (cond ((world-p name) name) ; ok if it already is a world\n   ((get name 'world))\n   (t (setf (get name 'world)\n     (make-world :name name :parents parents\n      :current current)))))\n(defvar *world* (get-world 'W0 nil nil)\n \"The current world used by index and fetch.\")\n```\n\nThe function `use-world` is used to switch to a new world.\nIt first makes the current world and all its parents no longer current, and then makes the new chosen world and all its parents current.\nThe function `use-new-world` is more efficient in the common case where you want to create a new world that inherits from the current world.\nIt doesn't have to turn any worlds off; it j ust crea tes the new world and makes it current.\n\n```lisp\n(defun use-world (world)\n \"Make this world current.\"\n ;; If passed a name, look up the world it names\n (setf world (get-world world))\n (unless (eq world *world*)\n  ;; Turn the old world(s) off and the new one(s) on,\n  ;; unless we are already using the new world\n  (set-world-current *world* nil)\n  (set-world-current world t)\n  (setf *world* world)))\n(defun use-new-world ()\n \"Make up a new world and use it.\n The world inherits from the current world.\"\n (setf *wor1d* (get-world (gensym \"W\")))\n (setf (world-current *world*) t)\n *world*)\n(defun set-world-current (world on/off)\n \"Set the current field of world and its parents on or off.\"\n ;; nil is off, anything else is on.\n (setf (world-current world) on/off)\n (dolist (parent (world-parents world))\n  (set-world-current parent on/off)))\n```\n\nWe also add a print function for worlds, which just prints the world's name.\n\n```lisp\n(defun print-world (world &optional (stream t) depth)\n (declare (ignore depth))\n (prin1 (world-name world) stream))\n```\n\nThe format of the dtree data base has changed to include worlds, so we need new retrieval functions to search through this new format.\nHere the functions `mapc-retrieve, retrieve`, and `retrieve-bagof` are modified to give new versions that treat worlds.\nTo reflect this change, the new functions all have names ending in -`in-world`:\n\n```lisp\n(defun mapc-retrieve-in-world (fn query)\n \"For every fact in the current world that matches the query,\n apply the function to the binding list.\"\n (dolist (bucket (fetch query))\n  (dolist (world/entries bucket)\n   (when (world-current (first world/entries))\n    (dolist (answer (rest world/entries))\n     (let ((bindings (unify query answer)))\n      (unless (eq bindings fall)\n       (funcall fn bindings))))))))\n(defun retrieve-in-world (query)\n \"Find all facts that match query. Return a list of bindings.\"\n (let ((answers nil))\n  (mapc-retrieve-in-world\n   #'(lambda (bindings) (push bindings answers))\n   query)\n  answers))\n(defun retrieve-bagof-in-world (query)\n \"Find all facts in the current world that match query.\n Return a list of queries with bindings filled in.\"\n (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n     (retrieve-in-world query)))\n```\n\nNow let's see how these worlds work.\nFirst, in `W0` we see that the facts from `test-index` are still in the data base:\n\n```lisp\n> *world* => W0\n```\n\n`> (retrieve-bagof-in-world '(p ?z c))`=>\n\n```lisp\n((P A C) (P A C) (P B C))\n```\n\nNow we create and use a new world that inherits from `W0`.\nTwo new facts are added to this new world:\n\n```lisp\n> (use-new-world)`=> `W7031\n> (index '(p new c))`=> `T\n> (index '(~p b b))`=> `T\n```\n\nWe see that the two new facts are accessible in this world:\n\n`> (retrieve-bagof-in-world '(p ?z c))`=>\n\n```lisp\n((P A C) (P A C) (P B C) (P NEW C))\n```\n\n`> (retrieve-bagof-in-world '(~p ?x ?y))`=>\n\n```lisp\n((~P B B))\n```\n\nNow we create another world as an alternative to the current one by first switching back to the original `W0`, then creating the new world, and then adding some facts:\n\n```lisp\n> (use-world 'W0)`=> `W0\n> (use-new-world)`=> `W7173\n> (index '(p newest c))`=> `T\n> (index '(~p c newest))`=> `T\n```\n\nHere we see that the facts entered in `W7031` are not accessible, but the facts in the new world and in `W0` are:\n\n`> (retrieve-bagof-in-world '(p ?z c))`=>\n\n```lisp\n((P A C) (P A C) (P B C) (P NEWEST C))\n```\n\n`> (retrieve-bagof-in-world '(~p ?x ?y))`=>\n\n```lisp\n((~P C NEWEST))\n```\n\n### Unification, Equality, Types, and Skolem Constants\n{:#s9155}\n{:.h2hd}\n\nThe lesson of the zebra puzzle in [section 11.4](B978008057115750011X.xhtml#s0040) was that unification can be used to lessen the need for backtracking, because an uninstantiated logic variable or partially instantiated term can stand for a whole range of possible solutions.\nHowever, this advantage can quickly disappear when the representation forces the problem solver to enumerate possible solutions rather than treating a whole range of solutions as one.\nFor example, consider the following query in the frame language and its expansion into primitives:\n\n```lisp\n(a person (name Fran))\n= (and (ind ?p person) (val name ?p fran))\n```\n\nThe way to answer this query is to enumerate all individuals `?p` of type `person` and then check the `name` slot of each such person.\nIt would be more efficient if `(ind ?p person)` did not act as an enumeration, but rather as a constraint on the possible values of `?p`.\nThis would be possible if we changed the definition of variables (and of the unification function) so that each variable had a type associated with it.\nIn fact, there are at least three sources of information that have been implemented as constraints on variables terms:\n\n*  The type or category of the term.\n\n*  The members or size of a term considered as a set or list.\n\n*  Other terms this term is equal or not equal to.\n\nNote that with a good solution to the problem of equality, we can solve the problem of Skolem constants.\nThe idea is that a regular constant unifies with itself but no other regular constant.\nOn the other hand, a Skolem constant can potentially unify with any other constant (regular or Skolem).\nThe equality mechanism is used to keep track of each Skolem variable's possible bindings.\n\n## 14.11 History and References\n{:#s0085}\n{:.h1hd}\n\n[Brachman and Levesque (1985)](B9780080571157500285.xhtml#bb0115) collect thirty of the key papers in knowledge representation.\nIncluded are some early approaches to semantic network based ([Quillian 1967](B9780080571157500285.xhtml#bb0965)) and logic-based ([McCarthy 1968](B9780080571157500285.xhtml#bb0805)) representation.\nTwo thoughtful critiques of the ad hoc use of representations without defining their meaning are by [Woods (1975)](B9780080571157500285.xhtml#bb1430) and [McDermott (1978)](B9780080571157500285.xhtml#bb0820).\nIt is interesting to contrast the latter with [McDermott 1987](B9780080571157500285.xhtml#bb0825), which argues that logic by itself is not sufficient to solve the problems of AI.\nThis argument should not be surprising to those who remember the slogan *logic = algorithm - control.*\n\n[Genesereth and Nilsson's textbook (1987)](B9780080571157500285.xhtml#bb0455) cover the predicate-calculus-based approach to knowledge representation and AI in general.\n[Ernest Davis (1990)](B9780080571157500285.xhtml#bb0275) presents a good overview of the field that includes specialized representations for time, space, qualitative physics, propositional attitudes, and the interaction between agents.\n\nMany representation languages focus on the problem of defining descriptions for categories of objects.\nThese have come to be known as *term-subsumption languages.* Examples include KL-ONE ([Schmolze and Lipkis 1983](B9780080571157500285.xhtml#bb1060)) and KRYPTON ([Brachman, Fikes, and Levesque 1983](B9780080571157500285.xhtml#bb0120)).\nSee [Lakoff 1987](B9780080571157500285.xhtml#bb0685) for much more on the problem of categories and prototypes.\n\nHector [Levesque (1986)](B9780080571157500285.xhtml#bb0720) points out that the areas Prolog has difficulty with-disjunction, negation, and existentials-all involve a degree of vagueness.\nIn his term, they lack *vividness.* A vivid proposition is one that could be represented directly in a picture: the car is blue; she has a martini in her left hand; Albany is the capital of New York.\nNonvivid propositions cannot be so represented: the car is not blue; she has a martini in one hand; either Albany or New York City is the capital of New York.\nThere is interest in separating vivid from nonvivid reasoning, but no current systems are actually built this way.\n\nThe possible world approach of [section 14.10](#s0055) was used in the MRS system ([Russell 1985](B9780080571157500285.xhtml#bb1020)).\nMore recent knowledge representation systems tend to use truth maintenance systems instead of possible worlds.\nThis approach was pioneered by [Doyle (1979)](B9780080571157500285.xhtml#bb0340) and [McAllester (1982)](B9780080571157500285.xhtml#bb0785).\nDoyle tried to change the name to \"reason maintenance,' in (1983), but it was too late.\nThe version in widest used today is the assumption-based truth maintenance system, or ATMS, developed by de Kleer (1986a,b,c).\n[Charniak et al.\n(1987)](B9780080571157500285.xhtml#bb0180) present a complete Common Lisp implementation of a McAllester-styleTMS.\n\nThere is little communication between the logic programming and knowledge representation communities, even though they cover overlapping territory.\n[Colmerauer (1990)](B9780080571157500285.xhtml#bb0250) and [Cohen (1990)](B9780080571157500285.xhtml#bb0230) describe Logic Programming languages that address some of the issues covered in this chapter.\nKey papers in equality reasoning include Galler and Fisher 1974, [Kornfeld 1983](B9780080571157500285.xhtml#bb0645),[1](#fn0015) Jaffar, Lassez, and Maher 1984, and [van Emden and Yukawa 1987](B9780080571157500285.xhtml#bb1265).\n[H&ouml;lldobler's book (1987)](B9780080571157500285.xhtml#bb0550) includes an overview of the area.\nPapers on extending unification in ways other than equality include [A&iuml;t-Kaci et al.\n1987](B9780080571157500285.xhtml#bb0025) and [Staples and Robinson 1988](B9780080571157500285.xhtml#bb1125).\nFinally, papers on extending Prolog to cover disjunction and negation (i.e., non-Horn clauses) include [Loveland 1987](B9780080571157500285.xhtml#bb0755), [Plaisted 1988](B9780080571157500285.xhtml#bb0960), and [Stickel l988](B9780080571157500285.xhtml#bb1200).\n\n## 14.12 Exercises\n{:#s0090}\n{:.h1hd}\n\n**Exercise 14.1 [m]** Arrange to store dtrees in a hash table rather than on the property list of predicates.\n\n**Exercise 14.2 [m]** Arrange to store the `dtree-atoms` in a hash table rather than in an association list.\n\n**Exercise 14.3 [m]** Change the `dtree` code so that `nil` is used as an atom index.\nTime the performance on an application and see if the change helps or hurts.\n\n**Exercise 14.4 [m]** Consider the query `(p a b c d e f g)`.\nIf the index under a returns only one or two keys, then it is probably a waste of time for `dtree-fetch` to consider the other keys in the hope of finding a smaller bucket.\nIt is certainly a waste if there are no keys at all indexed under `a`.\nMake appropriate changes to `dtree-fetch`.\n\n**Exercise 14.5 [h]** Arrange to delete elements from a `dtree`.\n\n**Exercise 14.6 [h]** Implement iterative-deepening search in the Prolog compiler.\nYou will have to change each function to accept the depth as an extra argument, and compile in checks for reaching the maximum depth.\n\n**Exercise 14.7 [d]** Integrate the Prolog compiler with the dtree data base.\nUse the dtrees for predicates with a large number of clauses, and make sure that each predicate that is implemented as a dtree has a Prolog primitive accessing the dtree.\n\n**Exercise 14.8 [d]** Add support for possible worlds to the Prolog compiler with dtrees.\nThis support has already been provided for dtrees, but you will have to provide it for ordinary Prolog rules.\n\n**Exercise 14.9 [h]** Integrate the language described in [section 14.10](#s0055) and the frame syntax from [section 14.10](#s0055) with the extended Prolog compiler from the previous exercise.\n\n**Exercise 14.10 [d]** Build a strategie reasoner that decides when to create a possible world and does reasoning by cases over these worlds.\nUse it to solve Moore 's problem ([page 466](#p466)).\n\n## 14.13 Answers\n{:#s0095}\n{:.h1hd}\n\n**Answer 14.1**\n\n```lisp\n(let ((dtrees (make-hash-table :test #'eq)))\n (defun get-dtree (predicate)\n  \"Fetch (or make) the dtree for this predicate.\"\n  (setf (gethash predicate dtrees)\n    (or (gethash predicate dtrees)\n     (make-dtree))))\n (defun clear-dtrees ()\n \"Remove all the dtrees for all the predicates.\"\n (clrhash dtrees)))\n```\n\n**Answer 14.5** Hint: here is the code for `nlist-delete`.\nNow figure out how to find all the nlists that an item is indexed under.\n\n```lisp\n(defun nlist-delete (item nlist)\n \"Remove an element from an nlist.\n Assumes that item is present exactly once.\"\n (decf (car nlist))\n (setf (cdr nlist) (delete item (cdr nlist) :count 1))\n nlist)\n```\n\n----------------------\n\n[1](#xfn0015) A commentary on this paper appears in [Elcock and Hoddinott 1986](B9780080571157500285.xhtml#bb0360).\n!!!(p) {:.ftnote1}\n\nPart IV\nAdvanced AI Programs\n!!!(p) {:.parttitle}\n\n# Chapter 15\n## Symbolic Mathematics with Canonical Forms\n{:.chaptitle}\n\n> Anything simple always interests me.\n\n> -David Hockney\n\n[Chapter 8](B978008057115750008X.xhtml) started with high hopes: to take an existing pattern matcher, copy down some mathematical identities out of a reference book, and come up with a usable symbolic algebra system.\nThe resulting system *was* usable for some purposes, and it showed that the technique of rule-based translation is a powerful one.\nHowever, the problems of [section 8.5](B978008057115750008X.xhtml#s0030) show that not everything can be done easily and efficiently within the rule-based pattern matching framework.\n\nThere are important mathematical transformations that are difficult to express in the rule-based approach.\nFor example, dividing two polynomials to obtain a quotient and remainder is a task that is easier to express as an algorithm-a program-than as a rule or set of rules.\n\nIn addition, there is a problem with efficiency.\nPieces of the input expressions are simplified over and over again, and much time is spent interpreting rules that do not apply.\n[Section 9.6](B9780080571157500091.xhtml#s0035) showed some techniques for speeding up the program by a factor of 100 on inputs of a dozen or so symbols, but for expressions with a hundred or so symbols, the speed-up is not enough.\nWe can do better by designing a specialized representation from the ground up.\n\nSerious algebraic manipulation programs generally enforce a notion of *canonical simplification.* That is, expressions are converted into a canonical internal format that may be far removed from the input form.\nThey are then manipulated, and translated back to external form for output.\nOf course, the simplifier we have already does this kind of translation, to some degree.\nIt translates `(3 + x + -3 + y)` into `(+ x y)` internally, and then outputs it as `(x + y)`.\nBut a *canonical* representation must have the property that any two expressions that are equal have identical canonical forms.\nIn our system the expression `(5 + y + x + -5)`is translated to the internal form `(+ y x)`, which is not identical to `(+ x y)`, even though the two expressions are equal.\nThus, our system is not canonical.\nMost of the problems of the previous section stem from the lack of a canonical form.\n\nAdhering to canonical form imposes grave restrictions on the representation.\nFor example, *x2*- 1 and (*x*- 1)(*x* + 1) are equal, so they must be represented identically.\nOne way to insure this is to multiply out all factors and collect similar terms.\nSo (*x*- 1)(*x* + 1) is *x2*- *x* + *x*- 1, which simplifies to *x2*- 1, in whatever the canonical internal form is.\nThis approach works fine for *x2*- 1, but for an expression like (*x*- 1)1000, multiplying out all factors would be quite time- (and space-) consuming.\nIt is hard to find a canonical form that is ideal for all problems.\nThe best we can do is choose one that works well for the problems we are most likely to encounter.\n\n## 15.1 A Canonical Form for Polynomials\n{:#s0010}\n{:.h1hd}\n\nThis section will concentrate on a canonical form for *polynomials.* Mathematically speaking, a polynomial is a function (of one or more variables) that can be computed using only addition and multiplication.\nWe will speak of a polynomial's *main variable, coefficents,* and *degree.* In the polynomial:\n\n5xx3+bxx2+cxx+1\n\n![si1_e](images/B9780080571157500157/si1_e.gif)\n\nthe main variable is *x,* the degree is 3 (the highest power of *x*), and the coefficients are 5, *b, c* and 1.\nWe can define an input format for polynomials as follows:\n\n1. Any Lisp number is a polynomial.\n!!!(p) {:.numlist}\n\n2. Any Lisp symbol is a polynomial.\n!!!(p) {:.numlist}\n\n3. If *p* and *q* are polynomials, so are (*p + q*) and (*p * q*).\n!!!(p) {:.numlist}\n\n4. If *p* is a polynomial and *n* is a positive integer, then (*p* ^ *n*) is a polynomial.\n!!!(p) {:.numlist}\n\nHowever, the input format cannot be used as the canonical form, because it would admit both `(x + y)` and `(y + x)`, and both `4` and `(2 + 2)`.\n\nBefore considering a canonical form for polynomials, let us see why polynomials were chosen as the target domain.\nFirst, the volume of programming needed to support canonical forms for a larger class of expressions grows substantially.\nTo make things easier, we have eliminated complications like log and trig functions.\nPolynomials are a good choice because they are closed under addition and multiplication: the sum or product of any two polynomials is a polynomial.\nIf we had allowed division, the result would not be closed, because the quotient of two polynomials need not be a polynomial.\nAs a bonus, polynomials are also closed under differentiation and integration, so we can include those operators as well.\n\nSecond, for sufficiently large classes of expressions it becomes not just difficult but impossible to define a canonical form.\nThis may be surprising, and we don't have space here to explain exactly why it is so, but here is an argument: Consider what would happen if we added enough functionality to duplicate all of Lisp.\nThen \"converting to canonical form\" would be the same as \"running a program.\" But it is an elementary result of computability theory that it is in general impossible to determine the result of running an arbitrary program (this is known as the halting problem).\nThus, it is not surprising that it is impossible to canonicalize complex expressions.\n\nOur task is to convert a polynomial as previously defined into some canonical form.[1](#fn0015) Much of the code and some of the commentary on this format and the routines to manipulate it was written by Richard Fateman, with some enhancements made by Peter Klier.\n\nThe first design decision is to assume that we will be dealing mostly with *dense* polynomials, rather than *sparse* ones.\nThat is, we expect most of the polynomials to be like *ax*3*+ bx*2*+ cx* + *d,* not like *ax*100*+ bx*50 + *c.* For dense polynomials, we can save space by representing the main variable (*x* in these examples) and the individual coefficients (*a*, *b*, *c*, and *d* in these examples) explicitly, but representing the exponents only implicitly, by position.\nVectors will be used instead of lists, to save space and to allow fast access to any element.\nThus, the representation of 5*x*3+ 10*x*2+ 20*x +* 30 will be the vector:\n\n```lisp\n#(x 30 20 10 5)\n```\n\nThe main variable, *x*, is in the 0th element of the vector, and the coefficient of the *i*th power of *x* is in element *i* + 1 of the vector.\nA single variable is represented as a vector whose first coefficient is 1, and a number is represented as itself:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `#(x 30 20 10 5)` | represents 5*x*3 + 10*x*2 + 20*x* + 30 |\n| `#(x 0 1)` | represents *x* |\n| `5` | represents 5 |\n\nThe fact that a number is represented as itself is a possible source of confusion.\nThe number 5, for example, is a polynomial by our mathematical definition of polynomials.\nBut it is represented as 5, not as a vector, so `(typep 5 'polynomial)` will be false.\nThe word \"polynomial\" is used ambiguously to refer to both the mathematical concept and the Lisp type, but it should be clear from context which is meant.\n\nA glossary for the canonical simplifier program is given in [figure 15.1](#f0010).\n\n![f15-01-9780080571157](images/B9780080571157500157/f15-01-9780080571157.jpg)     \nFigure 15.1\n!!!(span) {:.fignum}\nGlossary for the Symbolic Manipulation Program\nThe functions defining the type `polynomial` follow.\nBecause we are concerned with efficiency, we proclaim certain short functions to be compiled inline, use the specific function `svref` (simple-vector reference) rather than the more general aref, and provide declarations for the polynomials using the special form the.\nMore details on efficiency issues are given in [Chapter 9](B9780080571157500091.xhtml).\n\n```lisp\n(proclaim '(inline main-var degree coef\n       var= var> poly make-poly))\n(deftype polynomial () 'simple-vector)\n(defun main-var (p) (svref (the polynomial p) 0))\n(defun coef (p i) (svref (the polynomial p) (+ i 1)))\n(defun degree (p) (-(length (the polynomial p)) 2))\n```\n\nWe had to make another design decision in defining `coef`, the function to extract a coefficient from a polynomial.\nAs stated above, the *i*th coefficient of a polynomial is in element *i* + 1 of the vector.\nIf we required the caller of coef to pass in *i* + 1 to get *i,* we might be able to save a few addition operations.\nThe design decision was that this would be too confusing and error prone.\nThus, coef expects to be passed *i* and does the addition itself.\n\nFor our format, we will insist that main variables be symbols, while coefficients can be numbers or other polynomials.\nA \"production\" version of the program might have to account for main variables like `(sin x)`, as well as other complications like + and * with more than two arguments, and noninteger powers.\n\nNow we can extract information from a polynomial, but we also need to build and modify polynomials.\nThe function `poly` takes a variable and some coefficients and builds a vector representing the polynomial.\n`make-poly` takes a variable and a degree and produces a polynomial with all zero coefficients.\n\n```lisp\n(defun poly (x &rest coefs)\n  \"Make a polynomial with main variable x\n  and coefficients in increasing order.\"\n  (apply #'vector x coefs))\n(defun make-poly (x degree)\n  \"Make the polynomial 0 + 0*x + 0*x^2 + ... 0*x^degree\"\n  (let ((p (make-array (+ degree 2) : initial-element 0)))\n    (setf (main-var p) x)\n    p))\n```\n\nA polynomial can be altered by setting its main variable or any one of its coefficients using the following `defsetf` forms.\n\n```lisp\n(defsetf main-var (p) (val)\n '(setf (svref (the polynomial ,p) 0) ,val))\n(defsetf coef (p i) (val)\n '(setf (svref (the polynomial .p) (+ ,i 1)) .val))\n```\n\nThe function `poly` constructs polynomials in a fashion similar to `list` or `vector`: with an explicit list of the contents, `make-poly`, on the other hand, is like `make-array`: it makes a polynomial of a specified size.\n\nWe provide `setf` methods for modifying the main variable and coefficients.\nSince this is the first use of `defsetf`, it deserves some explanation.\nA `defsetf` form takes a function (or macro) name, an argument list, and a second argument list that must consist of a single argument, the value to be assigned.\nThe body of the form is an expression that stores the value in the proper place.\nSo the `defsetf` for `main-var` says that `(setf (main-varp) val)` is equivalent to `(setf (svref (the polynomial p) 0) val)`.\nA `defsetf` is much like a `defmacro`, but there is a little less burden placed on the writer of `defsetf`.\nInstead of passing `p` and `val` directly to the `setf` method, Common Lisp binds local variables to these expressions, and passes those variables to the `setf` method.\nThat way, the writer does not have to worry about evaluating the expressions in the wrong order or the wrong number of times.\nIt is also possible to gain finer control over the whole process with `define-setf-method`, as explained on [page 884](B978008057115750025X.xhtml#p884).\n\nThe functions `poly+poly, poly*poly` and `poly^n` perform addition, multiplication, and exponentiation of polynomials, respectively.\nThey are defined with several helping functions.\n`k*poly` multiplies a polynomial by a constant, `k`, which may be a number or another polynomial that is free of polynomial `p`'s main variable.\n`poly*same` is used to multiply two polynomials with the same main variable.\nFor addition, the functions `k+poly` and `poly+same` serve analogous purposes.\nWith that in mind, here's the function to convert from prefix to canonical form:\n\n```lisp\n(defun prefix->canon (x)\n \"Convert a prefix Lisp expression to canonical form.\n Exs: (+ (^ x 2) (* 3 x))` =>`#(x 0 3 1)\n   (- (* (- x 1) (+ x 1)) (- (^ x 2) 1))` =>`0\"\n (cond ((numberp x) x)\n   ((symbolp x) (poly x 0 1))\n   ((and (exp-p x) (get (exp-op x) 'prefix->canon))\n       (apply (get (exp-op x) 'prefix->canon)\n     (mapcar #'prefix->canon (exp-args x))))\n   (t (error \"Not a polynomial: ~a\" x))))\n```\n\nIt is data-driven, based on the `prefix->canon` property of each operator.\nIn the following we install the appropriate functions.\nThe existing functions `poly*poly` and `poly^n` can be used directly.\nBut other operators need interface functions.\nThe operators + and - need interface functions that handle both unary and binary.\n\n```lisp\n(dolist (item '((+ poly+) (- poly-) (* poly*poly)\n     (^ poly^n) (D deriv-poly)))\n (setf (get (first item) 'prefix->canon) (second item)))\n(defun poly+ (&rest args)\n \"Unary or binary polynomial addition.\"\n (ecase (length args)\n  (1 (first args))\n  (2 (poly+poly (first args) (second args)))))\n(defun poly- (&rest args)\n \"Unary or binary polynomial subtraction.\"\n (ecase (length args)\n  (1 (poly*poly -1 (first args)))\n  (2 (poly+poly (first args) (poly*poly -1 (second args))))))\n```\n\nThe function `prefix->canon` accepts inputs that were not part of our definition of polynomials: unary positive and negation operators and binary subtraction and differentiation operators.\nThese are permissible because they can all be reduced to the elementary + and * operations.\n\nRemember that our problems with canonical form all began with the inability to decide which was simpler: `(+ x y)` or `(+ y x)`.\nIn this system, we define a canonical form by imposing an ordering on variables (we use alphabetic ordering as defined by `string>`).\nThe rule is that a polynomial `p` can have coefficients that are polynomials in a variable later in the alphabet than `p`'s main variable, but no coefficients that are polynomials in variables earlier than `p`'s main variable.\nHere's how to compare variables:\n\n```lisp\n(defun var= (x y) (eq x y))\n(defun var> (x y) (string> x y))\n```\n\nThe canonical form of the variable `x` will be `#(x 0 1)`, which is 0 x *x*0 + 1 x *x*1.\nThe canonical form of `(+ x y)` is `#(x #(y 0 1) 1)`.\nIt couldn't be `#(y #(x 0 1) 1)`, because then the resulting polynomial would have a coefficient with a lesser main variable.\nThe policy of ordering variables assures canonicality, by properly grouping like variables together and by imposing a particular ordering on expressions that would otherwise be commutative.\n\nHere, then, is the code for adding two polynomials:\n\n```lisp\n(defun poly+poly (p q)\n \"Add two polynomials.\"\n (normalize-poly\n  (cond\n   ((numberp p)                      (k+poly p q))\n   ((numberp q)                      (k+poly q p))\n   ((var= (main-var p) (main-var q)) (poly+same p q))\n   ((var> (main-var q) (main-var p)) (k+poly q p))\n   (t                                (k+poly p q)))))\n(defun k+poly (k p)\n \"Add a constant k to a polynomial p.\"\n (cond ((eql k 0) p)     ;; 0 + p = p\n    ((and (numberp k)(numberp p))\n        (+ k p))       ;; Add numbers\n    (t (let ((r (copy-poly p))) ;; Add k to x^0 term of p\n      (setf (coef r 0) (poly+poly (coef r 0) k))\n      r))))\n(defun poly+same (p q)\n \"Add two polynomials with the same main variable.\"\n ;; First assure that q is the higher degree polynomial\n (if (> (degree p) (degree q))\n   (poly+same q p)\n   ;; Add each element of p into r (which is a copy of q).\n   (let ((r (copy-poly q)))\n    (loop for i from 0 to (degree p) do\n      (setf (coef r i) (poly+poly (coef r i) (coef p i))))\n    r)))\n(defun copy-poly (p)\n \"Make a copy a polynomial.\"\n (copy-seq p))\n```\n\nand the code for multiplying polynomials:\n\n```lisp\n(defun poly*poly (p q)\n \"Multiply two polynomials.\"\n (normalize-poly\n  (cond\n   ((numberp p)                      (k*poly p q))\n   ((numberp q)                      (k*poly q p))\n   ((var= (main-var p) (main-var q)) (poly*same p q))\n   ((var> (main-var q) (main-var p)) (k*poly q p))\n   (t                                (k*poly p q)))))\n(defun k*poly (k p)\n \"Multiply a polynomial p by a constant factor k.\"\n (cond\n  ((eql k 0)   0)   ;; 0 * p = 0\n  ((eql kl)   p)   ;; 1 * p = p\n  ((and (numberp k)\n    (numberp p)) (* k p)) ;; Multiply numbers\n  (t ;; Multiply each coefficient\n   (let ((r (make-poly (main-var p) (degree p))))\n       ;; Accumulate result in r; r[i] = k*p[i]\n       (loop for i from 0 to (degree p) do\n     (setf (coef r i) (poly*poly k (coef p i))))\n       r))))\n```\n\nThe hard part is multiplying two polynomials with the same main variable.\nThis is done by creating a new polynomial, `r`, whose degree is the sum of the two input polynomials `p` and `q`.\nInitially, all of `r`'s coefficients are zero.\nA doubly nested loop multiplies each coefficient of `p` and `q` and adds the `result` into the appropriate coefficient of `r`.\n\n```lisp\n(defun poly*same (p q)\n \"Multiply two polynomials with the same variable.\"\n ;; r[i] = p[0]*q[i] + p[l]*q[i-1] + ...\n (let* ((r-degree (+ (degree p) (degree q)))\n   (r (make-poly (main-var p) r-degree)))\n  (loop for i from 0 to (degree p) do\n    (unless (eql (coef p i) 0)\n     (loop for j from 0 to (degree q) do\n      (setf (coef r (+ i j))\n       (poly+poly (coef r (+ i j))\n        (poly*poly (coef p i)\n         (coef q j)))))))\n  r))\n```\n\nBoth `poly+poly` and `poly*poly` make use of the function `normalize-poly` to \"normalize\" the `result`.\nThe idea is that `(- (^ 5) (^ x 5))` should return 0, not `#(x 0 0 0 0 0 0)`.\nNote that `normal` ize`-poly` is a destructive operation: it calls `delete,` which can actually alter its argument.\nNormally this is a dangerous thing, but since `normalize-poly` is replacing something with its conceptual equal, no harm is done.\n\n```lisp\n(defun normalize-poly (p)\n \"Alter a polynomial by dropping trailing zeros.\"\n (if (numberp p)\n   p\n   (let ((p-degree (- (position 0 p :test (complement #'eql)\n                  :from-end t)\n            1)))\n    (cond ((<= p-degree 0) (normalize-poly (coef p 0)))\n     ((< p-degree (degree p))\n      (delete 0 p :start p-degree))\n     (t p)))))\n```\n\nThere are a few loose ends to clean up.\nFirst, the exponentiation function:\n\n```lisp\n(defun poly^n (p n)\n \"Raise polynomial p to the nth power, n>=0.\"\n (check-type n (integer 0 *))\n (cond ((= n 0) (assert (not (eql p 0))) 1)\n   ((integerp p) (expt p n))\n   (t (poly*poly p (poly^n p (- n 1))))))\n```\n\n## 15.2 Differentiating Polynomials\n{:#s0015}\n{:.h1hd}\n\nThe differentiation routine is easy, mainly because there are only two operators (+ and *) to deal with:\n\n```lisp\n(defun deriv-poly (p x)\n \"Return the derivative, dp/dx, of the polynomial p.\"\n ;; If p is a number or a polynomial with main-var > x,\n ;; then p is free of x, and the derivative is zero;\n ;; otherwise do real work.\n ;; But first, make sure X is a simple variable,\n ;; of the form #(X 0 1).\n (assert (and (typep x 'polynomial) (= (degree x) 1)\n     (eql (coef x 0) 0) (eql (coef x 1) 1)))\n  (cond\n     ((numberp p) 0)\n     ((var> (main-var p) (main-var x)) 0)\n     ((var= (main-var p) (main-var x))\n      ;; d(a + bx + cx^2 + dx^3)/dx = b + 2cx + 3dx^2\n      ;; So, shift the sequence p over by 1, then\n      ;; put x back in, and multiply by the exponents\n      (let ((r (subseq p 1)))\n      (setf (main-var r) (main-var x))\n      (loop for i from 1 to (degree r) do\n        (setf (coef r i) (poly*poly (+ i 1) (coef r i))))\n      (normalize-poly r)))\n     (t ;; Otherwise some coefficient may contain x. Ex:\n      ;; d(z + 3x + 3zx^2 + z^2x^3)/dz\n      ;; = 1 + 0 + 3x^2 + 2zx^3\n      ;; So copy p, and differentiate the coefficients.\n      (let ((r (copy-poly p)))\n      (loop for i from 0 to (degree p) do\n        (setf (coef r i) (deriv-poly (coef r i) x)))\n      (normalize-poly r)))))\n```\n\n**Exercise 15.1 [h]** Integrating polynomials is not much harder than differentiating them.\nFor example:\n\n&int;ax2+bxdx=ax33+bx22+c.\n\n![si2_e](images/B9780080571157500157/si2_e.gif)\n\nWrite a function to integrate polynomials and install it in `prefix->canon`.\n\n**Exercise 15.2 [m]** Add support for *definite* integrais, such as &int;abydx !!!(span) {:.hiddenClass} ![si3_e](images/B9780080571157500157/si3_e.gif).\nYou will need to make up a suitable notation and properly install it in both `infix->prefix` and `prefix->canon`.\nA full implementation of this feature would have to consider infinity as a bound, as well as the problem of integrating over singularises.\nYou need not address these problems.\n\n## 15.3 Converting between Infix and Prefix\n{:#s0020}\n{:.h1hd}\n\nAll that remains is converting from canonical form back to prefix form, and from there back to infix form.\nThis is a good point to extend the prefix form to allow expressions with more than two arguments.\nFirst we show an updated version of `prefix->infix` that handles multiple arguments:\n\n```lisp\n(defun prefix->infix (exp)\n \"Translate prefix to infix expressions.\n Handles operators with any number of args.\"\n (if (atom exp)\n   exp\n   (intersperse\n    (exp-op exp)\n    (mapcar #'prefix->infix (exp-args exp)))))\n(defun intersperse (op args)\n \"Place op between each element of args.\n Ex: (intersperse '+ '(a b c))` =>`'(a + b + c)\"\n (if (length=1 args)\n   (first args)\n   (rest (loop for arg in args\n      collect op\n      collect arg))))\n```\n\nNow we need only convert from canonical form to prefix:\n\n```lisp\n(defun canon->prefix (p)\n \"Convert a canonical polynomial to a lisp expression.\"\n (if (numberp p)\n    p\n    (args->prefix\n      '+ 0\n      (loop for i from (degree p) downto 0\n        collect (args->prefix\n        '* 1\n        (list (canon->prefix (coef pi))\n         (exponent->prefix\n          (main-var p) i)))))))\n(defun exponent->prefix (base exponent)\n \"Convert canonical base'exponent to prefix form.\"\n (case exponent\n  (0 1)\n  (1 base)\n  (t '(^ .base .exponent))))\n(defun args->prefix (op identity args)\n \"Convert argl op arg2 op ... to prefix form.\"\n (let ((useful-args (remove identity args)))\n  (cond ((null useful-args) identity)\n    ((and (eq op '*) (member 0 args)) 0)\n    ((length=1 args) (first useful-args))\n    (t (cons op (mappend\n        #'(lambda (exp)\n        (if (starts-with exp op)\n           (exp-args exp)\n           (list exp)))\n      useful-args))))))\n```\n\nFinally, here's a top level to make use of all this:\n\n```lisp\n(defun canon (infix-exp)\n \"Canonicalize argument and convert it back to infix\"\n (prefix->infix\n  (canon->prefix\n   (prefix->canon\n    (infix->prefix infix-exp)))))\n(defun canon-simplifier ()\n \"Read an expression, canonicalize it, and print the result.\"\n (loop\n  (print 'canon>)\n  (print (canon (read)))))\n```\n\nand an example of it in use:\n\n```lisp\n> (canon-simplifier)\nCANON> (3 + x + 4 - x)\n7\nCANON> (x + y + y + x)\n((2 * X) + (2 * Y))\nCANON> (3 * x + 4 * x)\n(7 * X)\nCANON> (3 * x + y + x + 4 * x)\n((8 * X) + Y)\nCANON> (3 * x + y + z + x + 4 * x)\n((8 * X) + (Y + Z))\nCANON> ((x + 1) ^ 10)\n((X ^ 10) + (10 * (X ^ 9)) + (45 * (X ^ 8)) + (120 * (X ^ 7))\n + (210 * (X ^ 6)) + (252 * (X ^ 5)) + (210 * (X ^ 4))\n + (120 * (X ^ 3)) + (45 * (X ^ 2)) + (10 * X) + 1)\nCANON> ((x + 1) ^ 10 + (x - 1) ^ 10)\n((2 * (X ^ 10)) + (90 * (X ^ 8)) + (420 * (X ^ 6))\n + (420 * (X ^ 4)) + (90 * (X ^ 2)) + 2)\nCANON> ((x + 1) ^ 10 - (x - 1) ^ 10)\n((20 * (X ^ 8)) + (240 * (X ^ 7)) + (504 * (X ^ 5))\n + (240 * (X ^ 3)) + (20 * X))\nCANON> (3 * x ^ 3 + 4 * x * y * (x - 1) + x ^ 2 * (x + y))\n((4 * (X ^ 3)) + ((5 * Y) * (X ^ 2)) + ((-4 * Y) * X))\nCANON> (3 * x ^ 3 + 4 * x * w * (x - 1) + x ^ 2 * (x + w))\n((((5 * (X ^ 2)) + (-4 * X)) * W) + (4 * (X ^ 3)))\nCANON> (d (3 * x ^ 2 + 2 * x + 1) / d x)\n((6 * X) + 2)\nCANON> (d(z + 3 * x + 3 * z * x ^ 2 + z ^ 2 * x ^ 3) / d z)\n(((2 * Z) * (X ^ 3)) + (3 * (X ^ 2)) + 1)\nCANON> [Abort]\n```\n\n## 15.4 Benchmarking the Polynomial Simplifier\n{:#s0025}\n{:.h1hd}\n\nUnlike the rule-based program, this version gets all the answers right.\nNot only is the program correct (at least as far as these examples go), it is also fast.\nWe can compare it to the canonical simplifier originally written for MACSYMA !!!(span) {:.smallcaps} by William Martin (circa 1968), and modified by Richard Fateman.\nThe modified version was used by Richard Gabriel in his suite of Common Lisp benchmarks (1985).\nThe benchmark program is called `frpoly`, because it deals with polynomials and was originally written in the dialect Franz Lisp.\nThe `frpoly` benchmark encodes polynomials as lists rather than vectors, and goes to great lengths to be efficient.\nOtherwise, it is similar to the algorithms used here (although the code itself is quite different, using progs and gos and other features that have fallen into disfavor in the intervening decades).\nThe particular benchmark we will use here is raising 1 ***+** x + y + z* to the 15th power:\n\n```lisp\n(defun r15-test ()\n (let ((r (prefix->canon'(+ 1 (+ x (+ y z))))))\n  (time (poly^n r 15))\n  nil))\n```\n\nThis takes .97 seconds on our system.\nThe equivalent test with the original `frpoly` code takes about the same time: .98 seconds.\nThus, our program is as fast as production-quality code.\nIn terms of storage space, vectors use about half as much storage as lists, because half of each cons cell is a pointer, while vectors are all useful data.[2](#fn0020)\n\nHow much faster is the polynomial-based code than the rule-based version?\nUnfortunately, we can't answer that question directly.\nWe can time `(simp ' ( (1 + x + y + z) ^ 15)))`.\nThis takes only a tenth of a second, but that is because it is doing no work at all-the answer is the same as the input!\nAlternately, we can take the expression computed by `(poly^n r 15)`, convert it to prefix, and pass that `to simplify.\nsimplify` takes 27.8 seconds on this, so the rule-based version is much slower.\n[Section 9.6](B9780080571157500091.xhtml#s0035) describes ways to speed up the rule-based program, and a comparison of timing data appears on [page 525](#p525).\n\nThere are always surprises when it cornes down to measuring timing data.\nFor example, the alert reader may have noticed that the version of `poly^n` defined above requires *n* multiplications.\nUsually, exponentiation is done by squaring a value when the exponent is even.\nSuch an algorithm takes only log *n* multiplications instead of *n.* We can add a line to the definition of `poly^n` to get an *O*(log *n*) algorithm:\n\n```lisp\n(defun poly^n (p n)\n \"Raise polynomial p to the nth power, n>=0.\"\n (check-type n (integer 0 *))\n (cond ((= n 0) (assert (not (eql p 0))) 1)\n   ((integerp p) (expt p n))\n   ((evenp n) (poly^2 (poly^n p (/ n 2)))) ;***\n   (t (poly*poly p (poly^n p (- n 1))))))\n(defun poly^2 (p) (poly*poly p p))\n```\n\nThe surprise is that this takes *longer* to raise `*r*` to the 15th power.\nEven though it does fewer `poly*poly` operations, it is doing them on more complex arguments, and there is more work altogether.\nIf we use this version of `poly^n,` then `r15-test` takes 1.6 seconds instead of .98 seconds.\n\nBy the way, this is a perfect example of the conceptual power of recursive functions.\nWe took an existing function, poly^n, added a single cond clause, and changed it from an *O*(*n*) to *O*(log *n*) algorithm.\n(This turned out to be a bad idea, but that's beside the point.\nIt would be a good idea for raising integers to powers.) The reasoning that allows the change is simple: First, *pn* is certainly equal to (*p**n*/2)2 when *n* is even, so the change can't introduce any wrong answers.\nSecond, the change continues the policy of decrementing *n* on every recursive call, so the function must eventually termina te (when *n =* 0).\nIf it gives no wrong answers, and it terminates, then it must give the right answer.\n\nIn contrast, making the change for an iterative algorithm is more complex.\nThe initial algorithm is simple:\n\n```lisp\n(defun poly^n (p n)\n (let ((result 1))\n  (loop repeat n do (setf result (poly*poly p result)))\n  result))\n```\n\nBut to change it, we have to change the repeat loop to a `while` loop, explicitly put in the decrement of *n*, and insert a test for the even case:\n\n```lisp\n(defun poly^n (p n)\n (let ((result 1))\n  (loop while (> n 0)\n   do (if (evenp n)\n     (setf p (poly^2 p)\n       n (/ n 2))\n     (setf result (poly*poly p result)\n       n (- n 1))))\n  result))\n```\n\nFor this problem, it is clear that thinking recursively leads to a simpler function that is easier to modify.\n\nIt turns out that this is not the final word.\nExponentiation of polynomials can be done even faster, with a little more mathematical sophistication.\n[Richard Fateman's 1974](B9780080571157500285.xhtml#bb0380) paper on Polynomial Multiplication analyzes the complexity of a variety of exponentiation algorithms.\nInstead of the usual asymptotic analysis (e.g.\n*O*(*n*) or *O*(*n*2)), he uses a fine-grained analysis that computes the constant factors (e.g.\n1000 x *n* or 2 x *n*2).\nSuch analysis is crucial for small values of *n*.\nIt turns out that for a variety of polynomials, an exponentiation algorithm based on the binomial theorem is best.\nThe binomial theorem states that\n\na+bn=&Sigma;i=0nn!i!n-i!aibn-i\n\n![si4_e](images/B9780080571157500157/si4_e.gif)\n\nfor example,\n\na+b3=b3+3ab2+3a2b+a3\n\n![si5_e](images/B9780080571157500157/si5_e.gif)\n\nWe can use this theorem to compute a power of a polynomial all at once, instead of computing it by repeated multiplication or squaring.\nOf course, a polynomial will in general be a sum of more than two components, so we have to decid`e` how to split it into the *a* and *b* pieces.\nThere are two obvious ways: either eut the polynomial in half, so that *a* and *b* will be of equal size, or split off one component at a time.\nFateman shows that the latter method is more efficient in most cases.\nIn other words, a polynomial k1xn+k2xn-1+k3xn-2+... !!!(span) {:.hiddenClass} ![si6_e](images/B9780080571157500157/si6_e.gif) will be treated as the sum *a + b* where *a*= *k*1*xn* and *b* is the rest of the polynomial.\n\nFollowing is the code for binomial exponentiation.\nIt is somewhat messy, because the emphasis is on efficiency.\nThis means reusing some data and using `p-add-into!` instead of the more general `poly+poly`.\n\n```lisp\n(defun poly^n (p n)\n \"Raise polynomial p to the nth power, n>=0.\"\n ;; Uses the binomial theorem\n (check-type n (integer 0 *))\n (cond\n  ((= n 0) 1)\n  ((integerp p) (expt p n))\n  (t ;; First: split the polynomial p = a + b, where\n   ;; a = k*x^d and b is the rest of p\n   (let ((a (make-poly (main-var p) (degree p)))\n    (b (normalize-poly (subseq p 0 (- (length p) 1))))\n    ;; Allocate arrays of powers of a and b:\n    (a^n (make-array (+ n 1)))\n    (b^n (make-array (+ n 1)))\n    ;; Initialize the result:\n    (result (make-poly (main-var p) (* (degree p) n))))\n   (setf (coef a (degree p)) (coef p (degree p)))\n   ;; Second: Compute powers of a^i and b^i for i up to n\n   (setf (aref a^n 0) 1)\n   (setf (aref b^n 0) 1)\n   (loop for i from 1 to n do\n     (setf (aref a^n i) (poly*poly a (aref a^n (- i 1))))\n     (setf (aref b^n i) (poly*poly b (aref b^n (- i 1)))))\n   ;; Third: add the products into the result,\n   ;; so that result[i] = (n choose i) * a^i * b^(n-i)\n   (let ((c 1)) ;; c helps compute (n choose i) incrementally\n    (loop for i from 0 to n do\n      (p-add-into! result c\n        (poly*poly (aref a^n i)\n          (aref b^n (- n i))))\n      (setf c (/ (* c (- n i)) (+ i 1)))))\n   (normalize-poly result)))))\n(defun p-add-into! (result c p)\n \"Destructively add c*p into result.\"\n (if (or (numberp p)\n     (not (var= (main-var p) (main-var result))))\n   (setf (coef result 0)\n      (poly+poly (coef result 0) (poly*poly c p)))\n   (loop for i from 0 to (degree p) do\n      (setf (coef result i)\n        (poly+poly (coef result i) (poly*poly c (coef p i))))))\n result)\n```\n\nUsing this version of `poly^n, r15-test` takes only .23 seconds, four times faster than the previous version.\nThe following table compares the times for `r15-test` with the three versions of `poly^n`, along with the times for applying `simply` to the `r15` polynomial, for various versions of `simplify`:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | program | secs | speed-up |\n| | **rule-based versions** |\n| 1 | original | 27.8 | - |\n| 2 | memoization | 7.7 | 4 |\n| 3 | memo+index | 4.0 | 7 |\n| 4 | compilation only | 2.5 | 11 |\n| 5 | memo+compilation | 1.9 | 15 |\n| | **canonical versions** |\n| 6 | squaring `poly^n` | 1.6 | 17 |\n| 7 | iterative `poly^n` | .98 | 28 |\n| 8 | binomial `poly^n` | .23 | 120 |\n\n![t0010](images/B9780080571157500157/t0010.png)\n\nAs we remarked earlier, the general techniques of memoization, indexing, and compilation provide for dramatic speed-ups.\nHowever, in the end, they do not lead to the fastest program.\nInstead, the fastest version was achieved by throwing out the original rule-based program, replacing it with a canonical-form-based program, and fine-tuning the algorithms within that program, using mathematical analysis.\n\nNow that we have achieved a sufficiently fast system, the next two sections concentrate on making it more powerful.\n\n## 15.5 A Canonical Form for Rational Expressions\n{:#s0030}\n{:.h1hd}\n\nA *rational* number is defined as a fraction: the quotient of two integers.\nA *rational expression* is hereby defined as the quotient of two polynomials.\nThis section presents a canonical form for rational expressions.\n\nFirst, a number or polynomial will continue to be represented as before.\nThe quotient of two polynomials will be represented as a cons cells of numerator and denominator pairs.\nHowever, just as Lisp automatically reduces rational numbers to simplest form (6/8 is represented as 3/4), we must reduce rational expressions.\nSo, for example, (*x*2- 1)/(*x*- 1) must be reduced to *x* + 1, not left as a quotient of two polynomials.\n\nThe following functions build and access rational expressions but do not reduce to simplest form, except in the case where the denominator is a number.\nBuilding up the rest of the functionality for full rational expressions is left to a series of exercises:\n\n```lisp\n(defun make-rat (numerator denominator)\n \"Build a rational: a quotient of two polynomials.\"\n (if (numberp denominator)\n   (k*poly (/ 1 denominator) numerator)\n   (cons numeratordenominator)))\n(defun rat-numerator (rat)\n \"The numerator of a rational expression.\"\n (typecase rat\n  (cons (car rat))\n  (number (numerator rat))\n  (t rat)))\n(defun rat-denominator (rat)\n \"The denominator of a rational expression.\"\n (typecase rat\n  (cons (cdr rat))\n  (number (denominator rat))\n  (t 1)))\n```\n\n**Exercise 15.3 [s]** Modify `prefix->canon` to accept input of the form `x / y` and to return rational expressions instead of polynomials.\nAlso allow for input of the form `x ^ - n`.\n\n**Exercise 15.4 [m]** Add arithmetic routines for multiplication, addition, and division of rational expressions.\nCall them `rat*rat, rat+rat`, and `rat/rat` respectively.\nThey will call upon `poly*poly.\npoly+poly` and a new function, `poly/poly`, which is defined in the next exercise.\n\n**Exercise 15.5 [h]** Define `poly-gcd`, which computes the greatest common divisor of two polynomials.\n\n**Exercise 15.6 [h]** Using `poly-gcd`, define the function `poly/poly`, which will implement division for polynomials.\nPolynomials are closed under addition and multiplication, so `poly+poly` and `poly*poly` both returned polynomials.\nPolynomials are not closed under division, so `poly/poly` will return a rational expression.\n\n## 15.6 Extending Rational Expressions\n{:#s0035}\n{:.h1hd}\n\nNow that we can divide polynomials, the final step is to reinstate the logarithmic, exponential, and trigonometrie functions.\nThe problem is that if we allow all these functions, we get into problems with canonical form again.\nFor example, the following three expressions are all equivalent :\n\nsinxcosx-&pi;2eix-e-ix2i\n\n![si7_e](images/B9780080571157500157/si7_e.gif)\n\nIf we are interested in assuring we have a canonical form, the safest thing is to allow only *e**x*** and log(*x*).\nAll the other functions can be defined in terms of these two.\nWith this extension, the set of expressions we can form is closed under differentiation, and it is possible to canonicalize expressions.\nThe `result` is a mathematically sound construction known as a *differentiable field.* This is precisely the construct that is assumed by the Risch integration algorithm ([Risch 1969](B9780080571157500285.xhtml#bb0985),[1979](B9780080571157500285.xhtml#bb0990)).\n\nThe disadvantage of this minimal extension is that answers may be expressed in unfamiliar terms.\nThe user asks for *d* sin(*x2*)*/dx,* expecting a simple answer in terms of cos, and is surprised to see a complex answer involving *eix*.\nBecause of this problem, most computer algebra systems have made more radical extensions, allowing sin, cos, and other functions.\nThese systems are treading on thin mathematical ice.\nAlgorithms that would be guaranteed to work over a simple differentiable field may fail when the domain is extended this way.\nIn general, the result will not be a wrong answer but rather the failure to find an answer at all.\n\n## 15.7 History and References\n{:#s0040}\n{:.h1hd}\n\nA brief history of symbolic algebra systems is given in [chapter 8](B978008057115750008X.xhtml).\n[Fateman (1979)](B9780080571157500285.xhtml#bb0385), [Martin and Fateman (1971)](B9780080571157500285.xhtml#bb0775), and [Davenport et al.\n(1988)](B9780080571157500285.xhtml#bb0270) give more details on the MACSYMA !!!(span) {:.smallcaps} system, on which this chapter is loosely based.\n[Fateman (1991)](B9780080571157500285.xhtml#bb0390) discusses the `frpoly` benchmark and introduces the vector implementation used in this chapter.\n\n## 15.8 Exercises\n{:#s0045}\n{:.h1hd}\n\n**Exercise 15.7 [h]** Implement an extension of the rationals to include logarithmic, exponential, and trigonometrie functions.\n\n**Exercise 15.8 [m]** Modify `deriv` to handle the extended rational expressions.\n\n**Exercise 15.9 [d]** Adapt the integration routine from [section 8.6](B9780080571157500078.xhtml#s0035) ([page 252](B978008057115750008X.xhtml#p252)) to the rational expression representation.\n[Davenport et al.\n1988](B9780080571157500285.xhtml#bb0270) may be useful.\n\n**Exercise 15.10 [s]** Give several reasons why constant polynomials, like 3, are represented as integers rather than as vectors.\n\n## 15.9 Answers\n{:#s0050}\n{:.h1hd}\n\n**Answer 15.4**\n\n```lisp\n(defun rat*rat (x y)\n \"Multiply rationals: a/b * c/d = a*c/b*d\"\n (poly/poly (poly*poly (rat-numerator x)\n        (rat-numerator y))\n    (poly*poly (rat-denominator x)\n        (rat-denominator y))))\n(defun rat+rat (x y)\n \"Add rationals: a/b + c/d = (a*d + c*b)/b*d\"\n (let ((a (rat-numerator x))\n    (b (rat-denominator x))\n    (c (rat-numerator y))\n    (d (rat-denominator y)))\n  (poly/poly (poly+poly (poly*poly a d) (poly*poly c b))\n       (poly*poly b d))))\n(defun rat/rat (x y)\n \"Divide rationals: a/b / c/d - a*d/b*c\"\n (rat*rat x (make-rat (rat-denominator y) (rat-numerator y))))\n```\n\n**Answer 15.6**\n\n```lisp\n(defun poly/poly (p q)\n \"Divide p by q: if d is the greatest common divisor of p and q\n then p/q = (p/d) / (q/d). Note if q-1. then p/q = p.\"\n (if (eql q 1)\n   p\n   (let ((d (poly-gcd p q)))\n    (make-rat (poly/poly p d)\n        (poly/poly q d)))))\n```\n\n**Answer 15.10** (1) An integer takes less time and space to process.\n(2) Representing numbers as a polynomial would cause an infinit`e` regress, because the coefficients would be numbers.\n(3) Unless a policy was decided upon, the representation would not be canonical, since `#(x 3)` and `#(y 3)` both represent 3.\n\n----------------------\n\n[1](#xfn0015) In fact, the algebraic properties of polynomial arithmetic and its generalizations fit so well with ideas in data abstraction that an extended example (in Scheme) on this topic is provided in *Structure and Interpretation of Computer Programs* by Abelson and Sussman (see section 2.4.3, [pages 153](B9780080571157500054.xhtml#p153)-[166](B9780080571157500054.xhtml#p166)).\nWe'll pursue a slightly different approach here.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0020) Note: systems that use `\"`cdr-coding`\"` take about the same space for lists that are allocated all at once as for vectors.\nBut cdr-coding is losing favor as RISC chips replace microcoded processors.\n!!!(p) {:.ftnote1}\n\n# Chapter 16\n## Expert Systems\n{:.chaptitle}\n\n> An expert is one who knows more and more about less and less.\n\n> -Nicholas Murray Butler (1862-1947)\n\nIn the 1970s there was terrifie interest in the area of *knowledge-based expert systems*.\nAn expert system or knowledge-based system is one that solves problems by applying knowledge that has been garnered from one or more experts in a field.\nSince these experts will not in general be programmers, they will very probably express their expertise in terms that cannot immediately be translated into a program.\nIt is the goal of expert-system research to come up with a representation that is flexible enough to handle expert knowledge, but still capable of being manipulated by a computer program to come up with solutions.\n\nA plausible candidate for this representation is as logical facts and rules, as in Prolog.\nHowever, there are three areas where Prolog provides poor support for a general knowledge-based system:\n\n*  Reasoning with uncertainty.\nProlog only deals with the black-and-white world of facts that are clearly true or false (and it doesn't even handle false very well).\nOften experts will express rules of thumb that are \"likely\" or \"90% certain.\"\n\n*  Explanation.\nProlog gives solutions to queries but no indication of how those solutions were derived.\nA system that can explain its solutions to the user in understandable terms will be trusted more.\n\n*  Flexible flow of control.\nProlog works by backward-chaining from the goal.\nIn some cases, we may need more varied control strategy.\nFor example, in medical diagnosis, there is a prescribed order for acquiring certain information about the patient.\nA medical system must follow this order, even if it doesn't fit in with the backward-chaining strategy.\n\nThe early expert systems used a wide variety of techniques to attack these problems.\nEventually, it became clear that certain techniques were being used frequently, and they were captured in *expert-system shells*: specialized programming environments that helped acquire knowledge from the expert and use it to solve problems and provide explanations.\nThe idea was that these shells would provide a higher level of abstraction than just Lisp or Prolog and would make it easy to write new expert systems.\n\nThe MYCIN !!!(span) {:.smallcaps} expert system was one of the earliest and remains one of the best known.\nIt was written by Dr.\nEdward Shortliffe in 1974 as an experiment in medical diagnosis.\nMYCIN !!!(span) {:.smallcaps} was designed to prescribe antibiotic therapy for bacterial blood infections, and when completed it was judged to perform this task as well as experts in the field.\nIts name cornes from the common suffix in drugs it prescribes: erythromycin, clindamycin, and so on.\nThe following is a slightly modified version of one of MYCIN' !!!(span) {:.smallcaps} s rules, along with an English paraphrase generated by the system:\n\n```lisp\n(defrule 52\n if (site culture is blood)\n  (gram organism is neg)\n  (morphology organism is rod)\n  (burn patient is serious)\n then .4\n  (identity organism is pseudomonas))\nRule 52:\n If\n  1) THE SITE OF THE CULTURE IS BLOOD\n  2) THE GRAM OF THE ORGANISM IS NEG\n  3) THE MORPHOLOGY OF THE ORGANISM IS ROD\n  4) THE BURN OF THE PATIENT IS SERIOUS\n Then there is weakly suggestive evidence (0.4) that\n  1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS\n```\n\nMYCIN !!!(span) {:.smallcaps} lead to the development of the EMYCIN !!!(span) {:.smallcaps} expert-system shell.\nEMYCIN !!!(span) {:.smallcaps} stands for \"essential MYCIN !!!(span) {:.smallcaps} ,\" although it is often mispresented as \"empty MYCIN.\" !!!(span) {:.smallcaps} Either way, the name refers to the shell for acquiring knowledge, reasoning with it, and explaining the results, without the specific medical knowledge.\n\nEMYCIN !!!(span) {:.smallcaps} is a backward-chaining rule interpreter that has much in common with Prolog.\nHowever, there are four important differences.\nFirst, and most importantly, EMYCIN !!!(span) {:.smallcaps} deals with uncertainty.\nInstead of insisting that all predications be true or false, EMYCIN !!!(span) {:.smallcaps} associates a *certainty factor* with each predication.\nSecond, EMYCIN !!!(span) {:.smallcaps} caches the results of its computations so that they need not be duplicated.\nThird, EMYCIN !!!(span) {:.smallcaps} provides an easy way for the system to ask the user for information.\nFourth, it provides explanations of its behavior.\nThis can be summed up in the equation:\n\n```lisp\nEMYCIN !!!(span) {:.smallcaps} = Prolog + uncertainty + caching + questions + explanations\n```\n\nWe will first cover the ways EMYCIN !!!(span) {:.smallcaps} is different from Prolog.\nAfter that we will return to the main core of EMYCIN, !!!(span) {:.smallcaps} the backward-chaining rule interpreter.\nFinally, we will show how to add some medical knowledge to EMYCIN !!!(span) {:.smallcaps} to reconstruct MYCIN.\n!!!(span) {:.smallcaps} A glossary of the program is in [figure 16.1](#f0010).\n\n![f16-01-9780080571157](images/B9780080571157500169/f16-01-9780080571157.jpg)     \nFigure 16.1\n!!!(span) {:.fignum}\nGlossary for the EMYCIN\n!!!(span) {:.smallcaps}\nProgram\n\n## 16.1 Dealing with Uncertainty\n{:#s0010}\n{:.h1hd}\n\nEMYCIN !!!(span) {:.smallcaps} deals with uncertainty by replacing the two boolean values, true and false, with a range of values called *certainty factors*.\nThese are numbers from - 1 (false) to + 1 (true), with 0 representing a complete unknown.\nIn Lisp:\n\n```lisp\n(defconstant true + 1.0)\n(defconstant false - 1.0)\n(defconstant unknown 0.0)\n```\n\nTo define the logic of certainty factors, we need to define the logical operations, such as `and, or`, and `not.` The first operation to consider is the combination of two distinct pieces of evidence expressed as certainty factors.\nSuppose we are trying to determine the chances of a patient having disease &Chi;.\nAssume we have a population of prior patients that have been given two lab tests.\nOne test says that 60% of the patients have the disease and the other says that 40% have it.\nHow should we combine these two pieces of evidence into one?\nUnfortunately, there is no way to answer that question correctly without knowing more about the *dependence* of the two sources on each other.\nSuppose the first test says that 60% of the patients (who all happen to be male) have the disease, and the second says that 40% (who all happen to be female) have it.\nThen we should conclude that 100% have it, because the two tests cover the entire population.\nOn the other hand, if the first test is positive only for patients that are 70 years old or older, and the second is positive only for patients that are 80 or older, then the second is just a subset of the first.\nThis adds no new information, so the correct answer is 60% in this case.\n\nIn [section 16.9](#s0050) we will consider ways to take this kind of reasoning into account.\nFor now, we will present the combination method actually used in EMYCIN !!!(span) {:.smallcaps} . It is defined by the formula:\n\ncombine (A, B) =\n\nA+B-AB;A,B>0A+B+AB;A,B<0A+B1-minAB;otherwise\n\n![si1_e](images/B9780080571157500169/si1_e.gif)\n\nAccording to this formula, combine(.60,.40) = .76, which is a compromise between the extremes of .60 and 1.00.\nIt is the same as the probability p(A or B), assuming that A and B are independent.\n\nHowever, it should be clear that certainty factors are not the same thing as probabilities.\nCertainty factors attempt to deal with disbelief as well as belief, but they do not deal with dependence and independence.\nThe EMYCIN !!!(span) {:.smallcaps} combination function has a number of desirable properties:\n\n*  It always computes a number between - 1 and + 1.\n\n*  Combining unknown (zero) with anything leaves it unchanged.\n\n*  Combining true with anything (except false) gives true.\n\n*  Combining true and false is an error.\n\n*  Combining two opposites gives unknown.\n\n*  Combining two positives (except true) gives a larger positive.\n\n*  Combining a positive and a negative gives something in between.\n\nSo far we have seen how to combine two separate pieces of evidence for the same hypothesis.\nIn other words, if we have the two rules:\n\nA => C\n\nB => C\n\nand we know A with certainty factor (cf) .6 and B with cf .4, then we can conclude C with cf .76.\nBut consider a rule with a conjunction in the premise:\n\nA and B => C\n\nCombining A and B in this case is quite different from combining them when they are in separate rules.\nEMYCIN !!!(span) {:.smallcaps} chooses to combine conjunctions by taking the minimum of each conjunct's certainty factor.\nIf certainty factors were probabilities, this would be equivalent to assumming dependence between conjuncts in a rule.\n(If the conjuncts were independent, then the product of the probabilities would be the correct answer.) So EMYCIN !!!(span) {:.smallcaps} is making the quite reasonable (but sometimes incorrect) assumption that conditions that are tied together in a single rule will be dependent on one another, while conditions in separate rules are independent.\n\nThe final complication is that rules themselves may be uncertain.\nThat is, MYCIN !!!(span) {:.smallcaps} accommodates rules that look like:\n\nA and B => .9C\n\nto say that A and B imply C with .9 certainty.\nEMYCIN !!!(span) {:.smallcaps} simply multiplies the rule's cf by the combined cf of the premise.\nSo if A has cf .6 and B has cf .4, then the premise as a whole has cf .4 (the minimum of A and B), which is multiplied by .9 to get .36.\nThe .36 is then combined with any exisiting cf for C.\nIf C is previously unknown, then combining .36 with 0 will give .36.\nIf C had a prior cf of .76, then the new cf would be .36 + .76 - (.36 x .76) = .8464.\n\nHere are the EMYCIN !!!(span) {:.smallcaps} certainty factor combination functions in Lisp:\n\n```lisp\n(defun cf-or (a b)\n \"Combine the certainty factors for the formula (A or B).\n This is used when two rules support the same conclusion.\"\n (cond ((and (> a 0) O b 0))\n    (+ a b (* -1 a b)))\n   ((and (< a 0) (< b 0))\n    (+ a b (* a b)))\n       (t (/ (+ a b)\n       (- 1 (min (abs a) (abs b)))))))\n(defun cf-and (a b)\n \"Combine the certainty factors for the formula (A and B).\"\n (min a b))\n```\n\nCertainty factors can be seen as a generalization of truth values.\nEMYCIN !!!(span) {:.smallcaps} is a backward-chaining rule system that combines certainty factors according to the functions laid out above.\nBut if we only used the certainty factors `true` and `false`, then EMYCIN !!!(span) {:.smallcaps} would behave exactly like Prolog, returning only answers that are definitely true.\nIt is only when we provide fractional certainty factors that the additional EMYCIN !!!(span) {:.smallcaps} mechanism makes a difference.\n\nTruth values actually serve two purposes in Prolog.\nThey determine the final answer, yes, but they also determine when to eut off search: if any one of the premises of a rule is false, then there is no sense looking at the other premises.\nIf in EMYCIN !!!(span) {:.smallcaps} we only eut off the search when one of the premises was absolutely false, then we might have to search through a lot of rules, only to yield answers with very low certainty factors.\nInstead, EMYCIN !!!(span) {:.smallcaps} arbitrarily cuts off the search and considers a premise false when it has a certainty factor below .2.\nThe following functions support this arbitrary cutoff point:\n\n```lisp\n(defconstant cf-cut-off 0.2\n \"Below this certainty we eut off search.\")\n(defun true-p (cf)\n \"Is this certainty factor considered true?\"\n (and (cf-p cf) (> cf cf-cut-off)))\n(defun false-p (cf)\n \"Is this certainty factor considered false?\"\n (and (cf-p cf) (< cf (- cf-cut-off 1.0))))\n(defun cf-p (x)\n \"Is X a valid numeric certainty factor?\"\n (and (numberp x) (<= false x true)))\n```\n\n**Exercise 16.1 [m]** Suppose you read the headline \"Elvis Alive in Kalamazoo\" in a tabloid newspaper to which you attribute a certainty factor of .01.\nIf you combine certainties using EMYCIN's !!!(span) {:.smallcaps} combination rule, how many more copies of the newspaper would you need to see before you were .95 certain Elvis is alive?\n\n## 16.2 Caching Derived Facts\n{:#s0015}\n{:.h1hd}\n\nThe second thing that makes EMYCIN !!!(span) {:.smallcaps} different from Prolog is that EMYCIN !!!(span) {:.smallcaps} *caches* all the facts it derives in a data base.\nWhen Prolog is asked to prove the same goal twice, it performs the same computation twice, no matter how laborious.\nEMYCIN !!!(span) {:.smallcaps} performs the computation the first time and just fetches it the second time.\n\nWe can implement a simple data base by providing three functions: `put-db` to add an association between a key and a value, `get-db` to retrieve a value, and `clear-db` to empty the data base and start over:\n\n```lisp\n(let ((db (make-hash-table :test #'equal)))\n (defun get-db (key) (gethash key db))\n (defun put-db (key val) (setf (gethash key db) val))\n (defun clear-db () (clrhash db)))\n```\n\nThis data base is general enough to hold any association between key and value.\nHowever, most of the information we will want to store is more specific.\n`EMYCIN !!!(span) {:.smallcaps}` is designed to deal with objects (or *instances*) and attributes (or *parameters*) of those objects.\nFor example, each patient has a name parameter.\nPresumably, the value of this parameter will be known exactly.\nOn the other hand, each microscopic organism has an `identity` parameter that is normally not known at the start of the consultation.\nApplying the rules will lead to several possible values for this parameter, each with its own certainty factor.\nIn general, then, the data base will have keys of the form (*parameter instance*) with values of the form ((*val*1*cf*1) (*val*2*cf*2)...).\nIn the following code, `get-vals` returns the list of value/cf pairs for a given parameter and instance, `get-cf` returns the certainty factor for a parameter/instance/value triplet, and `update-cf` changes the certainty factor by combining the old one with a new one.\nNote that the first time `update-cf` is called on a given parameter/instance/value triplet, `get-cf` will return un known (zero).\nCombining that with the given `cf` yields `cf` itself.\nAlso note that the data base has to be an equal hash table, because the keys may include freshly consed lists.\n\n```lisp\n(defun get-vals (parm inst)\n \"Return a list of (val cf) pairs for this (parm inst).\"\n (get-db (list parm inst)))\n(defun get-cf (parm inst val)\n \"Look up the certainty factor or return unknown.\"\n (or (second (assoc val (get-vals parm inst)))\n   unknown))\n(defun update-cf (parm inst val cf)\n \"Change the certainty factor for (parm inst is val),\n by combining the given cf with the old.\"\n (let ((new-cf (cf-or cf (get-cf parm inst val))))\n  (put-db (list parm inst)\n     (cons (list val new-cf)\n       (remove val (get-db (list parm inst))\n         :key #'first)))))\n```\n\nThe data base holds all information related to an instance of a problem.\nFor example, in the medical domain, the data base would hold all information about the current patient.\nWhen we want to consider a new patient, the data base is cleared.\n\nThere are three other sources of information that cannot be stored in this data base, because they have to be maintained from one problem to the next.\nFirst, the *rule base* holds all the rules defined by the expert.\nSecond, there is a structure to define each parameter; these are indexed under the name of each parameter.\nThird, we shall see that the flow of control is managed in part by a list of *contexts* to consider.\nThese are structures that will be passed to the `MYCIN` function.\n\n## 16.3 Asking Questions\n{:#s0020}\n{:.h1hd}\n\nThe third way that EMYCIN !!!(span) {:.smallcaps} differs from Prolog is in providing an automatic means of asking the user questions when answers cannot be derived from the rules.\nThis is not a fundamental difference; after all, it is not too hard to write Prolog rules that print a query and read a reply.\nEMYCIN !!!(span) {:.smallcaps} lets the knowledge-base designer write a simple declaration instead of a rule, and will even assume a default declaration if none is provided.\nThe system also makes sure that the same question is never asked twice.\n\nThe following function `ask-vals` prints a query that asks for the parameter of an instance, and reads from the user the value or a list of values with associated certainty factors.\nThe function first looks at the data base to make sure the question has not been asked before.\nIt then checks each value and certainty factor to see if each is of the correct type, and it also allows the user to ask certain questions.\nA ? reply will show what type answer is expected.\n`Rule` will show the current rule that the system is working on.\n`Why` also shows the current rule, but it explains in more detail what the system knows and is trying to find out.\nFinally, `help` prints the following summary:\n\n```lisp\n(defconstant help-string\n \"~&Type one of the following:\n ? - to see possible answers for this parameter\n rule - to show the current rule\n why - to see why this question is asked\n help - to see this list\n xxx - (for some specific xxx) if there is a definite answer\n (xxx .5 yyy .4) - If there are several answers\n       with different certainty factors.\")\n```\n\nHere is `ask-va1s`.\nNote that the `why` and `rule` options assume that the current rule has been stored in the data base.\nThe functions `print-why`, `parm-type`, and `check-reply` will be defined shortly.\n\n```lisp\n(defun ask-vals (parm inst)\n \"Ask the user for the value(s) of inst's parm parameter,\n unless this has already been asked. Keep asking until the\n user types UNKNOWN (return nil) or a valid reply (return t).\"\n (unless (get-db '(asked .parrn ,inst))\n  (put-db '(asked .parrn ,inst) t)\n  (loop\n   (let ((ans (prompt-and-read-vals parm inst)))\n    (case ans\n     (help (format t help-string))\n     (why (print-why (get-db 'current-rule) parm))\n     (rule (princ (get-db 'current-rule)))\n     ((unk unknown) (RETURN nil))\n     (? (format t \"~&A ~ a must be of type ~ a\"\n         parm (parm-type parm)) nil)\n     (t (if (check-reply ans parm inst)\n        (RETURN t)\n        (format t \"~&I1legal reply. ~\n           Type ? to see legal ones.\"))))))))\n```\n\nThe following is `prompt-and-read-vals,` the function that actually asks the query and reads the reply.\nIt basically calls `format` to print a prompt and `read` to get the reply, but there are a few subtleties.\nFirst, it calls `finish-output.` Some Lisp implementations buffer output on a line-by-line basis.\nSince the prompt may not end in a newline, `finish-output` makes sure the output is printed before the reply is read.\n\nSo far, all the code that refers to a `parm` is really referring to the name of a parameter-a symbol.\nThe actual parameters themselves will be implemented as structures.\nWe use `get-parm` to look up the structure associated with a symbol, and the selector functions `parm-prompt` to pick out the prompt for each parameter and `parm-reader` to pick out the reader function.\nNormally this will be the function `read`, but `read-line` is appropriate for reading string-valued parameters.\n\nThe macro `defparm` (shown here) provides a way to define prompts and readers for parameters.\n\n```lisp\n(defun prompt-and-read-vals (parm inst)\n \"Print the prompt for this parameter (or make one up) and\n read the reply.\"\n (fresh-line)\n (format t (parm-prompt (get-parm parm)) (inst-name inst) parm)\n (princ \" \")\n (finish-output)\n (funcall (parm-reader (get-parm parm))))\n(defun inst-name (inst)\n \"The name of this instance.\"\n ;; The stored name is either like ((\"Jan Doe\" 1.0)) or nil\n (or (first (first (get-vals 'name inst)))\n   inst))\n```\n\nThe function `check-reply` uses `parse - reply` to convert the user's reply into a canonical form, and then checks that each value is of the right type, and that each certainty factor is valid.\nIf so, the data base is updated to reflect the new certainty factors.\n\n```lisp\n(defun check-reply (reply parm inst)\n \"If reply is valid for this parm, update the DB.\n Reply should be a val or (vall cfl val2 cf2 ...).\n Each val must be of the right type for this parm.\"\n (let ((answers (parse-reply reply)))\n  (when (every #'(lambda (pair)\n       (and (typep (first pair) (parm-type parm))\n        (cf-p (second pair))))\n     answers)\n   ;; Add replies to the data base\n   (dolist (pair answers)\n    (update-cf parm inst (first pair) (second pair)))\n   answers)))\n(defun parse-reply (reply)\n \"Convert the reply into a list of (value cf) pairs.\"\n (cond ((null reply) nil)\n    ((atom reply) '((,reply ,true)))\n    (t (cons (list (first reply) (second reply))\n     (parse-reply (rest2 reply))))))\n```\n\nParameters are implemented as structures with six slots: the name (a symbol), the context the parameter is for, the prompt used to ask for the parameter's value, a Boolean that tells if we should ask the user before or after using rules, a type restriction describing the legal values, and finally, the function used to read the value of the parameter.\n\nParameters are stored on the property list of their names under the pa rm property, so getting the `parm-type` of a name requires first getting the parm structure, and then selecting the type restriction field.\nBy default, a parameter is given type t, meaning that any value is valid for that type.\nWe also define the type `yes/no`, which cornes in handy for Boolean parameters.\n\nWe want the default prompt to be \"What is the PARM of the INST?\" But most user-defined prompts will want to print the inst, and not the parm.\nTo make it easy to write user-defined prompts, `prompt-and-read-vals` makes the instance be the first argument to the format string, with the parm second.\nTherefore, in the default prompt we need to use the format directive `\"~*\"` to skip the instance argument, and `\"~2:*\"` to back up two arguments to get back to the instance.\n(These directives are common in `cerror` calls, where one list of arguments is passed to two format strings.)\n\n`defparm` is a macro that calls `new-parm`, the constructor function defined in the `parm` structure, and stores the resulting structure under the `parm` property of the parameter's name.\n\n```lisp\n(defstruct (parm (:constructor\n      new-parm (name &optional context type-restriction\n         prompt ask-first reader)))\n name (context nil) (prompt \"~&What is the ~*~a of ~ 2:*~a?\")\n (ask-first nil) (type-restriction t) (reader 'read))\n(defmacro defparm (parm &rest args)\n \"Define a parameter.\"\n '(setf (get ',parm 'parm) (apply #'new-parm ',parm ',args)))\n(defun parm-type (parm-name)\n \"What type is expected for a value of this parameter?\"\n (parm-type-restriction (get-parm parm-name)))\n(defun get-parm (parm-name)\n \"Look up the parameter structure with this name.\"\n ;; If there is none, make one\n (or (get parm-name 'parm)\n   (setf (get parm-name 'parm) (new-parm parm-name))))\n(deftype yes/no () '(member yes no))\n```\n\n## 16.4 Contexts Instead of Variables\n{:#s0025}\n{:.h1hd}\n\nEarlier we gave an equation relating EMYCIN !!!(span) {:.smallcaps} to Prolog.\nThat equation was not quite correct, because EMYCIN !!!(span) {:.smallcaps} lacks one of Prolog's most important features: the logic variable.\nInstead, EMYCIN !!!(span) {:.smallcaps} uses *contexts*.\nSo the complete equation is:\n\nEMYCIN !!!(span) {:.smallcaps} = Prolog + uncertainty + caching + questions + explanations + contexts - variables\n\nA context is defined by the designers of MYCIN !!!(span) {:.smallcaps} as a situation within which the program reasons.\nBut it makes more sense to think of a context simply as a data type.\nSo the list of contexts supplied to the program will determine what types of objects can be reasoned about.\nThe program keeps track of the most recent instance of each type, and the rules can refer to those instances only, using the name of the type.\nIn our version of MYCIN !!!(span) {:.smallcaps} , there are three types or contexts: patients, cultures, and organisms.\nHere is an example of a rule that references all three contexts:\n\n```lisp\n(defrule 52\n if (site culture is blood)\n   (gram organism is neg)\n   (morphology organism is rod)\n   (burn patient is serious)\n then .4\n   (identity organism is pseudomonas))\n```\n\nIgnoring certainty factors for the moment, this MYCIN !!!(span) {:.smallcaps} rule is equivalent to a Prolog rule of the form:\n\n```lisp\n(<- (identity ?o ?pseudomonas)\n (and (culture` ?c) `(site ?c blood)\n  (organism ?o) (gram ?o neg) (morphology ?o rod)\n  (patient ?p) (burn ?p serious)))\n```\n\nThe context mechanism provides sufficient flexibility to handle many of the cases that would otherwise be handled by variables.\nOne important thing that cannot be done is to refer to more than one instance of the same context.\nOnly the most recent instance can be referred to.\nContexts are implemented as structures with the following definition:\n\n```lisp\n(defstruct context\n \"A context is a sub-domain, a type.\"\n name (number 0) initial-data goals)\n(defmacro defeontext (name &optional initial-data goals)\n \"Define a context.\"\n '(make-context :name ',name :initial-data ',initial-data :goals ',goals))\n```\n\nThe `name` field is something like `patient or organism.` Instances of contexts are numbered; the `number` field holds the number of the most recent instance.\nEach context also has two lists of parameters.\nThe `initial-data` parameters are asked for when each instance is created.\nInitial data parameters are normally known by the user.\nFor example, a doctor will normally know the patient's name, age, and sex, and as a matter of training expects to be asked these questions first, even if they don't factor into every case.\nThe goal parameters, on the other hand, are usually unknown to the user.\nThey are determined through the backward-chaining process.\n\nThe following function creates a new instance of a context, writes a message, and stores the instance in two places in the data base: under the key `current-instance`, and also under the name of the context.\nThe contexts form a tree.\nIn our example, the `patient` context is the root of the tree, and the current patient is stored in the data base under the key `patient.` The next level of the tree is for cultures taken from the patient; the current culture is stored under the `culture` key.\nFinally, there is a level for organisms found in each culture.\nThe current organism is stored under both the `organism` and `current-instance` keys.\nThe context tree is shown in [figure 16.2](#f0015).\n\n![f16-02-9780080571157](images/B9780080571157500169/f16-02-9780080571157.jpg)     \nFigure 16.2\n!!!(span) {:.fignum}\nA Context Tree\n```lisp\n(defun new-instance (context)\n \"Create a new instance of this context.\"\n (let ((instance (format nil \"~a-~d\"\n        (context-name context)\n        (incf (context-number context)))))\n (format t \"~&------ ~ a ------ ~&\" instance)\n  (put-db (context-name context) instance)\n  (put-db 'current-instance instance)))\n```\n\n## 16.5 Backward-Chaining Revisited\n{:#s0030}\n{:.h1hd}\n\nNow that we have seen how EMYCIN !!!(span) {:.smallcaps} is different from Prolog, we are ready to tackle the way in which it is the same: the backward-chaining rule interpreter.\nLike Prolog, EMYCIN !!!(span) {:.smallcaps} is given a goal and applies rules that are appropriate to the goal.\nApplying a rule means treating each premise of the rule as a goal and recursively applying rules that are appropriate to each premise.\n\nThere are still some remaining differences.\nIn Prolog, a goal can be any expression, and appropriate rules are those whose heads unify with the goal.\nIf any appropriate rule succeeds, then the goal is known to be true.\nIn EMYCIN !!!(span) {:.smallcaps} , a rule might give a goal a certainty of .99, but we still have to consider all the other rules that are appropriate to the goal, because they might bring the certainty down below the cutoff threshold.\nThus, EMYCIN !!!(span) {:.smallcaps} always gathers all evidence relating to a parameter/instance pair first, and only evaluates the goal after all the evidence is in.\nFor example, if the goal was (`temp patient > 98.6`), Emycin !!!(span) {:.smallcaps} would first evaluate all rules with conclusions about the current patient's temperature, and only then compare the temperature to 98.6.\n\nAnother way of looking at it is that Prolog has the luxury of searching depth-first, because the semantics of Prolog rules is such that if any rule says a goal is true, then it is true.\nEMYCIN !!!(span) {:.smallcaps} must search breadth-first, because a goal with certainty of .99 might turn out to be false when more evidence is considered.\n\nWe are now ready to sketch out the design of the EMYCIN !!!(span) {:.smallcaps} rule interpreter: To `find-out` a parameter of an instance: If the value is already stored in the data base, use the known value.\nOtherwise, the two choices are using the rules or asking the user.\nDo these in the order specified for this parameter, and if the first one succeeds, don't bother with the second.\nNote that `ask-vals` (defined above) will not ask the same question twice.\n\nTo `use-rules`, find all the rules that concern the given parameter and evaluate them with `use-rule`.\nAfter each rule has been tried, if any of them evaluate to true, then succeed.\n\nTo `use-rule` a rule, first check if any of the premises can be rejected outright.\nIf we did not have this check, then the system could start asking the user questions that were obviously irrelevant.\nSo we waste some of the program's time (checking each premise twice) to save the more valuable user time.\n(The function `eval-condition` takes an optional argument specifying if we should recursively ask questions in trying to accept or reject a condition.)\n\nIf no premise can be rejected, then evaluate each premise in turn with `evaluate-condition`, keeping track of the accumulated certainty factor with `cf`-and (which is currently just `min`), and cutting off evaluation when the certainty factor drops below threshold.\nIf the premises evaluate true, then add the conclusions to the data base.\nThe calling sequence looks like this.\nNote that the recursive call to `find-out` is what enables chaining to occur:\n\n`find-out`         ; To find out a parameter for an instance:\n\n` get-db`         ;  See if it is cached in the data base\n\n` ask-vals`        ;  See if the user knows the answer\n\n` use-rules`       ;  See if there is a rule for it:\n\n`   reject-premise`  ;   See if the rule is outright false\n\n`   satisfy-premises` ;   Or see if each condition is true:\n\n`     eval-condition` ;    Evaluate each condition\n\n`      find-out`   ;     By finding the parameter's values\n\nBefore showing the interpreter, here is the structure definition for rules, along with the functions to maintain a data base of rules:\n\n```lisp\n(defstruct (rule (:print-function print-rule))\n number premises conclusions cf)\n(let ((rules (make-hash-table)))\n (defun put-rule (rule)\n  \"Put the rule in a table, indexed under each\n  parm in the conclusion.\"\n  (dolist (concl (rule-conclusions rule))\n   (push rule (gethash (first concl) rules)))\n  rule)\n (defun get-rules (parm)\n  \"A list of rules that help determine this parameter.\"\n  (gethash parm rules))\n (defun clear-rules () (clrhash rules)))\n```\n\nHere, then, is the interpreter, `find-out`.\nIt can find out the value(s) of a parameter three ways.\nFirst, it looks to see if the value is already stored in the data base.\nNext, it tries asking the user or using the rules.\nThe order in which these two options are tried depends on the `parm-ask-first` property of the parameter.\nEither way, if an answer is determined, it is stored in the data base.\n\n```lisp\n(defun find-out (parm &optional (inst (get-db 'current-instance)))\n \"Find the value(s) of this parameter for this instance,\n unless the values are already known.\n Some parameters we ask first; others we use rules first.\"\n (or (get-db '(known ,parm ,inst))\n   (put-db '(known ,parm ,inst)\n     (if (parm-ask-first (get-parm parm))\n       (or (ask-vals parm inst) (use-rules parm))\n       (or (use-rules parm) (ask-vals parm inst))))))\n(defun use-rules (parm)\n \"Try every rule associated with this parameter.\n Return true if one of the rules returns true.\"\n (some #'true-p (mapcar #'use-rule (get-rules parm))))\n(defun use-rule (rule)\n \"Apply a rule to the current situation.\"\n ;; Keep track of the rule for the explanation system:\n (put-db 'current-rule rule)\n ;; If any premise is known false, give up.\n ;; If every premise can be proved true, then\n ;; draw conclusions (weighted with the certainty factor).\n (unless (some #'reject-premise (rule-premises rule))\n  (let ((cf (satisfy-premises (rule-premises rule) true)))\n   (when (true-p cf)\n    (dolist (conclusion (rule-conclusions rule))\n     (conclude conclusion (* cf (rule-cf rule))))\n    cf))))\n(defun satisfy-premises (premises cf-so-far)\n \"A list of premises is satisfied if they are all true.\n A combined cf is returned.\"\n ;; cf-so-far is an accumulator of certainty factors\n (cond ((null premises) cf-so-far)\n    ((not (true-p cf-so-far)) false)\n    (t (satisfy-premises\n     (rest premises)\n     (cf-and cf-so-far\n        (eval-condition (first premises)))))))\n```\n\nThe function `eval-condition` evaluates a single condition, returning its certainty factor.\nIf `find-out-p` is true, it first calls `find-out`, which may either query the user or apply appropriate rules.\nIf `find-out-p` is false, it evaluates the condition using the current state of the data base.\nIt does this by looking at each stored value for the parameter/instance pair and evaluating the operator on it.\nFor example, if the condition is (`temp patient > 98.6`) and the values for `temp` for the current patient are (`(98 .3) (99 .6) (100 .1)`), then `eval-condition` will test each of the values 98, 99, and 100 against 98.6 using the > operator.\nThis test will succeed twice, so the resulting certainty factor is .6 + .1 = .7.\n\nThe function `reject-premise` is designed as a quick test to eliminate a rule.\nAs such, it calls `eval-condition` with `find-out-p` nil, so it will reject a premise only if it is clearly false without seeking additional information.\n\nIf a rule's premises are true, then the conclusions are added to the data base by `conclude`.\nNote that `is` is the only operator allowed in conclusions, `is` is just an alias for equal.\n\n```lisp\n(defun eval-condition (condition &optional (find-out-p t))\n \"See if this condition is true, optionally using FIND-OUT\n to determine unknown parameters.\"\n (multiple-value-bind (parm inst op val)\n  (parse-condition condition)\n   (when find-out-p\n    (find-out parm inst))\n   ;; Add up all the (val cf) pairs that satisfy the test\n   (loop for pair in (get-vals parm inst)\n     when (funcall op (first pair) val)\n     sum (second pair))))\n(defun reject-premise (premise)\n \"A premise is rejected if it is known false, without\n needing to call find-out recursively.\"\n (false-p (eval-condition premise nil)))\n(defun conclude (conclusion cf)\n \"Add a conclusion (with specified certainty factor) to DB.\"\n (multiple-value-bind (parm inst op val)\n   (parse-condition conclusion)\n  (update-cf parm inst val cf)))\n(defun is (a b) (equal a b))\n```\n\nAll conditions are of the form: (*parameter instance operator value*).\nFor example: `(morphology organism is rod).` The function `parse-condition` turns a list of this form into four values.\nThe trick is that it uses the data base to return the current instance of the context, rather than the context name itself:\n\n```lisp\n(defun parse-condition (condition)\n \"A condition is of the form (parm inst op val).\n So for (age patient is 21), we would return 4 values:\n (age patient-1 is 21), where patient-1 is the current patient.\"\n (values (first condition)\n   (get-db (second condition))\n   (third condition)\n   (fourth condition)))\n```\n\nAt this point a call like (`find-out 'identity 'organism-1`) would do the right thing only if we had somehow entered the proper information on the current patient, culture, and organism.\nThe function `get-context-data` makes sure that each context is treated in order.\nFirst an instance is created, then `find-out` is used to determine both the initial data parameters and the goals.\nThe findings for each goal are printed, and the program asks if there is another instance of this context.\nFinally, we also need a top-level function, `emycin`, which just clears the data base before calling `get-context-data`.\n\n```lisp\n(defun emycin (contexts)\n \"An Expert-System Shell. Accumulate data for instances of each\n context, and solve for goals. Then report the findings.\"\n (clear-db)\n (get-context-data contexts))\n(defun get-context-data (contexts)\n \"For each context, create an instance and try to find out\n required data. Then go on to other contexts, depth first,\n and finally ask if there are other instances of this context.\"\n (unless (null contexts)\n  (let* ((context (first contexts))\n    (inst (new-instance context)))\n   (put-db 'current-rule 'initial)\n   (mapc #'find-out (context-initial-data context))\n   (put-db 'current-rule 'goal)\n   (mapc #'find-out (context-goals context))\n   (report-findings context inst)\n   (get-context-data (rest contexts))\n   (when (y-or-n-p \"Is there another ~ a?\"\n      (context-name context))\n  (get-context-data contexts)))))\n```\n\n## 16.6 Interacting with the Expert\n{:#s0035}\n{:.h1hd}\n\nAt this point all the serious computational work is done: we have defined a backward-chaining rule mechanism that deals with uncertainty, caching, questions, and contexts.\nBut there is still quite a bit of work to do in terms of input/output interaction.\nA programming language needs only to interface with programmers, so it is acceptable to make the programmer do all the work.\nBut an expert-system shell is supposed to alleviate (if not abolish) the need for programmers.\nExpert-system shells really have two classes of users: the experts use the shell when they are developing the system, and the end users or clients use the resulting expert system when it is completed.\nSometimes the expert can enter knowledge directly into the shell, but more often it is assumed the expert will have the help of a *knowledge engineer*-someone who is trained in the use of the shell and in eliciting knowledge, but who need not be either an expert in the domain or an expert programmer.\n\nIn our version of EMYCIN !!!(span) {:.smallcaps} , we provide only the simplest tools for making the expert's job easier.\nThe macros `defcontext` and `defparm`, defined above, are a little easier than calling `make-context` and `make-parm` explicitly, but not much.\nThe macro `defrule` defines a rule and checks for some obvious errors:\n\n```lisp\n(defmacro defrule (number &body body)\n \"Define a rule with conditions, a certainty factor, and\n conclusions. Example: (defrule R001 if ... then .9 ...)\"\n (assert (eq (first body) 'if))\n (let* ((then-part (member 'then body))\n     (premises (ldiff (rest body) then-part))\n     (conclusions (rest2 then-part))\n     (cf (second then-part)))\n   ;; Do some error checking:\n   (check-conditions number premises 'premise)\n   (check-conditions number conclusions 'conclusion)\n   (when (not (cf-p cf))\n    (warn \"Rule ~a: Illegal certainty factor: ~a\" number cf))\n   ;; Now build the rule:\n   '(put-rule\n    (make-rule :number ',number :cf ,cf :premises ',premises\n       :conclusions ',conclusions))))\n```\n\nThe function `check-conditions` makes sure that each rule has at least one premise and conclusion, that each condition is of the right form, and that the value of the condition is of the right type for the parameter.\nIt also checks that conclusions use only the operator `is`:\n\n```lisp\n(defun check-conditions (rule-num conditions kind)\n \"Warn if any conditions are invalid.\"\n (when (null conditions)\n  (warn \"Rule ~a: Missing ~a\" rule-num kind))\n (dolist (condition conditions)\n  (when (not (consp condition))\n   (warn \"Rule ~a: Illegal ~a: ~a\" rule-num kind condition))\n  (multiple-value-bind (parm inst op val)\n    (parse-condition condition)\n   (declare (ignore inst))\n   (when (and (eq kind 'conclusion) (not (eq op 'is)))\n    (warn \"Rule ~a: Illegal operator (~a) in conclusion: ~a\"\n      rule-num op condition))\n   (when (not (typep val (parm-type parm)))\n    (warn \"Rule ~a: Illegal value (~a) in ~a: ~a\"\n      rule-num val kind condition)))))\n```\n\nThe real EMYCIN !!!(span) {:.smallcaps} had an interactive environment that prompted the expert for each context, parameter, and rule.\nRandall Davis ([1977](B9780080571157500285.xhtml#bb0290), [1979](B9780080571157500285.xhtml#bb0295), [Davis and Lenat 1982](B9780080571157500285.xhtml#bb0300)) describes the TEIRESIAS !!!(span) {:.smallcaps} program, which helped experts enter and debug rules.\n\n## 16.7 Interacting with the Client\n{:#s0040}\n{:.h1hd}\n\nOnce the knowledge is in, we need some way to get it out.\nThe client wants to run the system on his or her own problem and see two things: a solution to the problem, and an explanation of why the solution is reasonable.\nEMYCIN !!!(span) {:.smallcaps} provides primitive facilities for both of these.\nThe function `report-findings` prints information on all the goal parameters for a given instance:\n\n```lisp\n(defun report-findings (context inst)\n \"Print findings on each goal for this instance.\"\n (when (context-goals context)\n  (format t \"~&Findings for ~a:\" (inst-name inst))\n  (dolist (goal (context-goals context))\n   (let ((values (get-vals goal inst)))\n    ;; If there are any values for this goal.\n    ;; print them sorted by certainty factor.\n    (if values\n      (format t \"~a:~{~{ ~a (~,3f) ~}~}\" goal\n        (sort (copy-list values) #'> :key #'second))\n      (format t \"~&~a: unknown\" goal))))))\n```\n\nThe only explanation facility our version of EMYCIN !!!(span) {:.smallcaps} offers is a way to see the current rule.\nIf the user types `rule` in response to a query, a pseudo-English translation of the current rule is printed.\nHere is a sample rule and its translation:\n\n```lisp\n(defrule 52\n if (site culture is blood)\n   (gram organism is neg)\n   (morphology organism is rod)\n   (burn patient is serious)\n then .4\n   (identity organism is pseudomonas))\nRule 52:\n If\n  1) THE SITE OF THE CULTURE IS BLOOD\n  2) THE GRAM OF THE ORGANISM IS NEG\n  3) THE MORPHOLOGY OF THE ORGANISM IS ROD\n  4) THE BURN OF THE PATIENT IS SERIOUS\n Then there is weakly suggestive evidence (0.4) that\n  1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS\n```\n\nThe function `print-rule` generates this translation:\n\n```lisp\n(defun print-rule (rule &optional (stream t) depth)\n (declare (ignore depth))\n (format stream \"~&Rule ~a:~& If\" (rule-number rule))\n (print-conditions (rule-premises rule) stream)\n (format stream \"~& Then ~a (~a) that\"\n     (cf->english (rule-cf rule)) (rule-cf rule))\n (print-conditions (rule-conclusions rule) stream))\n(defun print-conditions (conditions &optional\n         (stream t) (num 1))\n \"Print a list of numbered conditions.\"\n (dolist (condition conditions)\n  (print-condition condition stream num)))\n(defun print-condition (condition stream number)\n \"Print a single condition in pseudo-English.\"\n (format stream \"~&~d)~{ ~a~}\" number\n     (let ((parm (first condition))\n        (inst (second condition))\n        (op (third condition))\n        (val (fourth condition)))\n      (case val\n       (YES '(the ,inst ,op ,parm))\n       (NO '(the ,inst ,op not ,parm))\n       (T '(the ,parm of the ,inst ,op ,val))))))\n(defun cf->english (cf)\n \"Convert a certainy factor to an English phrase.\"\n (cond ((= cf 1.0) \"there is certain evidence\")\n    ((> cf .8) \"there is strongly suggestive evidence\")\n    ((> cf .5) \"there is suggestive evidence\")\n    ((> cf 0.0) \"there is weakly suggestive evidence\")\n    ((= cf 0.0) \"there is N0 evidence either way\")\n    ((< cf 0.0) (concatenate 'string (cf->english (- cf))\n          \" AGAINST the conclusion\"))))\n```\n\nIf the user types `why` in response to a query, a more detailed account of the same rule is printed.\nFirst, the premises that are already known are displayed, followed by the remainder of the rule.\nThe parameter being asked for will always be the first premise in the remainder of the rule.\nThe `current-rule` is stored in the data base by `use-rule` whenever a rule is applied, but it is also set by `get-context-data` to the atom `initial` or goal when the system is prompting for parameters.\n`print-why` checks for this case as well.\nNote the use of the `partition-if` function from page 256.\n\n```lisp\n(defun print-why (rule parm)\n \"Tell why this rule is being used. Print what is known,\n what we are trying to find out, and what we can conclude.\"\n (format t \"~&[Why is the value of ~a being asked for?]\" parm)\n (if (member rule '(initial goal))\n   (format t \"~&~a is one of the ~a parameters.\"\n      parm rule)\n   (multiple-value-bind (knowns unknowns)\n     (partition-if #'(lambda (premise)\n          (true-p (eval-condition premise nil)))\n         (rule-premises rule))\n    (when knowns\n     (format t \"~&It is known that:\")\n     (print-conditions knowns)\n     (format t \"~&Therefore,\"))\n    (let ((new-rule (copy-rule rule)))\n     (setf (rule-premises new-rule) unknowns)\n     (print new-rule)))))\n```\n\nThat completes the definition of `emycin`.\nWe are now ready to apply the shell to a specific domain, yielding the beginnings of an expert system.\n\n## 16.8 **MYCIN !!!(span) {:.smallcaps}**, A Medical Expert System\n{:#s0045}\n{:.h1hd}\n\nThis section applies `emycin` to Mycin' !!!(span) {:.smallcaps} s original domain: infectious blood disease.\nIn our version of MYCIN !!!(span) {:.smallcaps} , there are three contexts: first we consider a patient, then any cultures that have been grown from samples taken from the patient, and finally any infectious organisms in the cultures.\nThe goal is to determine the identity of each organism.\nThe real MYCIN !!!(span) {:.smallcaps} was more complex, taking into account any drugs or operations the patient may previously have had.\nIt also went on to decide the real question: what therapy to prescribe.\nHowever, much of this was done by special-purpose procedures to compute optimal dosages and the like, so it is not included here.\nThe original MYCIN !!!(span) {:.smallcaps} also made a distinction between current versus prior cultures, organisms, and drugs.\nAll together, it had ten contexts to consider, while our version only has three:\n\n```lisp\n(defun mycin ()\n \"Determine what organism is infecting a patient.\"\n (emycin\n   (list (defcontext patient (name sex age) ())\n      (defcontext culture (site days-old) ())\n      (defcontext organism () (identity)))))\n```\n\nThese contexts declare that we will first ask each patient's name, sex, and age, and each culture's site and the number of days ago it was isolated.\nOrganisms have no initial questions, but they do have a goal: to determine the identity of the organism.\n\nThe next step is to declare parameters for the contexts.\nEach parameter is given a type, and most are given prompts to improve the naturalness of the dialogue:\n\n```lisp\n;;; Parameters for patient:\n(defparm name patient t \"Patient's name: \" t read-line)\n(defparm sex patient (member male female) \"Sex:\" t)\n(defparm age patient number \"Age:\" t)\n(defparm burn patient (member no mild serious)\n \"Is ~a a burn patient? If so. mild or serious?\" t)\n(defparm compromised-host patient yes/no\n \"Is ~a a compromised host?\")\n;;; Parameters for culture:\n(defparm site culture (member blood)\n \"From what site was the specimen for ~a taken?\" t)\n(defparm days-old culture number\n \"How many days ago was this culture (~a) obtained?\" t)\n;;; Parameters for organism:\n(defparm identity organism\n (member pseudomonas klebsiella enterobacteriaceae staphylococcus bacteroides streptococcus)\n \"Enter the identity (genus) of ~a:\" t)\n(defparm gram organism (member acid-fast pos neg)\n \"The gram stain of ~a:\" t)\n(defparm morphology organism (member rod coccus)\n \"Is ~a a rod or coccus (etc.):\")\n(defparm aerobicity organism (member aerobic anaerobic))\n(defparm growth-conformation organism\n (member chains pairs clumps))\n```\n\nNow we need some rules to help determine the identity of the organisms.\nThe following rules are taken from [Shortliffe 1976](B9780080571157500285.xhtml#bb1100).\nThe rule numbers refer to the pages on which they are listed.\nThe real MYCIN !!!(span) {:.smallcaps} had about 400 rules, dealing with a much wider variety of premises and conclusions.\n\n```lisp\n(clear-rules)\n(defrule 52\n if (site culture is blood)\n   (gram organism is neg)\n   (morphology organism is rod)\n   (burn patient is serious)\n then .4\n   (identity organism is pseudomonas))\n(defrule 71\n if (gram organism is pos)\n   (morphology organism is coccus)\n   (growth-conformation organism is clumps)\n then .7\n   (identity organism is staphylococcus))\n(defrule 73\n if (site culture is blood)\n   (gram organism is neg)\n   (morphology organism is rod)\n   (aerobicity organism is anaerobic)\n then .9\n   (identity organism is bacteroides))\n(defrule 75\n if (gram organism is neg)\n   (morphology organism is rod)\n   (compromised-host patient is yes)\n then .6\n   (identity organism is pseudomonas))\n(defrule 107\n if (gram organism is neg)\n   (morphology organism is rod)\n   (aerobicity organism is aerobic)\nthen .8\n   (identity organism is enterobacteriaceae))\n(defrule 165\n if (gram organism is pos)\n   (morphology organism is coccus)\n   (growth-conformation organism is chains)\nthen .7\n   (identity organism is streptococcus))\n```\n\nHere is an example of the program in use:\n\n```lisp\n> (mycin)\n------ PATIENT-1 ------\nPatient's name: Sylvia Fischer\nSex: female\nAge: 27\n------ CULTURE-1 ------\nFrom what site was the specimen for CULTURE-1 taken? blood\nHow many days ago was this culture (CULTURE-1) obtained? 3\n------ ORGANISM-1 ------\nEnter the identity (genus) of ORGANISM-1: unknown\nThe gram stain of ORGANISM-1: ?\nA GRAM must be of type (MEMBER ACID-FAST POS NEG)\nThe gram stain of ORGANISM-1: neg\n```\n\nThe user typed ? to see the list of valid responses.\nThe dialog continues:\n\n```lisp\nIs ORGANISM-1 a rod or coccus (etc.): rod\nWhat is the AEROBICITY of ORGANISM-1? Why\n[Why is the value of AEROBICITY being asked for?]\nIt is known that:\n   1) THE GRAM OF THE ORGANISM IS NEG\n   2) THE MORPHOLOGY OF THE ORGANISM IS ROD\nTherefore,\nRule 107:\n If\n   1) THE AEROBICITY OF THE ORGANISM IS AEROBIC\n Then there is suggestive evidence (0.8) that\n   1) THE IDENTITY OF THE ORGANISM IS ENTEROBACTERIACEAE\n```\n\nThe user wants to know why the system is asking about the organism's aerobicity.\nThe reply shows the current rule, what is already known about the rule, and the fact that if the organism is aerobic, then we can conclude something about its identity.\nIn this hypothetical case, the organism is in fact aerobic:\n\n```lisp\nWhat is the AEROBICITY of ORGANISM-1? aerobic\nIs Sylvia Fischer a compromised host? yes\nIs Sylvia Fischer a burn patient? If so. mild or serious? why\n[Why is the value of BURN being asked for?]\nIt is known that:\n   1) THE SITE OF THE CULTURE IS BLOOD\n   2) THE GRAM OF THE ORGANISM IS NEG\n   3) THE MORPHOLOGY OF THE ORGANISM IS ROD\nTherefore,\nRule 52:\n If\n   1) THE BURN OF THE PATIENT IS SERIOUS\n Then there is weakly suggestive evidence (0.4) that\n   1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS\nIs Sylvia Fischer a burn patient? If so, mild or serious? serious\nFindings for ORGANISM-1:\n IDENTITY: ENTEROBACTERIACEAE (0.800) PSEUDOMONAS (0.760)\n```\n\nThe system used rule 107 to conclude the identity might be enterobacteriaceae.\nThe certainty is .8, the certainty for the rule itself, because all the conditions were known to be true with certainty.\nRules 52 and 75 both support the hypothesis of pseudomonas.\nThe certainty factors of the two rules, .6 and .4, are combined by the formula .6 + .4 - (.6 x .4) = .76.\nAfter printing the findings for the first organism, the system asks if another organism was obtained from this culture:\n\n```lisp\nIs there another ORGANISM? (Y or N) Y\n------ ORGANISM-2 ------\nEnter the identity (genus) of ORGANISM-2: unknown\nThe gram stain of ORGANISM-2: (neg .8 pos .2)\nIs ORGANISM-2 a rod or coccus (etc.): rod\nWhat is the AEROBICITY of ORGANISM-2? anaerobic\n```\n\nFor the second organism, the lab test was inconclusive, so the user entered a qualified answer indicating that it is probably gram-negative, but perhaps gram-positive.\nThis organism was also a rod but was anaerobic.\nNote that the system does not repeat questions that it already knows the answers to.\nIn considering rules 75 and 52 it already knows that the culture came from the blood, and that the patient is a compromised host and a serious burn patient.\nIn the end, rule 73 contributes to the bacteroides conclusion, and rules 75 and 52 again combine to suggest pseudomonas, although with a lower certainty factor, because the neg finding had a lower certainty factor:\n\n```lisp\nFindings for ORGANISM-2:\n IDENTITY: BACTEROIDES (0.720) PSEUDOMONAS (0.646)\n```\n\nFinally, the program gives the user the opportunity to extend the context tree with new organisms, cultures, or patients:\n\n```lisp\nIs there another ORGANISM? (Y or N) N\nIs there another CULTURE? (Y or N) N\nIs there another PATIENT? (Y or N) N\n```\n\nThe set of rules listed above do not demonstrate two important features of the system: the ability to backward-chain, and the ability to use operators other than i s in premises.\n\nIf we add the following three rules and repeat the case shown above, then evaluating rule 75 will back-chain to rule 1, 2, and finally 3 trying to determine if the patient is a compromised host.\nNote that the question asked will be \"What is Sylvia Fischer's white blood cell count?\" and not \"Is the white blood cell count of Sylvia Fischer < 2.5?\" The latter question would suffice for the premise at hand, but it would not be as useful for other rules that might refer to the WBC.\n\n```lisp\n(defparm wbc patient number\n \"What is ~a's white blood cell count?\")\n(defrule 1\n if (immunosuppressed patient is yes)\n then 1.0 (compromised-host patient is yes))\n(defrule 2\n if (leukopenia patient is yes)\n then 1.0 (immunosuppressed patient is yes))\n(defrule 3\n if (wbc patient < 2.5)\n then .9 (leukopenia patient is yes))\n```\n\n## 16.9 Alternatives to Certainty Factors\n{:#s0050}\n{:.h1hd}\n\nCertainty factors are a compromise.\nThe good news is that a system based on rules with certainty factors requires the expert to come up with only a small set of numbers (one for each rule) and will allow fast computation of answers.\nThe bad news is that the answer computed may lead to irrational decisions.\n\nCertainty factors have been justified by their performance (MYCIN !!!(span) {:.smallcaps} performed as well or better than expert doctors) and by intuitive appeal (they satisfy the criteria listed on page 534).\nHowever, they are subject to paradoxes where they compute bizarre results (as in Exercise 16.1, page 536).\nIf the rules that make up the knowledge base are designed in a modular fashion, then problems usually do not arise, but it is certainly worrisome that the answers may be untrustworthy.\n\nBefore MYCIN !!!(span) {:.smallcaps} , most reasoning with uncertainty was done using probability theory.\nThe laws of probability-in particular, Bayes's law-provide a well-founded mathematical formalism that is not subject to the inconsistencies of certainty factors.\nIndeed, probability theory can be shown to be the only formalism that leads to rational behavior, in the sense that if you have to make a series of bets on some uncertain events, combining information with probability theory will give you the highest expected value for your bets.\nDespite this, probability theory was largely set aside in the mid-1970s.\nThe argument made by [Shortliffe and Buchanan (1975)](B9780080571157500285.xhtml#bb1105) was that probability theory required too many conditional probabilities, and that people were not good at estimating these.\nThey argued that certainty factors were intuitively easier to deal with.\nOther researchers of the time shared this view.\nShafer, with later refinements by Dempster, created a theory of belief functions that, like certainty factors, represented a combination of the belief for and against an event.\nInstead of representing an event by a single probability or certainty, Dempster-Shafer theory maintains two numbers, which are analagous to the lower and upper bound on the probability.\nInstead of a single number like .5, Dempster-Shafer theory would have an interval like [.4,.6] to represent a range of probabilities.\nA complete lack of knowledge would be represented by the range [0,1].\nA great deal of effort in the late 1970s and early 1980s was invested in these and other nonprobabilistic theories.\nAnother example is Zadeh's fuzzy set theory, which is also based on intervais.\n\nThere is ample evidence that people have difficulty with problems involving probability.\nIn a very entertaining and thought-provoking series of articles, Tversky and Kahneman ([1974](B9780080571157500285.xhtml#bb1245), [1983](B9780080571157500285.xhtml#bb1250), [1986](B9780080571157500285.xhtml#bb1255)) show how people make irrational choices when faced with problems that are quite simple from a mathematical viewpoint.\nThey liken these errors in choice to errors in visual perception caused by optical illusions.\nEven trained doctors and statisticians are subject to these errors.\n\nAs an example, consider the following scenario.\nAdrian and Dominique are to be married.\nAdrian goes for a routine blood test and is told that the results are positive for a rare genetic disorder, one that strikes only 1 in 10,000 people.\nThe doctor says that the test is 99% accurate-it gives a false positive reading in only 1 in 100 cases.\nAdrian is despondent, being convinced that the probability of actually having the disease is 99%.\nFortunately, Dominique happens to be a Bayesian, and quickly reassures Adrian that the chance is more like 1 %.\nThe reasoning is as follows: Take 10,001 people at random.\nOf these, only 1 is expected to have the disease.\nThat person could certainly expect to test positive for the disease.\nBut if the other 10,000 people all took the blood test, then 1 % of them, or 100 people would also test positive.\nThus, the chance of actually having the disease given that one tests positive is 1/101.\nDoctors are trained in this kind of analysis, but unfortunately many of them continue to reason more like Adrian than Dominique.\n\nIn the late 1980s, the tide started to turn back to subjective Bayesian probability theory.\n[Cheeseman (1985)](B9780080571157500285.xhtml#bb0185) showed that, while Dempster-Shafer theory looks like it can, in fact it cannot help you make better decisions than probability theory.\n[Heckerman (1986)](B9780080571157500285.xhtml#bb0525) re-examined MYCIN's !!!(span) {:.smallcaps} certainty factors, showing how they could be interpreted as probabilities.\nJudea [Pearl's 1988](B9780080571157500285.xhtml#bb0935) book is an eloquent defense of probability theory.\nHe shows that there are efficient algorithms for combining and propagating probabilities, as long as the network of interdependencies does not contain loops.\nIt seems likely that uncertain reasoning in the 1990s will be based increasingly on Bayesian probability theory.\n\n## 16.10 History and References\n{:#s0055}\n{:.h1hd}\n\nThe MYCIN !!!(span) {:.smallcaps} project is well documented in [Buchanan and Shortliffe 1984](B9780080571157500285.xhtml#bb0145).\nAn earlier book, [Shortliffe 1976](B9780080571157500285.xhtml#bb1100), is interesting mainly for historical purposes.\nGood introductions to expert systems in general include [Weiss and Kulikowski 1984](B9780080571157500285.xhtml#bb1365), [Waterman 1986](B9780080571157500285.xhtml#bb1345), [Luger and Stubblefield 1989](B9780080571157500285.xhtml#bb0760), and [Jackson 1990](B9780080571157500285.xhtml#bb0580).\n\nDempster-Shafer evidence theory is presented enthusiastically in [Gordon and Shortliffe 1984](B9780080571157500285.xhtml#bb0485) and in a critical light in [Pearl 1989](B9780080571157500285.xhtml#bb0940)/1978.\nFuzzy set theory is presented in Zadeh 1979 and [Dubois and Prade 1988](B9780080571157500285.xhtml#bb0350).\n\n[Pearl (1988)](B9780080571157500285.xhtml#bb0935) captures most of the important points that lead to the renaissance of probability theory.\n[Shafer and Pearl 1990](B9780080571157500285.xhtml#bb1090) is a balanced collection of papers on all kinds of uncertain reasoning.\n\n## 16.11 Exercises\n{:#s0060}\n{:.h1hd}\n\n**Exercise 16.2 [s]** Suppose the rule writer wanted to be able to use symbolic certainty factors instead of numbers.\nWhat would you need to change to support rules like this:\n\n```lisp\n(defrule 100 if ... then true ...)\n(defrule 101 if ... then probably ...)\n```\n\n**Exercise 16.3 [m]** Change `prompt-and-read-vals` so that it gives a better prompt for parameters of type `yes/no`.\n\n**Exercise 16.4 [m]** Currently, the rule writer can introduce a new parameter without defining it first.\nThat is handy for rapid testing, but it means that the user of the system won't be able to see a nice English prompt, nor ask for the type of the parameter.\nIn addition, if the rule writer simply misspells a parameter, it will be treated as a new one.\nMake a simple change to fix these problems.\n\n**Exercise 16.5 [d]** Write rules in a domain you are an expert in, or find and interview an expert in some domain, and write down rules coaxed from the expert.\nEvaluate your resulting system.\nWas it easier to develop your system with EMYCIN !!!(span) {:.smallcaps} than it would have been without it?\n\n**Exercise 16.6 [s]** It is said that an early version of MYCIN !!!(span) {:.smallcaps} asked if the patient was pregnant, even though the patient was male.\nWrite a rule that would fix this problem.\n\n**Exercise 16.7 [m]** To a yes/no question, what is the difference between yes and `(no-1)` ? What does this suggest?\n\n**Exercise 16.8 [m]** What happens if the user types `why` to the prompt about the patient's name?\nWhat happens if the expert wants to have more than one context with a name parameter?\nIf there is a problem, fix it.\n\nThe remaining exercises discuss extensions that were in the original EMYCIN, !!!(span) {:.smallcaps} but were not implemented in our version.\nImplementing all the extensions will result in a system that is very close to the full power of EMYCIN !!!(span) {:.smallcaps} . These extensions are discussed in [chapter 3](B9780080571157500030.xhtml) of [Buchanan and Shortliffe 1984](B9780080571157500285.xhtml#bb0145).\n\n**Exercise 16.9 [h]** Add a spelling corrector to `ask-vals`.\nIf the user enters an invalid reply, and the parameter type is a `member` expression, check if the reply is \"close\" in spelling to one of the valid values, and if so, use that value.\nThat way, the user can type just `entero` instead of `enterobacteriaceae`.\nYou may experiment with the definition of \"close,\" but you should certainly allow for prefixes and at least one instance of a changed, missing, inserted, or transposed letter.\n\n**Exercise 16.10 [m]** Indent the output for each new branch in the context tree.\nIn other words, have the prompts and findings printed like this:\n\n```lisp\n------ PATIENT-1 ------\nPatient's name: Sylvia Fischer\nSex: female\nAge: 27\n   ------ CULTURE-1 ------\n   From what site was the specimen for CULTURE-1 taken? blood\n   How many days ago was this culture (CULTURE-1) obtained? 3\n     ------ ORGANISM-1 ------\n     Enter the identity (genus) of ORGANISM-1: unknown\n     The gram stain of ORGANISM-1: neg\n     ...\n     Findings for ORGANISM-1:\n      IDENTITY: ENTEROBACTERIACEAE (0.800) PSEUDOMONAS (0.760)\n     Is there another ORGANISM? (Y or N) N\n   Is there another CULTURE? (Y or N) N\nIs there another PATIENT? (Y or N) N\n```\n\n**Exercise 16.11 [h]** We said that our `emycin` looks at all possible rules for each parameter, because there is no telling how a later rule may affect the certainty factor.\nActually, that is not quite true.\nIf there is a rule that leads to a conclusion with certainty 1, then no other rules need be considered.\nThis was called a *unity path*.\nModify the program to look for unity paths first.\n\n**Exercise 16.12 [m]** Depending on whether a parameter is in `initial-data` or not, all the relevant rules are run either before or after asking the user for the value of the parameter.\nBut there are some cases when not all initial data parameters should be asked for.\nAs an example, suppose that `identity` and `gram` were initial data parameters of `organism`.\nIf the user gave a positive answer for `identity`, then it would be wasteful to ask for the `gram` parameter, since it could be determined directly from rules.\nAfter receiving complaints about this problem, a system of *antecedent rules* was developed.\nThese rules were always run first, before asking questions.\nImplement antecedent rules.\n\n**Exercise 16.13 [h]** It is useful to be able to write *default rules* that fill in a value after all other rules have failed to determine one.\nA default rule looks like this:\n\n```lisp\n(defrule n if (parm inst unknown) then (parm inst is default))\n```\n\nIt may also have other conjuncts in the premise.\nBeside details like writing the `unknown` operator, the difficult part is in making sure that these rules get run at the right time (after other rules have had a chance to fill in the parameter), and that infinite loops are avoided.\n\n**Exercise 16.14 [h]** The context tree proved to be a limitation.\nEventually, the need arose for a rule that said, \"If any of the organisms in a culture has property X, then the culture has property Y.\" Implement a means of checking for `some` or `every` instance of a context.\n\n**Exercise 16.15 [m]** As the rule base grew, it became increasingly hard to remember the justification for previous rules.\nImplement a mechanism that keeps track of the author and date of creation of each rule, and allows the author to add documentation explaining the rationale for the rule.\n\n**Exercise 16.16 [m]** It is difficult to come up with the perfect prompt for each parameter.\nOne solution is not to insist that one promptfits all users, but rather to allow the expert to supply three different prompts: a normal prompt, a verbose prompt (or reprompt) for when the user replies with a ?, and a terse prompt for the experienced user.\nModify `defparm` to accommodate this concept, add a command for the user to ask for the terse prompts, and change `ask-vals` to use the proper prompt.\n\nThe remaining exercises cover three additional replies the user can make: `how`, `stop`, and `change`.\n\n**Exercise 16.17 [d]** In addition to `why` replies, EMYCIN !!!(span) {:.smallcaps} also allowed for `how` questions.\nThe user can ask how the value of a particular parameter/instance pair was determined, and the system will reply with a list of rules and the evidence they supplied for or against each value.\nImplement this mechanism.\nIt will require storing additional information in the data base.\n\n**Exercise 16.18 [m]** There was also a stop command that immediately halted the session.\nImplement it.\n\n**Exercise 16.19 [d]** The original EMYCIN !!!(span) {:.smallcaps} also had a change command to allow the user to change the answer to certain questions without starting all over.\nEach question was assigned a number, which was printed before the prompt.\nThe command change, followed by a list of numbers, causes the system to look up the questions associated with each number and delete the answer to these questions.\nThe system also throws away the entire context tree and all derived parameter values.\nAt that point the entire consultation is restarted, using only the data obtained from the unchanged questions.\nAlthough it may seem wasteful to start over from the beginning, it will not be wasteful of the user's time, since correct answers will not be asked again.\n\nIdentify what needs to be altered to implement change and make the alterations.\n\n**Exercise 16.20 [h]** Change the definition of `cf`-and and `cf-or` to use fuzzy set theory instead of certainty factors.\nDo the same for Dempster-Shafer theory.\n\n## 16.12 Answers\n{:#s0065}\n{:.h1hd}\n\n**Answer 16.1** Because EMYCIN !!!(span) {:.smallcaps} assumes independence, each reading of the same headline would increase the certainty factor.\nThe following computation shows that 298 more copies would be needed to reach .95 certainty.\nA more sophisticated reasoner would realize that multiple copies of a newspaper are completely dependent on one another, and would not change the certainty with each new copy.\n\n```lisp\n> (loop for cf = .01 then (cf-or .01 cf)\n   until (> cf .95)\n   count t)\n298\n```\n\n**Answer 16.2** The `defrule` expandsto (`make-rule :number '101 :cf true ...`); that is, the certainty factor is unquoted, so it is already legal to use true as a certainty factor!\nTo support `probably` and other hedges, just define new constants.\n\n**Answer 16.4** Just make the default parameter type be `nil` (by changing `t` to `nil` in `parm-type`).\nThen any rule that uses an undefined parameter will automatically generate a warning.\n\n**Answer 16.6**\n\n```lisp\n(defrule 4\n if (sex patient is male)\n then - 1 (pregnant patient is yes))\n```\n\n**Answer 16.7** Logically, there should be no difference, but to EMYCIN !!!(span) {:.smallcaps} there is a big difference.\nEMYCIN !!!(span) {:.smallcaps} would not complain if you answered `(yes 1 no 1)`.\nThis suggests that the system should have some way of dealing with mutually exclusive answers.\nOne way would be to accept only yes responses for Boolean parameters, but have the input routine translate no to `(yes -1)` and `(no *cf*)` to `(yes 1-*cf*)`.\nAnother possibility would be to have `update-cf check` to see if any certainty factor on a mutually exclusive value is 1, and if so, change the other values to -1.\n\n**Answer 16.18** Add the clause `(stop (throw 'stop nil))` to the case statement inask-valsandwrapa `(catch 'stop ...)` around the code in `emycin`.\n\n# Chapter 17\n## Line-Diagram Labeling by Constraint Satisfaction\n{:.chaptitle}\n\n> It is wrong to think of Waltz's work only as a statement of the epistemology of line drawings of polyhedra.\nInstead I think it is an elegant case study of a paradigm we can expect to see again and again.\n\n> -Patrick Winston\n\n> The Psychology of Computer Vision (1975)\n\nThis book touches only the areas of AI that deal with abstract reasoning.\nThere is another side of AI, the field of *robotics,* that deals with interfacing abstract reasoning with the real world through sensors and motors.\nA robot receives input from cameras, microphones, sonar, and touch-sensitive devices, and produces \"ouput\" by moving its appendages or generating sounds.\nThe real world is a messier place than the abstract worlds we have been covering.\nA robot must deal with noisy data, faulty components, and other agents and events in the world that can affect changes in the environment.\n\nComputer vision is the subfield of robotics that deals with interpreting visual information.\nLow-level vision takes its input directly from a camera and detects lines, regions and textures.\nWe will not be concerned with this.\nHigh-level vision uses the findings of the low-level component to build a three-dimensional model of the objects depicted in the scene.\nThis chapter covers one small aspect of high-level vision.\n\n## 17.1 The Line-Labeling Problem\n{:#s0010}\n{:.h1hd}\n\nIn this chapter we look at the line-diagram labeling problem: Given a list of lines and the vertexes at which they intersect, how can we determine what the lines represent?\nFor example, given the nine lines in [figure 17.1](#f0010), how can we interpret the diagram as a cube?\n\n![f17-01-9780080571157](images/B9780080571157500170/f17-01-9780080571157.jpg)     \nFigure 17.1\n!!!(span) {:.fignum}\nA Cube\nBefore we can arrive at an interpretation, we have to agree on what the candidates are.\nAfter all, [figure 17.1](#f0010) could be just a hexagon with three lines in the middle.\nFor the purposes of this chapter, we will consider only diagrams that depict one or more *polyhedra-*three-dimensional solid figures whose surfaces are flat faces bounded by straight lines.\nIn addition, we will only allow *trihedral* vertexes.\nThat is, each vertex must be formed by the intersection of three faces, as in the corner of a cube, where the top, front, and side of the cube come together.\nA third restriction on diagrams is that no so-called *accidental* vertexes are allowed.\nFor example, [figure 17.1](#f0010) might be a picture of three different cubes hanging in space, which just happen to line up so that the edge of one is aligned with the edge of another from our viewpoint.\nWe will assume that this is not the case.\n\nGiven a diagram that fits these three restrictions, our goal is to identify each line, placing it in one of three classes:\n\n1. A convex line separates two visible faces of a polyhedron such that a line from one face to the other would lie inside the polyhedron.\nIt will be marked with a plus sign:+.\n!!!(p) {:.numlist}\n\n2. A concave line separates two faces of two polyhedra such that a line between the two spaces would pass through empty space.\nIt will be marked with a minus sign:-.\n!!!(p) {:.numlist}\n\n3. A boundary line denotes the same physical situation as a convex line, but the diagram is oriented in such a way that only one of the two faces of the polyhedron is visible.\nThus, the line marks the boundary between the polyhedron and the background.\nIt will be marked with an arrow:&rarr;.\nTraveling along the line from the tail to the point of the arrow, the polyhedron is on the right, and the background is on the left.\n!!!(p) {:.numlist}\n\n[Figure 17.2](#f0015) shows a labeling of the cube using these conventions.\nVertex A is the near corner of the cube, and the three lines coming out of it are all convex lines.\nLines GD and DF are concave lines, indicating the junction between the cube and the surface on which it is resting.\nThe remaining lines are boundary lines, indicating that there is no physical connection between the cube and the background there, but that there are other sides of the cube that cannot be seen.\n\n![f17-02-9780080571157](images/B9780080571157500170/f17-02-9780080571157.jpg)     \nFigure 17.2\n!!!(span) {:.fignum}\nA Line-labeled Cube\nThe line-labeling technique developed in this chapter is based on a simple idea.\nFirst we enumerate all the possible vertexes, and all the possible labelings for each vertex.\nIt turns out there are only four different vertex types in the trihedral polygon world.\nWe call them L, Y, W, and T vertexes, because of their shape.\nThe Y and W vertexes are also known as forks and arrows, respectively.\nThe vertexes are listed in [figure 17.3](#f0020).\nEach vertex imposes some constraints on the lines that compose it.\nFor example, in a W vertex, the middle line can be labeled with a + or -, but not with an arrow.\n\n![f17-03-9780080571157](images/B9780080571157500170/f17-03-9780080571157.jpg)     \nFigure 17.3\n!!!(span) {:.fignum}\nThe Possible Vertexes and Labels\nEach line connects two vertexes, so it must satisfy both constraints.\nThis suggests a simple algorithm for labeling a diagram based on constraint propagation: First, label each vertex with all the possible labelings for the vertex type.\nAn L vertex has six possibilities, Y has five, T has four, and W has three.\nNext, pick a vertex, V.\nConsider a neighboring vertex, N (that is, N and V are connected by a line).\nN will also have a set of possible labelings.\nIf N and V agree on the possible labelings for the line between them, then we have gained nothing.\nBut if the intersection of the two possibility sets is smaller than V's possibility set, then we have found a constraint on the diagram.\nWe adjust N and V's possible labelings accordingly.\nEvery time we add a constraint at a vertex, we repeat the whole process for all the neighboring vertexes, to give the constraint a chance to propagate as far as possible.\nWhen every vertex has been visited at least once and there are no more constraints to propagate, then we are done.\n\n[Figure 17.4](#f0025) illustrates this process.\nOn the left we start with a cube.\nAll vertexes have all possible labelings, except that we know line GD is concave (-), indicating that the cube is resting on a surface.\nThis constrains vertex D in such a way that line DA must be convex (+).\nIn the middle picture the constraint on vertex D has propagated to vertex A, and in the right-hand picture it propagates to vertex B.\nSoon, the whole cube will be uniquely labeled.\n\n![f17-04-9780080571157](images/B9780080571157500170/f17-04-9780080571157.jpg)     \nFigure 17.4\n!!!(span) {:.fignum}\nPropagating Constraints\nMany diagrams will be labeled uniquely by this constraint propagation process.\nSome diagrams, however, are ambiguous.\nThey will still have multiple labelings after constraint propagation has finished.\nIn this case, we can search for a solution.\nSimply choose an ambiguous vertex, choose one of the possible labelings for that vertex, and repeat the constraint propagation/search process.\nKeep going until the diagram is either unambiguous or inconsistent.\n\nThat completes the sketch of the line-labeling algorithm.\nWe are now ready to implement a labeling program.\nIt's glossary is in [figure 17.5](#f0030).\n\n![f17-05-9780080571157](images/B9780080571157500170/f17-05-9780080571157.jpg)     \nFigure 17.5\n!!!(span) {:.fignum}\nGlossary for the Line-Labeling Program\nThe two main data structures are the di agram and the vertex.\nIt would have been possible to implement a data type for `lines`, but it is not necessary: lines are defined implicitly by the two vertexes at their end points.\n\nA diagram is completely specified by its list of vertexes, so the structure di agram needs only one slot.\nA vertex, on the other hand, is a more complex structure.\nEach vertex has an identifying name (usually a single letter), a vertex type (L, Y, W, or T), a list of neighboring vertexes, and a list of possible labelings.\nA labeling is a list of line labels.\nFor example, a Y vertex will initially have a list of five possible labelings.\nIf it is discovered that the vertex is the interior of a concave corner, then it will have the single labeling ( - - - ).\nWe give type information on the slots of vertex because it is a complicated data type.\nThe syntax of defstruct is such that you cannot specify a : type without first specifying a default value.\nWe chose L as the default value for the type slot at random, but note that it would have been an error to give `nil` as the default value, because `nil` is not of the right type.\n\n```lisp\n(defstruct diagram \"A diagram is a list of vertexes.\" vertexes)\n(defstruct (vertex (:print-function print-vertex))\n (name   nil :type atom)\n (type    'L :type (member L Y W T))\n (neighbors nil :type list) ; of vertex\n (labelings nil :type list)) ; of lists of (member + - L R)))))\n```\n\nAn ambiguous vertex will have several labelings, while an unambiguous vertex has exactly one, and a vertex with no labelings indicates an impossible diagram.\nInitially we don't know which vertexes are what, so they all start with several possible labelings.\nNote that a labeling is a list, not a set: the order of the labels is significant and matches the order of the neighboring vertexes.\nThe function possible-labelings gives a list of all possible labelings for each vertex type.\nWe use R and L instead of arrows as labels, because the orientation of the arrows is significant.\nAn R means that as you travel from the vertex to its neighbor, the polyhedron is on the right and the background object is on the left.\nThus, an R is equivalent to an arrow pointing away from the vertex.\nThe L is just the reverse.\n\n```lisp\n(defun ambiguous-vertex-p (vertex)\n \"A vertex is ambiguous if it has more than one labeling.\"\n (> (number-of-labelings vertex) 1))\n(defun number-of-labelings (vertex)\n (length (vertex-labelings vertex)))\n(defun impossible-vertex-p (vertex)\n \"A vertex is impossible if it has no labeling.\"\n (null (vertex-labelings vertex)))\n(defun impossible-diagram-p (diagram)\n \"An impossible diagram is one with an impossible vertex.\"\n (some #'impossible-vertex-p (diagram-vertexes diagram)))\n(defun possible-labelings (vertex-type)\\\n \"The list of possible labelings for a given vertex type.\"\n ;; In these labelings, R means an arrow pointing away from\n ;; the vertex, L means an arrow pointing towards it.\n  (case vertex-type\n  ((L) '((R L) (L R) (+ R) (L +) (- L) (R -)))\n  ((Y) '((+ + +) ( ) (L R -) (- L R) (R - L)))\n  ((T) '((R L +) (R L -) (R L L) (R L R)))\n  ((W) '((L R +) (- - +) (+ + -)))))\n```\n\n## 17.2 Combining Constraints and Searching\n{:#s0015}\n{:.h1hd}\n\nThe main function `print-labelings` takes a diagram as input, reduces the number of labelings on each vertex by constraint propagation, and then searches for all consistent interpretations.\nOutput is printed before and after each step.\n\n```lisp\n(defun print-labelings (diagram)\n \"Label the diagram by propagating constraints and then\n searching for solutions if necessary. Print results.\"\n (show-diagram diagram \"~&The initial diagram is:\")\n (every #'propagate-constraints (diagram-vertexes diagram))\n (show-diagram diagram\n       \"~2&After constraint propagation the diagram is:\")\n (let* ((solutions (if (impossible-diagram-p diagram)\n         nil\n         (search-solutions diagram)))\n    (n (length solutions)))\n  (unless (= n 1)\n   (format t \"~2&There are ~ r solution~:p:\" n)\n   (mapc #'show-diagram solutions)))\n (values))\n```\n\nThe function `propagate-constraints` takes a vertex and considers the constraints imposed by neighboring vertexes to get a list of all the `consistent-labelings` for the vertex.\nIf the number of consistent labelings is less than the number before we started, then the neighbors' constraints have had an effect on this vertex, so we propagate the new-found constraints on this vertex back to each neighbor.\nThe function returns nil and thus immediately stops the propagation if there is an impossible vertex.\nOtherwise, propagation continues until there are no more changes to the labelings.\n\nThe whole propagation algorithm is started by a call to `every in print-labelings,` which propagates constraints from each vertex in the diagram.\nBut it is not obvious that this is all that is required.\nAfter propagating from each vertex once, couldn't there be another vertex that needs relabeling?\nThe only vertex that could possibly need relabeling would be one that had a neighbor changed since its last update.\nBut any such vertex would have been visited by `propagate-constraint,` since we propagate to all neighbors.\nThus, a single pass through the vertexes, compounded with recursive calls, will find and apply all possible constraints.\n\nThe next question worth asking is if the algorithm is guaranteed to terminate.\nClearly, it is, because `propagate-constraints` can only produce recursive calls when it removes a labeling.\nBut since there are a finite number of labelings initially (no more than six per vertex), there must be a finite number of calls to `propagate-constraints.`\n\n```lisp\n(defun propagate-constraints (vertex)\n \"Reduce the labelings on vertex by considering neighbors.\n If we can reduce, propagate the constraints to each neighbor.\n ;; Return nil only when the constraints lead to an impossibility\n (let ((old-num (number-of-labelings vertex)))\n  (setf (vertex-labelings vertex) (consistent-labelings vertex))\n  (unless (impossible-vertex-p vertex)\n   (when (< (number-of-labelings vertex) old-num)\n    (every #'propagate-constraints (vertex-neighbors vertex)))\n   t)))\n```\n\nThe function `consistent-labelings` is passed a vertex.\nIt gets all the labels for this vertex from the neighboring vertexes, collecting them in `neighbor-labels`.\nIt then checks all the labels on the current vertex, keeping only the ones that are consistent with all the neighbors' constraints.\nThe auxiliary function `labels-for` finds the labels for a particular neighbor at a vertex, and reverse-1 abel accounts for the fact that L and R labels are interpreted with respect to the vertex they point at.\n\n```lisp\n(defun consistent-labelings (vertex)\n \"Return the set of labelings that are consistent with neighbors.\"\n (let ((neighbor-labels\n     (mapcar #'(lambda (neighbor) (labels-for neighbor vertex))\n       (vertex-neighbors vertex))))\n  :: Eliminate labelings that don't have` all `lines consistent\n  :: with the corresponding line's label from the neighbor.\n  :: Account for the L-R mismatch with reverse-label.\n  (find-all-if\n   #'(lambda (labeling)\n     (every #'member (mapcar #'reverse-label labeling)\n       neighbor-labels))\n   (vertex-labelings vertex))))\n```\n\nConstraint propagation is often sufficient to yield a unique interpretation.\nBut sometimes the diagram is still underconstrained, and we will have to search for solutions.\nThe function `search-solutions` first checks to see if the diagram is ambiguous, by seeing if it has an ambiguous vertex, v.\nIf the diagram is unambiguous, then it is a solution, and we return it (in a list, `since search-solutions` is designed to return a list of all solutions).\nOtherwise, for each of the possible labelings for the ambiguous vertex, we create a brand new copy of the diagram and set v's labeling in the copy to one of the possible labelings.\nIn effect, we are guessing that a labeling is a correct one.\nWe call `propagate-constraints;` if it falls, then we have guessed wrong, so there are no solutions with this labeling.\nBut if it succeeds, then we call `search-solutions` recursively to give us the list of solutions generated by this labeling.\n\n```lisp\n(defun search-solutions (diagram)\n \"Try` all `labelings for one ambiguous vertex. and pro pagate.\"\n :: If there is no ambiguous vertex, return the diagram.\n :: If there is one. make copies of the diagram trying each of\n :: the possible labelings. Propagate constraints and append\n ::` all `the solutions together.\n (let ((v (find-if #'ambiguous-vertex-p\n            (diagram-vertexes diagram))))\n  (if (null v)\n     (list diagram)\n     (mapcan\n      #'(lambda (v-labeling)\n (let* ((diagram2 (make-copy-diagram diagram))\n   (v2 (find-vertex (vertex-name v) diagram2)))\n (setf (vertex-labelings v2) (list v-labeling))\n (if (propagate-constraints v2)\n   (search-solutions diagram2)\n   nil)))\n(vertex-labelings v)))))\n```\n\nThat's all there is to the algorithm; all that remains are some auxiliary functions.\nHere are three of them:\n\n```lisp\n(defun labels-for (vertex from)\n \"Return all the labels for the line going to vertex.\"\n (let ((pos (position from (vertex-neighbors vertex))))\n  (mapcar #'(lambda (labeling) (nth pos labeling))\n      (vertex-labelings vertex))))\n(defun reverse-label (label)\n \"Account for the fact that one vertex's right is another's left.\"\n (case label (L 'R) (R 'L) (otherwise label)))\n(defun find-vertex (name diagram)\n \"Find the vertex in the given diagram with the given name.\"\n (find name (diagram-vertexes diagram) :key #'vertex-name))\n```\n\nHere are the printing functions.\n`print-vertex` prints a vertex in short form.\nIt obeys the `print` convention of returning the first argument.\nThe functions `show-vertex` and `show-diagram` print more de tailed forms.\nThey obey the convention f or `describe`-like functions of returning no values at all.\n\n```lisp\n(defun print-vertex (vertex stream depth)\n \"Print a vertex in the short form.\"\n (d`e`clar`e `(ignore depth))\n (format stream \"~a/~d\" (vertex-name vertex)\n      (number-of-labelings vertex))\n vertex)\n(defun show-vertex (vertex &optional (stream t))\n \"Print a vertex in a long form, on a new line.\"\n (format stream \"~&~a ~d:\" vertex (vertex-type vertex))\n (mapc #'(lambda (neighbor labels)\n      (format stream \" ~a~a=[~{~a~}]\" (vertex-name vertex)\n          (vertex-name neighbor) labels))\n   (vertex-neighbors vertex)\n   (matrix-transpose (vertex-labelings vertex)))\n (values))\n(defun show-diagram (diagram &optional (title \"~2&Diagram:\")\n               (stream t))\n \"Print a diagram in a long form. Include a title.\"\n (format stream title)\n (mapc #'show-vertex (diagram-vertexes diagram))\n (let ((n (reduce #'* (mapcar #'number-of-labelings\n                (diagram-vertexes diagram)))))\n (when (> n 1)\n  (format stream \"~&For ~:d interpretation ~:p.\" n))\n (values)))\n```\n\n`Note` that `matrix-transpose` is called by `show-vertex` to turn the matrix of labelings on its side.\nIt works like this:\n\n```lisp\n(possible-labelings 'Y)\n((+ + +)\n (- - -)\n (L R -)\n (- L R)\n (R - L))\n(matrix-transpose (possible-labelings 'Y))\n((+ - L - R)\n (+ - R L -)\n (+ - - R L))\n```\n\nThe implementation of `matrix-transpose` is surprisingly concise.\nIt is an old Lisp trick, and well worth understanding:\n\n```lisp\n(defun matrix-transpose (matrix)\n \"Turn a matrix on its side.\"\n (if matrix (apply #'mapcar #'list matrix)))\n```\n\nThe remaining code has to do with creating diagrams.\nWe need some handy way of specifying diagrams.\nOne way would be with a line-recognizing program operating on digitized input from a camera or bitmap display.\nAnother possibility is an interactive drawing program using a mouse and bitmap display.\nBut since there is not yet a Common Lisp standard for interacting with such devices, we will have to settle for a textual description.\nThe macro `defdiagram` defines and names a diagram.\nThe name is followed by a list of vertex descriptions.\nEach description is a list consisting of the name of a vertex, the vertex type (Y, A, L, or T), and the names of the neighboring vertexes.\nHere again is the `defdiagram` description for the cube shown in [figure 17.6](#f0035).\n\n![f17-06-9780080571157](images/B9780080571157500170/f17-06-9780080571157.jpg)     \nFigure 17.6\n!!!(span) {:.fignum}\nA Cube\n```lisp\n(defdiagram cube\n (a Y b c d)\n (b W g e a)\n (c W e f a)\n (d W f g a)\n (e L c b)\n (f L d c)\n (g L b d))\n```\n\nThe macro `defdiagram` calls `construct-diagram` to do the real work.\nIt would be feasible to have `defdiagram` expand into a `defvar,` making the names be special variables.\nBut then it would be the user`'s` responsibility to make copies of such a variable before passing it to a destructive function.\nInstead, I use `put-diagram` and `diagram` to put and get diagrams in a table, `diagram` retrieves the named diagram and makes a copy of it.\nThus, the user cannot corrupt the original diagrams stored in the table.\nAnother possibility would be to have `defdiagram` expand into a function definition for `name` that returns a copy of the diagram.\nI chose to keep the diagram name space separate from the function name space, since names like `cube` make sense in both spaces.\n\n```lisp\n(defmacro defdiagram (name &rest vertex-descriptors)\n \"Define a diagram. A copy can be gotten by (diagram name).\"\n '(put-diagram '.name (construct-diagram '.vertex-descriptors)))\n(let ((diagrams (make-hash-table)))\n(defun diagram (name)\n \"Get a fresh copy of the diagram with this name.\"\n (make-copy-diagram (gethash name diagrams)))\n(defun put-diagram (name diagram)\n \"Store a diagram under a name.\"\n (setf (gethash name diagrams) diagram)\n name))\n```\n\nThe function `construct-diagram` translates each vertex description, using `construct-vertex`, and then fills in the neighbors of each vertex.\n\n```lisp\n(defun construct-diagram (vertex-descriptors)\n \"Build a new diagram from a set of vertex descriptor.\"\n (let ((diagram (make-diagram)))\n  :: Put in the vertexes\n  (setf (diagram-vertexes diagram)\n     (mapcar #'construct-vertex vertex-descriptors))\n  :: Put in the neighbors for each vertex\n  (dolist (v-d vertex-descriptors)\n   (setf (vertex-neighbors (find-vertex (first v-d) diagram))\n      (mapcar #'(lambda (neighbor)\n          (find-vertex neighbor diagram))\n         (v-d-neighbors v-d))))\n  diagram))\n(defun construct-vertex (vertex-descriptor)\n \"Build the vertex corresponding to the descriptor.\"\n :: Descriptors are like: (x L y z)\n (make-vertex\n  :name (first vertex-descriptor)\n  :type (second vertex-descriptor)\n  :labelings (possible-labelings (second vertex-descriptor))))\n(defun v-d-neighbors (vertex-descriptor)\n \"The neighboring vertex names in a vertex descriptor.\"\n (rest (rest vertex-descriptor)))\n```\n\nThe `defstruct` for `diagram` automatically creates the function `copy-diagram,` but it just copies each field, without copying the contents of each field.\nThus we need `make-copy-diagram` to create a copy that shares no structure with the original.\n\n```lisp\n(defun make-copy-diagram (diagram)\n \"Make a copy of a diagram, preserving connectivity.\"\n (let* ((new (make-diagram\n      :vertexes (mapcar #'copy-vertex\n               (diagram-vertexes diagram)))))\n  :: Put in the neighbors for each vertex\n  (dolist (v (diagram-vertexes new))\n   (setf (vertex-neighbors v)\n       (mapcar #'(lambda (neighbor)\n            (find-vertex (vertex-name neighbor) new))\n          (vertex-neighbors v))))\n  new))\n```\n\n## 17.3 Labeling Diagrams\n{:#s0020}\n{:.h1hd}\n\nWe are now ready to try labeling diagrams.\nFirst the cube:\n\n```lisp\n> (print-labelings (diagram 'cube))\nThe initial diagram is:\n A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n E/6 L: EC=[RL+L-R] EB=[LRR+L-]\n F/6 L: FD=[RL+L-R] FC=[LRR+L-]\n G/6 L: GB=[RL+L-R] GD=[LRR+L-]\nFor 29,160 interpr`e`tations.\nAfter constraint propagation the diagram is:\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/2 W: BG=[L-] BE=[R-] BA=[++]\n C/2 W: CE=[L-] CF=[R-] CA=[++]\n D/2 W: DF=[L-] DG=[R-] DA=[++]\n E/3 L: EC=[R-R] EB=[LL-]\n F/3 L: FD=[R-R] FC=[LL-]\n G/3 L: GB=[R-R] GD=[LL-]\nFor 216 interpr`e`tations.\nThere are four solutions:\nDiagram:\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/1 W: BG=[L] BE=[R] BA=[+]\n C/l W: CE=[L] CF=[R] CA=[+]\n D/1 W: DF=[L] DG=[R] DA=[+]\n E/l L: EC=[R] EB=[L]\n F/1 L: FD=[R] FC=[L]\n G/1 L: GB=[R] GD=[L]\n Diagram:\n A/1 Y: AD=[+] AC=[+] AD=[+]\n B/1 W: BG=[L] BE=[R] BA=[+]\n C/l W: CE=[L] CF=[R] CA=[+]\n D/1 W: DF=[-] DG=[-] DA=[+]\n E/l L: EC=[R] EB=[L]\n F/1 L: FD=[-] FC=[L]\n G/1 L: GB=[R] GD=[-]\nDiagram:\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/1 W: BG=[L] BE=[R] BA=[+]\n C/l W: CE=[-] CF=[-] CA=[+]\n D/1 W: DF=[L] DG=[R] DA=[+]\n E/l L: EC=[-] EB=[L]\n F/1 L: FD=[R] FC=[-]\n G/1 L: GB=[R] GD=[L]\nDiagram:\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/1 W: BG=[-] BE=[-] BA=[+]\n C/1 W: CE=[L] CF=[R] CA=[+]\n D/1 W: DF=[L] DG=[R] DA=[+]\n E/1 L: EC=[R] EB=[-]\n F/1 L: FD=[R] FC=[L]\n G/1 L: GB=[-] GD=[L]\n```\n\nThe four interpretations correspond, respectively, to the cases where the cube is free floating, attached to the floor (GD and DF = -), attached to a wall on the right (EC and CF = -), or attached to a wall on the left (BG and BE = -).\nThese are shown in [figure 17.7](#f0040).\nIt would be nice if we could supply information about where the cube is attached, and see if we can get a unique interpretation.\nThe function ground takes a diagram and modifies it by making one or more lines be grounded lines-lines that have a concave (-) label, corresponding to a junction with the ground.\n\n![f17-07-9780080571157](images/B9780080571157500170/f17-07-9780080571157.jpg)     \nFigure 17.7\n!!!(span) {:.fignum}\nFour Interpretations of the Cube\n```lisp\n(defun ground (diagram vertex-a vertex-b)\n \"Attach the line between the two vertexes to the ground.\n That is, label the line with a -\"\n (let* ((A (find-vertex vertex-a diagram))\n    (B (find-vertex vertex-b diagram))\n    (i (position B (vertex-neighbors A))))\n  (assert (not (null i)))\n  (setf (vertex-labelings A)\n    (find-all-if #'(lambda (1) (eq (nth i 1) '-))\n        (vertex-labelings A)))\n  diagram))\n```\n\nWe can see how this works on the cube:\n\n```lisp\n> (print-labelings (ground (diagram 'cube) 'g 'd))\nThe initial diagram is:\n A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n E/6 L: EC=[RL+L-R] EB[LRR+L-]\n F/6 L: FD=[RL+L-R] FC=[LRR+L-]\n G/1 L: GB=[R] GD=[-]\nFor 4,860 interpr`e`tations.\nAfter constraint propagation the diagram is:\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/l W: BG=[L] BE=[R] BA=[+]\n C/l W: CE=[L] CF=[R] CA=[C +]\n D/l W: DF=[-] DG=[-] DA=[+]\n E/l L: EC=[R] EB=[L]\n F/1 L: FD=[-] FC=[L]\n G/1 L: GB=[R] GD=[-]\n```\n\nNote that the user only had to specify one of the two ground lines, GD.\nThe program found that DF is also grounded.\nSimilarly, in programming `ground-line`, we only had to update one of the vertexes.\nThe rest is done by constraint propagation.\n\nThe next example yields the same four interpretations, in the same order (free floating, attached at bottom, attached at right, and attached at left) when interpreted ungrounded.\nThe grounded version yields the unique solution shown in the following output and in [figure 17.9](#f0050).\n\n![f17-08-9780080571157](images/B9780080571157500170/f17-08-9780080571157.jpg)     \nFigure 17.8\n!!!(span) {:.fignum}\nCube on a Plate\n![f17-09-9780080571157](images/B9780080571157500170/f17-09-9780080571157.jpg)     \nFigure 17.9\n!!!(span) {:.fignum}\nLabeled Cube on a Plate\n```lisp\n(defdiagram cube-on-plate\n (a Y b c d)\n (b W g e a)\n (c W e f a)\n (d W f g a)\n (e L c b)\n (f Y d c i)\n (g Y b d h)\n (h W l g j)\n (i W f m j)\n (j Y h i k)\n (k W m l j)\n (l L h k)\n (m L k i))\n> (print-labelings (ground (diagram 'cube-on-plate) 'k 'm))\nThe initial diagram is:\n A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n E/6 L: EC=[RL+L-R] EB=[LRR+L-]\n F/5 Y: FD=C+-L-R] FC=[+-RL-] FI=[+--RL]\n G/5 Y: GB=[+-L-R] GD=[+-RL-] GH=[+--RL]\n H/3 W: HL=[L-+] HG=[R-+] HJ=[++-]\n I/3 W: IF=[L-+] IM=[R-+] IJ=[++-]\n J/5 Y: JH=[+-L-R] JI=[+-RL-] JK=[+--RL]\n K/1 W: KM=[-] KL=[-] KJ=[+]\n L/6 L: LH=[RL+L-R] LK=[LRR+L-]\n M/6 L: MK=[RL+L-R] MI=[LRR+L-]\nFor 32.805.000 interpr`e`tations.\nAfter constraint propagation the diagram is\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/2 W: BG=[L-] BE=[R-] BA=[++]\n C/2 W: CE=[L-] CF=[R-] CA=[++]\n D/2 W: DF=[L-] DG=[R-] DA=[++]\n E/1 L: EC=[R] EB=[L]\n F/1 Y: FD=[-] FC=[L] FI=[R]\n G/1 Y: GB=[R] GD=[-] GH=[L]\n H/1 W: HL=[L] HG=[R] HJ=[+]\n I/1 W: IF=[L] IM=[R] IJ=[+]\n J/1 Y: JH=[+] JI=[+] JK=[+]\n K/1 W: KM=[-] KL=[-] KJ=[+]\n L/1 L: LH=[R] LK=[-]\n M/1 L: MK=[-] MI=[L]\n```\n\nIt is interesting to try the algorithm on an \"impossible\" diagram.\nIt turns out the algorithm correctly finds no interpretation for this well-known illusion:\n\n```lisp\n(defdiagram poiuyt\n (a L b g)\n (b L j a)\n (c L d l)\n (d L h c)\n (e L f i)\n (f L k e)\n (g L a l)\n (h L l d)\n (i L e k)\n (j L k b)\n (k W j i f)\n (l W h g c))\n> (print-1 abel ings (diagram 'poiuyt))\nThe initial diagram is:\n A/6 L: AB=[RL+L-R] AG=[LRR+L-]\n B/6 L: BJ=[RL+L-R] BA=[LRR+L-]\n C/6 L: CD=[RL+L-R] CL=[LRR+L-]\n D/6 L: DH=[RL+L-R] DC=[LRR+L-]\n E/6 L: EF=[RL+L-R] EI=[LRR+L-]\n F/6 L: FK=[RL+L-R] FE=[LRR+L-]\n G/6 L: GA=[RL+L-R] GL=[LRR+L-]\n H/6 L: HL=[RL+L-R] HD=[LRR+L-]\n I/6 L: IE=[RL+L-R] IK=[LRR+L-]\n J/6 L: JK=[RL+L-R] JB=[LRR+L-]\n K/3 W: KJ=[L-+] KI=[R-+] KF=[++-]\n L/3 W: LH=[L-+] LG=[R-+] LC=[++-]\nFor 544,195.584 interpr`e`tations.\nAfter constraint propagation the diagram is:\n A/5 L: AB=[RL+-R] AG=[LRRL-]\n B/5 L: BJ=[RLL-R] BA=[LR+L-]\n C/2 L: CD=[LR] CL=[+-]\n D/3 L: DH=[RL-] DC=[LRL]\n E/3 L: EF=[RLR] EI=[LR-]\n F/2 L: FK=[+-] FE=[RL]\n G/4 L: GA=[RL-R] GL=[L+L-]\n H/4 L: HL=[R+-R] HD=[LRL-]\n I/4 L: IE=[RL-R] IK=[L+L-]\n J/4 L: JK=[R+-R] JB=[LRL-]\n K/3 W: KJ=[L-+] KI=[R-+] KF=[++-]\n L/3 W: LH=[L-+] LG=[R-+] LC=[++-]\nFor 2,073,600 interpr`e`tations.\nThere are z`e`ro solutions:\n```\n\nNow we try a more complex diagram:\n\n```lisp\n(defdiagram tower\n (a Y b c d)  (n L q o)\n (b W g e a)  (o W y j n)\n (c W e f a)  (P L r i)\n (d W f g a)  (q W n s w)\n (e L c b)   (r W s p x)\n (f Y d c i)  (s L r q)\n (g Y b d h)  (t W w x z)\n (h W l g J)  (u W x y z)\n (i W f m p)  (v W y w z)\n (j Y h o k)  (w Y t v q)\n (k W m l j)  (x Y r u t)\n (l L h k)   (y Y v u o)\n (m L k i)   (z Y t u v))\n> (print-labelings (ground (diagram 'tower) 'l 'k))\nThe initial diagram is:\n A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n E/6 L: EC[RL+L-R] EB=[LRR+L-]\n F/5 Y: FD=[+-L-R] FC=[+-RL-] FI=[+--RL]\n G/5 Y: GB=[+-L-R] GD=[+-RL-] GH=[+--RL]\n H/3 W: HL=[L-+] HG=[R-+] HJ=[++-]\n I/3 W: IF=[L-+] IM=[R-+] IP=[++-]\n J/5 Y: JH=[+-L-R] JO=[+-RL-] JK=[+--RL]\n K/3 W: KM=[L-+] KL=[R-+] KJ=[++-]\n L/1 L: LH=[R] LK=[-]\n M/6 L: MK=[RL+L-R] MI=[LRR+L-]\n N/6 L: NQ=[RL+L-R] NO=[LRR+L-]\n O/3 W: OY=[L-+] OJ=[R-+] ON=[++-]\n P/6 L: PR=[RL+L-R] PI=[LRR+L-]\n Q/3 W: QN=[L-+] QS=[R-+] QW=[++-]\n R/3 W: RS=[L-+] RP=[R-+] RX=[++-]\n S/6 L: SR=[RL+L-R] SQ=[LRR+L-]\n T/3 W:` TW=[L-+] `TX=[R-+] TZ=[++-]\n U/3 W: UX=[L-+] UY=[R-+] UZ=[++-]\n V/3 W: VY=[L-+] VW=[R-+] VZ=[++-]\n W/5 Y: WT=[+-L-R] WV=[+-RL-] WQ=[+--RL]\n X/5 Y: XR=[+-L-R] XU=[+-RL-] XT=[+--RL]\n Y/5 Y: YV=[+-L-R] YU=[+-RL-] YO=[+--RL]\n Z/5 Y: ZT=[+-L-R] ZU=[+-RL-] ZV=[+--RL]\nFor 1,614,252,037,500,000 interpretations.\n```\n\nAfter constraint propagation the diagram is:\n\n```lisp\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/l W: BG=[L] BE=[R] BA=[+]\n C/1 W: CE=[L] CF=[R] CA=[+]\n D/l W: DF=[-] DG=[-] DA=[+]\n E/1 L: EC=[R] EB=[L]\n F/1 Y: FD=[-] FC=[L] FI=[R]\n G/1 Y: GB=[R] GD=[-]GH=[L]\n H/1 W: HL=[L] HG=[R] HJ=[+]\n I/1 W: IF=[L] IM=[R] IP=[+]\n J/l Y: JH=[+] JO=[+] JK=[+]\n K/l W: KM=[-] KL=[-] KJ=[+]\n L/l L: LH=[R] LK=[-]\n M/1 L: MK=[-] MI=[L]\n N/l L: NQ=[R] NO[-]\n O/l W: OY=[+] OJ=[+] ON=[-]\n P/l L: PR=[L] PI=[+]\n Q/1 W: QN=[L] QS=[R] QW=[+]\n R/1 W: RS=[L] RP=[R] RX=[+]\n S/1 L: SR=[R] SQ=[L]\n T/1 W: TW=[+] TX=[+] TZ=[-]\n U/1 W: UX=[+] UY=[+] UZ=[-]\n V/l W: VY=[+] VW=[+] VZ=[-]\n W/l Y: WT=[+] WV=[+] WQ=[+]\n X/1 Y: XR=[+] XU=[+] XT=[+]\n Y/1 Y: YV=[+] YU=[+] YO=[+]\n Z/l Y: ZT=[-] ZU=[-] ZV=[-]\n```\n\nWe see that the algorithm was able to arrive at a single interpretation.\nMoreover, even though there were a large number of possibilities-over a quadrillion-the computation is quite fast.\nMost of the time is spent printing, so to get a good measurement, we define a function to find solutions without printing anything:\n\n```lisp\n(defun find-labelings (diagram)\n \"Return a list of all consistent labelings of the diagram.\"\n (every #'propagate-constraints (diagram-vertexes diagram))\n (search-solutions diagram))\n```\n\nWhen we time the application of `find-labelings` to the grounded tower and the poiuyt, we find the tower takes 0.11 seconds, and the poiuyt 21 seconds.\nThis is over 180 times longer, even though the poiuyt has only half as many vertexes and only about half a million interpretations, compared to the tower's quadrillion.\nThe poiuyt takes a long time to process because there are few local constraints, so violations are discovered only by considering several widely separated parts of the figure all at the same time.\nIt is interesting that the same fact that makes the processing of the poiuyt take longer is also responsible for its interest as an illusion.\n\n## 17.4 Checking Diagrams for Errors\n{:#s0025}\n{:.h1hd}\n\nThis section considers one more example, and considers what to do when there are apparent errors in the input.\nThe example is taken from Charniak and McDermott's *Introduction to Artificial Intelligence*, page 138, and shown in [figure 17.12](#f0065).\n\n![f17-10-9780080571157](images/B9780080571157500170/f17-10-9780080571157.jpg)     \nFigure 17.10\n!!!(span) {:.fignum}\nAn Impossible Figure (A Poiuyt)\n![f17-11-9780080571157](images/B9780080571157500170/f17-11-9780080571157.jpg)     \nFigure 17.11\n!!!(span) {:.fignum}\nA Tower\n![f17-12-9780080571157](images/B9780080571157500170/f17-12-9780080571157.jpg)     \nFigure 17.12\n!!!(span) {:.fignum}\nDiagram of an arch\n```lisp\n(defdiagram arch\n (a W e b c)  (p L o q)\n (b L d a)   (q T P i r)\n (c Y a d g)  (r T j s q)\n (d Y c b m)  (s L r t)\n (e L a f)   (t W v s k)\n (f T e g n)  (u L t l)\n (g W h f c)  (v L t l)\n (h T g i o)  (w W x l y)\n (i T h j q)  (x L w z)\n (j T i k r)  (y Y w 2 z)\n (k T J l t)  (z W 3 x y)\n (l T k m v)  (l T n o w)\n (m L l d)   (2 W v 3 y)\n (n L f 1)   (3 L z 2)\n (o W P 1 h)  (4 T u l v))\n```\n\nUnfortunately, running this example results in no consistent interpretations after constraint propagation.\nThis seems wrong.\nWorse, when we try to ground the diagram on the line XZ and call `print-labelings` on that, we get the following error:\n\n```lisp\n>>>ERROR: The first argument to NTH was of the wrong type.\nThe function expected a fixnum >= z`e`ro.\nWhile in the function LABELS-FOR`<= `CONSISTENT-LABELINGS\nDebugger entered while in the following function:\nLABELS-FOR (P.C. = 23)\n Arg 0 (VERTEX): U/6\n Arg 1 (FROM): 4/4\n```\n\nWhat has gone wrong?\nA good guess is that the diagram is somehow inconsistent- somewhere an error was made in transcribing the diagram.\nIt could be that the diagram is in fact impossible, like the poiuyt.\nBut that is unlikely, as it is easy for us to provide an intuitive interpretation.\nWe need to debug the diagram, and it would also be a good idea to handle the error more gracefully.\n\nOne property of the diagram that is easy to check for is that every line should be mentioned twice.\nIf there is a line between vertexes A and B, there should be two entries in the vertex descriptors of the following form:\n\n```lisp\n(A ? ... B ...)\n(B ? ... A ...)\n```\n\nHere the symbol \"?\" means we aren't concerned about the type of the vertexes, only with the presence of the line in two places.\nThe following code makes this check when a diagram is defined.\nIt also checks that each vertex is one of the four legal types, and has the right number of neighbors.\n\n```lisp\n(defmacro defdiagram (name &rest vertex-descriptors)\n \"Define a diagram. A copy can be gotten by (diagram name).\"\n '(put-diagram '.name (construct-diagram\n          (check-diagram ',vertex-descriptors))))\n(defun check-diagram (vertex-descriptors)\n \"Check if the diagram description appears consistent.\"\n (let ((errors 0))\n  (dolist (v-d vertex-descriptors)\n   :: v-d is like: (a Y b c d)\n   (let ((A (first v-d))\n          (v-type (second v-d)))\n    :: Check that the number of neighbors is right for\n    :: the vertex type (and that the vertex type is l`e`gal)\n    (when (/= (length (v-d-neighbors v-d))\n       (case v-type ((W Y T) 3) ((L) 2) (t - 1)))\n     (warn \"Ill`e`gal type/neighbor combo: ~a\" v-d)\n     (incf errors))\n    :: Check that each neighbor B is connected to\n    :: this vertex. A, exactly once\n     (dolist (B (v-d-neighbors v-d))\n      (when (/= 1 (count-if\n        #'(lambda (v-d2)\n         (and (eql (first v-d2) B)\n          (member A (v-d-neighbors v-d2))))\n       vertex-descri ptors))\n    (warn \"Inconsistent vertex: ~a-~a\" A B)\n    (incf errors)))))\n   (when (> errors 0)\n    (error \"Inconsistent diagram. ~d total error~:p.\"\n      errors)))\n  vertex-descriptors)\n```\n\nNow let's try the arch again:\n\n```lisp\n(defdiagram arch\n (a W e b c)  (p L o q)\n (b L d a)   (q T p i r)\n (c Y a d g)  (r T j s q)\n (d Y c b m)  (s L r t)\n (e L a f)   (t W v s k)\n (f T e g n)  (u L t l)\n (g W h f c)  (v L 2 4)\n (h T g i o)  (w W x l y)\n (i T h j q)  (x L w z)\n (j T i k r)  (y Y w 2 z)\n (k T j l t)  (z W 3 x y)\n (l T k m v)  (1 T n o w)\n (m L l d)   (2 W v 3 y)\n (n L f 1)   (3 L z 2)\n (o W P 1 h)  (4 T u l v))\nWarning: Inconsistent vertex: T-V\nWarning: Inconsistent vertex: U-T\nWarning: Inconsistent vertex: U-L\nWarning: Inconsistent vertex: L-V\nWarning: Inconsistent vertex: 4-U\nWarning: Inconsistent vertex: 4-L\n>>ERR0R: Inconsistent diagram. 6 total errors.\n```\n\nThe `defdiagram` was transcribed from a hand-labeled diagram, and it appears that the transcription has fallen prey to one of the oldest problems in mathematical notation: confusing a \"u\" with a \"v.\" The other problem was in seeing the line U-L as a single line, when in fact it is broken up into two segments, U-4 and 4-L.\nRepairing these bugs gives the diagram:\n\n```lisp\n(defdiagram arch\n (a W e b c)  (P L o q)\n (b L d a)   (q T P i r)\n (c Y a d g)  (r T j s q)\n (d Y c b m)  (s L r t)\n (e L a f)   (t W u s k)    *;t-u not t-v*\n (f T e g n)  (u L t 4)     *;u-4 not u-l*\n (g W h f c)  (v L 2 4)\n (h T g i o)  (w W x l y)\n (i T h j q)  (x L w z)\n (j T i k r)  (y Y w 2 z)\n (k T J l t)  (z W 3 x y)\n (l T k m 4)  (1 T n o w)     *;l-4 not l-v*\n (m L l d)   (2 W v 3 y)\n (n L f 1)   (3 L z 2)\n (o W P 1 h)  (4 T u l v))\n```\n\nThis time there arenoerrorsdetected by `check-diagram,` butrunning `print-labelings` again still does not give a solution.\n`To` get more information about which constraints are applied, `I` modified `propagate-constraints` to print out some information:\n\n```lisp\n(defun propagate-constraints (vertex)\n \"Reduce the number of labelings on vertex by considering neighbors.\n If we can reduce, propagate the new constraint to each neighbor.\"\n :: Return nil only when the constraints lead to an impossibility\n (let ((old-num (number-of-labelings vertex)))\n  (setf (vertex-labelings vertex) (consistent-labelings vertex))\n  (unless (impossible-vertex-p vertex)\n   (when (< (number-of-labelings vertex) old-num)\n    (format t \"~&; ~a: ~14a ~a\" vertex ;***\n        (vertex-neighbors vertex) ;***\n        (vertex-labelings vertex)) ;***\n    (every #'propagate-constraints (vertex-neighbors vertex)))\n   vertex)))\n```\n\nRunning the problem again gives the following trace:\n\n```lisp\n> (print-labelings (ground (diagram 'arch) 'x 'z))\nThe initial diagram is:\n A/3 W: AE=[L-+] AB-CR-+] AC=[++-]\n P/6 L: P0=[RL+L-R] PQ=[LRR+L-]\n B/6 L: BD=[RL+L-R] BA=[LRR+L-]\n Q/4 T: QP=[RRRR] QI=[LLLL] QR=[+-LR]\n C/5 Y: CA=[+-L-R] CD=[+-RL-] CG=[+--RL]\n R/4 T: RJ=[RRRR] RS=[LLLL] RQ=[+-LR]\n D/5 Y: DC=[+-L-R] DB=[+-RL-] DM=[+--RL]\n S/6 L: SR=[RL+L-R] ST=[LRR+L-]\n S/6 L: EA=[RL+L-R] EF=[LRR+L-]\n T/3 W: TU=[L-+] TS=[R-+] TK=[++-]\n F/4 T: FE=[RRRR] FG=[LLLL] FN=[+-LR]\n U/6 L: UT=[RL+L-R] U4=[LRR+L-]\n G/3 W: GH=[L-+] GF=[R-+] GC=[++-]\n V/6 L: V2=[RL+L-R] V4=[LRR+L-]\n H/4 T: HG=[RRRR] HI=[LLLL] Ho=[+-LR]\n W/3 W: WX=[L-+] W1=[R-+] WY=[++-]\n I/4 T: IH=[RRRR] IJ=[LLLL] IQ=[+-LR]\n X/1 L: XW=[R] XZ=[-]\n J/4 T: JI=[RRRR] JK=[LLLL] JR=[+-LR]\n Y/5 Y: YW=[+-L-R] Y2=[+-RL-] YZ=[+--RL]\n K/4 T: KJ=[RRRR] KL=[LLLL] KT=[+-LR]\n Z/3 W: Z3=[L-+] ZX=[R-+] ZY=[++-]\n L/4 T: LK=[RRRR] LM=[LLLL] L4=[+-LR]\n 1/4 T: 1N=[RRRR] 10=[LLLL] 1 W=[+-LR]\n M/6 L: ML=[RL+L-R] MD=[LRR+L-]\n 2/3 W: 2 V=[L-+] 23=[R-+] 2Y=[++-]\n N/6 L: NF=[RL+L-R] N1=[LRR+L-]\n 3/6 L: 3Z=[RL+L-R] 32=[LRR+L-]\n 0/3 W: 0P=[L-+] 01=[R-+] 0H=[++-]\n 4/4 T: 4U=[RRRR] 4 L=[LLLL] 4 V=[+-LR]\nFor 2,888, 816, 545.234, 944,000 interpretations\n: P/2: (0/3 Q/4)    ((R L) (- L))\n: 0/1: (P/2 1/4 H/4)  ((L R +))\n: P/1: (0/1 Q/4)    ((R L))\n: 1/3: (N/6 0/1 W/3)  ((R L +) (R L -) (R L L))\n: N/2: (F/4 1/3)    ((R L) (- L))\n: F/2: (E/6 G/3 N/2)  ((R L -) (R L L))\n: E/2: (A/3 F/2)   ((R L) (- L))\n: A/2: (E/2 B/6 C/5)  ((L R +) (- - +))\n: B/3: (D/5 A/2)   ((R L) (- L) (R -))\n: D/3: (C/5 B/3 M/6)  ((- - -) (- L R) (R - L))\n: W/1: (X/l 1/3 Y/5)  ((L R +))\n: 1/1: (N/2 0/1 W/l)  ((R L L))\n: Y/1: (W/l 2/3 Z/3)  ((+ + +))\n: 2/2: (V/6 3/6 Y/1)  ((L R +) (- - +))\n: V/3: (2/2 4/4)   ((R L) (- L) (R -))\n: 4/2: (U/6 L/4 V/3)  ((R L -) (R L R))\n: U/2: (T/3 4/2)   ((R L) (- L))\n: T/2: (U/2 S/6 K/4)  ((L R +) (- - +))\n: S/2: (R/4 T/2)   ((R L) (R -))\n: K/1: (J/4 L/4 T/2)  ((R L +))\n: J/1: (1/4 K/1 R/4)  ((R L L))\n: I/1: (H/4 J/1 Q/4)  ((R L R))\n: L/1: (K/l M/6 4/2)  ((R L R))\n: M/2: (L/1 D/3)   ((R L) (R -))\n: 3/3: (Z/3 2/2)   ((R L) (- L) (R -))\n: Z/1 : (3/3 X/1 Y/1)  ((- - +))\n: 3/1: (Z/l 2/2)  ((- L))\n: 2/1: (V/3 3/1 Y/1)  ((L R +))\n: V/2: (2/1 4/2)   ((R L) (R -))\nAfter constraint propagation the diagram is:\n A/0 W:\n P/l L: P0=[R] PQ=CL]\n B/0 L:\n Q/4 T: QP=[RRRR] QI=[LLLL] QR=[+-LR]\n C/0 Y:\n R/4 T: RJ=[RRRR] RS=[LLLL] RQ=[+-LR]\n D/0 Y:\n S/2 L: SR=[RR] ST=[L-]\n E/2 L: EA=[R-] EF=[LL]\n T/2 W: TU=[L-] TS=CR-] TK=[++]\n F/2 T: FE=[RR] FG=[LL] FN=[- L]\n U/2 L: UT=[R-] U4=[LL]\n G/0 W:\n V/2 L: V2=[RR] V4=[L-]\n H/0 T:\n W/l W: WX=[L] W1=[R] WY=[+]\n I/1 T: IH=[R] IJ=[L] IQ=[R]\n X/1 L: XW=[R] XZ=[-]\n J/1 T: JI=[R] JK=[L] JR=[L]\n Y/1 Y: YW=[+] Y2=[+] YZ=[+]\n K/1 T: KJ=[R] KL=[L] KT=[+]\n Z/1 W: Z3=[-] ZX=[-] ZY=[+]\n L/1 T: LK=[R] LM=[L] L4=[R]\n 1/1 T: 1 N=[R] 10=[L] 1 W=[L]\n M/2 L: ML=[RR] MD=[L-]\n 2/1 W: 2 V=[L] 23=[R] 2Y=[+]\n N/2 L: NF=[R-] N1=[LL]\n 3/1 L: 3Z=[-] 32=[L]\n 0/1 W: 0P=[L] 01=[R] 0H=[+]\n 4/2 T: 4U=[RR] 4 L=[LL] 4 V=[- R]\n```\n\nFrom the diagram after constraint propagation we can see that the vertexes A,B,C,D,G, and H have no interpretations, so they are a good place to look first for an error.\nFrom the trace generated by `propagate-constraints` (the lines beginning with a semicolon), we see that constraint propagation started at P and after seven propagations reached some of the suspect vertexes:\n\n```lisp\n: A/2: (E/2 B/6 C/5)  ((L R +) (- - + ))\n: B/3: (D/5 A/2)    ((R L) (- L) (R -))\n: D/3: (C/5 B/3 M/6)  ((- - -) (- L R) (R - L))\n```\n\nA and B look acceptable, but look at the entry for vertex D.\nIt shows three interpretations, and it shows that the neighbors are C, B, and M.\nNote that line DC, the first entry in each of the interpretations, must be either -, - or R.\nBut this is an error, because the \"correct\" interpretation has DC as a + line.\nLooking more closely, we notice that D is in fact a W-type vertex, not a Y vertex as written in the definition.\nWe should have:\n\n```lisp\n(defdiagram arch\n (a W e b c)  (p L o q)\n (b L d a)   (q T p i r)\n (c Y a d g)  (r T j s q)\n (d W b m c)  (s L r t)     ;*d is a W, not Y*\n (e L a f)   (t W u s k)\n (f T e g n)  (u L t 4)\n (g W h f c)  (v L 2 4)\n (h T g i o)  (w W x 1 y)\n (i T h j q)  (x L w z)\n (j T i k r)  (y Y w 2 z)\n (k T J l t)  (z W 3 x y)\n (1 T k m 4)  (1 T n o w)\n (m L l d)   (2 W v 3 y)\n (n L f 1)   (3 L z 2)\n (o W P 1 h)  (4 T u l v))\n```\n\nBy running the problem again and inspecting the trace output, we soon discover the real root of the problem: the most natural interpretation of the diagram is beyond the scope of the program!\nThere are many interpretations that involve blocks floating in air, but if we ground lines OP, TU and XZ, we run into trouble.\nRemember, we said that we were considering trihedral vertexes only.\nBut vertex 1 would be a quad-hedral vertex, formed by the intersection of four planes: the top and back of the base, and the bottom and left-hand side of the left pillar.\nThe intuitively correct labeling for the diagram would have O1 be a concave (-) line and Al be an occluding line, but our repertoire of labelings for T vertexes does not allow this.\nHence, the diagram cannot be labeled consistently.\n\nLet's go back and consider the error that came up in the first version of the diagram.\nEven though the error no longer occurs on this diagram, we want to make sure that it won't show up in another case.\nHere's the error:\n\n```lisp\n>>>ERROR: The first argument to NTH was of the wrong type.\nThe function expected a fixnum >= z`e`ro.\nWhile in the function LABELS-FOR`<= `CONSISTENT-LABELINGS\nDebugger entered while in the following function:\nLABELS-FOR (P.C. = 23)\n   Arg 0 (VERTEX): U/6\n   Arg 1 (FROM): 4/4\n```\n\nLooking at the definition of `labels-for`, we see that it is looking for the from vertex, which in this case is 4, among the neighbors of U.\nIt was not found, so pos became nil, and the function nth complained that it was not given an integer as an argument.\nSo this error, if we had pursued it earlier, would have pointed out that 4 was not listed as a neighbor of U, when it should have been.\nOf course, we found that out by other means.\nIn any case, there is no bug here to fix-as long as a diagram is guaranteed to be consistent, the `labels-for` bug will not appear again.\n\nThis section has made two points: First, write code that checks the input as thoroughly as possible.\nSecond, even when input checking is done, it is still up to the user to understand the limitations of the program.\n\n## 17.5 History and References\n{:#s0030}\n{:.h1hd}\n\n[Guzman (1968)](B9780080571157500285.xhtml#bb0500) was one of the first to consider the problem of interpreting line diagrams.\nHe classified vertexes, and defined some heuristics for combining information from adjacent vertexes.\n[Huffman (1971)](B9780080571157500285.xhtml#bb0560) and [Clowes (1971)](B9780080571157500285.xhtml#bb0215) independently came up with more formai and complete analyses, and David [Waltz (1975)](B9780080571157500285.xhtml#bb1300) extended the analysis to handle shadows, and introduced the constraint propagation algorithm to eut down on the need for search.\nThe algorithm is sometimes called \"Waltz filtering\" in his honor.\nWith shadows and nontrihedral angles, there are thousands of vertex labelings instead of 18, but there are also more constraints, so the constraint propagation actually does better than it does in our limited world.\nWaltz's approach and the Huf f man-Clowes labels are covered in most introductory AI books, including Rich and Knight 1990, [Charniak and McDermott 1985](B9780080571157500285.xhtml#bb0175), and [Winston 1984](B9780080571157500285.xhtml#bb1405).\nWaltz's original paper appears in *The Psychology of Computer Vision* ([Winston 1975](B9780080571157500285.xhtml#bb1400)), an influential volume collecting early work done at MIT.\nHe also contributed a summary article on Waltz filtering ([Waltz 1990](B9780080571157500285.xhtml#bb1305)).\n\nMany introductory AI texts give vision short coverage, but [Charniak and McDermott (1985)](B9780080571157500285.xhtml#bb0175) and [Tanimoto (1990)](B9780080571157500285.xhtml#bb1220) provide good overviews of the field.\n[Zucker (1990)](B9780080571157500285.xhtml#bb1450) provides an overview of low-level vision.\n\n[Ramsey and Barrett (1987)](B9780080571157500285.xhtml#bb0975) give an implementation of a line-recognition program.\nIt would make a good project to connect their program to the one presented in this chapter, and thereby go all the way from pixels to 3-D descriptions.\n\n## 17.6 Exercises\n{:#s0035}\n{:.h1hd}\n\nThis chapter has solved the problem of line-labeling for polyhedra made of trihedral vertexes.\nThe following exercises extend this solution.\n\n**Exercise 17.1 [h]** Use the line-labeling to produce a face labeling.\nWrite a function that takes a labeled diagram as input and produces a list of the faces (planes) that comprise the diagram.\n\n**Exercise 17.2 [h]** Use the face labeling to produce a polyhedron labeling.\nWrite a function that takes a list of faces and a diagram and produces a list of polyhedra (blocks) that comprise the diagram.\n\n**Exercise 17.3 [d]** Extend the system to include quad-hedral vertexes and/or shadows.\nThere is no conceptual difficulty in this, but it is a very demanding task to find all the possible vertex types and labelings for them.\nConsult [Waltz 1975](B9780080571157500285.xhtml#bb1300).\n\n**Exercise 17.4 [d]** Implement a program to recognize lines from pixels.\n\n**Exercise 17.5 [d]** If you have access to a workstation with a graphical interface, implement a program to allow a user to draw diagrams with a mouse.\nHave the program generate output in the form expected by `construct-diagram`\n\n# Chapter 18\n## Search and the Game of Othello\n{:.chaptitle}\n\n> In the beginner's mind there are endless possibilities; in the expert's there are few.\n\n> -Suzuki Roshi, Zen Master\n\n**G**ame playing has been the target of much early work in AI for three reasons.\nFirst, the rules of most games are formalized, and they can be implemented in a computer program rather easily.\nSecond, in many games the interface requirements are trivial.\nThe computer need only print out its moves and read in the opponent's moves.\nThis is true for games like chess and checkers, but not for ping-pong and basketball, where vision and motor skills are crucial.\nThird, playing a good game of chess is considered by many an intellectual achievement.\nNewell, Shaw, and Simon say, \"Chess is the intellectual game *par excellence*,\" and Donald Michie called chess the \"*Drosophila melanogaster* of machine intelligence,\" meaning that chess is a relatively simple yet interesting domain that can lead to advances in AI, just as study of the fruit fly served to advance biology.\n\nToday there is less emphasis on game playing in AI.\nIt has been realized that techniques that work well in the limited domain of a board game do not necessarily lead to intelligent behavior in other domains.\nAlso, as it turns out, the techniques that allow computers to play well are not the same as the techniques that good human players use.\nHumans are capable of recognizing abstract patterns learned from previous games, and formulating plans of attack and defense.\nWhile some computer programs try to emulate this approach, the more succesful programs work by rapidly searching thousands of possible sequences of moves, making fairly superficial evaluations of the worth of each sequence.\n\nWhile much previous work on game playing has concentrated on chess and checkers, this chapter demonstrates a program to play the game of Othello.[1](#fn0015) Othello is a variation on the nineteenth-century game Reversi.\nIt is an easy game to program because the rules are simpler than chess.\nOthello is also a rewarding game to program, because a simple search technique can yield an excellent player.\nThere are two reasons for this.\nFirst, the number of legal moves per turn is low, so the search is not too explosive.\nSecond, a single Othello move can flip a dozen or more opponent pieces.\nThis makes it difficult for human players to visualize the long-range consequences of a move.\nSearch-based programs are not confused, and thus do well relative to humans.\n\nThe very name \"Othello\" derives from the fact that the game is so unpredictable, like the Moor of Venice.\nThe name may also be an allusion to the line, \"Your daughter and the Moor are now making the beast with two backs,\"[2](#fn0020) since the game pieces do indeed have two backs, one white and one black.\nIn any case, the association between the game and the play carries over to the name of several programs: Cassio, Iago, and Bill.\nThe last two will be discussed in this chapter.\nThey are equal to or better than even champion human players.\nWe will be able to develop a simplified version that is not quite a champion but is much better than beginning players.\n\n## 18.1 The Rules of the Game\n{:#s0010}\n{:.h1hd}\n\nOthello is played on a 8-by-8 board, which is initially set up with four pieces in the center, as shown in [figure 18.1](#f0010).\nThe two players, black and white, alternate turns, with black playing first.\nOn each turn, a player places a single piece of his own color on the board.\nNo piece can be moved once it is placed, but subsequent moves may flip a piece from one color to another.\nEach piece must be placed so that it *brackets* one or more opponent pieces.\nThat is, when black plays a piece there must be a line (horizontal, vertical, or diagonal) that goes through the piece just played, then through one or more white pieces, and then to another black piece.\nThe intervening white pieces are flipped over to black.\nIf there are bracketed white pieces in more than one direction, they are all flipped.\n[Figure 18.2 (a)](#f0015) indicates the legal moves for black with small dots.\n[Figure 18.2 (b)](#f0015) shows the position after black moves to square b4.\nPlayers alternate turns, except that a player who has no legal moves must pass.\nWhen neither player has any moves, the game is over, and the player with the most pieces on the board wins.\nThis usually happens because there are no empty squares left, but it occasionally happens earlier in the game.\n\n![f18-01-9780080571157](images/B9780080571157500182/f18-01-9780080571157.jpg)     \nFigure 18.1\n!!!(span) {:.fignum}\nThe Othello Board\n![f18-02-9780080571157](images/B9780080571157500182/f18-02-9780080571157.jpg)     \nFigure 18.2\n!!!(span) {:.fignum}\nLegal Othello Moves\n\n## 18.2 Representation Choices\n{:#s0015}\n{:.h1hd}\n\nIn developing an Othello program, we will want to test out various strategies, playing those strategies against each other and against human players.\nWe may also want our program to allow two humans to play a game.\nTherefore, our main function, `othello`, will be a monitoring function that takes as arguments two strategies.\nIt uses these strategies to get each player's moves, and then applies these moves to a representation of the game board, perhaps printing out the board as it goes.\n\nThe first choice to make is how to represent the board and the pieces on it.\nThe board is an 8-by-8 square, and each square can be filled by a black or white piece or can be empty.\nThus, an obvious representation choice is to make the board an 8-by-8 array, where each element of the array is the symbol `black, white,` or `nil`.\n\nNotice what is happening here: we are following the usual Lisp convention of implementing an *enumerated type* (the type of pieces that can fill a square) as a set of symbols.\nThis is an appropriate representation because it supports the primary operation on elements of an enumerated type: test for equality using eq.\nIt also supports input and output quite handily.\n\nIn many other languages (such as C or Pascal), enumerated types are implemented as integers.\nIn Pascal one could declare:\n\n```lisp\ntype piece = (black, white, empty);\n```\n\nto define `piece` as a set of three elements that is treated as a subtype of the integers.\nThe language does not allow for direct input and output of such types, but equality can be checked.\nAn advantage of this approach is that an element can be packed into a small space.\nIn the Othello domain, we anticipate that efficiency will be important, because one way to pick a good move is to look at a large number of possible sequences of moves, and choose a sequence that leads toward a favorable result.\nThus, we are willing to look hard at alternative representations to find an efficient one.\nIt takes only two bits to represent one of the three possible types, while it takes many more (perhaps 32) to represent a symbol.\nThus, we may save space by representing pieces as small integers rather than symbols.\n\nNext, we consider the board.\nThe two-dimensional array seems like such an obvious choice that it is hard to imagine a better representation.\nWe could consider an 8-element list of 8-element lists, but this would just waste space (for the cons cells) and time (in accessing the later elements of the lists).\nHowever, we will have to implement two other abstract data types that we have not yet considered: the square and the direction.\nWe will need, for example, to represent the square that a player chooses to move into.\nThis will be a pair of integers, such as 4,5.\nWe could represent this as a two-element list, or more compactly as a cons cell, but this still means that we may have to generate garbage (create a cons cell) every time we want to refer to a new square.\nSimilarly, we need to be able to scan in a given direction from a square, looking for pieces to flip.\nDirections will be represented as a pair of integers, such as +1,-1.\nOne clever possibility is to use complex numbers for both squares and directions, with the real component mapped to the horizontal axis and the imaginary component mapped to the vertical axis.\nThen moving in a given direction from a square is accomplished by simply adding the direction to the square.\nBut in most implementations, creating new complex numbers will also generate garbage.\n\nAnother possibility is to represent squares (and directions) as two distinct integers, and have the routines that manipulate them accept two arguments instead of one.\nThis would be efficient, but it is losing an important abstraction: that squares (and directions) are conceptually single objects.\n\nA way out of this dilemma is to represent the board as a one-dimensional vector.\nSquares are represented as integers in the range 0 to 63.\nIn most implementations, small integers (fixnums) are represented as immediate data that can be manipulated without generating garbage.\nDirections can also be implemented as integers, representing the numerical difference between adjacent squares along that direction.\nTo get a feel for this, take a look at the board:\n\n```lisp\n 0  1  2  3  4  5  6  7\n 8  9 10 11 12 13 14 15\n16 17 18 19 20 21 22 23\n24 25 26 27 28 29 30 31\n32 33 34 35 36 37 38 39\n40 41 42 43 44 45 46 47\n48 49 50 51 52 53 54 55\n56 57 58 59 60 61 62 63\n```\n\nYou can see that the direction +1 corresponds to movement to the right, +7 corresponds to diagonal movement downward and to the left, +8 is downward, and +9 is diagonally downward and to the right.\nThe negations of these numbers (-1, -7, -8, -9) represent the opposite directions.\n\nThere is one complication with this scheme: we need to know when we hit the edge of the board.\nStarting at square 0, we can move in direction +1 seven times to arrive at the right edge of the board, but we aren't allowed to move in that direction yet again to arrive at square 8.\nIt is possible to check for the edge of the board by considering quotients and remainders modulo 8, but it is somewhat complicated and expensive to do so.\n\nA simpler solution is to represent the edge of the board explicitly, by using a 100-element vector instead of a 64-element vector.\nThe outlying elements are filled with a marker indicating that they are outside the board proper.\nThis representation wastes some space but makes edge detection much simpler.\nIt also has the minor advantage that legal squares are represented by numbers in the range 11-88, which makes them easier to understand while debugging.\nHere's the new 100-element board:\n\n```lisp\n 0  1  2  3  4  5  6  7  8  9\n10 11 12 13 14 15 16 17 18 19\n20 21 22 23 24 25 26 27 28 29\n30 31 32 33 34 35 36 37 38 39\n40 41 42 43 44 45 46 47 48 49\n50 51 52 53 54 55 56 57 58 59\n60 61 62 63 64 65 66 67 68 69\n70 71 72 73 74 75 76 77 78 79\n80 81 82 83 84 85 86 87 88 89\n90 91 92 93 94 95 96 97 98 99\n```\n\nThe horizontal direction is now &plusmn;1, vertical is &plusmn;10, and the diagonals are &plusmn;9 and &plusmn;11.\nWe'll tentatively adopt this latest representation, but leave open the possibility of changing to another format.\nWith this much decided, we are ready to begin.\n[Figure 18.3](#f0020) is the glossary for the complete program.\nA glossary for a second version of the program is on [page 623](#p623).\n\n![f18-03-9780080571157](images/B9780080571157500182/f18-03-9780080571157.jpg)     \nFigure 18.3\n!!!(span) {:.fignum}\nGlossary for the Othello Program\nWhat follows is the code for directions and pieces.\nWe explicitly define the type `piece` to be a number from `empty` to `outer` (0 to 3), and define the function `name-of` to map from a piece number to a character: a dot for empty, `@` for black, 0 for white, and a question mark (which should never be printed) for `outer`.\n\n```lisp\n(defconstant all-directions '(-11 -10 -9 -1 1 9 10 11))\n(defconstant empty 0 \"An empty square\")\n(defconstant black 1 \"A black piece\")\n(defconstant white 2 \"A white piece\")\n(defconstant outer 3 \"Marks squares outside the 8x8 board\")\n(deftype piece () '(integer ,empty ,outer))\n(defun name-of (piece) (char \".@0?\" piece))\n(defun opponent (player) (if (eql player black) white black))\n```\n\nAnd here is the code for the board.\nNote that we introduce the function `bref`, for \"board reference\" rather than using the built-in function `aref`.\nThis facilitates possible changes to the representation of boards.\nAlso, even though there is no contiguous range of numbers that represents the legal squares, we can define the constant `all-squares` to be a list of the 64 legal squares, computed as those numbers from 11 to 88 whose value mod 10 is between 1 and 8.\n\n```lisp\n(deftype board () '(simple-array piece (100)))\n(defun bref (board square) (aref board square))\n(defsetf bref (board square) (val)\n  '(setf (aref ,board ,square) ,val))\n(defun copy-board (board)\n  (copy-seq board))\n(defconstant all-squares\n  (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i))\n(defun initial-board ()\n  \"Return a board, empty except for four pieces in the middle.\"\n  ;; Boards are 100-element vectors, with elements 11-88 used,\n  ;; and the others marked with the sentinel OUTER. Initially\n  ;; the 4 center squares are taken, the others empty.\n  (let ((board (make-array 100 :element-type 'piece\n                    :initial-element outer)))\n    (dolist (square all-squares)\n      (setf (bref board square) empty))\n    (setf (bref board 44) white (bref board 45) black\n         (bref board 54) black (bref board 55) white)\n    board))\n(defun print-board (board)\n  \"Print a board, along with some statistics.\"\n  (format t \"~2&   1 2 3 4 5 6 7 8  [~c =~2a ~c =~2a (~@d)]\"\n         (name-of black) (count black board)\n         (name-of white) (count white board)\n         (count-difference black board))\n  (loop for row from 1 to 8 do\n       (format t \"~&~d\" (* 10 row))\n       (loop for col from 1 to 8\n           for piece = (bref board (+ col (* 10 row)))\n           do (format t \"~c\" (name-of piece))))\n  (format t \"~2&\"))\n(defun count-difference (player board)\n  \"Count player's pieces minus opponent's pieces.\"\n  (- (count player board)\n   (count (opponent player) board)))\n```\n\nNow let's take a look at the initial board, as it is printed by `print-board`, and by a raw `write` (I added the line breaks to make it easier to read):\n\n```lisp\n> (write (initial-board)  > (print-board (initial-board))\n     :array t)\n#(3 3 3 3 3 3 3 3 3 3         1 2 3 4 5 6 7 8[@=2 0=2 (+0)]\n  3 0 0 0 0 0 0 0 0 3      10 . . . . . . . .\n  3 0 0 0 0 0 0 0 0 3      20 . . . . . . . .\n  3 0 0 0 0 0 0 0 0 3      30 . . . . . . . .\n  3 0 0 0 2 1 0 0 0 3      40 . . . 0 @ . . .\n  3 0 0 0 1 2 0 0 0 3      50 . . . @ 0 . . .\n  3 0 0 0 0 0 0 0 0 3      60 . . . . . . . .\n  3 0 0 0 0 0 0 0 0 3      70 . . . . . . . .\n  3 0 0 0 0 0 0 0 0 3      80 . . . . . . . .\n  3 3 3 3 3 3 3 3 3 3)\n#<ART-2B-100 -72570734>  NIL\n```\n\nNotice that `print-board` provides some additional information: the number of pieces that each player controls, and the difference between these two counts.\n\nThe next step is to handle moves properly: given a board and a square to move to, update the board to reflect the effects of the player moving to that square.\nThis means flipping some of the opponent's pieces.\nOne design decision is whether the procedure that makes moves, `make-move`, will be responsible for checking for error conditions.\nMy choice is that `make-move` assumes it will be passed a legal move.\nThat way, a strategy can use the function to explore sequences of moves that are known to be valid without slowing `make-move` down.\nOf course, separate procedures will have to insure that a move is legal.\nHere we introduce two terms: a *valid* move is one that is syntactically correct: an integer from 11 to 88 that is not off the board.\nA *legal* move is a valid move into an empty square that will flip at least one opponent.\nHere's the code:\n\n```lisp\n(defun valid-p (move)\n  \"Valid moves are numbers in the range 11-88 that end in 1-8.\"\n  (and (integerp move) (<= 11 move 88) (<= 1 (mod move 10) 8)))\n(defun legal-p (move player board)\n  \"A Legal move must be into an empty square, and it must\n  flip at least one opponent piece.\"\n  (and (eql (bref board move) empty)\n     (some #'(lambda (dir) (would-flip? move player board dir))\n           all-directions)))\n(defun make-move (move player board)\n  \"Update board to reflect move by player\"\n  ;; First make the move, then make any flips\n  (setf (bref board move) player)\n  (dolist (dir all-directions)\n    (make-flips move player board dir))\n  board)\n```\n\nNow all we need is to `make-flips`.\nTo do that, we search in all directions for a *bracketing* piece: a piece belonging to the player who is making the move, which sandwiches a string of opponent pieces.\nIf there are no opponent pieces in that direction, or if an empty or outer piece is hit before the player's piece, then no flips are made.\nNote that `would-flip?` is a semipredicate that returns false if no flips would be made in the given direction, and returns the square of the bracketing piece if there is one.\n\n```lisp\n(defun make-flips (move player board dir)\n  \"Make any flips in the given direction.\"\n  (let ((bracketer (would-flip? move player board dir)))\n    (when bracketer\n      (loop for c from (+ move dir) by dir until (eql c bracketer)\n          do (setf (bref board c) player)))))\n(defun would-flip? (move player board dir)\n  \"Would this move result in any flips in this direction?\n  If so, return the square number of the bracketing piece.\"\n  ;; A flip occurs if, starting at the adjacent square, c, there\n  ;; is a string of at least one opponent pieces, bracketed by\n  ;; one of player's pieces\n  (let ((c (+ move dir)))\n    (and (eql (bref board c) (opponent player))\n        (find-bracketing-piece (+ c dir) player board dir))))\n(defun find-bracketing-piece (square player board dir)\n  \"Return the square number of the bracketing piece.\"\n  (cond ((eql (bref board square) player) square)\n       ((eql (bref board square) (opponent player))\n        (find-bracketing-piece (+ square dir) player board dir))\n       (t nil)))\n```\n\nFinally we can write the function that actually monitors a game.\nBut first we are faced with one more important choice: how will we represent a player?\nWe have already distinguished between black and white's pieces, but we have not decided how to ask black or white for their moves.\nI choose to represent player's strategies as functions.\nEach function takes two arguments: the color to move (black or white) and the current board.\nThe function should return a legal move number.\n\n```lisp\n(defun othello (bl-strategy wh-strategy &optional (print t))\n  \"Play a game of Othello. Return the score, where a positive\n  difference means black (the first player) wins.\"\n  (let ((board (initial-board)))\n    (loop for player = black\n          then (next-to-play board player print)\n        for strategy = (if (eql player black)\n             bl-strategy\n             wh-strategy)\n      until (null player)\n      do (get-move strategy player board print))\n  (when print\n    (format t \"~&The game is over. Final result:\")\n    (print-board board))\n  (count-difference black board)))\n```\n\nWe need to be able to determine who plays next at any point.\nThe rules say that players alternate turns, but if one player has no legal moves, the other can move again.\nWhen neither has a legal move, the game is over.\nThis usually happens because there are no empty squares left, but it sometimes happens earlier in the game.\nThe player with more pieces at the end of the game wins.\nIf neither player has more, the game is a draw.\n\n```lisp\n(defun next-to-play (board previous-player print)\n  \"Compute the player to move next, or NIL if nobody can move.\"\n  (let ((opp (opponent previous-player)))\n    (cond ((any-legal-move? opp board) opp)\n        ((any-legal-move? previous-player board)\n         (when print\n           (format t \"~&~c has no moves and must pass.\"\n                (name-of opp)))\n         previous-player)\n        (t nil))))\n(defun any-legal-move? (player board)\n  \"Does player have any legal moves in this position?\"\n  (some #'(lambda (move) (legal-p move player board))\n      all-squares))\n```\n\nNote that the argument `print` (of `othello`, `next-to-play`, and below, `get-move`) determines if information about the progress of the game will be printed.\nFor an interactive game, `print` should be true, but it is also possible to play a \"batch\" game with `print` set to false.\n\nIn `get-move` below, the player's strategy function is called to determine his move.\nIllegal moves are detected, and proper moves are reported when `print` is true.\nThe strategy function is passed a number representing the player to move (black or white) and a copy of the board.\nIf we passed the *real* game board, the function could cheat by changing the pieces on the board!\n\n```lisp\n(defun get-move (strategy player board print)\n  \"Call the player's strategy function to get a move.\n  Keep calling until a legal move is made.\"\n  (when print (print-board board))\n  (let ((move (funcall strategy player (copy-board board))))\n    (cond\n      ((and (valid-p move) (legal-p move player board))\n       (when print\n         (format t \"~&~c moves to ~d.\" (name-of player) move))\n       (make-move move player board))\n      (t (warn \"Illegal move: ~d\" move)\n        (get-move strategy player board print)))))\n```\n\nHere we define two simple strategies:\n\n```lisp\n(defun human (player board)\n  \"A human player for the game of Othello\"\n  (declare (ignore board))\n  (format t \"~&~c to move: \" (name-of player))\n  (read))\n(defun random-strategy (player board)\n  \"Make any legal move.\"\n  (random-elt (legal-moves player board)))\n(defun legal-moves (player board)\n  \"Returns a list of legal moves for player\"\n  (loop for move in all-squares\n    when (legal-p move player board) collect move))\n```\n\nWe are now in a position to play the game.\nThe expression\n\n`(othello #'human #'human)` will let two people play against each other.\nAlternately, `(othello #' random-strategy #'human)` will allow us to match our wits against a particularly poor strategy.\nThe rest of this chapter shows how to develop a better strategy.\n\n## 18.3 Evaluating Positions\n{:#s0020}\n{:.h1hd}\n\nThe random-move strategy is, of course, a poor one.\nWe would like to make a good move rather than a random move, but so far we don't know what makes a good move.\nThe only positions we are able to evaluate for sure are final positions: when the game is over, we know that the player with the most pieces wins.\nThis suggests a strategy: choose the move that maximizes `count-difference`, the piece differential.\nThe function `maximize-difference` does just that.\nIt calls `maximizer`, a higher-order function that chooses the best move according to an arbitrary evaluation function.\n\n```lisp\n(defun maximize-difference (player board)\n  \"A strategy that maximizes the difference in pieces.\"\n  (funcall (maximizer #'count-difference) player board))\n(defun maximizer (eval-fn)\n  \"Return a strategy that will consider every legal move,\n  apply EVAL-FN to each resulting board, and choose\n  the move for which EVAL-FN returns the best score.\n  FN takes two arguments: the player-to-move and board\"\n  #'(lambda (player board)\n      (let* ((moves (legal-moves player board))\n          (scores (mapcar #'(lambda (move)\n                (funcall\n                  eval-fn\n                  player\n                  (make-move move player\n                      (copy-board board))))\n              moves))\n         (best (apply #'max scores)))\n      (elt moves (position best scores)))))\n```\n\n**Exercise 18.1** Play some games with `maximize-difference` against `random-strategy` and `human`.\nHow good is `maximize-difference`?\n\nThose who complete the exercise will quickly see that the `maximize-difference` player does better than random, and may even beat human players in their first game or two.\nBut most humans are able to improve, learning to take advantage of the overly greedy play of `maximize-difference`.\nHumans learn that the edge squares, for example, are valuable because the player dominating the edges can surround the opponent, while it is difficult to recapture an edge.\nThis is especially true of corner squares, which can never be recaptured.\n\nUsing this knowledge, a clever player can temporarily sacrifice pieces to obtain edge and corner squares in the short run, and win back pieces in the long run.\nWe can approximate some of this reasoning with the `weighted-squares` evaluation function.\nLike `count-difference`, it adds up all the player's pieces and subtracts the opponents, but each piece is weighted according to the square it occupies.\nEdge squares are weighted highly, corner squares higher still, and squares adjacent to the corners and edges have negative weights, because occupying these squares often gives the opponent a means of capturing the desirable square.\n[Figure 18.4](#f0025) shows the standard nomenclature for edge squares: X, A, B, and C.\nIn general, X and C squares are to be avoided, because taking them gives the opponent a chance to take the corner.\nThe `weighted-squares` evaluation function reflects this.\n\n![f18-04-9780080571157](images/B9780080571157500182/f18-04-9780080571157.jpg)     \nFigure 18.4\n!!!(span) {:.fignum}\nNames for Edge Squares\n```lisp\n(defparameter *weights*\n  '#(0   0   0  0  0  0  0   0   0 0\n     0 120 -20 20  5  5 20 -20 120 0\n     0 -20 -40 -5 -5 -5 -5 -40 -20 0\n     0  20  -5 15  3  3 15  -5  20 0\n     0   5  -5  3  3  3  3  -5   5 0\n     0   5  -5  3  3  3  3  -5   5 0\n     0  20  -5 15  3  3 15  -5  20 0\n     0 -20 -40 -5 -5 -5 -5 -40 -20 0\n     0 120 -20 20  5  5 20 -20 120 0\n     0   0   0  0  0  0  0   0   0 0))\n(defun weighted-squares (player board)\n  \"Sum of the weights of player's squares minus opponent's.\n  (let ((opp (opponent player)))\n    (loop for i in all-squares\n        when (eql (bref board i) player)\n        sum (aref *weights* i)\n        when (eql (bref board i) opp)\n        sum (- (aref *weights* i)))))\n```\n\n**Exercise 18.2** Compare strategies by evaluating the two forms below.\nWhat happens?\nIs this a good test to determine which strategy is better?\n\n```lisp\n(othello (maximizer #'weighted-squares)\n         (maximizer #'count-difference) nil)\n(othello (maximizer #'count-difference)\n         (maximizer #'weighted-squares) nil)\n```\n\n## 18.4 Searching Ahead: Minimax\n{:#s0025}\n{:.h1hd}\n\nEven the weighted-squares strategy is no match for an experienced player.\nThere are two ways we could improve the strategy.\nFirst, we could modify the evaluation function to take more information into account.\nBut even without changing the evaluation function, we can improve the strategy by searching ahead.\nInstead of choosing the move that leads immediately to the highest score, we can also consider the opponent's possible replies, our replies to those replies, and so on.\nBy searching through several levels of moves, we can steer away from potential disaster and find good moves that were not immediately apparent.\n\nAnother way to look at the `maximizer` function is as a search function that searches only one level, or *ply*, deep:\n\n![u18-01-9780080571157](images/B9780080571157500182/u18-01-9780080571157.jpg)     \n\nThe top of the tree is the current board position, and the squares below that indicate possible moves.\nThe `maximizer` function evaluates each of these and picks the best move, which is underlined in the diagram.\n\nNow let's see how a 3-ply search might go.\nThe first step is to apply `maximizer` to the positions just above the bottom of the tree.\nSuppose we get the following values:\n\n![u18-02-9780080571157](images/B9780080571157500182/u18-02-9780080571157.jpg)     \n\nEach position is shown as having two possible legal moves, which is unrealistic but makes the diagram fit on the page.\nIn a real game, five to ten legal moves per position is typical.\nThe values at the leaves of the tree were computed by applying the evaluation function, while the values one level up were computed by `maximizer`.\nThe result is that we know what our best move is for any of the four positions just above the bottom of the tree.\n\nGoing up a level, it is the opponent's turn to move.\nWe can assume the opponent will choose the move that results in the minimal value to us, which would be the maximal value to the opponent.\nThus, the opponent's choices would be the 10- and 9-valued positions, avoiding the 20- and 23-valued positions.\n\n![u18-03-9780080571157](images/B9780080571157500182/u18-03-9780080571157.jpg)     \n\nNow it is our turn to move again, so we apply `maximizer` once again to get the final value of the top-level position:\n\n![u18-04-9780080571157](images/B9780080571157500182/u18-04-9780080571157.jpg)     \n\nIf the opponent plays as expected, we will always follow the left branch of the tree and end up at the position with value 10.\nIf the opponent plays otherwise, we will end up at a position with a better value.\n\nThis kind of search is traditionally called a *minimax* search, because of the alternate application of the `maximizer` and a hypothetical `minimizer` function.\nNotice that only the leaf positions in the tree are looked at by the evaluation function.\nThe value of all other positions is determined by minimizing and maximizing.\n\nWe are almost ready to code the minimax algorithm, but first we have to make a few design decisions.\nFirst, we could write two functions, `minimax` and `maximin`, which correspond to the two players' analyses.\nHowever, it is easier to write a single function that maximizes the value of a position for a particular player.\nIn other words, by adding the player as a parameter, we avoid having to write two otherwise identical functions.\n\nSecond, we have to decide if we are going to write a general minimax searcher or an Othello-specific searcher.\nI decided on the latter for efficiency reasons, and because there are some Othello-specific complications that need to be accounted for.\nFirst, it is possible that a player will not have any legal moves.\nIn that case, we want to continue the search with the opponent to move.\nIf the opponent has no moves either, then the game is over, and the value of the position can be determined with finality by counting the pieces.\n\nThird, we need to decide the interaction between the normal evaluation function and this final evaluation that occurs when the game is over.\nWe could insist that each evaluation function determine when the game is over and do the proper computation.\nBut that overburdens the evaluation functions and may lead to wasteful checking for the end of game.\nInstead, I implemented a separate `final-value` evaluation function, which returns 0 for a draw, a large positive number for a win, and a large negative number for a loss.\nBecause fixnum arithmetic is most efficient, the constants `most-positive-fixnum` and `most-negative-fixnum` are used.\nThe evaluation functions must be careful to return numbers that are within this range.\nAll the evaluation functions in this chapter will be within range if fixnums are 20 bits or more.\n\nIn a tournament, it is not only important who wins and loses, but also by how much.\nIf we were trying to maximize the margin of victory, then `final-value` would be changed to include a small factor for the final difference.\n\n```lisp\n(defconstant winning-value most-positive-fixnum)\n(defconstant losing-value most-negative-fixnum)\n(defun final-value (player board)\n  \"Is this a win, loss, or draw for player?\"\n  (case (signum (count-difference player board))\n    (-1 losing-value)\n    ( 0 0)\n    (+1 winning-value)))\n```\n\nFourth, and finally, we need to decide on the parameters for the minimax function.\nLike the other evaluation functions, it needs the player to move and the current board as parameters.\nIt also needs an indication of how many ply to search, and the static evaluation function to apply to the leaf positions.\nThus, minimax will be a function of four arguments.\nWhat will it return?\nIt needs to return the best move, but it also needs to return the value of that move, according to the static evaluation function.\nWe use multiple values for this.\n\n```lisp\n(defun minimax (player board ply eval-fn)\n  \"Find the best move, for PLAYER, according to EVAL-FN,\n  searching PLY levels deep and backing up values.\"\n  (if (= ply 0)\n      (funcall eval-fn player board)\n      (let ((moves (legal-moves player board)))\n        (if (null moves)\n         (if (any-legal-move? (opponent player) board)\n            (- (minimax (opponent player) board\n                 (- ply 1) eval-fn))\n            (final-value player board))\n         (let ((best-move nil)\n               (best-val nil))\n           (dolist (move moves)\n      (let* ((board2 (make-move move player\n                    (copy-board board)))\n          (val (- (minimax\n               (opponent player) board2\n               (- ply 1) eval-fn))))\n       (when (or (null best-val)\n             (> val best-val))\n         (setf best-val val)\n         (setf best-move move))))\n    (values best-val best-move))))))\n```\n\nThe `minimax` function cannot be used as a strategy function as is, because it takes too many arguments and returns too many values.\nThe functional `minimax-searcher` returns an appropriate strategy.\nRemember that a strategy is a function of two arguments: the player and the board.\n`get-move` is responsible for passing the right arguments to the function, so the strategy need not worry about where the arguments come from.\n\n```lisp\n(defun minimax-searcher (ply eval-fn)\n  \"A strategy that searches PLY levels and then uses EVAL-FN.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value move)\n         (minimax player board ply eval-fn)\n        (declare (ignore value))\n        move)))\n```\n\nWe can test the minimax strategy, and see that searching ahead 3 ply is indeed better than looking at only 1 ply.\nI show only the final result, which demonstrates that it is indeed an advantage to be able to look ahead:\n\n```lisp\n> (othello (minimax-searcher 3 #'count-difference)\n         (maximizer #'count-difference))\n...\nThe game is over. Final result:\n   1 2 3 4 5 6 7 8   [@=53 0=0 (+53)]\n10 @ @ @ @ @ @ @ @\n20 @ @ @ @ @ @ @ @\n30 @ @ @ @ @ @ @ @\n40 @ @ @ @ @ @ @ @\n50 @ @ @ @ @ @ @ @\n60 . . @ @ @ @ @ @\n70 . . . @ @ @ @ @\n80 . . . . @ @ . .\n```\n\n## 18.5 Smarter Searching: Alpha-Beta Search\n{:#s0030}\n{:.h1hd}\n\nThe problem with a full minimax search is that it considers too many positions.\nIt looks at every line of play, including many improbable ones.\nFortunately, there is a way to find the optimal line of play without looking at every possible position.\nLet's go back to our familiar search tree:\n\n![u18-05-9780080571157](images/B9780080571157500182/u18-05-9780080571157.jpg)     \n\nHere we have marked certain positions with question marks.\nThe idea is that the whole search tree evaluates to 10 regardless of the value of the positions labeled ?*i*.\nConsider the position labeled ?1.\nIt does not matter what this position evaluates to, because the opponent will always choose to play toward the 10-position, to avoid the possibility of the 15.\nThus, we can cut off the search at this point and not consider the ?-position.\nThis kind of cutoff has historically been called a *beta* cutoff.\n\nNow consider the position labeled ?4.\nIt does not matter what this position evaluates to, because we will always prefer to choose the 10 position at the left branch, rather than giving the opponent a chance to play to the 9-position.\nThis is an *alpha* cutoff.\nNotice that it cuts off a whole subtree of positions below it (labeled ?2 and ?3).\n\nIn general, we keep track of two parameters that bound the true value of the current position.\nThe lower bound is a value we know we can achieve by choosing a certain line of play.\nThe idea is that we need not even consider moves that will lead to a value lower than this.\nThe lower bound has traditionally been called *alpha,* but we will name it `achievable`.\nThe upper bound represents a value the opponent can achieve by choosing a certain line of play.\nIt has been called *beta*, but we will call it `cutoff`.\nAgain, the idea is that we need not consider moves with a higher value than this (because then the opponent would avoid the move that is so good for us).\nThe alpha-beta algorithm is just minimax, but with some needless evaluations pruned by these two parameters.\n\nIn deeper trees with higher branching factors, many more evaluations can be pruned.\nIn general, a tree of depth *d* and branching factor *b* requires *bd* evaluations for full minimax, and as few as *b**d*/2 evaluations with alpha-beta minimax.\n\nTo implement alpha-beta search, we add two more parameters to the function `minimax` and rename it `alpha-beta`.\n`achievable` is the best score the player can achieve; it is what we want to maximize.\nThe `cutoff` is a value that, when exceeded, will make the opponent choose another branch of the tree, thus making the rest of the current level of the tree irrelevant.\nThe test `until (>= achievable cutoff)` in the penultimate line of `minimax` does the cutoff; all the other changes just involve passing the parameters around properly.\n\n```lisp\n(defun alpha-beta (player board achievable cutoff ply eval-fn)\n  \"Find the best move, for PLAYER, according to EVAL-FN,\n  searching PLY levels deep and backing up values,\n  using cutoffs whenever possible.\"\n  (if (= ply 0)\n    (funcall eval-fn player board)\n    (let ((moves (legal-moves player board)))\n      (if (null moves)\n        (if (any-legal-move? (opponent player) board)\n          (- (alpha-beta (opponent player) board\n                  (- cutoff) (- achievable)\n                  (- ply 1) eval-fn))\n          (final-value player board))\n      (let ((best-move (first moves)))\n        (loop for move in moves do\n         (let* ((board2 (make-move move player\n                     (copy-board board)))\n            (val (- (alpha-beta\n                  (opponent player) board2\n                  (- cutoff) (- achievable)\n                  (- ply 1) eval-fn))))\n           (when (> val achievable)\n             (setf achievable val)\n             (setf best-move move)))\n         until (>= achievable cutoff))\n      (values achievable best-move))))))\n(defun alpha-beta-searcher (depth eval-fn)\n  \"A strategy that searches to DEPTH and then uses EVAL-FN.\"\n  #'(lambda (player board)\n    (multiple-value-bind (value move)\n      (alpha-beta player board losing-value winning-value\n                  depth eval-fn)\n        (declare (ignore value))\n        move)))\n```\n\nIt must be stressed that `alpha-beta` computes the exact same result as the full-search version of `minimax`.\nThe only advantage of the cutoffs is making the search go faster by considering fewer positions.\n\n## 18.6 An Analysis of Some Games\n{:#s0035}\n{:.h1hd}\n\nNow is a good time to stop and analyze where we have gone.\nWe've demonstrated a program that can play a *legal* game of Othello, and some strategies that may or may not play a *good* game.\nFirst, we'll look at some individual games to see the mistakes made by some strategies, and then we'll generate some statistics for series of games.\n\nIs the weighted-squares measure a good one?\nWe can compare it to a strategy of maximizing the number of pieces.\nSuch a strategy would of course be perfect if it could look ahead to the end of the game, but the speed of our computers limits us to searching only a few ply, even with cutoffs.\nConsider the following game, where black is maximizing the difference in the number of pieces, and white is maximizing the weighted sum of squares.\nBoth search to a depth of 4 ply:\n\n```lisp\n> (othello (alpha-beta-searcher 4 #'count-difference)\n           (alpha-beta-searcher 4 #'weighted-squares))\n```\n\nBlack is able to increase the piece difference dramatically as the game progresses.\nAfter 17 moves, white is down to only one piece:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=20 0=1 (+19)]\n  10 0 @ . . . . . .\n  20 . @ . . . @ @ .\n  30 @ @ @ @ @ @ . .\n  40 . @ . @ @ . . .\n  50 @ @ @ @ @ @ . .\n  60 . . @ . . . . .\n  70 . . . . . . . .\n  80 . . . . . . . .\n```\n\nAlthough behind by 19 points, white is actually in a good position, because the piece in the corner is safe and threatens many of black's pieces.\nWhite is able to maintain good position while being numerically far behind black, as shown in these positions later in the game:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=32 0=15 (+17)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 @ @ @ @ @\n  30 @ @ 0 0 @ 0 @ @\n  40 0 0 @ @ @ @ @ @\n  50 @ 0 @ @ @ @ . .\n  60 @ @ 0 @ @ 0 . .\n  70 @ . . @ @ . . .\n  80 . . . . . . . .\n     1 2 3 4 5 6 7 8  [@=34 0=19 (+15)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 @ @ @ @ @\n  30 @ @ 0 0 @ 0 @ @\n  40 0 @ 0 @ @ @ @ @\n  50 0 @ 0 @ @ @ @ .\n  60 0 @ 0 @ @ @ . .\n  70 0 @ @ @ @ . . .\n  80 0 @ 0 . . . . .\n```\n\nAfter some give-and-take, white gains the advantage for good by capturing eight pieces on a move to square 85 on the third-to-last move of the game:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=31 0=30 (+1)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ @ @ @ 0\n  70 0 @ @ @ @ @ 0 0\n  80 0 @ @ @ . . .0\n0 moves to 85.\n     1 2 3 4 5 6 7 8  [@=23 0=39 (-16)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ 0 @ 0 0\n  70 0 @ @ 0 0 0 0 0\n  80 0 0 0 0 0 . . 0\n@ moves to 86.\n     1 2 3 4 5 6 7 8  [@=26 0=37 (-11)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ 0 @ 0 0\n  70 0 @ @ 0 @ @ 0 0\n  80 0 0 0 0 0 @ . 0\n0 moves to 87.\nThe game is over. Final result:\n     1 2 3 4 5 6 7 8  [@=24 0=40 (-16)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ 0 @ 0 0\n  70 0 @ @ 0 @ 0 0 0\n  80 0 0 0 0 0 0 0 0\n-16\n```\n\nWhite ends up winning by 16 pieces.\nBlack's strategy was too greedy: black was willing to give up position (all four corners and all but four of the edge squares) for temporary gains in material.\n\nIncreasing the depth of search does not compensate for a faulty evaluation function.\nIn the following game, black's search depth is increased to 6 ply, while white's is kept at 4.\nThe same things happen, although black's doom takes a bit longer to unfold.\n\n```lisp\n> (othello (alpha-beta-searcher 6 #'count-difference)\n           (alpha-beta-searcher 4 #'weighted-squares))\n```\n\nBlack slowly builds up an advantage:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=21 0=8 (+13)]\n  10 . . @ @ @ @ @ .\n  20 . @ . @ 0 @ . .\n  30 0 @ @ 0 @ 0 0 .\n  40 . @ . @ 0 @ 0 .\n  50 . @ @ @ @ @ . .\n  60 . @ . @ . 0 . .\n  70 . . . . . . . .\n  80 . . . . . . . .\n```\n\nBut at this point white has clear access to the upper left corner, and through that corner threatens to take the whole top edge.\nStill, black maintains a material edge as the game goes on:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=34 0=11 (+23)]\n  10 0 . @ @ @ @ @ .\n  20 . 0 0 @ @ @ . .\n  30 0 @ 0 0 @ @ @ @\n  40 @ @ @ @ 0 @ @ .\n  50 @ @ @ @ @ 0 @ .\n  60 @ @ @ @ @ @ 0 0\n  70 @ . . @ . . @ 0\n  80 . . . . . . . .\n```\n\nBut eventually white's weighted-squares strategy takes the lead:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=23 0=27 (-4)]\n  10 0 0 0 0 0 0 0 0\n  20 @ @ 0 @ @ @ . .\n  30 0 @ 0 0 @ @ @ @\n  40 0 @ 0 @ 0 @ @ .\n  50 0 @ 0 @ @ 0 @ .\n  60 0 0 0 @ @ @ 0 0\n  70 0 . 0 @ . . @ 0\n  80 0 . . . . . . .\n```\n\nand is able to hold on to win:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=24 0=40 (-16)]\n  10 0 0 0 0 0 0 0 0\n  20 @ @ 0 @ 0 0 @ @\n  30 0 @ 0 0 @ @ @ @\n  40 0 @ 0 0 @ @ @ 0\n  50 0 0 @ @ 0 @ 0 0\n  60 0 0 0 @ 0 @ @ 0\n  70 0 0 0 0 @ @ 0 0\n  80 0 0 0 0 0 @ @ 0\n-16\n```\n\nThis shows that brute-force searching is not a panacea.\nWhile it is helpful to be able to search deeper, greater gains can be made by making the evaluation function more accurate.\nThere are many problems with the weighted-squares evaluation function.\nConsider again this position from the first game above:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=20 0=1 (+19)]\n  10 0 @ . . . . . .\n  20 . @ . . . @ @ .\n  30 @ @ @ @ @ @ . .\n  40 . @ . @ @ . . .\n  50 @ @ @ @ @ @ . .\n  60 . @ . . . . . .\n  70 . . . . . . . .\n  80 . . . . . . . .\n```\n\nHere white, playing the weighted-squares strategy, chose to play 66.\nThis is probably a mistake, as 13 would extend white's dominance of the top edge, and allow white to play again (since black would have no legal moves).\nUnfortunately, white rejects this move, primarily because square 12 is weighted as -20.\nThus, there is a disincentive to taking this square.\nBut 12 is weighted -20 because it is a bad idea to take such a square when the corner is empty-the opponent will then have a chance to capture the corner, regaining the 12 square as well.\nThus, we want squares like 12 to have a negative score when the corner is empty, but not when it is already occupied.\nThe `modified-weighted-squares` evaluation function does just that.\n\n```lisp\n(defun modified-weighted-squares (player board)\n  \"Like WEIGHTED-SQUARES, but don't take off for moving\n  near an occupied corner.\"\n  (let ((w (weighted-squares player board)))\n    (dolist (corner '(11 18 81 88))\n      (when (not (eql (bref board corner) empty))\n        (dolist (c (neighbors corner))\n          (when (not (eql (bref board c) empty))\n            (incf w (* (- 5 (aref *weights* c))\n                  (if (eql (bref board c) player)\n                     +1 -1)))))))\n    w))\n(let ((neighbor-table (make-array 100 : initial-element nil)))\n  ;; Initialize the neighbor table\n  (dolist (square all-squares)\n    (dolist (dir all-directions)\n      (if (valid-p (+ square dir))\n          (push (+ square dir)\n              (aref neighbor-table square)))))\n  (defun neighbors (square)\n    \"Return a list of all squares adjacent to a square.\"\n    (aref neighbor-table square)))\n```\n\n## 18.7 The Tournament Version of Othello\n{:#s0040}\n{:.h1hd}\n\nWhile the `othello` function serves as a perfectly good moderator for casual play, there are two points that need to be fixed for tournament-level play.\nFirst, tournament games are played under a strict time limit: a player who takes over 30 minutes total to make all the moves forfeits the game.\nSecond, the standard notation for Othello games uses square names in the range al to h8, rather than in the 11 to 88 range that we have used so far.\na1 is the upper left corner, a8 is the lower left corner, and h8 is the lower right corner.\nWe can write routines to translate between this notation and the one we were using by creating a table of square names.\n\n```lisp\n(let ((square-names\n      (cross-product #'symbol\n            '(? a b c d e f g h ?)\n            '(? 1 2 3 4 5 6 7 8 ?))))\n  (defun h8->88 (str)\n    \"Convert from alphanumeric to numeric square notation.\"\n    (or (position (string str) square-names :test #'string-equal)\n        str))\n  (defun 88->h8 (num)\n    \"Convert from numeric to alphanumeric square notation.\"\\\n    (if (valid-p num)\n        (elt square-names num)\n        num)))\n  (defun cross-product (fn xlist ylist)\n    \"Return a list of all (fn x y) values.\"\n    (mappend #'(lambda (y)\n             (mapcar #'(lambda (x) (funcall fn x y))\n                 xlist))\n        ylist))\n```\n\nNote that these routines return their input unchanged when it is not one of the expected values.\nThis is to allow commands other than moving to a particular square.\nFor example, we will add a feature that recognizes `resign` as a move.\n\nThe `human` player needs to be changed slightly to read moves in this format.\nWhile we're at it, we'll also print the list of possible moves:\n\n```lisp\n(defun human (player board)\n  \"A human player for the game of Othello\"\n  (format t \"~&~c to move ~a: \" (name-of player)\n         (mapcar #'88->h8 (legal-moves player board)))\n  (h8->88 (read)))\n```\n\n![f18-05-9780080571157](images/B9780080571157500182/f18-05-9780080571157.jpg)     \nFigure 18.5\n!!!(span) {:.fignum}\nGlossary for the Tournament Version of Othello\nThe `othello` function needn't worry about notation, but it does need to monitor the time.\nWe make up a new data structure, the clock, which is an array of integers saying how much time (in internal units) each player has left.\nFor example, (`aref clock black`) is the amount of time black has left to make all his moves.\nIn Pascal, we would declare the clock array as `array[black..white]`, but in Common Lisp all arrays are zero-based, so we need an array of three elements to allow the subscript `black`, which is 2.\n\nThe clock is passed to `get-move` and `print-board` but is otherwise unused.\nI could have complicated the main game loop by adding tests for forfeits because of expired time and, as we shall see later, resignation by either player.\nHowever, I felt that would add a great deal of complexity for rarely used options.\nInstead, I wrap the whole game loop, along with the computation of the final score, in a `catch` special form.\nThen, if get-move encounters a forfeit or resignation, it can `throw` an appropriate final score: 64 or -64, depending on which player forfeits.\n\n```lisp\n(defvar *move-number* 1 \"The number of the move to be played\")\n(defun othello (bl-strategy wh-strategy\n         &optional (print t) (minutes 30))\n  \"Play a game of othello. Return the score, where a positive\n  difference means black, the first player, wins.\"\n  (let ((board (initial-board))\n      (clock (make-array (+1 (max black white))\n            :initial-element\n            (* minutes 60\n               internal-time-units-per-second))))\n    (catch 'game-over\n      (loop for *move-number* from 1\n        for player = black then (next-to-play board player print)\n        for strategy = (if (eql player black)\n             bl-strategy\n             wh-strategy)\n        until (null player)\n        do (get-move strategy player board print clock))\n      (when print\n           (format t \"~&The game is over. Final result:\")\n           (print-board board clock))\n      (count-difference black board))))\n```\n\nStrategies now have to comply with the time-limit rule, so they may want to look at the time remaining.\nRather than passing the clock in as an argument to the strategy, I decided to store the clock in the special variable `*clock*`.\nThe new version of `othello` also keeps track of the `*move-number*`.\nThis also could have been passed to the strategy functions as a parameter.\nBut adding these extra arguments would require changes to all the strategies we have developed so far.\nBy storing the information in special variables, strategies that want to can look at the clock or the move number, but other strategies don't have to know about them.\n\nWe still have the security problem-we don't want a strategy to be able to set the opponent's remaining time to zero and thereby win the game.\nThus, we use `*clock*` only as a copy of the \"real\" game clock.\nThe function `replace` copies the real clock into `*clock*`, and also copies the real board into `*board*`.\n\n```lisp\n(defvar *clock* (make-array 3) \"A copy of the game clock\")\n(defvar *board* (initial-board) \"A copy of the game board\")\n(defun get-move (strategy player board print clock)\n  \"Call the player's strategy function to get a move.\n  Keep calling until a legal move is made.\"\n  ;; Note we don't pass the strategy function the REAL board.\n  ;; If we did, it could cheat by changing the pieces on the board.\n  (when print (print-board board clock))\n  (replace *clock* clock)\n  (let* ((t0 (get-internal-real-time))\n         (move (funcall strategy player (replace *board* board)))\n         (t1 (get-internal-real-time)))\n    (decf (elt clock player) (- t1 t0))\n    (cond\n      ((< (elt clock player) 0)\n       (format t \"~&~c has no time left and forfeits.\"\n           (name-of player))\n       (THROW 'game-over (if (eql player black) -64 64)))\n      ((eq move 'resign)\n       (THROW 'game-over (if (eql player black) -64 64)))\n      ((and (valid-p move) (legal-p move player board))\n       (when print\n         (format t \"~&~c moves to ~ a.\"\n             (name-of player) (88->h8 move)))\n       (make-move move player board))\n      (t (warn \"Illegal move: ~ a\" (88->h8 move))\n         (get-move strategy player board print clock)))))\n```\n\nFinally, the function `print-board` needs to print the time remaining for each player; this requires an auxiliary function to get the number of minutes and seconds from an internal-format time interval.\nNote that we make the arguments optional, so that in debugging one can say just (`print-board`) to see the current situation.\nAlso note the esoteric format option: `\"~2, '0d\"` prints a decimal number using at least two places, padding on the left with zeros.\n\n```lisp\n(defun print-board (&optional (board *board*) clock)\n  \"Print a board, along with some statistics.\"\n  ;; First print the header and the current score\n  (format t \"~2& a b c d e f g h  [~c =~2a ~c =~2a (~@d)]\"\n         (name-of black) (count black board)\n         (name-of white) (count white board)\n         (count-difference black board))\n  ;; Print the board itself\n  (loop for row from 1 to 8 do\n        (format t \"~&~d\" row)\n        (loop for col from 1 to 8\n            for piece = (bref board (+ col (* 10 row)))\n            do (format t \"~c \" (name-of piece))))\n  ;; Finally print the time remaining for each player\n  (when clock\n    (format t \" [~c =~a ~c =~a]~2&\"\n         (name-of black) (time-string (elt clock black))\n         (name-of white) (time-string (elt clock white)))))\n(defun time-string (time)\n  \"Return a string representing this internal time in min:secs.\"\n  (multiple-value-bind (min sec)\n      (floor (round time internal-time-units-per-second) 60)\n    (format nil \"~2d:~2,'0d\" min sec)))\n```\n\n## 18.8 Playing a Series of Games\n{:#s0045}\n{:.h1hd}\n\nA single game is not enough to establish that one strategy is better than another.\nThe following function allows two strategies to compete in a series of games:\n\n```lisp\n(defun othello-series (strategy1 strategy2 n-pairs)\n  \"Play a series of 2*n-pairs games, swapping sides.\"\n  (let ((scores (loop repeat n-pairs\n            collect (othello strategy1 strategy2 nil)\n            collect (- (othello strategy2 strategy1 nil)))))\n    ;; Return the number of wins, (1/2 for a tie),\n    ;; the total of thepoint differences, and the\n    ;; scores themselves. all from strategy1's point of view.\n    (values (+ (count-if #'plusp scores)\n          (/ (count-if #'zerop scores) 2))\n        (apply #'+ scores)\n        scores)))\n```\n\nLet's see what happens when we use it to pit the two weighted-squares functions against each other in a series of ten games:\n\n```lisp\n>(othello-series\n    (alpha-beta-searcher 2 #'modified-weighted-squares)\n    (alpha-beta-searcher 2 #'weighted-squares) 5)\n0\n60\n(-28 40 -28 40 -28 40 -28 40 -28 40)\n```\n\nSomething is suspicious here-the same scores are being repeated.\nA little thought reveals why: neither strategy has a random component, so the exact same game was played five times with one strategy going first, and another game was played five times when the other strategy goes first!\nA more accurate appraisal of the two strategies' relative worth would be gained by starting each game from some random position and playing from there.\n\nThink for a minute how you would design to run a series of games starting from a random position.\nOne possibility would be to change the function `othello` to accept an optional argument indicating the initial state of the board.\nThen `othello-series` could be changed to somehow generate a random board and pass it to `othello`.\nWhile this approach is feasible, it means changing two existing working functions, as well as writing another function, `generate-random-board`.\nBut we couldn't generate just any random board: it would have to be a legal board, so it would have to call `othello` and somehow get it to stop before the game was over.\n\nAn alternative is to leave both `othello` and `othello-series` alone and build another function on top of it, one that works by passing in two new strategies: strategies that make a random move for the first few moves and then revert to the normal specified behavior.\nThis is a better solution because it uses existing functions rather than modifying them, and because it requires no new functions besides `switch-strategies`, which could prove useful for other purposes, and `random-othello-series`, which does nothing more than call `othello-series` with the proper arguments.\n\n```lisp\n(defun random-othello-series (strategy1 strategy2\n              n-pairs &optional (n-random 10))\n  \"Play a series of 2*n games, starting from a random position.\"\n  (othello-series\n    (switch-strategies #'random-strategy n-random strategy1)\n    (switch-strategies #'random-strategy n-random strategy2)\n    n-pairs))\n(defun switch-strategies (strategy1 m strategy2)\n  \"Make a new strategy that plays strategy1 for m moves,\n  then plays according to strategy2.\"\n  #'(lambda (player board)\n      (funcall (if (<= *move-number* m) strategy1 strategy2)\n         player board)))\n```\n\nThere is a problem with this kind of series: it may be that one of the strategies just happens to get better random positions.\nA fairer test would be to play two games from each random position, one with the each strategy playing first.\nOne way to do that is to alter `othello-series` so that it saves the random state before playing the first game of a pair, and then restores the saved random state before playing the second game.\nThat way the same random position will be duplicated.\n\n```lisp\n(defun othello-series (strategy1 strategy2 n-pairs)\n  \"Play a series of 2*n-pairs games. swapping sides.\"\n  (let ((scores\n        (loop repeat n-pairs\n           for random-state = (make-random-state)\n           collect (othello strategy1 strategy2 nil)\n           do (setf *random-state* random-state)\n           collect (- (othello strategy2 strategy1 nil)))))\n    ;; Return the number of wins (1/2 for a tie).\n    ;; the total of the point differences, and the\n    ;; scores themselves. all from strategy1's point of view.\n    (values (+ (count-if #'plusp scores)\n             (/ (count-if #'zerop scores) 2))\n         (apply #'+ scores)\n         scores)))\n```\n\nNow we are in a position to do a more meaningful test.\nIn the following, the weighted-squares strategy wins 4 out of 10 games against the modified strategy, losing by a total of 76 pieces, with the actual scores indicated.\n\n```lisp\n> (random-othello-series\n    (alpha-beta-searcher 2 #'weighted-squares)\n    (alpha-beta-searcher 2#'modified-weighted-squares)\n    5)\n4\n```\n\n- `76`\n\n```lisp\n(-8 -40 22 -30 10 -10 12 -18 4 -18)\n```\n\nThe `random-othello-series` function is useful for comparing two strategies.\nWhen there are more than two strategies to be compared at the same time, the following function can be useful:\n\n```lisp\n(defun round-robin (strategies n-pairs &optional\n            (n-random 10) (names strategies))\n  \"Play a tournament among the strategies.\n  N-PAIRS = games each strategy plays as each col or against\n  each opponent. So with N strategies, a total of\n  N*(N-1)*N-PAIRS games are played.\"\n  (let* ((N (length strategies))\n        (totals (make-array N :initial-element 0))\n        (scores (make-array (list N N)\n                : initial-element 0)))\n    ;; Play the games\n    (dotimes (i N)\n      (loop for j from (+i 1) to (- N 1) do\n         (let* ((wins (random-othello-series\n                (elt strategies i)\n                (elt strategies j)\n                n-pairs n-random))\n            (losses (- (* 2 n-pairs) wins)))\n         (incf (aref scores i j) wins)\n         (incf (aref scores j i) losses)\n         (incf (aref totals i) wins)\n         (incf (aref totals j) losses))))\n  ;; Print the results\n  (dotimes (i N)\n    (format t \"~&~a~20 T ~ 4f: \" (elt names i) (elt totals i))\n    (dotimes (j N)\n      (format t \"~4f \" (if (= i j) '---\n                   (aref scores i j)))))))\n```\n\nHere is a comparison of five strategies that search only 1 ply:\n\n```lisp\n(defun mobility (player board)\n  \"The number of moves a player has.\"\n  (length (legal-moves player board)))\n> (round-robin\n  (list (maximizer #'count-difference)\n        (maximizer #'mobility)\n        (maximizer #'weighted-squares)\n        (maximizer #'modified-weighted-squares)\n        #'random-strategy)\n  5 10\n  '(count-difference mobility weighted modified-weighted random))\nCOUNT-DIFFERENCE   12.5:  --- 3.0 2.5 0.0 7.0\nMOBILITY           20.5:  7.0 --- 1.5 5.0 7.0\nWEIGHTED           28.0:  7.5 8.5 --- 3.0 9.0\nMODIFIED-WEIGHTED  31.5: 10.0 5.0 7.0 --- 9.5\nRANDOM              7.5:  3.0 3.0 1.0 0.5 ---\n```\n\nThe parameter `n-pairs` is 5, meaning that each strategy plays five games as black and five as white against each of the other four strategies, for a total of 40 games for each strategy and 100 games overall.\nThe first line of output says that the count-difference strategy won 12.5 of its 40 games, including 3 against the mobility strategy, 2.5 against the weighted strategy, none against the modified weighted, and 7 against the random strategy.\nThe fact that the random strategy manages to win 7.5 out of 40 games indicates that the other strategies are not amazingly strong.\nNow we see what happens when the search depth is increased to 4 ply (this will take a while to run):\n\n```lisp\n> (round-robin\n  (list (alpha-beta-searcher 4 #'count-difference)\n        (alpha-beta-searcher 4 #'weighted-squares)\n        (alpha-beta-searcher 4 #'modified-weighted-squares)\n        #'random-strategy)\n  5 10\n  '(count-difference weighted modified-weighted random))\nCOUNT-DIFFERENCE   12.0:  --- 2.0 0.0 10.0\nWEIGHTED           23.5:  8.0 --- 5.5 10.0\nMODIFIED-WEIGHTED  24.5: 10.0 4.5 --- 10.0\nRANDOM              0.0:  0.0 0.0 0.0  ---\n```\n\nHere the random strategy does not win any games-an indication that the other strategies are doing something right.\nNotice that the modified weighted-squares has only a slight advantage over the weighted-squares, and in fact it lost their head-to-head series, four games to five, with one draw.\nSo it is not clear which strategy is better.\n\nThe output does not break down wins by black or white, nor does it report the numerical scores.\nI felt that that would clutter up the output too much, but you're welcome to add this information.\nIt turns out that white wins 23 (and draws 1) of the 40 games played between 4-ply searching strategies.\nUsually, Othello is a fairly balanced game, because black has the advantage of moving first but white usually gets to play last.\nIt is clear that these strategies do not play well in the opening game, but for the last four ply they play perfectly.\nThis may explain white's slight edge, or it may be a statistical aberration.\n\n## 18.9 More Efficient Searching\n{:#s0050}\n{:.h1hd}\n\nThe alpha-beta cutoffs work when we have established a good move and another move proves to be not as good.\nThus, we will be able to make cutoffs earlier if we ensure that good moves are considered first.\nOur current algorithm loops through the list of `legal-moves`, but `legal-moves` makes no attempt to order the moves in any way.\nWe will call this the *random-ordering* strategy (even though the ordering is not random at all-square 11 is always considered first, then 12, etc.).\n\nOne way to try to generate good moves first is to search highly weighted squares first.\nSince `legal-moves` considers squares in the order defined by `all-squares`, all we have to do is redefine the list `all-squares`[3](#fn0025):\n\n```lisp\n(defconstant all-squares\n  (sort (loop for i from 11 to 88\n         when (<= 1 (mod i 10) 8) collect i)\n      #'> :key #'(lambda (sq) (elt *weights* sq))))\n```\n\nNow the corner squares will automatically be considered first, followed by the other highly weighted squares.\nWe call this the s*tatic-ordering* strategy, because the ordering is not random, but it does not change depending on the situation.\n\nA more informed way to try to generate good moves first is to sort the moves according to the evaluation function.\nThis means making more evaluations.\nPreviously, only the boards at the leaves of the search tree were evaluated.\nNow we need to evaluate every board.\nIn order to avoid evaluating a board more than once, we make up a structure called a `node`, which holds a board, the square that was taken to result in that board, and the evaluation value of that board.\nThe search is the same except that nodes are passed around instead of boards, and the nodes are sorted by their value.\n\n```lisp\n(defstruct (node) square board value)\n(defun alpha-beta-searcher2 (depth eval-fn)\n  \"Return a strategy that does A-B search with sorted moves.\"\n  #'(lambda (player board)\n    (multiple-value-bind (value node)\n        (alpha-beta2\n          player (make-node :board board\n                 :value (funcall eval-fn player board))\n          losing-value winning-value depth eval-fn)\n      (declare (ignore value))\n      (node-square node))))\n(defun alpha-beta2 (player node achievable cutoff ply eval-fn)\n  \"A-B search. sorting moves by eval-fn\"\n  ;; Returns two values: achievable-value and move-to-make\n  (if (= ply 0)\n    (values (node-value node) node)\n    (let* ((board (node-board node))\n           (nodes (legal-nodes player board eval-fn)))\n      (if (null nodes)\n         (if (any-legal-move? (opponent player) board)\n           (values (- (alpha-beta2 (opponent player)\n                   (negate-value node)\n                   (- cutoff) (- achievable)\n                   (- ply 1) eval-fn))\n               nil)\n           (values (final-value player board) nil))\n      (let ((best-node (first nodes)))\n        (loop for move in nodes\n             for val = (- (alpha-beta2\n                  (opponent player)\n                  (negate-value move)\n                  (- cutoff) (- achievable)\n                  (- ply 1) eval-fn))\n             do (when (> val achievable)\n               (setf achievable val)\n               (setf best-node move))\n             until (>= achievable cutoff))\n           (values achievable best-node))))))\n(defun negate-value (node)\n  \"Set the value of a node to its negative.\"\n  (setf (node-value node) (- (node-value node)))\n  node)\n(defun legal-nodes (player board eval-fn)\n  \"Return a list of legal moves, each one packed into a node.\"\n  (let ((moves (legal-moves player board)))\n    (sort (map-into\n        moves\n        #'(lambda (move)\n           (let ((new-board (make-move move player\n                    (copy-board board))))\n             (make-node\n               :square move :board new-board\n               :value (funcall eval-fn player new-board))))\n        moves)\n      #'> :key #'node-value)))\n```\n\n(Note the use of the function `map-into`.\nThis is part of ANSI Common Lisp, but if it is not a part of your implementation, a definition is provided on [page 857](B9780080571157500248.xhtml#p857).)\n\nThe following table compares the performance of the random-ordering strategy, the sorted-ordering strategy and the static-ordering strategy in the course of a single game.\nAll strategies search 6 ply deep.\nThe table measures the number of boards investigated, the number of those boards that were evaluated (in all cases the evaluation function was `modified-weighted-squares`) and the time in seconds to compute a move.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| random order | sorted order | static order |\n| boards | evals | secs | boards | evals | secs | boards | evals | secs |\n| 13912 | 10269 | 69 | 5556 | 5557 | 22 | 2365 | 1599 | 19 |\n| 9015 | 6751 | 56 | 6571 | 6572 | 25 | 3081 | 2188 | 18 |\n| 9820 | 7191 | 46 | 11556 | 11557 | 45 | 5797 | 3990 | 31 |\n| 4195 | 3213 | 20 | 5302 | 5303 | 17 | 2708 | 2019 | 15 |\n| 10890 | 7336 | 60 | 10709 | 10710 | 38 | 3743 | 2401 | 23 |\n| 13325 | 9679 | 63 | 6431 | 6432 | 24 | 4222 | 2802 | 24 |\n| 13163 | 9968 | 58 | 9014 | 9015 | 32 | 6657 | 4922 | 31 |\n| 16642 | 12588 | 70 | 9742 | 9743 | 33 | 10421 | 7488 | 51 |\n| 18016 | 13366 | 80 | 11002 | 11003 | 37 | 9508 | 7136 | 41 |\n| 23295 | 17908 | 104 | 15290 | 15291 | 48 | 26435 | 20282 | 111 |\n| 34120 | 25895 | 143 | 22994 | 22995 | 75 | 20775 | 16280 | 78 |\n| 56117 | 43230 | 224 | 46883 | 46884 | 150 | 48415 | 36229 | 203 |\n| 53573 | 41266 | 209 | 62252 | 62253 | 191 | 37803 | 28902 | 148 |\n| 43943 | 33184 | 175 | 31039 | 31040 | 97 | 33180 | 24753 | 133 |\n| 51124 | 39806 | 193 | 45709 | 45710 | 135 | 19297 | 15064 | 69 |\n| 24743 | 18777 | 105 | 20003 | 20004 | 65 | 15627 | 11737 | 66 |\n| 1.0 | 1.0 | 1.0 | .81 | 1.07 | .62 | .63 | .63 | .63 |\n\n![t0010](images/B9780080571157500182/t0010.png)\n\nThe last two lines of the table give the averages and the averages normalized to the random-ordering strategy's performance.\nThe sorted-ordering strategy takes only 62% of the time of the random-ordering strategy, and the static-ordering takes 63%.\nThese times are not to be trusted too much, because a large-scale garbage collection was taking place during the latter part of the game, and it may have thrown off the times.\nThe board and evaluation count may be better indicators, and they both show the static-ordering strategy doing the best.\n\nWe have to be careful how we evaluate these results.\nEarlier I said that alpha-beta search makes more cutoffs when it is presented first with better moves.\nThe actual truth is that it makes more cutoffs when presented first with moves that *the evaluation function thinks* are better.\nIn this case the evaluation function and the static-ordering strategy are in strong agreement on what are the best moves, so it is not surprising that static ordering does so well.\nAs we develop evaluation functions that vary from the weighted-squares approach, we will have to run experiments again to see if the static-ordering is still the best.\n\n## 18.10 It Pays to Precycle\n{:#s0055}\n{:.h1hd}\n\nThe progressive city of Berkeley, California, has a strong recycling program to reclaim glass, paper, and aluminum that would otherwise be discarded as garbage.\nIn 1989, Berkeley instituted a novel program of *precycling:* consumers are encouraged to avoid buying products that corne in environmentally wasteful packages.\n\nYour Lisp system also has a recycling program: the Lisp garbage collector automatically recycles any unused storage.\nHowever, there is a cost to this program, and you the consumer can get better performance by precycling your data.\nDon't buy wasteful data structures when simpler ones can be used or reused.\nYou, the Lisp programmer, may not be able to save the rain forests or the ozone layer, but you can save valuable processor time.\n\nWe saw before that the search routines look at tens of thousands of boards per move.\nCurrently, each board position is created anew by `copy-board` and discarded soon thereaf ter.\nWe could avoid generating all this garbage by reusing the same board at each ply.\nWe'd still need to keep the board from the previous ply for use when the search backs up.\nThus, a vector of boards is needed.\nIn the following we assume that we will never search deeper than 40 ply.\nThis is a safe assumption, as even the fastest Othello programs can only search about 15 ply before running out of time.\n\n```lisp\n(defvar *ply-boards*\n  (apply #'vector (loop repeat 40 collect (initial-board))))\n```\n\nNow that we have sharply limited the number of boards needed, we may want to reevaluate the implementation of boards.\nInstead of having the board as a vector of pieces (to save space), we may want to implement boards as vectors of bytes or full words.\nIn some implementations, accessing elements of such vectors is faster.\n(In other implementations, there is no difference.)\n\nAn implementation using the vector of boards will be done in the next section.\nNote that there is another alternative: use only one board, and update it by making and retracting moves.\nThis is a good alternative in a game like chess, where a move only alters two squares.\nIn Othello, many squares can be altered by a move, so copying the whole board over and making the move is not so bad.\n\nIt should be mentioned that it is worth looking into the problem of copying a position from one board to another.\nThe function `replace` copies one sequence (or part of it) into another, but it is a generic function that may be slow.\nIn particular, if each element of a board is only 2 bits, then it may be much faster to use displaced arrays to copy 32 bits at a time.\nThe advisability of this approach depends on the implementation, and so it is not explored further here.\n\n## 18.11 Killer Moves\n{:#s0060}\n{:.h1hd}\n\nIn [section 18.9](#s0050), we considered the possibility of searching moves in a different order, in an attempt to search the better moves first, thereby getting more alpha-beta pruning.\nIn this section, we consider the *killer heuristic,* which states that a move that has proven to be a good one in one line of play is also likely to be a good one in another line of play.\nTo use chess as perhaps a more familiar example, suppose I consider one move, and it leads to the opponent replying by capturing my queen.\nThis is a killer move, one that I would like to avoid.\nTherefore, when I consider other possible moves, I want to immediately consider the possibility of the opponent making that queen-capturing move.\n\nThe function `alpha-beta3` adds the parameter `killer`, which is the best move found so far at the current level.\nAfter we determine the `legal-moves`, we use `put-first` to put the killer move first, if it is in fact a legal move.\nWhen it cornes time to search the next level, we keep track of the best move in `killer2`.\nThis requires keeping track of the value of the best move in `killer2-val`.\nEverything else is unchanged, except that we get a new board by recycling the `*ply-boards*` vector rather than by allocating fresh ones.\n\n```lisp\n(defun alpha-beta3 (player board achievable cutoff ply eval-fn\n           killer)\n  \"A-B search, putting killer move first.\"\n  (if (= ply 0)\n    (funcall eval-fn player board)\n    (let ((moves (put-first killer (legal-moves player board))))\n      (if (null moves)\n        (if (any-legal-move? (opponent player) board)\n          (- (alpha-beta3 (opponent player) board\n                  (- cutoff) (- achievable)\n                  (- ply 1) eval-fn nil))\n          (final-value player board))\n        (let ((best-move (first moves))\n            (new-board (aref *ply-boards* ply))\n            (killer2 nil)\n            (killer2-val winning-value))\n          (loop for move in moves\n              do (multiple-value-bind (val reply)\n                  (alpha-beta3\n                    (opponent player)\n                    (make-move move player\n                      (replace new-board board))\n                    (- cutoff) (- achievable)\n                    (- ply 1) eval-fn killer2)\n                (setf val (- val))\n                (when (> val achievable)\n                  (setf achievable val)\n                  (setf best-move move))\n                (when (and reply (< val killer2-val))\n                  (setf killer2 reply)\n                  (setf killer2-val val)))\n              until (>= achievable cutoff))\n            (values achievable best-move))))))\n(defun alpha-beta-searcher3 (depth eval-fn)\n  \"Return a strategy that does A-B search with killer moves.\"\n  #'(lambda (player board)\n    (multiple-value-bind (value move)\n        (alpha-beta3 player board losing-value winning-value\n            depth eval-fn nil)\n      (declare (ignore value))\n      move)))\n(defun put-first (killer moves)\n  \"Move the killer move to the front of moves,\n  if the killer move is in fact a legal move.\"\n  (if (member killer moves)\n    (cons killer (delete killer moves))\n    moves))\n```\n\nAnother experiment on a single game reveals that adding the killer heuristic to staticordering search (again at 6-ply) cuts the number of boards and evaluations, and the total time, all by about 20%.\nTo summarize, alpha-beta search at 6 ply with random ordering takes 105 seconds per move (in our experiment), adding static-ordering cuts it to 66 seconds, and adding killer moves to that cuts it again to 52 seconds.\nThis doesn't include the savings that alpha-beta cutoffs give over full minimax search.\nAt 6 ply with a branching factor of 7, full minimax would take about nine times longer than static ordering with killers.\nThe savings increase with increased depth.\nAt 7 ply and a branching factor of 10, a small experiment shows that static-ordering with killers looks at only 28,000 boards in about 150 seconds.\nFull minimax would evaluate 10 million boards and take 350 times longer.\nThe times for full minimax are estimates based on the number of boards per second, not on an actual experiment.\n\nThe algorithm in this section just keeps track of one killer move.\nIt is of course possible to keep track of more than one.\nThe Othello program Bill ([Lee and Mahajan 1990b](B9780080571157500285.xhtml#bb0715)) merges the idea of killer moves with legal move generation: it keeps a list of possible moves at each level, sorted by their value.\nThe legal move generator then goes down this list in sorted order.\n\nIt should be stressed once again that all this work on alpha-beta cutoffs, ordering, and killer moves has not made any change at all in the moves that are selected.\nWe still end up choosing the same move that would be made by a full minimax search to the given depth, we are just doing it faster, without looking at possibilities that we can prove are not as good.\n\n## 18.12 Championship Programs: Iago and Bill\n{:#s0065}\n{:.h1hd}\n\nAs mentioned in the introduction, the unpredictability of Othello makes it a difficult game for humans to master, and thus programs that search deeply can do comparatively well.\nIn fact, in 1981 the reigning champion, Jonathan Cerf, proclaimed \"In my opinion the top programs ... are now equal (if not superior) to the best human players.\" In discussing Rosenbloom's Iago program (1982), Cerf went on to say \"I understand Paul Rosenbloom is interested in arranging a match against me.\nUnfortunately my schedule is very full, and I'm going to see that it remains that way for the foreseeable future.\"\n\nIn 1989, another program, Bill ([Lee and Mahajan 1990](B9780080571157500285.xhtml#bb0715)) beat the highest rated American Othello player, Brian Rose, by a score of 56-8.\nBill's evaluation function is fast enough to search 6-8 ply under tournament conditions, yet it is so accurate that it beats its creator, Kai-Fu Lee, searching only 1 ply.\n(However, Lee is only a novice Othello player; his real interest is in speech recognition; see [Waibel and Lee 1991](B9780080571157500285.xhtml#bb1285).) There are other programs that also play at a high level, but they have not been written up in the AI literature as Iago and Bill have.\n\nIn this section we present an evaluation function based on Iago's, although it also contains elements of Bill, and of an evaluation function written by Eric Wefald in 1989.\nThe evaluation function makes use of two main features: *mobilityand edge stability*.\n\n### Mobility\n{:#s0070}\n{:.h2hd}\n\nBoth Iago and Bill make heavy use of the concept of *mobility*.\nMobility is a measure of the ability to make moves; basically, the more moves one can make, the better.\nThis is not quite true, because there is no advantage in being able to make bad moves, but it is a useful heuristic.\nWe define *current mobility* as the number of legal moves available to a player, and *potential mobility* as the number of blank squares that are adjacent to opponent's pieces.\nThese include the legal moves.\nA better measure of mobility would try to count only good moves.\nThe following function computes both current and potential mobility for a player:\n\n```lisp\n(defun mobility (player board)\n  \"Current mobility is the number of legal moves.\n  Potential mobility is the number of blank squares\n  adjacent to an opponent that are not legal moves.\n  Returns current and potential mobility for player.\"\n  (let ((opp (opponent player))\n      (current 0) ; player's current mobility\n      (potential 0)) ; player's potential mobility\n  (dolist (square all-squares)\n    (when (eql (bref board square) empty)\n      (cond ((legal-p square player board)\n   (incf current))\n    ((some #'(lambda (sq) (eql (bref board sq) opp))\n        (neighbors square))\n      (incf potential)))))\n(values current (+ current potential))))\n```\n\n### Edge Stability\n{:#s0075}\n{:.h2hd}\n\nSuccess at Othello often hinges around edge play, and both Iago and Bill evaluate the edges carefully.\nEdge analysis is made easier by the fact that the edges are fairly independent of the interior of the board: once a piece is placed on the edge, no interior moves can flip it.\nThis independence allows a simplifying assumption: to evaluate a position's edge strength, evaluate each of the four edges independently, without consideration of the interior of the board.\nThe evaluation can be made more accurate by considering the X-squares to be part of the edge.\n\nEven evaluating a single edge is a time-consuming task, so Bill and Iago compile away the evaluation by building a table of all possible edge positions.\nAn \"edge\" according to Bill is ten squares: the eight actual edge squares and the two X-squares.\nSince each square can be black, white, or empty, there are 310 or 59,049 possible edge positions-a large but manageable number.\n\nThe value of each edge position is determined by a process of succesive approximation.\nJust as in a minimax search, we will need a static edge evaluation function to determine the value of a edge position without search.\nThis static edge evaluation function is applied to every possible edge position, and the results are stored in a 59,049 element vector.\nThe static evaluation is just a weighted sum of the occupied squares, with different weights given depending on if the piece is stable or unstable.\n\nEach edge position's evaluation can be improved by a process of search.\nIago uses a single ply search: given a position, consider all moves that could be made (including no move at all).\nSome moves will be clearly legal, because they flip pieces on the edge, but other moves will only be legal if there are pieces in the interior of the board to flip.\nSince we are only considering the edge, we don't know for sure if these moves are legal.\nThey will be assigned probabilities of legality.\nThe updated evaluation of a position is determined by the values and probabilities of each move.\nThis is done by sorting the moves by value and then summing the product of the value times the probability that the move can be made.\nThis process of iterative approximation is repeated five times for each position.\nAt that point, Rosenbloom reports, the values have nearly converged.\n\nIn effect, this extends the depth of the normal alpha-beta search by including an edge-only search in the evaluation function.\nSince each edge position with *n* pieces is evaluated as a function of the positions with *n* + 1 pieces, the search is complete-it is an implicit 10-ply search.\n\nCalculating edge stability is a bit more complicated than the other features.\nThe first step is to define a variable, `*edge-table*`, which will hold the evaluation of each edge position, and a constant, `edge-and-x-lists`, which is a list of the squares on each of the four edges.\nEach edge has ten squares because the X-squares are included.\n\n```lisp\n(defvar *edge-table* (make-array (expt 3 10))\n  \"Array of values to player-to-move for edge positions.\")\n(defconstant edge-and-x-lists\n  '((22 11 12 13 14 15 16 17 18 27)\n    (72 81 82 83 84 85 86 87 88 77)\n    (22 11 21 31 41 51 61 71 81 72)\n    (27 18 28 38 48 58 68 78 88 77))\n  \"The four edges (with their X-squares).\")\n```\n\nNow for each edge we can compute an index into the edge table by building a 10-digit base-3 number, where each digit is 1 if the corresponding edge square is occupied by the player, 2 if by the opponent, and 0 if empty.\nThe function `edge-index` computes this, and `edge-stability` sums the values of the four edge indexes.\n\n```lisp\n(defun edge-index (player board squares)\n  \"The index counts 1 for player; 2 for opponent,\n  on each square---summed as a base 3 number.\"\n  (let ((index 0))\n    (dolist (sq squares)\n      (setq index (+ (* index 3)\n          (cond ((eql (bref board sq) empty) 0)\n              ((eql (bref board sq) player) 1)\n              (t 2)))))\n    index))\n(defun edge-stability (player board)\n  \"Total edge evaluation for player to move on board.\"\n  (loop for edge-list in edge-and-x-lists\n      sum (aref *edge-table*\n         (edge-index player board edge-list))))\n```\n\nThe function `edge-stability` is all we will need in Iago's evaluation function, but we still need to generate the edge table.\nSince this needs to be done only once, we don't have to worry about efficiency.\nIn particular, rather than invent a new data structure to represent edges, we will continue to use complete boards, even though they will be mostly empty.\nThe computations for the edge table will be made on the top edge, from the point of view of black, with black to play.\nBut the same table can be used for white, or for one of the other edges, because of the way the edge index is computed.\n\nEach position in the table is first initialized to a static value computed by a kind of weighted-squares metric, but with different weights depending on if a piece is in danger of being captured.\nAfter that, each position is updated by considering the possible moves that can be made from the position, and the values of each of these moves.\n\n```lisp\n(defconstant top-edge (first edge-and-x-lists))\n(defun init-edge-table ()\n  \"Initialize *edge-table*, starting from the empty board.\"\n  ;; Initialize the static values\n  (loop for n-pieces from 0 to 10 do\n      (map-edge-n-pieces\n           #'(lambda (board index)\n             (setf (aref *edge-table* index)\n               (static-edge-stability black board)))\n           black (initial-board) n-pieces top-edge 0))\n  ;; Now iterate five times trying to improve:\n  (dotimes (i 5)\n    ;; Do the indexes with most pieces first\n    (loop for n-pieces from 9 downto 1 do\n      (map-edge-n-pieces\n        #'(lambda (board index)\n          (setf (aref *edge-table* index)\n            (possible-edge-moves-value\n              black board index)))\n        black (initial-board) n-pieces top-edge 0))))\n```\n\nThe function `map-edge-n-pieces` iterates through all edge positions with a total of `n` pieces (of either color), applying a function to each such position.\nIt also keeps a running count of the edge index as it goes.\nThe function should accept two arguments: the board and the index.\nNote that a single board can be used for all the positions because squares are reset after they are used.\nThe function has three cases: if the number of squares remaining is less than `n`, then it will be impossible to place `n` pieces on those squares, so we give up.\nIf there are no more squares then `n` must also be zero, so this is a valid position, and the function `fn` is called.\nOtherwise we first try leaving the current square blank, then try filling it with player's piece, and then with the opponent's piece, in each case calling `map-edge-n-pieces` recursively.\n\n```lisp\n(defun map-edge-n-pieces (fn player board n squares index)\n  \"Call fn on all edges with n pieces.\"\n  ;; Index counts 1 for player; 2 for opponent\n  (cond\n    ((< (length squares) n) nil)\n    ((null squares) (funcall fn board index))\n    (t (let ((index3 (* 3 index))\n         (sq (first squares)))\n      (map-edge-n-pieces fn player board n (rest squares) index3)\n    (when (and (> n 0) (eql (bref board sq) empty))\n        (setf (bref board sq) player)\n        (map-edge-n-pieces fn player board (- n 1) (rest squares)\n                (+1 index3))\n        (setf (bref board sq) (opponent player))\n        (map-edge-n-pieces fn player board (- n 1) (rest squares)\n                (+2 index3))\n        (setf (bref board sq) empty))))))\n```\n\nThe function `possible-edge-moves-value` searches through all possible moves to determine an edge value that is more accurate than a static evaluation.\nIt loops through every empty square on the edge, calling `possible-edge-move` to return a (*probability value*) pair.\nSince it is also possible for a player not to make any move at all on an edge, the pair (`1.0`*current-value*) is also included.\n\n```lisp\n(defun possible-edge-moves-value (player board index)\n  \"Consider all possible edge moves.\n  Combine their values into a single number.\"\n  (combine-edge-moves\n    (cons\n      (list 1.0 (aref *edge-table* index)) ;; no move\n      (loop for sq in top-edge ;; possible moves\n        when (eql (bref board sq) empty)\n        collect (possible-edge-move player board sq)))\n    player))\n```\n\nThe value of each position is determined by making the move on the board, then looking up in the table the value of the resulting position for the opponent, and negating it (since we are interested in the value to us, not to our opponent).\n\n```lisp\n(defun possible-edge-move (player board sq)\n  \"Return a (prob val) pair for a possible edge move.\"\n  (let ((new-board (replace (aref *ply-boards* player) board)))\n    (make-move sq player new-board)\n    (list (edge-move-probability player board sq)\n      (- (aref *edge-table*\n        (edge-index (opponent player)\n          new-board top-edge))))))\n```\n\nThe possible moves are combined with `combine-edge-moves`, which sorts the moves best-first.\n(Since `init-edge-table` started from black's perspective, black tries to maximize and white tries to minimize scores.) We then go down the moves, increasing the total value by the value of each move times the probability of the move, and decreasing the remaining probability by the probability of the move.\nSince there will always be a least one move (pass) with probability 1.0, this is guaranteed to converge.\nIn the end we round off the total value, so that we can do the run-time calculations with fixnums.\n\n```lisp\n(defun combine-edge-moves (possibilities player)\n  \"Combine the best moves.\"\n  (let ((prob 1.0)\n      (val 0.0)\n      (fn (if (eql player black) #'> #'<)))\n    (loop for pair in (sort possibilities fn :key #'second)\n        while (>= prob 0.0)\n        do (incf val (* prob (first pair) (second pair)))\n          (decf prob (* prob (first pair))))\n    (round val)))\n```\n\nWe still need to compute the probability that each possible edge move is legal.\nThese probabilities should reflect things such as the fact that it is easy to capture a corner if the opponent is in the adjacent X-square, and very difficult otherwise.\nFirst we define some functions to recognize corner and X-squares and relate them to their neighbors:\n\n```lisp\n(let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77))))\n  (defun corner-p (sq) (assoc sq corner/xsqs))\n  (defun x-square-p (sq) (rassoc sq corner/xsqs))\n  (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))\n  (defun corner-for (xsq) (car (rassoc xsq corner/xsqs))))\n```\n\nNow we consider the probabilities.\nThere are four cases.\nFirst, since we don't know anything about the interior of the board, we assume each player has a 50% chance of being able to play in an X-square.\nSecond, if we can show that a move is legal (because it flips opponent pieces on the edge) then it has 100% probability.\nThird, for the corner squares, we assign a 90% chance if the opponent occupies the X-square, 10% if it is empty, and only .1 % if we occupy it.\nOtherwise, the probability is determined by the two neighboring squares: if a square is next to one or more opponents it is more likely we can move there; if it is next to our pieces it is less likely.\nIf it is legal for the opponent to move into the square, then the chances are cut in half (although we may still be able to move there, since we move first).\n\n```lisp\n(defun edge-move-probability (player board square)\n  \"What's the probability that player can move to this square?\"\n  (cond\n    ((x-square-p square) .5) ;; X-squares\n    ((legal-p square player board) 1.0) ;; immediate capture\n    ((corner-p square) ;; move to corner depends on X-square\n    (let ((x-sq (x-square-for square)))\n      (cond\n        ((eql (bref board x-sq) empty) .1)\n        ((eql (bref board x-sq) player) 0.001)\n        (t .9))))\n    (t (/ (aref\n          '#2A((.l .4 .7)\n            (.05 .3 *)\n            (.01 * *))\n          (count-edge-neighbors player board square)\n          (count-edge-neighbors (opponent player) board square))\n        (if (legal-p square (opponent player) board) 2 1)))))\n(defun count-edge-neighbors (player board square)\n  \"Count the neighbors of this square occupied by player.\"\n  (count-if #'(lambda (inc)\n            (eql (bref board (+ square inc)) player))\n        '(+1 -1)))\n```\n\nNow we return to the problem of determining the static value of an edge position.\nThis is computed by a weighted-squares metric, but the weights depend on the *stability* of each piece.\nA piece is called stable if it cannot be captured, unstable if it is in immediate danger of being captured, and semistable otherwise.\nA table of weights follows for each edge square and stability.\nNote that corner squares are always stable, and X-squares we will call semistable if the adjacent corner is taken, and unstable otherwise.\n\n```lisp\n(defparameter *static-edge-table*\n  '#2A(;stab semi    un\n       (   *   0 -2000) ; X\n       ( 700   *     *) ; corner\n       (1200 200   -25) ; C\n       (1000 200    75) ; A\n       (1000 200    50) ; B\n       (1000 200    50) ; B\n       (1000 200    75) ; A\n       (1200 200   -25) ; C\n       ( 700   *     *) ; corner\n       (   *   0 -2000) ; X\n       ))\n```\n\nThe static evaluation then just sums each piece's value according to this table:\n\n```lisp\n(defun static-edge-stability (player board)\n  \"Compute this edge's static stability\"\n  (loop for sq in top-edge\n      for i from 0\n      sum (cond\n          ((eql (bref board sq) empty) 0)\n          ((eql (bref board sq) player)\n           (aref *static-edge-table* i\n              (piece-stability board sq)))\n          (t (- (aref *static-edge-table* i\n                 (piece-stability board sq)))))))\n```\n\nThe computation of stability is fairly complex.\nIt centers around finding the two \"pieces,\" `p1` and `p2`, which lay on either side of the piece in question and which are not of the same color as the piece.\nThese \"pieces\" may be empty, or they may be off the board.\nA piece is unstable if one of the two is empty and the other is the opponent; it is semistable if there are opponents on both sides and at least one empty square to play on, or if it is surrounded by empty pieces.\nFinally, if either `p1` or `p2` is nil then the piece is stable, since it must be connected by a solid wall of pieces to the corner.\n\n```lisp\n(let ((stable 0) (semi-stable 1) (unstable 2))\n  (defun piece-stability (board sq)\n    (cond\n      ((corner-p sq) stable)\n      ((x-square-p sq)\n       (if (eql (bref board (corner-for sq)) empty)\n         unstable semi-stable))\n      (t (let* ((player (bref board sq))\n             (opp (opponent player))\n             (p1 (find player board :test-not #'eql\n               :start sq :end 19))\n             (p2 (find player board :test-not #'eql\n               :start 11 :end sq\n               :from-end t)))\n         (cond\n           ;; unstable pieces can be captured immediately\n           ;; by playing in the empty square\n           ((or (and (eql p1 empty) (eql p2 opp))\n             (and (eql p2 empty) (eql p1 opp)))\n            unstable)\n           ;; semi-stable pieces might be captured\n           ((and (eql p1 opp) (eql p2 opp)\n             (find empty board :start 11 :end 19))\n            semi-stable)\n           ((and (eql p1 empty) (eql p2 empty))\n            semi-stable)\n           ;; Stable pieces can never be captured\n           (t stable)))))))\n```\n\nThe edge table can now be built by a call to `init-edge-lable`.\nAfter the table is built once, it is a good idea to save it so that we won't need to repeat the initialization.\nWe could write simple routines to dump the table into a file and read it back in, but it is faster and easier to use existing tools that already do this job quite well: `compile-file` and `load`.\nAll we have to do is create and compile a file containing the single line:\n\n```lisp\n(setf *edge-table* '#.*edge-table*)\n```\n\nThe `#.` read macro evaluates the following expression at read time.\nThus, the compiler will see and compile the current edge table.\nIt will be able to store this more compactly and `load` it back in more quickly than if we printed the contents of the vector in decimal (or any other base).\n\n### Combining the Factors\n{:#s0080}\n{:.h2hd}\n\nNow we have a measure of the three factors: current mobility, potential mobility, and edge stability.\nAll that remains is to find a good way to combine them into a single evaluation metric.\nThe combination function used by [Rosenbloom (1982)](B9780080571157500285.xhtml#bb1000) is a linear combination of the three factors, but each factor's coefficient is dependent on the move number.\nRosenbloom's features are normalized to the range [-1000, 1000]; we normalize to the range [-1, 1] by doing a division after multiplying by the coefficient.\nThat allows us to use fixnuums for the coefficients.\nSince our three factors are not calculated in quite the same way as Rosenbloom's, it is not surprising that his coefficients are not the best for our program.\nThe edge coefficient was doubled and the potential coefficient cut by a factor of five.\n\n```lisp\n(defun Iago-eval (player board)\n  \"Combine edge-stability, current mobility and\n  potential mobility to arrive at an evaluation.\"\n  ;; The three factors are multiplied by coefficients\n  ;; that vary by move number:\n  (let ((c-edg(+ 312000 (* 6240 *move-number*)))\n    (c-cur (if (< *move-number* 25)\n      (+ 50000 (* 2000 *move-number*))\n      (+ 75000 (* 1000 *move-number*))))\n    (c-pot 20000))\n  (multiple-value-bind (p-cur p-pot)\n      (mobility player board)\n    (multiple-value-bind (o-cur o-pot)\n        (mobility (opponent player) board)\n      ;; Combine the three factors into one sum:\n      (+ (round (* c-edg (edge-stability player board)) 32000)\n          (round (* c-cur (- p-cur o-cur)) (+ p-cur o-cur 2))\n          (round (* c-pot (- p-pot o-pot)) (+ p-pot o-pot 2)))))))\n```\n\nFinally, we are ready to code the `Iago` function.\nGiven a search depth, `Iago` returns a strategy that will do alpha-beta search to that depth using the `Iago-eval` evaluation function.\nThis version of Iago was able to defeat the modified weighted-squares strategy in 8 of 10 games at 3 ply, and 9 of 10 at 4 ply.\nOn an Explorer II, 4-ply search takes about 20 seconds per move.\nAt 5 ply, many moves take over a minute, so the program runs the risk of forfeiting.\nAt 3 ply, the program takes only a few seconds per move, but it still was able to defeat the author in five straight games, by scores of 50-14, 64-0, 51-13, 49-15 and 36-28.\nDespite these successes, it is likely that the evaluation function could be improved greatly with a little tuning of the parameters.\n\n```lisp\n(defun Iago (depth)\n  \"Use an approximation of Iago's evaluation function.\"\n  (alpha-beta-searcher3 depth #'iago-eval))\n```\n\n## 18.13 Other Techniques\n{:#s0085}\n{:.h1hd}\n\nThere are many other variations that can be tried to speed up the search and improve play.\nUnfortunately, choosing among the techniques is a bit of a black art.\nYou will have to experiment to find the combination that is best for each domain and each evaluation function.\nMost of the following techniques were incorporated, or at least considered and rejected, in Bill.\n\n### Iterative Deepening\n{:#s0090}\n{:.h2hd}\n\nWe have seen that the average branching factor for Othello is about 10.\nThis means that searching to depth *n* + 1 takes roughly 10 times longer than search to depth *n*.\nThus, we should be willing to go to a lot of overhead before we search one level deeper, to assure two things: that search will be done efficiently, and that we won't forfeit due to running out of time.\nA by-now familiar technique, iterative deepening (see [chapters 6](B9780080571157500066.xhtml) and [14](B9780080571157500145.xhtml)), serves both these goals.\n\nIterative deepening is used as follows.\nThe strategy determines how much of the remaining time to allocate to each move.\nA simple strategy could allocate a constant amount of time for each move, and a more sophisticated strategy could allocate more time for moves at crucial points in the game.\nOnce the time allocation is determined for a move, the strategy starts an iterative deepening alpha-beta search.\nThere are two complications: First, the search at *n* ply keeps track of the best moves, so that the search at *n* + 1 ply will have better ordering information.\nIn many cases it will be faster to do both the *n* and *n* + 1 ply searches with the ordering information than to do only the *n* + 1 ply search without it.\nSecond, we can monitor how much time has been taken searching each ply, and cut off the search when searching one more ply would exceed the allocated time limit.\nThus, iterative-deepening search degrades gracefully as time limits are imposed.\nIt will give a reasonable answer even with a short time allotment, and it will rarely exceed the allotted time.\n\n### Forward Pruning\n{:#s0095}\n{:.h2hd}\n\nOne way to cut the number of positions searched is to replace the legal move generator with a *plausible* move generator: in other words, only consider good moves, and never even look at moves that seem clearly bad.\nThis technique is called *forward pruning*.\nIt has fallen on disfavor because of the difficulty in determining which moves are plausible.\nFor most games, the factors that would go into a plausible move generator would be duplicated in the static evaluation function anyway, so forward pruning would require more effort without much gain.\nWorse, forward pruning could rule out a brilliant sacrifice-a move that looks bad initially but eventually leads to a gain.\n\nFor some games, forward pruning is a necessity.\nThe game of Go, for example, is played on a 19 by 19 board, so the first player has 361 legal moves, and a 6-ply search would involve over 2 quadrillion positions.\nHowever, many good Go programs can be viewed as not doing forward pruning but doing abstraction.\nThere might be 30 empty squares in one portion of the board, and the program would treat a move to any of these squares equivalently.\n\nBill uses forward pruning in a limited way to rule out certain moves adjacent to the corners.\nIt does this not to save time but because the evaluation function might lead to such a move being selected, even though it is in fact a poor move.\nIn other words, forward pruning is used to correct a bug in the evaluation function cheaply.\n\n### Nonspeculative Forward Pruning\n{:#s0100}\n{:.h2hd}\n\nThis technique makes use of the observation that there are limits in the amount the evaluation function can change from one position to the next.\nFor example, if we are using the count difference as the evaluation function, then the most a move can change the evaluation is +37 (one for placing a piece in the corner, and six captures in each of the three directions).\nThe smallest change is 0 (if the player is forced to pass).\nThus, if there are 2 ply left in the search, and the backed-up value of position *A* has been established as 38 points better than the static value of position *B*, then it is useless to expand position *B*.\nThis assumes that we are evaluating every position, perhaps to do sorted ordering or iterative deepening.\nIt also assumes that no position in the search tree is a final position, because then the evaluation could change by more than 37 points.\nIn conclusion, it seems that nonspeculative forward pruning is not very useful for Othello, although it may play a role in other games.\n\n### Aspiration Search\n{:#s0105}\n{:.h2hd}\n\nAlpha-beta search is initated with the `achievable` and `cutoff` boundaries set to `losing-value` and `winning-value`, respectively.\nIn other words, the search assumes nothing: the final position may be anything from a loss to a win.\nBut suppose we are in a situation somewhere in the mid-game where we are winning by a small margin (say the static evaluation for the current position is 50).\nIn most cases, a single move will not change the evaluation by very much.\nTherefore, if we invoked the alpha-beta search with a window defined by boundaries of, say, 0 and 100, two things can happen: if the actual backed-up evaluation for this position is in fact in the range 0 to 100, then the search will find it, and it will be found quickly, because the reduced window will cause more pruning.\nIf the actual value is not in the range, then the value returned will reflect that, and we can search again using a larger window.\nThis is called aspiration search, because we aspire to find a value within a given window.\nIf the window is chosen well, then often we will succeed and will have saved some search time.\n\n[Pearl (1984)](B9780080571157500285.xhtml#bb0930) suggests an alternative called zero-window search.\nAt each level, the first possible move, which we'll call *m*, is searched using a reasonably wide window to determine its exact value, which we'll call *v*.\nThen the remaining possible moves are searched using *v* as both the lower and upper bounds of the window.\nThus, the result of the search will tell if each subsequent move is better or worse than *m*, but won't tell how much better or worse.\nThere are three outcomes for zero-window search.\nIf no move turns out to be better than *m*, then stick with *m*.\nIf a single move is better, then use it.\nIf several moves are better than *m*, then they have to be searched again using a wider window to determine which is best.\n\nThere is always a trade-off between time spent searching and information gained.\nZero-window search makes an attractive trade-off: we gain some search time by losing information about the value of the best move.\nWe are still guaranteed of finding the best move, we just don't know its exact value.\n\nBill's zero-window search takes only 63% of the time taken by full alpha-beta search.\nIt is effective because Bill's move-ordering techniques ensure that the first move is often best.\nWith random move ordering, zero-window search would not be effective.\n\n### Think-Ahead\n{:#s0110}\n{:.h2hd}\n\nA program that makes its move and then waits for the opponent's reply is wasting half the time available to it.\nA better use of time is to compute, or *think-ahead* while the opponent is moving.\nThink-ahead is one factor that helps Bill defeat Iago.\nWhile many programs have done think-ahead by choosing the most likely move by the opponent and then starting an iterative-deepening search assuming that move, Bill's algorithm is somewhat more complex.\nIt can consider more than one move by the opponent, depending on how much time is available.\n\n### Hashing and Opening Book Moves\n{:#s0115}\n{:.h2hd}\n\nWe have been treating the search space as a tree, but in general it is a directed acyclic graph (dag): there may be more than one way to reach a particular position, but there won't be any loops, because every move adds a new piece.\nThis raises the question we explored briefly in [section 6.4](B9780080571157500066.xhtml#s0025): should we treat the search space as a tree or a graph?\nBy treating it as a graph we eliminate duplicate evaluations, but we have the overhead of storing all the previous positions, and of checking to see if a new position has been seen before.\nThe decision must be based on the proportion of duplicate positions that are actually encountered in play.\nOne compromise solution is to store in a hash table a partial encoding of each position, encoded as, say, a single fixnum (one word) instead of the seven or so words needed to represent a full board.\nAlong with the encoding of each position, store the move to try first.\nThen, for each new position, look in the hash table, and if there is a hit, try the corresponding move first.\nThe move may not even be legal, if there is an accidental hash collision, but there is a good chance that the move will be the right one, and the overhead is low.\n\nOne place where it is clearly worthwhile to store information about previous positions is in the opening game.\nSince there are fewer choices in the opening, it is a good idea to compile an opening \"book\" of moves and to play by it as long as possible, until the opponent makes a move that departs from the book.\nBook moves can be gleaned from the literature, although not very much has been written about Othello (as compared to openings in chess).\nHowever, there is a danger in following expert advice: the positions that an expert thinks are advantageous may not be the same as the positions from which our program can play well.\nIt may be better to compile the book by playing the program against itself and determining which positions work out best.\n\n### The End Game\n{:#s0120}\n{:.h2hd}\n\nIt is also a good idea to try to save up time in the midgame and then make an all-out effort to search the complete game tree to completion as soon as feasible.\nBill can search to completion from about 14 ply out.\nOnce the search is done, of course, the most promising lines of play should be saved so that it won't be necessary to solve the game tree again.\n\n### Metareasoning\n{:#s0125}\n{:.h2hd}\n\nIf it weren't for the clock, Othello would be a trivial game: just search the complete game tree all the way to the end, and then choose the best move.\nThe clock imposes a complication: we have to make all our moves before we run out of time.\nThe algorithms we have seen so far manage the clock by allocating a certain amount of time to each move, such that the total time is guaranteed (or at least very likely) to be less than the allotted time.\nThis is a very crude policy.\nA finer-grained way of managing time is to consider computation itself as a possible move.\nThat is, at every tick of the clock, we need to decide if it is better to stop and play the best move we have computed so far or to continue and try to compute a better move.\nIt will be better to compute more only in the case where we eventually choose a better move; it will be better to stop and play only in the case where we would otherwise forfeit due to time constraints, or be forced to make poor choices later in the game.\nAn algorithm that includes computation as a possible move is called a metareasoning system, because it reasons about how much to reason.\n\n[Russell and Wefald (1989)](B9780080571157500285.xhtml#bb1025) present an approach based on this view.\nIn addition to an evaluation function, they assume a variance function, which gives an estimate of how much a given position's true value is likely to vary from its static value.\nAt each step, their algorithm compares the value and variance of the best move computed so far and the second best move.\nIf the best move is clearly better than the second best (taking variance into account), then there is no point Computing any more.\nAlso, if the top two moves have similar values but both have very low variance, then Computing will not help much; we can just choose one of the two at random.\n\nFor example, if the board is in a symmetric position, then there may be two symmetric moves that will have identical value.\nBy searching each move's subtree more carefully, we soon arrive at a low variance for both moves, and then we can choose either one, without searching further.\nOf course, we could also add special-case code to check for symmetry, but the metareasoning approach will work for nonsymmetric cases as well as symmetric ones.\nIf there is a situation where two moves both lead to a clear win, it won't waste time choosing between them.\n\nThe only situation where it makes sense to continue Computing is when there are two moves with high variance, so that it is uncertain if the true value of one exceeds the other.\nThe metareasoning algorithm is predicated on devoting time to just this case.\n\n### Learning\n{:#s0130}\n{:.h2hd}\n\nFrom the earliest days of computer game playing, it was realized that a championship program would need to learn to improve itself.\n[Samuel (1959)](B9780080571157500285.xhtml#bb1040) describes a program that plays checkers and learns to improve its evaluation function.\nThe evaluation function is a linear combination of features, such as the number of pieces for each player, the number of kings, the number of possible forks, and so on.\nLearning is done by a hill-climbing search procedure: change one of the coefficients for one of the features at random, and then see if the changed evaluation function is better than the original one.\n\nWithout some guidance, this hill-climbing search would be very slow.\nFirst, the space is very large-Samuel used 38 different features, and although he restricted the coefficients to be a power of two between 0 and 20, that still leaves 2138 possible evaluation functions.\nSecond, the obvious way of determining the relative worth of two evaluation functions-playing a series of games between them and seeing which wins more often-is quite time-consuming.\n\nFortunately, there is a faster way of evaluating an evaluation function.\nWe can apply the evaluation function to a position and compare this static value with the backed-up value determined by an alpha-beta search.\nIf the evaluation function is accurate, the static value should correlate well with the backed-up value.\nIf it does not correlate well, the evaluation function should be changed in such a way that it does.\nThis approach still requires the trial-and-error of hill-climbing, but it will converge much faster if we can gain information from every position, rather than just from every game.\n\nIn the past few years there has been increased interest in learning by a process of guided search.\n*Neural nets* are one example of this.\nThey have been discussed elsewhere.\nAnother example is *genetic learning* algorithms.\nThese algorithms start with several candidate solutions.\nIn our case, each candidate would consist of a set of coefficients for an evaluation function.\nOn each generation, the genetic algorithm sees how well each candidate does.\nThe worst candidates are eliminated, and the best ones \"mate\" and \"reproduce\"-two candidates are combined in some way to yield a new one.\nIf the new offspring has inherited both its parents' good points, then it will prosper; if it has inherited both its parents' bad points, then it will quickly die out.\nEither way, the idea is that natural selection will eventually yield a high-quality solution.\nTo increase the chances of this, it is a good idea to allow for mutations: random changes in the genetic makeup of one of the candidates.\n\n## 18.14 History and References\n{:#s0135}\n{:.h1hd}\n\n[Lee and Mahajan (1986,](B9780080571157500285.xhtml#bb0710)[1990)](B9780080571157500285.xhtml#bb0715)present the current top Othello program, Bill.\nTheir description outlines all the techniques used but does not go into enough detail to allow the reader to reconstruct the program.\nBill is based in large part on Rosenbloom's Iago program.\nRosenbloom's article (1982) is more thorough.\nThe presentation in this chapter is based largely on this article, although it also contains some ideas from Bill and from other sources.\n\nThe journal *Othello Quarterly* is the definitive source for reports on both human and computer Othello games and strategies.\n\nThe most popular game for computer implementation is chess.\n[Shannon (1950a,](B9780080571157500285.xhtml#bb1070)[b)](B9780080571157500285.xhtml#bb1075) speculated that a computer might play chess.\nIn a way, this was one of the boldest steps in the history of AI.\nToday, writing a chess program is a challenging but feasible project for an undergraduate.\nBut in 1950, even suggesting that such a program might be possible was a revolutionary step that changed the way people viewed these arithmetic calculating devices.\nShannon introduced the ideas of a game tree search, minimaxing, and evaluation functions-ideas that remain intact to this day.\n[Marsland (1990)](B9780080571157500285.xhtml#bb0770) provides a good short introduction to computer chess, and David Levy has two books on the subject (1976, 1988).\nIt was Levy, an international chess master, who in 1968 accepted a bet from John McCarthy, Donald Michie, and others that a computer chess program would not beat him in the next ten years.\nLevy won the bet.\nLevy's *Heuristic Programming* (1990) and *Computer Games* (1988) cover a variety of computer game playing programs.\nThe studies by [DeGroot (1965,](B9780080571157500285.xhtml#bb0305)[1966)](B9780080571157500285.xhtml#bb0310) give a fascinating insight into the psychology of chess masters.\n\n[Knuth and Moore (1975)](B9780080571157500285.xhtml#bb0630) analyze the alpha-beta algorithm, and Pearl's book *Heuristics* (1984) covers all kinds of heuristic search, games included.\n\n[Samuel (1959)](B9780080571157500285.xhtml#bb1040) is the classic work on learning evaluation function parameters.\nIt is based on the game of checkers.\n[Lee and Mahajan (1990)](B9780080571157500285.xhtml#bb0715) present an alternative learning mechanism, using Bayesian classification to learn an evaluation function that optimally distinguishes winning positions from losing positions.\nGenetic algorithms are discussed by L.\n[Davis (1987,](B9780080571157500285.xhtml#bb0280)[1991)](B9780080571157500285.xhtml#bb0285) and [Goldberg (1989)](B9780080571157500285.xhtml#bb0480).\n\n## 18.15 Exercises\n{:#s0140}\n{:.h1hd}\n\n**Exercise 18.3 [s]** How many different Othello positions are there?\nWould it be feasible to store the complete game tree and thus have a perfect player?\n\n**Exercise 18.4 [m]** At the beginning of this chapter, we implemented pieces as an enumerated type.\nThere is no built-in facility in Common Lisp for doing this, so we had to introduce a series of `defconstant` forms.\nDefine a macro for defining enumerated types.\nWhat else should be provided besides the constants?\n\n**Exercise 18.5 [h]** Add fixnum and speed declarations to the Iago evaluation function and the alpha-beta code.\nHow much does this speed up Iago?\nWhat other efficiency measures can you take?\n\n**Exercise 18.6 [h]** Implement an iterative deepening search that allocates time for each move and checks between each iteration if the time is exceeded.\n\n**Exercise 18.7 [h]** Implement zero-window search, as described in [section 18.13](#s0085).\n\n**Exercise 18.8 [d]** Read the references on Bill ([Lee and Mahajan 1990](B9780080571157500285.xhtml#bb0715), and [1986](B9780080571157500285.xhtml#bb0710) if you can get it), and reimplement Bill's evaluation function as best you can, using the table-based approach.\nIt will also be helpful to read [Rosenbloom 1982](B9780080571157500285.xhtml#bb1000).\n\n**Exercise 18.9 [d]** Improve the evaluation function by tuning the parameters, using one of the techniques described in [section 18.13](#s0085).\n\n**Exercise 18.10 [h]** Write move-generation and evaluation functions for another game, such as chess or checkers.\n\n## 18.16 Answers\n{:#s0145}\n{:.h1hd}\n\n**Answer 18.2** The `weighted-squares` strategy wins the first game by 20 pieces, but when `count-difference` plays first, it captures all the pieces on its fifth move.\nThese two games alone are not enough to determine the best strategy; the function `othello-series` on [page 626](#p626) shows a better comparison.\n\n**Answer 18.3** 364 = 3, 433, 683, 820, 292, 512, 484, 657, 849, 089, 281.\nNo.\n\n**Answer 18.4** Besides the constants, we provide a `deftype` for the type itself, and conversion routines between integers and symbols:\n\n```lisp\n(defmacro define-enumerated-type (type &rest elements)\n  \"Represent an enumerated type with integers 0-n.\"\n  '(progn\n    (deftype ,type () '(integer 0 , (- (length elements) 1)))\n    (defun ,(symbol type '->symbol) (,type)\n      (elt ',elements ,type))\n    (defun ,(symbol 'symbol-> type) (symbol)\n      (position symbol ',elements))\n    ,@(loop for element in elements\n        for i from 0\n        collect '(defconstant ,element ,i))))\n```\n\nHere's how the macro would be used to define the piece data type, and the code produced:\n\n```lisp\n> (macroexpand\n    '(define-enumerated-type piece\n      empty black white outer))\n(PROGN\n  (DEFTYPE PIECE () '(INTEGER 0 3))\n  (DEFUN PIECE->SYMBOL (PIECE)\n    (ELT '(EMPTY BLACK WHITE OUTER) PIECE))\n  (DEFUN SYMBOL->PIECE (SYMBOL)\n    (POSITION SYMBOL '(EMPTY BLACK WHITE OUTER)))\n  (DEFCONSTANT EMPTY 0)\n  (DEFCONSTANT BLACK 1)\n  (DEFCONSTANT WHITE 2)\n  (DEFCONSTANT OUTER 3))\n```\n\nA more general facility would, like `defstruct`, provide for several options.\nFor example, it might allow for a documentation string for the type and each constant, and for a : `conc-name`, so the constants could have names like `piece-empty` instead of `empty`.\nThis would avoid conflicts with other types that wanted to use the same names.\nThe user might also want the ability to start the values at some number other than zero, or to assign specific values to some of the symbols.\n\n----------------------\n\n[1](#xfn0015) Othello is a registered trademark of CBS Inc.\nGameboard design @ 1974 CBS Inc.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0020)*Othello,* [I.\ni.\n117] William Shakespeare.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0025) Remember, when a constant is redefined, it may be necessary to recompile any functions that use the constant.\n!!!(p) {:.ftnote1}\n\n# Chapter 19\n## Introduction to Natural Language\n{:.chaptitle}\n\n> Language is everywhere.\nIt permeates our thoughts mediates our relations with others, and even creeps into our dreams.\nThe overwhelming bulk of human knowledge is stored and transmitted in language.\nLanguage is so ubiquitous that we take it for granted but without it, society as we know it would be impossible.\n\n> -Ronand Langacker\n\n> Language and its Structure (1967)\n\nAnatural language is a language spoken by people, such as English, German, or Tagalog.\nThis is in opposition to artificial languages like Lisp, FORTRAN, or Morse code.\nNatural language processing is an important part of AI because language is intimately connected to thought.\nOne measure of this is the number of important books that mention language and thought in the title: in AI, Schank and Colby's *Computer Models of Thought and Language;* in linguistics, Whorf's *Language, Thought, and Reality* (and Chomsky's *Language and Mind;)* in philosophy, Fodor's *The Language of Thought;* and in psychology, Vygotsky's *Thought and Language* and John Anderson's *Language, Memory, and Thought.* Indeed, language is the trait many think of as being the most characteristic of humans.\nMuch controversy has been generated over the question of whether animais, especially primates and dolphins, can use and \"understand\" language.\nSimilar controversy surrounds the same question asked of computers.\n\nThe study of language has been traditionally separated into two broad classes: syntax, or grammar, and semantics, or meaning.\nHistorically, syntax has achieved the most attention, largely because on the surface it is more amenable to formai and semiformal methods.\nAlthough there is evidence that the boundary between the two is at best fuzzy, we still maintain the distinction for the purposes of these notes.\nWe will cover the \"easier\" part, syntax, first, and then move on to semantics.\n\nA good artificial language, like Lisp or C, is unambiguous.\nThere is only one interpretation for a valid Lisp expression.\nOf course, the interpretation may depend on the state of the current state of the Lisp world, such as the value of global variables.\nBut these dependencies can be explicitly enumerated, and once they are spelled out, then there can only be one meaning for the expression.[1](#fn0015)\n\nNatural language does not work like this.\nNatural expressions are inherently ambiguous, depending on any number of factors that can never be quite spelled out completely.\nIt is perfectly reasonable for two people to disagree on what some other person meant by a natural language expression.\n(Lawyers and judges make their living largely by interpreting natural language expressions-laws-that are meant to be unambiguous but are not.)\n\nThis chapter is a brief introduction to natural language processing.\nThe next chapter gives a more thorough treatment from the point of view of logic grammars, and the chapter after that puts it all together into a full-fledged system.\n\n## 19.1 Parsing with a Phrase-Structure Grammar\n{:#s0010}\n{:.h1hd}\n\nTo parse a sentence means to recover the constituent structure of the sentence-to discover what sequence of generation rules could have been applied to come up with the sentence.\nIn general, there may be several possible derivations, in which case we say the sentence is grammatically ambiguous.\nIn certain circles, the term \"parse\" means to arrive at an understanding of a sentence's meaning, not just its grammatical form.\nWe will attack that more difficult question later.\n\nWe start with the grammar defined on [page 39](B9780080571157500029.xhtml#p39) for the generate program:\n\n```lisp\n(defvar *grammar* \"The grammar used by GENERATE.\")\n(defparameter *grammarl*\n   '((Sentence -> (NP VP))\n     (NP -> (Art Noun))\n     (VP -> (Verb NP))\n     (Art -> the a)\n     (Noun -> man ball woman table)\n     (Verb -> hit took saw liked)))\n```\n\nOur parser takes as input a list of words and returns a structure containing the parse tree and the unparsed words, if any.\nThat way, we can parse the remaining words under the next category to get compound rules.\nFor example, in parsing \"the man saw the table,\" we would first parse \"the man,\" returning a structure representing the noun phrase, with the remaining words \"saw the table.\" This remainder would then be parsed as a verb phrase, returning no remainder, and the two phrases could then be joined to form a parse that is a complete sentence with no remainder.\n\nBefore proceeding, I want to make a change in the representation of grammar rules.\nCurrently, rules have a left-hand side and a list of alternative right-hand sides.\nBut each of these alternatives is really a separate rule, so it would be more modular to write them separately.\nFor the `generate` program it was fine to have them all together, because that made processing choices easier, but now I want a more flexible representation.\nLater on we will want to add more information to each rule, like the semantics of the assembled left-hand side, and constraints between constituents on the right-hand side, so the rules would become quite large indeed if we didn't split up the alternatives.\nI also take this opportunity to clear up the confusion between words and category symbols.\nThe convention is that a right-hand side can be either an atom, in which case it is a word, or a list of symbols, which are then all interpreted as categories.\nTo emphasize this, I include \"noun\" and \"verb\" as nouns in the grammar `*grammar3*`, which is otherwise equivalent to the previous `*grammarl*`.\n\n```lisp\n(defparameter *grammar3*\n   '((Sentence -> (NP VP))\n     (NP -> (Art Noun))\n     (VP -> (Verb NP))\n     (Art -> the) (Art -> a)\n     (Noun -> man) (Noun -> ball) (Noun -> woman) (Noun -> table)\n     (Noun -> noun) (Noun -> verb)\n     (Verb -> hit) (Verb -> took) (Verb -> saw) (Verb -> liked)))\n(setf *grammar* *grammar3*)\n```\n\nI also define the data types `rule, parse`, and `tree`, and some functions for getting at the rules.\nRules are defined as structures of type list with three slots: the left-hand side, the arrow (which should always be represented as the literal ->) and the right-hand side.\nCompare this to the treatment on [page 40](B9780080571157500029.xhtml#p40).\n\n```lisp\n(defstruct (rule (:type list)) lhs -> rhs)\n(defstruct (parse) \"A parse tree and a remainder.\" tree rem)\n;; Trees are of the form: (lhs . rhs)\n(defun new-tree (cat rhs) (cons cat rhs))\n(defun tree-lhs (tree) (first tree))\n(defun tree-rhs (tree) (rest tree))\n(defun parse-lhs (parse) (tree-lhs (parse-tree parse)))\n(defun lexical-rules (word)\n   \"Return a list of rules with word on the right-hand side.\"\n   (find-all word *grammar* :key #'rule-rhs :test #'equal))\n(defun rules-starting-with (cat)\n   \"Return a list of rules where cat starts the rhs.\"\n   (find-all cat *grammar*\n                :key #'(lambda (rule) (first-or-nil (rule-rhs rule)))))\n(defun first-or-nil (x)\n   \"The first element of x if it is a list; else nil.\"\n   (if (consp x) (first x) nil))\n```\n\nNow we're ready to define the parser.\nThe main function parser takes a list of words to parse.\nIt calls parse, which returns a list of all parses that parse some subsequence of the words, starting at the beginning.\nparser keeps only the parses with no remainder-that is, the parses that span all the words.\n\n```lisp\n(defun parser (words)\n   \"Return all complete parses of a list of words.\"\n   (mapcar #'parse-tree (compiete-parses (parse words))))\n(defun compiete-parses (parses)\n   \"Those parses that are complete (have no remainder).\"\n   (find-all-if #'null parses :key #'parse-rem))\n```\n\nThe function parse looks at the first word and considers each category it could be.\nIt makes a parse of the first word under each category, and calls extend - parse to try to continue to a complete parse.\nparse uses mapcan to append together all the resulting parses.\nAs an example, suppose we are trying to parse \"the man took the ball.\" pa rse would find the single lexical rule for \"the\" and call extend-parse with a parse with tree (Art the) and remainder \"man took the ball,\" with no more categories needed.\n\n`extend-parse` has two cases.\nIf the partial parse needs no more categories to be complete, then it returns the parse itself, along with any parses that can be formed by extending parses starting with the partial parse.\nIn our example, there is one rule starting with `Art`, namely `(NP -> (Art Noun))`, so the function would try to extend the parse tree (`NP (Art the))` with remainder \"man took the ball,\" with the category `Noun` needed.\nThat call to `extend-parse` represents the second case.\nWe first parse \"man took the ball,\" and for every parse that is of category `Noun` (there will be only one), we combine with the partial parse.\nIn this case we get `(NP (Art the) (Noun man))`.\nThis gets extended as a sentence with a VP needed, and eventually we get a parse of the complete list of words.\n\n```lisp\n(defun parse (words)\n   \"Bottom-up parse, returning all parses of any prefix of words.\"\n   (unless (null words)\n      (mapcan #'(lambda (rule)\n                         (extend-parse (rule-lhs rule) (list (first words))\n                                               (rest words) nil))\n                    (lexical-rules (first words)))))\n(defun extend-parse (lhs rhs rem needed)\n   \"Look for the categories needed to complete the parse.\"\n   (if (null needed)\n       ;; If nothing needed. return parse and upward extensions\n       (let ((parse (make-parse :tree (new-tree lhs rhs) :rem rem)))\n         (cons parse\n                   (mapcan\n                     # '(lambda (rule)\n                             (extend-parse (rule-lhs rule)\n                                                   (list (parse-tree parse))\n                                                   rem (rest (rule-rhs rule))))\n                     (rules-starting-with lhs))))\n       ;; otherwise try to extend rightward\n       (mapcan\n         #'(lambda (p)\n             (if (eq (parse-lhs p) (first needed))\n                       (extend-parse lhs (appendl rhs (parse-tree p))\n                                              (parse-rem p) (rest needed))))\n          (parse rem))))\n```\n\nThis makes use of the auxiliary function append1:\n\n```lisp\n(defun appendl (items item)\n   \"Add item to end of list of items.\"\n   (append items (list item)))\n```\n\nSome examples of the parser in action are shown here:\n\n```lisp\n> (parser '(the table))\n((NP (ART THE) (NOUN TABLE)))\n> (parser '(the ball hit the table))\n((SENTENCE (NP (ART THE) (NOUN BALL))\n              (VP (VERB HIT)\n                   (NP (ARTTHE) (NOUN TABLE)))))\n> (parser '(the noun took the verb))\n((SENTENCE (NP (ART THE) (NOUN NOUN))\n              (VP (VERB TOOK)\n                   (NP (ARTTHE) (NOUN VERB)))))\n```\n\n## 19.2 Extending the Grammar and Recognizing Ambiguity\n{:#s0015}\n{:.h1hd}\n\nOverall, the parser seems to work fine, but the range of sentences we can parse is quite limited with the current grammar.\nThe following grammar includes a wider variety of linguistic phenomena: adjectives, prepositional phrases, pronouns, and proper names.\nIt also uses the usual linguistic conventions for category names, summarized in the table below:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | Category | Examples |\n| S | Sentence | *John likes Mary* |\n| NP | Noun Phrase | *John; a blue table* |\n| VP | Verb Phrase | *likes Mary; hit the ball* |\n| PP | Prepositional Phrase | *to Mary; with the man* |\n| A | Adjective | *little; blue* |\n| A + | A list of one or more adjectives | *little blue* |\n| D | Determiner | *the; a* |\n| N | Noun | *ball; table* |\n| Name | Proper Name | *John; Mary* |\n| P | Preposition | *to; with* |\n| Pro | Pronoun | *you; me* |\n| V | Verb | *liked; hit* |\n\nHere is the grammar:\n\n```lisp\n(defparameter *grammar4*\n   '((S -> (NP VP))\n     (NP -> (D N))\n     (NP -> (D A + N))\n     (NP -> (NP PP))\n     (NP -> (Pro))\n     (NP -> (Name))\n     (VP -> (V NP))\n     (VP -> (V))\n     (VP -> (VP PP))\n     (PP -> (P NP))\n     (A + -> (A))\n     (A + -> (A A +))\n     (Pro -> I) (Pro -> you) (Pro -> he) (Pro -> she)\n     (Pro -> it) (Pro -> me) (Pro -> him) (Pro -> her)\n     (Name -> John) (Name -> Mary)\n     (A -> big) (A -> little) (A -> old) (A -> young)\n     (A -> blue) (A -> green) (A -> orange) (A -> perspicuous)\n     (D -> the) (D -> a) (D -> an)\n     (N -> man) (N -> ball) (N -> woman) (N -> table) (N -> orange)\n     (N -> saw) (N -> saws) (N -> noun) (N -> verb)\n     (P -> with) (P -> for) (P -> at) (P -> on) (P -> by) (P -> of) (P -> in)\n     (V -> hit) (V -> took) (V -> saw) (V -> liked) (V -> saws)))\n(setf *grammar* *grammar4*)\n```\n\nNow we can parse more interesting sentences, and we can see a phenomenon that was not present in the previous examples: ambiguous sentences.\nThe sentence \"The man hit the table with the ball\" has two parses, one where the ball is the thing that hits the table, and the other where the ball is on or near the table, parser finds both of these parses (although of course it assigns no meaning to either parse):\n\n```lisp\n> (parser '(The man hit the table with the ball))\n((S (NP (D THE) (N MAN))\n   (VP (VP (V HIT) (NP (D THE) (N TABLE)))\n     (PP (P WITH) (NP (DTHE) (N BALL)))))\n(S (NP (D THE) (N MAN))\n   (VP (V HIT)\n     (NP (NP (D THE) (N TABLE))\n            (PP (P WITH) (NP (DTHE) (N BALL)))))))\n```\n\nSentences are not the only category that can be ambiguous, and not all ambiguities have to be between parses in the same category.\nHere we see a phrase that is ambiguous between a sentence and a noun phrase:\n\n```lisp\n> (parser '(the orange saw))\n((S (NP (D THE) (N ORANGE)) (VP (V SAW)))\n (NP (D THE) (A + (A ORANGE)) (N SAW)))\n```\n\n## 19.3 More Efficient Parsing\n{:#s0020}\n{:.h1hd}\n\nWith more complex grammars and longer sentences, the parser starts to slow down.\nThe main problem is that it keeps repeating work.\nFor example, in parsing \"The man hit the table with the ball,\" it has to reparse \"with the ball\" for both of the resulting parses, even though in both cases it receives the same analysis, a PP.\nWe have seen this problem before and have already produced an answer: memoization (see [section 9.6](#s0035)).\nTo see how much memoization will help, we need a benchmark:\n\n```lisp\n> (setf s (generate 's))\n(THE PERSPICUOUS BIG GREEN BALL BY A BLUE WOMAN WITH A BIG MAN\n  HIT A TABLE BY THE SAW BY THE GREEN ORANGE)\n> (time (length (parser s)))\nEvaluation of (LENGTH (PARSER S)) took 33.11 Seconds of elapsed time.\n10\n```\n\nThe sentence S has 10 parses, since there are two ways to parse the subject NP and five ways to parse the VP.\nIt took 33 seconds to discover these 10 parses with the parse function as it was written.\n\nWe can improve this dramatically by memoizing parse (along with the table- lookup functions).\nBesides memoizing, the only change is to clear the memoization table within parser.\n\n```lisp\n(memoize 'lexical-rules)\n(memoize 'rules-starting-with)\n(memoize 'parse :test #'eq)\n(defun parser (words)\n   \"Return all complete parses of a list of words.\"\n   (clear-memoize 'parse) ;***\n   (mapcar #'parse-tree (complete-parses (parse words))))\n```\n\nIn normal human language use, memoization would not work very well, since the interpretation of a phrase depends on the context in which the phrase was uttered.\nBut with context-f ree grammars we have a guarantee that the context cannot af f ect the interpretation.\nThe call `(parse words)` must return all possible parses for the words.\nWe are free to choose between the possibilities based on contextual information, but context can never supply a new interpretation that is not in the context-free list of parses.\n\nThe function use is introduced to tell the table-lookup functions that they are out of date whenever the grammar changes:\n\n```lisp\n(defun use (grammar)\n   \"Switch to a new grammar.\"\n   (clear-memoize !!!(char) ߣrules-starting-with)\n   (clear-memoize !!!(char) ߣlexical-rules)\n   (length (setf *grammar* grammar)))\n```\n\nNow we run the benchmark again with the memoized version of pa rse:\n\n```lisp\n> (time (length (parser s)))\nEvaluation of (LENGTH (PARSER S 's)) took .13 Seconds of elapsed time.\n10\n```\n\nBy memoizing p a r s e we reduce the parse time f rom 33 to.\n13 seconds, a 250-f old speed- up.\nWe can get a more systematic comparison by looking at a range of examples.\nFor example, consider sentences of the form \"The man hit the table [with the ball]*\" for zero or more repetitions of the PP \"with the ball.\" In the following table we record N, the number of repetitions of the PP, along with the number of resulting parses,[2](#fn0020) and for both memoized and unmemoized versions of parse, the number of seconds to produce the parse, the number of parses per second (PPS), and the number of recursive calls to `parse`.\nThe performance of the memoized version is quite acceptable; for N=5, a 20-word sentence is parsed into 132 possibilities in .68 seconds, as opposed to the 20 seconds it takes in the unmemoized version.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | Memoized | Unmemoized |\n| N | Parses | Secs | PPS | Calls | Secs | PPS | Calls |\n| 0 | 1 | 0.02 | 60 | 4 | 0.02 | 60 | 17 |\n| 1 | 2 | 0.02 | 120 | 11 | 0.07 | 30 | 96 |\n| 2 | 5 | 0.05 | 100 | 21 | 0.23 | 21 | 381 |\n| 3 | 14 | 0.10 | 140 | 34 | 0.85 | 16 | 1388 |\n| 4 | 42 | 0.23 | 180 | 50 | 3.17 | 13 | 4999 |\n| 5 | 132 | 0.68 | 193 | 69 | 20.77 | 6 | 18174 |\n| 6 | 429 | 1.92 | 224 | 91 | - | | |\n| 7 | 1430 | 5.80 | 247 | 116 | - | | |\n| 8 | 4862 | 20.47 | 238 | 144 | - | | |\n\n![t0015](images/B9780080571157500194/t0015.png)\n\n**Exercise 19.1 [h]** It seems that we could be more efficient still by memoizing with a table consisting of a vector whose length is the number of words in the input (plus one).\nImplement this approach and see if it entails less overhead than the more general hash table approach.\n\n## 19.4 The Unknown-Word Problem\n{:#s0025}\n{:.h1hd}\n\nAs it stands, the parser cannot deal with unknown words.\nAny sentence containing a word that is not in the grammar will be rejected, even if the program can parse all the rest of the words perfectly.\nOne way of treating unknown words is to allow them to be any of the \"open-class\" categories-nouns, verbs, adjectives, and names, in our grammar.\nAn unknown word will not be considered as one of the \"closed-class\" categories-prepositions, determiners, or pronouns.\nThis can be programmed very simply by having `lexical-rules` return a list of these open-class rules for every word that is not already known.\n\n```lisp\n(defparameter *open-categories* '(N V A Name)\n   \"Categories to consider for unknown words\")\n(defun lexical-rules (word)\n   \"Return a list of rules with word on the right-hand side.\"\n   (or (find-all word *grammar* :key #'rule-rhs :test #'equal)\n         (mapcar #'(lambda (cat) '(,cat -> ,word)) *open-categories*)))\n```\n\nWith memoization of lexical - rules, this means that the lexicon is expanded every time an unknown word is encountered.\nLet's try this out:\n\n```lisp\n> (parser '(John liked Mary))\n((S (NP (NAME JOHN))\n      (VP (V LIKED) (NP (NAME MARY)))))\n> (parser '(Dana liked Dale))\n((S (NP (NAME DANA))\n      (VP (V LIKED) (NP (NAME DALE)))))\n> (parser '(the rab zaggled the woogly quax))\n((S (NP (D THE) (N RAB))\n      (VP (V ZAGGLED) (NP (D THE) (A + (A WOOGLY)) (N QUAX)))))\n```\n\nWe see the parser works as well with words it knows (John and Mary) as with new words (Dana and Dale), which it can recognize as names because of their position in the sentence.\nIn the last sentence in the example, it recognizes each unknown word unambiguously.\nThings are not always so straightforward, unfortunately, as the following examples show:\n\n```lisp\n> (parser '(the slithy toves gymbled))\n((S (NP (D THE) (N SLITHY)) (VP (V TOVES) (NP (NAME GYMBLED))))\n (S (NP (D THE) (A + (A SLITHY)) (N TOVES)) (VP (V GYMBLED)))\n (NP (D THE) (A + (A SLITHY) (A + (A TOVES))) (N GYMBLED)))\n> (parser '(the slithy toves gymbled on the wabe))\n((S (NP (D THE) (N SLITHY))\n   (VP (VP (V TOVES) (NP (NAME GYMBLED)))\n      PP (P ON) (NP (D THE) (N WABE)))))\n(S (NP (D THE) (N SLITHY))\n   (VP (V TOVES) (NP (NP (NAME GYMBLED))\n      (PP (P ON) (NP (D THE) (N WABE))))))\n(S (NP (D THE) (A + (A SLITHY)) (N TOVES))\n    (VP (VP (V GYMBLED)) (PP (P ON) (NP (D THE) (N WABE)))))\n(NP (NP (D THE) (A + (A SLITHY) (A + (A TOVES))) (N GYMBLED))\n    (PP (P ON) (NP (D THE) (N WABE)))))\n```\n\nIf the program knew morphology-that a *y* at the end of a word often signais an adjective, an *s* a plural noun, and an *ed* a past-tense verb-then it could do much better.\n\n## 19.5 Parsing into a Semantic Representation\n{:#s0030}\n{:.h1hd}\n\nSyntactic parse trees of a sentence may be interesting, but by themselves they're not very useful.\nWe use sentences to communicate ideas, not to display grammatical structures.\nTo explore the idea of the semantics, or meaning, of a phrase, we need a domain to talk about.\nImagine the scenario of a compact dise player capable of playing back selected songs based on their track number.\nImagine further that this machine has buttons on the front panel indicating numbers, as well as words such as \"play,\" \"to,\" \"and,\" and \"without.\" If you then punch in the sequence of buttons \"play 1 to 5 without 3,\" you could reasonably expect the machine to respond by playing tracks 1,2,4, and 5.\nAfter a few such successful interactions, you might say that the machine \"understands\" a limited language.\nThe important point is that the utility of this machine would not be enhanced much if it happened to display a parse tree of the input.\nOn the other hand, you would be justifiably annoyed if it responded to \"play 1 to 5 without 3\" by playing 3 or skipping 4.\n\nNow let's stretch the imagination one more time by assuming that this CD player cornes equipped with a full Common Lisp compiler, and that we are now in charge of writing the parser for its input language.\nLet's first consider the relevant data structures.\nWe need to add a component for the semantics to both the rule and tree structures.\nOnce we've done that, it is clear that trees are nothing more than instances of rules, so their definitions should reflect that.\nThus, I use an : incl ude defstruct to define trees, and I specify no copier function, because copy-tree is already a Common Lisp function, and I don't want to redefine it.\nTo maintain consistency with the old new-tree function (and to avoid having to put in all those keywords) I define the constructor new-tree.\nThis option to `defstruct makes (new-tree a b c)` equivalent to `(make-tree :lhs a :sem b :rhs c)`.\n\n```lisp\n(defstruct (rule (:type list))\n   lhs -> rhs sem)\n(defstruct (tree (:type list) (:include rule) (:copiernil)\n                 (:constructor new-tree (lhs sem rhs))))\n```\n\nWe will adopt the convention that the semantics of a word can be any Lisp object.\nFor example, the semantics of the word \"1\" could be the object 1, and the semantics of \"without\" could be the function set-di fference.\nThe semantics of a tree is formed by taking the semantics of the rule that generated the tree and applying it (as a function) to the semantics of the constituents of the tree.\nThus, the grammar writer must insure that the semantic component of rules are functions that expect the right number of arguments.\nFor example, given the rule\n\n```lisp\n   (NP -> (NP CONJ NP) infix-funcall)\n```\n\nthen the semantics of the phrase \"1 to 5 without 3\" could be determined by first determining the semantics of\"1 to 5\" tobe(l 2 3 4 5),of\"without\"tobe set-`difference`, and of \"3\" to be (3).\nAfter these sub-constituents are determined, the rule is applied by calling the function `infix-funcall` with the three arguments (1 2 3 4 5), `set-difference`, and (3).\nAssuming that `infix-funcall` is defined to apply its second argument to the other two arguments, the resuit will be (1 2 4 5).\n\nThis may make more sense if we look at a complete grammar for the CD player problem:\n\n```lisp\n(use\n   '((NP -> (NP CONJ NP)    infix-funcall)\n    (NP -> (N)              list)\n    (NP -> (N P N)          infix-funcall)\n    (N -> (DIGIT)           identity)\n    (P -> to                integers)\n    (CONJ -> and            union)\n    (CONJ -> without        set-difference)\n    (N -> 1 1) (N -> 2 2) (N -> 3 3) (N -> 4 4) (N -> 5 5)\n    (N -> 6 6) (N -> 7 7) (N -> 8 8) (N -> 9 9) (N -> 0 0)))\n(defun integers (start end)\n   \"A list of all the integers in the range [start...end] inclusive.\"\n   (if (> start end) nil\n       (cons start (integers (+ start 1) end))))\n(defun infix-funcal1 (argl function arg2)\n   \"Apply the function to the two arguments\"\n   (funcall function argl arg2))\n```\n\nConsider the first three grammar rules, which are the only nonlexical rules.\nThe first says that when two NPs are joined by a conjunction, we assume the translation of the conjunction will be a function, and the translation of the phrase as a whole is derived by calling that function with the translations of the two NPs as arguments.\nThe second rule says that a single noun (whose translation should be a number) translates into the singleton list consisting of that number.\nThe third rule is similar to the first, but concerns joining Ns rather than NPs.\nThe overall intent is that the translation of an NP will always be a list of integers, representing the songs to play.\n\nAs for the lexical rules, the conjunction \"and\" translates to the union function, \"without\" translates to the function that subtracts one set from another, and \"to\" translates to the function that generates a list of integers between two end points.\nThe numbers \"0\" to \"9\" translate to themselves.\nNote that both lexical rules like \"`CONJ ->` and\" and nonlexical rules like \"`NP -> (N P N)`\" can have functions as their semantic translations; in the first case, the function will just be returned as the semantic translation, whereas in the second case the function will be applied to the list of constituents.\n\nOnly minor changes are needed to pa rse to support this kind of semantic processing.\nAs we see in the following, we add a sem argument to extend - parse and arrange to pass the semantic components around properly.\nWhen we have gathered all the right-hand-side components, we actually do the function application.\nAll changes are marked with ***.\nWe adopt the convention that the semantic value `nil` indicates failure, and we discard all such parses.\n\n```lisp\n(defun parse (words)\n   \"Bottom-up parse, returning all parses of any prefix of words.\n   This version has semantics.\"\n   (unless (null words)\n      (mapcan #'(lambda (rule)\n                  (extend-parse (rule-lhs rule) (rule-sem rule) ;***\n                                (list (first words)) (rest words) nil))\n              (lexical-rules (first words)))))\n(defun extend-parse (lhs sem rhs rem needed) ;***\n   \"Look for the categories needed to complete the parse.\n   This version has semantics.\"\n   (if (null needed)\n       ;; If nothing is needed, return this parse and upward extensions.\n       ;; unless the semantics fails\n       (let ((parse (make-parse :tree (new-tree lhs sem rhs) :rem rem)))\n         (unless (null (apply-semantics (parse-tree parse))) ;***\n           (cons parse\n                 (mapcan\n                    #'(lambda (rule)\n                         (extend-parse (rule-lhs rule) (rule-semrule) ;***\n                                       (list (parse-tree parse)) rem\n                                       (rest (rule-rhs rule))))\n                          (rules-starting-with lhs)))))\n       ;; otherwise try to extend rightward\n       (mapcan\n         #'(lambda (p)\n             (if (eq (parse-lhs p) (first needed))\n                 (extend-parse lhs sem (appendl rhs (parse-tree p)) ;***\n                              (parse-rem p) (rest needed))))\n         (parse rem))))\n```\n\nWe need to add some new functions to support this:\n\n```lisp\n(defun apply-semantics (tree)\n   \"For terminal nodes, just fetch the semantics.\n   Otherwise, apply the sem function to its constituents.\"\n   (if (terminal-tree-p tree)\n       (tree-sem tree)\n       (setf (tree-sem tree)\n              (apply (tree-sem tree)\n                    (mapcar #'tree-sem (tree-rhs tree))))))\n(defun terminal-tree-p (tree)\n   \"Does this tree have a single word on the rhs?\"\n   (and (length=l (tree-rhs tree))\n           (atom (first (tree-rhs tree)))))\n(defun meanings (words)\n   \"Return all possible meanings of a phrase. Throw away the syntactic part.\"\n   (remove-duplicates (mapcar #'tree-sem (parser words)) :test #'equal))\n```\n\nHere are some examples of the meanings that the parser can extract:\n\n(meanings '(1 to 5 without 3))\n\n((1 2 4 5))\n\n(meanings '(1 to 4 and 7 to 9))\n\n((1 2 3 4 7 8 9))\n\n(meanings '(1 to 6 without 3 and 4))\n\n((12 4 5 6)\n\n(1 2 5 6))\n\nThe example \"(1 to 6 without 3 and 4)\" is ambiguous.\nThe first reading corresponds to \"((1 to 6) without 3) and 4,\" while the second corresponds to \"(1 to 6) without (3 and 4).\" The syntactic ambiguity leads to a semantic ambiguity-the two meanings have different lists of numbers in them.\nHowever, it seems that the second reading is somehow better, in that it doesn't make a lot of sense to talk of adding 4 to a set that already includes it, which is what the first translation does.\n\nWe can upgrade the lexicon to account for this.\nThe following lexicon insists that \"and\" conjoins disjoint sets and that \"without\" removes only elements that were already in the first argument.\nIf these conditions do not hold, then the translation will return nil, and the parse will fail.\nNote that this also means that an empty list, such as \"3 to 2,\" will also fail.\n\nThe previous grammar only allowed for the numbers 0 to 9.\nWe can allow larger numbers by stringing together digits.\nSo now we have two rules for numbers: a number is either a single digit, in which case the value is the digit itself (the i denti ty function), or it is a number followed by another digit, in which case the value is 10 times the number plus the digit.\nWe could alternately have specified a number to be a digit followed by a number, or even a number followed by a number, but either of those formulations would require a more complex semantic interpretation.\n\n```lisp\n(use\n   '((NP -> (NP CONJ NP)   infix-funcall)\n   (NP -> (N)              list)\n   (NP -> (N P N)          infix-funcall)\n   (N -> (DIGIT)           identity)\n   (N -> (N DIGIT)         10*N+D)\n   (P -> to                integers)\n   (CONJ -> and            union*)\n   (CONJ -> without        set-diff)\n   (DIGIT -> 1 1) (DIGIT -> 2 2)   (DIGIT -> 3 3)\n   (DIGIT -> 4 4) (DIGIT -> 5 5)   (DIGIT -> 6 6)\n   (DIGIT -> 7 7) (DIGIT -> 8 8)   (DIGIT -> 9 9)\n   (DIGIT -> 0 0)))\n(defun union* (x y) (if (null (intersection x y)) (append x y)))\n(defun set-diff (x y) (if (subsetp y x) (set-difference x y)))\n(defun 10*N+D (N D) (+ (* 10 N) D))\n```\n\nWith this new grammar, we can get single interpretations out of most reasonable inputs:\n\n```lisp\n> (meanings '(1 to 6 without 3 and 4))\n((1 2 5 6))\n> (meanings '(1 and 3 to 7 and 9 without 5 and 6))\n((13 4 7 9))\n> (meanings '(1 and 3 to 7 and 9 without 5 and 2))\n((1 3 4 6 7 9 2))\n> (meanings '(1 9 8 to 2 0 1))\n((198 199 200 201))\n> (meanings '(1 2 3))\n(123 (123))\n```\n\nThe example \"1 2 3\" shows an ambiguity between the number 123 and the list (123), but all the others are unambiguous.\n\n## 19.6 Parsing with Preferences\n{:#s0035}\n{:.h1hd}\n\nOne reason we have unambiguous interpretations is that we have a very limited domain of interpretation: we are dealing with sets of numbers, not lists.\nThis is perhaps typical of the requests faced by a CD player, but it does not account for all desired input.\nFor example, if you had a favorite song, you couldn't hear it three times with the request \"1 and 1 and 1\" under this grammar.\nWe need some compromise between the permissive grammar, which generated all possible parses, and the restrictive grammar, which eliminates too many parses.\nTo get the \"best\" interpretation out of an arbitrary input, we will not only need a new grammar, we will also need to modify the program to compare the relative worth of candidate interpretations.\nIn other words, we will assign each interpretation a numeric score, and then pick the interpretation with the highest score.\n\nWe start by once again modifying the rule and tree data types to include a score component.\nAs with the sem component, this will be used to hold first a function to compute a score and then eventually the score itself.\n\n```lisp\n(defstruct (rule (:type list)\n                 (:constructor\n                 rule (lhs -> rhs &optional sem score)))\n    lhs -> rhs sem score)\n(defstruct (tree (:type list) (:include rule) (:copiernil)\n                 (:constructor new-tree (lhs sem score rhs))))\n```\n\nNote that we have added the constructor function rul e.\nThe intent is that the sem and score component of grammar rules should be optional.\nThe user does not have to supply them, but the function use will make sure that the function rul e is called to fill in the missing sem and score values with nil.\n\n```lisp\n(defun use (grammar)\n    \"Switch to a new grammar.\"\n    (clear-memoize 'rules-starting-with)\n    (clear-memoize 'lexical-rules)\n    (length (setf *grammar*\n                  (mapcar #'(lambda (r) (apply #'rule r))\n                          grammar))))\n```\n\nNow we modify the parser to keep track of the score.\nThe changes are again minor, and mirror the changes needed to add semantics.\nThere are two places where we put the score into trees as we create them, and one place where we apply the scoring function to its arguments.\n\n```lisp\n(defun parse (words)\n    \"Bottom-up parse, returning all parses of any prefix of words.\n    This version has semantics and preference scores.\"\n    (unless (null words)\n      (mapcan #'(lambda (rule)\n                  (extend-parse\n                     (rule-lhs rule) (rule-sem rule)\n                     (rule-score rule) (list (first words)) ;***\n                     (rest words) nil))\n              (lexical-rules (first words)))))\n(defun extend-parse (lhs sem score rhs rem needed) ;***\n    \"Look for the categories needed to complete the parse.\n    This version has semantics and preference scores.\"\n    (if (null needed)\n          ;; If nothing is needed, return this parse and upward extensions,\n          ;; unless the semantics fails\n          (let ((parse (make-parse :tree (new-tree lhs sem score rhs) ;***\n                                   :rem rem)))\n             (unless (null (apply-semantics (parse-tree parse)))\n    (apply-scorer (parse-tree parse)) ;***\n    (cons parse\n          (mapcan\n            #'(lambda (rule)\n                (extend-parse\n                  (rule-lhs rule) (rule-sem rule)\n                  (rule-score rule) (list (parse-tree parse)) ;***\n                  rem (rest (rule-rhs rule))))\n              (rules-starting-with lhs)))))\n    ;; otherwise try to extend rightward\n    (mapcan\n      #'(lambda (p)\n          (if (eq (parse-lhs p) (first needed))\n              (extend-parse lhs sem score\n                            (appendl rhs (parse-tree p)) ;***\n                            (parse-rem p) (rest needed))))\n           (parse rem))))\n```\n\nAgain we need some new functions to support this.\nMost important is appl y - scorer, which computes the score for a tree.\nIf the tree is a terminal (a word), then the function just looks up the score associated with that word.\nIn this grammar all words have a score of 0, but in a grammar with ambiguous words it would be a good idea to give lower scores for infrequently used senses of ambiguous words.\nIf the tree is a nonterminal, then the score is computed in two steps.\nFirst, all the scores of the constituents of the tree are added up.\nThen, this is added to a measure for the tree as a whole.\nThe rule associated with each tree will have either a number attached to it, which is added to the sum, or a function.\nIn the latter case, the function is applied to the tree, and the resuit is added to obtain the final score.\nAs a final special case, if the function returns nil, then we assume it meant to return zero.\nThis will simplify the definition of some of the scoring functions.\n\n```lisp\n(defun apply-scorer (tree)\n    \"Compute the score for this tree.\"\n    (let ((score (or (tree-score tree) 0)))\n       (setf (tree-score tree)\n              (if (terminal-tree-p tree)\n                   score\n                   ;; Add up the constituent's scores,\n                   ;; along with the tree's score\n                   (+ (sum (tree-rhs tree) #'tree-score-or-0)\n                       (if (numberp score)\n                           score\n                           (or (apply score (tree-rhs tree)) 0)))))))\n```\n\nHere is an accessor function to pick out the score from a tree:\n\n```lisp\n(defun tree-score-or-0 (tree)\n    (if (numberp (tree-score tree))\n        (tree-score tree)\n        0))\n```\n\nHere is the updated grammar.\nFirst, I couldn't resist the chance to add more features to the grammar.\nI added the postnominal adjectives \"shuffled,\" which randomly permutes the list of songs, and \"reversed,\" which reverses the order of play.\nI also added the operator \"repeat,\" as in \"1 to 3 repeat 5,\" which repeats a list a certain number of times.\nI also added brackets to allow input that says explicitly how it should be parsed.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(use` |\n| `    '((NP` | `->` | `(NP CONJ NP)` | `infix-funcal1` | `infix-scorer)` |\n| `    (NP` | `->` | `(N P N)` | `infix-funcal1` | `infix-scorer)` |\n| `    (NP` | `->` | `(N)` | `list)` | |\n| `    (NP` | `->` | `([ NP ])` | `arg2)` | |\n| `    (NP` | `->` | `(NP ADJ)` | `rev-funcall` | `rev-scorer)` |\n| `    (NP` | `->` | `(NP OP N)` | `infix-funcall)` | |\n| `    (N` | `->` | `(D)` | `identity)` | |\n| `    (N` | `->` | `(N D)` | `10*N+D)` | |\n| `    (P` | `->` | `to` | `integers` | `prefer <)` |\n| `    ([` | `->` | `[` | `[)` | |\n| `    (]` | `->` | `]` | `])` | |\n| `    (OP` | `->` | `repeat` | `repeat)` | |\n| `    (CONJ` | `-> and` | `append` | `prefer-disjoint)` |\n| `    (CONJ` | `-> without` | `set-difference` | `prefer-subset)` |\n| `    (ADJ` | | `-> reversed` | `reverse` | `inv-span)` |\n| `    (ADJ` | | `-> shuffled` | `permute` | `prefer-not-singleton)` |\n| `    (D -> 1 1) (D -> 2 2) (D -> 3 3) (D -> 4 4) (D -> 5 5)` |\n| `    (D -> 6 6) (D -> 7 7) (D -> 8 8) (D -> 9 9) (D -> 0 0)))` |\n\n![t0020](images/B9780080571157500194/t0020.png)\n\nThe following scoring functions take trees as inputs and compute bonuses or penalties for those trees.\nThe scoring function `prefer <`, used for the word \"to,\" gives a one-point penalty for reversed ranges: \"5 to 1\" gets a score of -1, while \"1 to 5\" gets a score of 0.\nThe scorer for \"and,\" `prefer-disjoint`, gives a one-point penalty for intersecting lists: \"1 to 3 and 7 to 9\" gets a score of 0, while \"1 to 4 and 2 to 5\" gets -1.\nThe \"x without y\" scorer, `prefer-subset`, gives a three-point penalty when the y list has elements that aren't in the x list.\nIt also awards points in inverse proportion to the length (in words) of the x phrase.\nThe idea is that we should prefer to bind \"without\" tightly to some small expression on the left.\nIf the final scores corne out as positive or as nonintegers, then this scoring component is responsible, since all the other components are negative intgers.\nThe \"x shuffled\" scorer, `prefer-not-singleton`, is similar, except that there the penalty is for shuffling a list of less than two songs.\n\n```lisp\n(defun prefer < (x y)\n   (if (>= (sem x) (sem y)) -1))\n(defun prefer-disjoint (x y)\n   (if (intersection (sem x) (sem y)) -1))\n(defun prefer-subset (x y)\n   (+ (inv-span x) (if (subsetp (sem y) (sem x)) 0 -3)))\n(defun prefer-not-singleton (x)\n   (+ (inv-span x) (if (< (length (sem x)) 2) -4 0)))\n```\n\nThe `infix-scorer` and `rev-scorer` functionsdon'taddanythingnew, they justassure that the previously mentioned scoring functions will get applied in the right place.\n\n```lisp\n(defun infix-scorer (argl scorer arg2)\n   (funcall (tree-score scorer) argl arg2))\n(defun rev-scorer (arg scorer) (funcall (tree-score scorer) arg))\n```\n\nHere are the functions mentioned in the grammar, along with some useful utilities:\n\n```lisp\n(defun arg2 (al a2 &rest a-n) (declare (ignore al a-n)) a2)\n(defun rev-funcall (arg function) (funcall function arg))\n(defun repeat (list n)\n   \"Append list n times.\"\n   (if (= n 0)\n        nil\n        (append list (repeat list (- n 1)))))\n(defun span-length (tree)\n   \"How many words are in tree?\"\n   (if (terminal-tree-p tree) 1\n        (sum (tree-rhs tree) #'span-length)))\n(defun inv-span (tree) (/ 1 (span-length tree)))\n(defun sem (tree) (tree-sem tree))\n(defun integers (start end)\n   \"A list of all the integers in the range [start...end] inclusive.\n   This version allows start > end.\"\n   (cond ((< start end) (cons start (integers (+ start 1) end)))\n         ((> start end) (cons start (integers (- start 1) end)))\n         (t (list start))))\n(defun sum (numbers &optional fn)\n   \"Sum the numbers, or sum (mapcar fn numbers).\"\n   (if fn\n       (loop for x in numbers sum (funcall fn x))\n       (loop for x in numbers sum x)))\n(defun permute (bag)\n   \"Return a random permutation of the given input list.\"\n   (if (null bag)\n        nil\n        (let ((e (random-elt bag)))\n          (cons e (permute (remove e bag :count 1 :test #'eq))))))\n```\n\nWe will need a way to show off the preference rankings:\n\n```lisp\n(defun all-parses (words)\n   (format t \"~%Score Semantics~25T~a\" words)\n   (format t \"~%======= ========== ~ 25T =============== ~% \")\n   (loop for tree in (sort (parser words) #'> :key #'tree-score)\n     do (format t \"~5.1f ~ 9a~25T~a~%\" (tree-score tree) (tree-sem tree)\n                    (bracketing tree)))\n   (values))\n(defun bracketing (tree)\n   \"Extract the terminais, bracketed with parens.\"\n   (cond ((atom tree) tree)\n         ((length=l (tree-rhs tree))\n          (bracketing (first (tree-rhs tree))))\n         (t (mapcar #'bracketing (tree-rhs tree)))))\n```\n\nNow we can try some examples:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (all-parses '(1 to 6 without 3 and 4))` |\n| `Score` | `Semantics` | `(1 TO 6 WITHOUT 3 AND 4)` |\n| `=======` | `===========` | `========================` |\n| `0.3` | `(12 5 6)` | `((1 TO 6) WITHOUT (3 AND 4))` |\n| `-0.7` | `(12 4 5 6 4)` | `(((1 TO 6) WITHOUT 3) AND 4)` |\n| `> (all-parses '(1 and 3 to 7 and 9 without 5 and 6))` |\n| `Score` | `Semantics` | `(1 AND 3 T0 7 AND 9 WITHOUT 5 AND 6)` |\n| `=======` | `===========` | `=================================` |\n| `0.2` | `(1 3 4 7 9)` | `(1 AND (((3 T0 7) AND 9) WITHOUT (5 AND 6)))` |\n| `0.1` | `(1 3 4 7 9)` | `(((1 AND (3 T0 7)) AND 9) WITHOUT (5 AND 6))` |\n| `0.1` | `(1 3 4 7 9)` | `((1 AND ((3 T0 7) AND 9)) WITHOUT (5 AND 6))` |\n| `-0.8` | `(1 3 4 6 7 9 6)` | `((1 AND (((3 T0 7) AND 9) WITHOUT 5)) AND 6)` |\n| `-0.8` | `(1 3 4 6 7 9 6)` | `(1 AND ((((3 T0 7) AND 9) WITHOUT 5) AND 6))` |\n| `-0.9` | `(1 3 4 6 7 9 6)` | `((((1 AND (3 T0 7)) AND 9) WITHOUT 5) AND 6)` |\n| `-0.9` | `(1 3 4 6 7 9 6)` | `(((1 AND ((3 T0 7) AND 9)) WITHOUT 5) AND 6)` |\n| `-2.0` | `(1 3 4 5 6 7 9)` | `((1 AND (3 TO 7)) AND (9 WITHOUT (5 AND 6)))` |\n| `-2.0` | `(1 3 4 5 6 7 9)` | `(1 AND ((3 TO 7) AND (9 WITHOUT (5 AND 6))))` |\n| `-3.0` | `(1 3 4 5 6 7 9 6)` | `(((1 AND (3 TO 7)) AND (9 WITHOUT 5)) AND 6)` |\n| `-3.0` | `(1 3 4 5 6 7 9 6)` | `((1 AND (3 TO 7)) AND ((9 WITHOUT 5) AND 6))` |\n| `-3.0` | `(1 3 4 5 6 7 9 6)` | `((1 AND ((3 TO 7) AND (9 WITHOUT 5))) AND 6)` |\n| `-3.0` | `(1 3 4 5 6 7 9 6)` | `(1 AND (((3 T0 7) AND (9 WITHOUT 5)) AND 6))` |\n| `-3.0` | `(1 3 4 5 6 7 9 6)` | `(1 AND ((3 T0 7) AND ((9 WITHOUT 5) AND 6)))` |\n| `> (all -parses '(1 and 3 to 7 and 9 without 5 and 2))` |\n| `Score` | `Semantics` | `(1 AND 3 T0 7 AND 9 WITHOUT 5 AND 2)` |\n| `======` | `================` | `===================================` |\n| `0.2` | `(1 3 4 6 7 9 2)` | `((1 AND (((3 T0 7) AND 9) WITHOUT 5)) AND 2)` |\n| `0.2` | `(1 3 4 6 7 9 2)` | `(1 AND ((((3 T0 7) AND 9) WITHOUT 5) AND 2))` |\n| `0.1` | `(1 3 4 6 7 9 2)` | `((((1 AND (3 T0 7)) AND 9) WITHOUT 5) AND 2)` |\n| `0.1` | `(1 3 4 6 7 9 2)` | `(((1 AND ((3 T0 7) AND 9)) WITHOUT 5) AND 2)` |\n| `-2.0` | `(1 3 4 5 6 7 9 2)` | `(((1 AND (3 T0 7)) AND (9 WITHOUT 5)) AND 2)` |\n| `-2.0` | `(1 3 4 5 6 7 9 2)` | `((1 AND (3 T0 7)) AND ((9 WITHOUT 5) AND 2))` |\n| `-2.0` | `(1 3 4 5 6 7 9)` | `((1 AND (3 T0 7)) AND (9 WITHOUT (5 AND 2)))` |\n| `-2.0` | `(1 3 4 5 6 7 9 2)` | `((1 AND ((3 T0 7) AND (9 WITHOUT 5))) AND 2)` |\n| `-2.0` | `(1 3 4 5 6 7 9 2)` | `(1 AND (((3 T0 7) AND (9 WITHOUT 5)) AND 2))` |\n| `-2.0` | `(1 3 4 5 6 7 9 2)` | `(1 AND ((3 T0 7) AND ((9 WITHOUT 5) AND 2)))` |\n| `-2.0` | `(1 3 4 5 6 7 9)` | `(1 AND ((3 T0 7) AND (9 WITHOUT (5 AND 2))))` |\n| `-2.8` | `(1 3 4 6 7 9)` | `(1 AND (((3 T0 7) AND 9) WITHOUT (5 AND 2)))` |\n| `-2.9` | `(1 3 4 6 7 9)` | `(((1 AND (3 T0 7)) AND 9) WITHOUT (5 AND 2))` |\n| `-2.9` | `(1 3 4 6 7 9)` | `((1 AND ((3 T0 7) AND 9)) WITHOUT (5 AND 2))` |\n\n![t0025](images/B9780080571157500194/t0025.png)\n\nIn each case, the preference rules are able to assign higher scores to more reasonable interpretations.\nIt turns out that, in each case, all the interpretations with positive scores represent the same set of numbers, while interpretations with negative scores seem worse.\nSeeing all the scores in gory detail may be of academic interest, but what we really want is something to pick out the best interpretation.\nThe following code is appropriate for many situations.\nIt picks the top scorer, if there is a unique one, or queries the user if several interpretations tie for the best score, and it complains if there are no valid parses at all.\nThe query-user function may be useful in many applications, but note that meani ng uses it only as a default; a program that had some automatic way of deciding could supply another `tie-breaker` function to meani ng.\n\n```lisp\n(defun meaning (words &optional (tie-breaker #'query-user))\n    \"Choose the single top-ranking meaning for the words.\"\n    (let* ((trees (sort (parser words) #'> :key #'tree-score))\n           (best-score (if trees (tree-score (first trees)) 0))\n           (best-trees (delete best-score trees\n                               :key #'tree-score :test-not #'eql))\n           (best-sems (delete-duplicates (mapcar #'tree-sem best-trees)\n                                         :test #'equal)))\n(case (length best-sems)\n    (0 (format t \"~&Sorry. I didn't understand that.\") nil)\n    (1 (first best-sems))\n    (t (funcall tie-breaker best-sems)))))\n(defun query-user (choices &optional\n                           (header-str \"~&Please pick one:\")\n                           (footer-str \"~&Your choice? \"))\n    \"Ask user to make a choice.\"\n    (format *query-io* header-str)\n    (loop for choice in choices for i from 1 do\n           (format *query-io* \"~&~3d: ~ a\" i choice))\n    (format *query-io* footer-str)\n    (nth (- (read) 1) choices))\n```\n\nHere we see some final examples:\n\n```lisp\n> (meaning '(1 to 5 without 3 and 4))\n(1 2 5)\n> (meaning '(1 to 5 without 3 and 6))\n(1 2 4 5 6)\n> (meaning '(1 to 5 without 3 and 6 shuffled))\n(6 4 1 2 5)\n> (meaning '([ 1 to 5 without [ 3 and 6 ] ] reversed))\n(5 4 2 1)\n> (meaning '(1 to 5 to 9))\nSorry. I didn't understand that.\nNIL\n> (meaning '(1 to 5 without 3 and 7 repeat 2))\nPlease pick one:\n   1: (12 4 5 7 12 4 5 7)\n   2: (12 4 5 7 7)\nYour choice? 1\n(1 2 4 5 7 1 2 4 5 7)\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (all-parses '(1 to 5 without 3 and 7 repeat 2))` |\n| `Score` | `Semantics` | `(1 TO 5 WITHOUT 3 AND 7 REPEAT 2)` |\n| `==========` | `=========` | `===========================` |\n| `0.3` | `(1 2 4 5 7 1 2 4 5 7)` | `((((1 TO 5) WITHOUT 3) AND 7) REPEAT 2)` |\n| `0.3` | `(1 2 4 5 7 7)` | `(((1 TO 5) WITHOUT 3) AND (7 REPEAT 2))` |\n| `-2.7` | `(1 2 4 5 1 2 4 5)` | `(((1 TO 5) WITHOUT (3 AND 7)) REPEAT 2)` |\n| `-2.7` | `(1 2 4 5)` | `((1 TO 5) WITHOUT ((3 AND 7) REPEAT 2))` |\n| `-2.7` | `(1 2 4 5)` | `((1 TO 5) WITHOUT (3 AND (7 REPEAT 2)))` |\n\n![t0030](images/B9780080571157500194/t0030.png)\n\nThis last example points out a potential problem: I wasn't sure what was a good scoring function for \"repeat\", so I left it blank, it defaulted to 0, and we end up with two parses with the same score.\nThis example suggests that \"repeat\" should probably involve `inv-span` like the other modifiers, but perhaps other factors should be involved as well.\nThere can be a complicated interplay between phrases, and it is not always clear where to assign the score.\nFor example, it doesn't make much sense to repeat a \"without\" phrase; that is, the bracketing `(x without (y repeat n))` is probably a bad one.\nBut the scorer for \"without\" nearly handles that already.\nIt assigns a penalty if its right argument is not a subset of its left.\nUnfortunately, repeated elements are not counted in sets, so for example, the list (1 2 3 1 2 3) is a subset of (1 2 3 4).\nHowever, we could change the scorer for \"without\" to test for `sub-bag-p` (not a built-in Common Lisp function) instead, and then \"repeat\" would not have to be concerned with that case.\n\n## 19.7 The Problem with Context-Free Phrase-Structure Rules\n{:#s0040}\n{:.h1hd}\n\nThe fragment of English grammar we specified in [section 19.2](#s0015) admits a variety of ungrammatical phrases.\nFor example, it is equally happy with both \"I liked her\" and \"me liked she.\" Only the first of these should be accepted; the second should be ruled out.\nSimilarly, our grammar does not state that verbs have to agree with their subjects in person and number.\nAnd, since the grammar has no notion of meaning, it will accept sentences that are semantically anomalous (or at least unusual), such as \"the table liked the man.\"\n\nThere are also some technical problems with context-free grammars.\nFor example, it can be shown that no context-free grammar can be written to account for the language consisting of just the strings ABC, AABBCC, AAABBBCCC, and so forth, where each string has an equal number of As, Bs, and Cs.\nYet sentences roughly of that form show up (admittedly rarely) in natural languages.\nAn example is \"Robin and Sandy loved and hated Pat and Kim, respectively.\" While there is still disagreement over whether it is possible to generate natural languages with a context-free grammar, clearly it is much easier to use a more powerful grammatical formalism.\nFor example, consider solving the subject-predicate agreement problem.\nIt is possible to do this with a context-free language including categories like singular-NP, plural-NP, singular-VP, and plural-VP, but it is far easier to augment the grammatical formalism to allow passing features between constituents.\n\nIt should be noted that context-free phrase-structure rules turned out to be very useful for describing programming languages.\nStarting with Algol 60, the formalism has been used under the name *Backus-NaurForm* (BNF) by computer scientists.\nIn this book we are more interested in natural languages, so in the next chapter we will see a more powerful formalism known as *unification grammar* that can handle the problem of agreement, as well as other difficulties.\nFurthermore, *unification grammars* allow a natural way of attaching semantics to a parse.\n\n## 19.8 History and References\n{:#s0045}\n{:.h1hd}\n\nThere is a class of parsing algorithms known as *chart parsers* that explicitly cache partial parses and reuse them in constructing larger parses.\nEarley's algorithm (1970) is the first example, and Martin [Kay (1980)](B9780080571157500285.xhtml#bb0605) gives a good overview of the field and introduces a data structure, the *chart*, for storing substrings of a parse.\n[Winograd (1983)](B9780080571157500285.xhtml#bb1395) gives a complex (five-page) specification of a chart parser.\nNone of these authors have noticed that one can achieve the same results by augmenting a simple (one-page) parser with memoization.\nIn fact, it is possible to write a top-down parser that is even more succinct.\n(See [exercise 19.3](#p2455) below.)\n\nFor a general overview of natural language processing, my preferences (in order) are [Allen 1987](B9780080571157500285.xhtml#bb0030), [Winograd 1983](B9780080571157500285.xhtml#bb1395) or [Gazdar and Mellish 1989](B9780080571157500285.xhtml#bb0445).\n\n## 19.9 Exercises\n{:#s0050}\n{:.h1hd}\n\n**Exercise 19.2 [m-h]** Experiment with the grammar and the parser.\nFind sentences it cannot parse correctly, and try to add new syntactic rules to account for them.\n\n**Exercise 19.3 [m-h]** The parser works in a bottom-up fashion.\nWrite a top-down parser, and compare it to the bottom-up version.\nCan both parsers work with the same grammar?\nIf not, what constraints on the grammar does each parsing strategy impose?\n\n**Exercise 19.4 [h]** Imagine an interface to a dual cassette deck.\nWhereas the CD player had one assumed verb, \"play,\" this unit has three explicit verb forms: \"record,\" \"play,\" and \"erase.\" There should also be modifiers \"from\" and \"to,\" where the object of a \"to\" is either 1 or 2, indicating which cassette to use, and the object of a \"from\" is either 1 or 2, or one of the symbols PHONO, CD, or AUX.\nIt's up to you to design the grammar, but you should allow input something like the following, where I have chosen to generate actual Lisp code as the meaning:\n\n```lisp\n> (meaning '(play 1 to 5 from CD shuffled and\n             record 1 to 5 from CD and 1 and 3 and 7 from 1))\n(PROGN (PLAY '(15 2 3 4) :FROM 'CD)\n       (RECORD '(12345) :FROM 'CD)\n       (RECORD '(1 3 7) :FROM '1))\n```\n\nThis assumes that the functions play and record take keyword arguments (with defaults) for : `from` and : `to`.\nYou could also extend the grammar to accommodate an automatic timer, with phrases like \"at 3:00.\"\n\n**Exercise 19.5 [m]** In the definition of `permute`, repeated here, why is the :`test # ' eq needed?`\n\n```lisp\n(defun permute (bag)\n   \"Return a random permutation of the given input list.\"\n   (if (null bag)\n       nil\n       (let ((e (random-elt bag)))\n         (cons e (permute (remove e bag :count 1 :test #'eq))))))\n```\n\n**Exercise 19.6 [m]** The definition of `permute` takes *O*(*n*2).\nReplace it by an *O*(*n*) algorithm.\n\n## 19.10 Answers\n{:#s0055}\n{:.h1hd}\n\n**Answer 19.1**\n\n```lisp\n(defun parser (words)\n   \"Return all complete parses of a list of words.\"\n   (let* ((table (make-array (+ (length words) 1) :initial-element 0))\n            (parses (parse words (length words) table)))\n     (mapcar #'parse-tree (complete-parses parses))))\n(defun parse (words num-words table)\n   \"Bottom-up parse. returning all parses of any prefix of words.\"\n   (unless (null words)\n     (let ((ans (aref table num-words)))\n       (if (not (eq ans 0))\n           ans\n           (setf (aref table num-words)\n                  (mapcan #'(lambda (rule)\n                              (extend-parse (rule-lhs rule)\n                                            (list (firstwords))\n                                            (rest words) nil\n                                            (- num-words 1) table))\n                            (lexical-rules (first words))))))))\n(defun extend-parse (lhs rhs rem needed num-words table)\n   \"Look for the categories needed to complete the parse.\"\n   (if (null needed)\n      ;; If nothing is needed, return this parse and upward extensions\n      (let ((parse (make-parse :tree (new-tree lhs rhs) :rem rem)))\n        (cons parse\n              (mapcan\n             #'(lambda (rule)\n                     (extend-parse (rule-lhs rule)\n                                   (list (parse-tree parse))\n                                    rem (rest (rule-rhs rule))\n                                    num-words table))\n                 (rules-starting-with lhs))))\n       ;; otherwise try to extend rightward\n       (mapcan\n         #'(lambda (p)\n             (if (eq (parse-lhs p) (first needed))\n                  (extend-parse lhs (appendl rhs (parse-tree p))\n                                (parse-rem p) (rest needed)\n                                (length (parse-rem p)) table)))\n         (parse rem num-words table))))\n```\n\nIt turns out that, for the Lisp system used in the timings above, this version is no faster than normal memoization.\n\n**Answer 19.3** Actually, the top-down parser is a little easier (shorter) than the bottom-up version.\nThe problem is that the most straightforward way of implementing a top-down parser does not handle so-called *left recursive* rules-rules of the form `(X -> (X ...))`.\nThis includes rules we've used, like `(NP -> (NP and NP))`.\nThe problem is that the parser will postulate an NP, and then postulate that it is of the form `(NP and NP)`, and that the first NPof that expression is ofthe form `(NP and NP)`, and so on.\nAn infinite structure of NPs is explored before even the first word is considered.\n\nBottom-up parsers are stymied by rules with null right-hand sides: `(X -> O)`.\nNote that I was careful to exclude such rules in my grammars earlier.\n\n```lisp\n(defun parser (words &optional (cat 's))\n   \"Parse a list of words; return only parses with no remainder.\"\n   (mapcar #'parse-tree (compiete-parses (parse words cat))))\n(defun parse (tokens start-symbol)\n   \"Parse a list of tokens, return parse trees and remainders.\"\n   (if (eq (first tokens) start-symbol)\n       (list (make-parse :tree (first tokens) :rem (rest tokens)))\n       (mapcan #'(lambda (rule)\n                   (extend-parse (lhs rule) nil tokens (rhs rule)))\n                 (rules-for start-symbol))))\n(defun extend-parse (lhs rhs rem needed)\n   \"Parse the remaining needed symbols.\"\n   (if (null needed)\n       (list (make-parse :tree (cons lhs rhs) :rem rem))\n       (mapcan\n         #'(lambda (p)\n              (extend-parse lhs (append rhs (list (parse-tree p)))\n                              (parse-rem p) (rest needed)))\n         (parse rem (first needed)))))\n(defun rules-for (cat)\n   \"Return all the rules with category on lhs\"\n   (find-all cat *grammar* :key #'rule-lhs))\n```\n\n**Answer 19.5** If it were omitted, then : test would default `to #'eql`, and it would be possible to remove the \"wrong\" element from the list.\nConsider the list (1.0 1.0) in an implementation where floating-point numbers are `eql` but not `eq`.\nif `random-elt` chooses the first 1.0 first, then everything is satisfactory-the resuit list is the same as the input list.\nHowever, if `random-elt` chooses the second 1.0, then the second 1.0 will be the first element of the answer, but `remove` will remove the wrong 1.0!\nIt will remove the first 1.0, and the final answer will be a list with two pointers to the second 1.0 and none to the first.\nIn other words, we could have:\n\n```lisp\n > (member (first x) (permute x) :test #'eq)\n NIL\n```\n\n**Answer 19.6**\n\n```lisp\n(defun permute (bag)\n   \"Return a random permutation of the bag.\"\n   ;; It is done by converting the bag to a vector, but the\n   ;; resuit is always the same type as the input bag.\n   (let ((bag-copy (replace (make-array (length bag)) bag))\n         (bag-type (if (listp bag) 'list (type-of bag))))\n      (coerce (permute-vector! bag-copy) bag-type)))\n(defun permute-vector! (vector)\n   \"Destructively permute (shuffle) the vector.\"\n   (loop for i from (length vector) downto 2 do\n         (rotatef (aref vector (- i 1))\n                  (aref vector (random i))))\nvector)\n```\n\nThe answer uses `rotatef`, a relative of `setf` that swaps 2 or more values.\nThat is, `(rotatef a b)` is like:\n\n```lisp\n(let ((temp a))\n   (setf a b)\n   (setf b temp)\n   nil)\n```\n\nRarely, `rotatef` is used with more than two arguments, `(rotatef a b c)` is like:\n\n```lisp\n(let ((temp a))\n   (setf a b)\n   (setf b c)\n   (setf c temp)\n   nil)\n```\n\n----------------------\n\n[1](#xfn0015) Some erroneous expressions are underspecified and may return different results in different implementations, but we will ignore that problem.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0020) The number of parses of sentences of this kind is the same as the number of bracketings of a arithmetic expression, or the number of binary trees with a given number of leaves.\nThe resulting sequence (1,2,5,14,42,...) is known as the Catalan Numbers.\nThis kind of ambiguity is discussed by [Church and Patil (1982)](B9780080571157500285.xhtml#bb0200) in their article *Coping with Syntactic Ambiguity, or How to Put the Block in the Box on the Table.*\n!!!(p) {:.ftnote1}\n\n# Chapter 20\n## Unification Grammars\n{:.chaptitle}\n\nProlog was invented because Alain Colmerauer wanted a formalism to describe the grammar of French.\nHis intuition was that the combination of Horn clauses and unification resulted in a language that was just powerful enough to express the kinds of constraints that show up in natural languages, while not as powerful as, for example, full predicate calculus.\nThis lack of power is important, because it enables efficient implementation of Prolog, and hence of the language-analysis programs built on top of it.\n\nOf course, Prolog has evolved and is now used for many applications besides natural language, but Colmerauer's underlying intuition remains a good one.\nThis chapter shows how to view a grammar as a set of logic programming clauses.\nThe clauses define what is a legal sentence and what isn't, without any explicit reference to the process of parsing or generation.\nThe amazing thing is that the clauses can be defined in a way that leads to a very efficient parser.\nFurthermore, the same grammar can be used for both parsing and generation (at least in some cases).\n\n## 20.1 Parsing as Deduction\n{:#s0010}\n{:.h1hd}\n\nHere's how we could express the grammar rule \"A sentence can be composed of a noun phrase followed by a verb phrase\" in Prolog:\n\n```lisp\n(<- (S ?s)\n   (NP ?np)\n   (VP ?vp)\n   (concat ?np ?vp ?s))\n```\n\nThe variables represent strings of words.\nAs usual, they will be implemented as lists of symbols.\nThe rule says that a given string of words `?s` is a sentence if there is a string that is noun phrase and one that is a verb phrase, and if they can be concatenated to form `?s`.\nLogically, this is fine, and it would work as a program to generate random sentences.\nHowever, it is a very inefficient program for parsing sentences.\nIt will consider all possible noun phrases and verb phrases, without regard to the input words.\nOnly when it gets to the concat goal (defined on [page 411](B9780080571157500121.xhtml#p411)) will it test to see if the two constituents can be concatenated together to make up the input string.\nThus, a better order of evaluation for parsing is:\n\n```lisp\n(<- (S ?s)\n   (concat ?np ?vp ?s)\n   (NP ?np)\n   (VP ?vp))\n```\n\nThe first version had `NP` and `VP` guessing strings to be verified by `concat`.\nIn most grammars, there will be a very large or infinite number of `NPs` and `VPs`.\nThis second version has `concat` guessing strings to be verified by `NP` and `VP`.\nIf there are *n* words in the sentence, then concat can only make *n* + 1 guesses, quite an improvement.\nHowever, it would be better still if we could in effect have `concat` and `NP` work together to make a more constrained guess, which would then be verified by `VP`.\n\nWe have seen this type of problem before.\nIn Lisp, the answer is to return multiple values.\n`NP` would be a function that takes a string as input and returns two values: an indication of success or failure, and a remainder string of words that have not yet been parsed.\nWhen the first value indicates success, then `VP` would be called with the remaining string as input.\nIn Prolog, return values are just extra arguments.\nSo each predicate will have two parameters: an input string and a remainder string.\nFollowing the usual Prolog convention, the output parameter comes after the input.\nIn this approach, no calls to concat are necessary, no wild guesses are made, and Prolog's backtracking takes care of the necessary guessing:\n\n```lisp\n(<- (S ?s0 ?s2)\n       (NP ?s0 ?sl)\n       (VP ?sl ?s2))\n```\n\nThis rule can be read as \"The string from `*s*0` to `*s*2` is a sentence if there is an `*s*1` such that the string from `s0` to `*s*1` is a noun phrase and the string from `*s*1` to `*s*2` is a verb phrase.\"\n\nA sample query would be `(?- (S (The boy ate the apple) ())).` With suitable definitions of `NP` and `VP`, this would succeed, with the following bindings holding within `S`:\n\n```lisp\n?s0 = (The boy ate the apple)\n?sl =         (ate the apple)\n?s2 =                      ()\n```\n\nAnother way of reading the goal `(NP ?s0 ?sl)`, for example, is as \"`IS` the list `?s0` minus the list `?sl` a noun phrase?\" In this case, `?s0` minus `?sl` is the list `(The boy)`.\nThe combination of two arguments, an input list and an output list, is often called a *difference list*, to emphasize this interpretation.\nMore generally, the combination of an input parameter and output parameter is called an *accumulator.* Accumulators, particularly difference lists, are an important technique throughout logic programming and are also used in functional programming, as we saw on [page 63](B9780080571157500030.xhtml#p63).\n\nIn our rule for `S`, the concatenation of difference lists was implicit.\nIf we prefer, we could define a version of `concat` for difference lists and call it explicitly:\n\n```lisp\n(<- (S ?s-in ?s-rem)\n       (NP ?np-in ?np-rem)\n       (VP ?vp-in ?vp-rem)\n       (concat ?np-in ?np-rem ?vp-in ?vp-rem ?s-in ?s-rem))\n(<- (concat ?a ?b ?b ?c ?a ?c))\n```\n\nBecause this version of `concat` has a different arity than the old version, they can safely coexist.\nIt states the difference list equation *(a - b) + (b - c) = (a - c)*.\n\nIn the last chapter we stated that context-free phrase-structure grammar is inconvenient for expressing things like agreement between the subject and predicate of a sentence.\nWith the Horn-clause-based grammar formalism we are developing here, we can add an argument to the predicates NP and VP to represent agreement.\nIn English, the agreement rule does not have a big impact.\nFor all verbs except *be,* the difference only shows up in the third-person singular of the present tense:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | Singular | Plural |\n| first person second person third person | I you he/she | sleep sleep sleeps | we you they | sleep sleep sleep |\n\n![t0010](images/B9780080571157500200/t0010.png)\n\nThus, the agreement argument will take on one of the two values `3sg` or `\"3sg` to indicate third-person-singular or not-third-person-singular.\nWe could write:\n\n```lisp\n(<- (S ?s0 ?s2)\n       (NP ?agr ?s0 ?sl)\n       (VP ?agr ?sl ?s2))\n(<- (NP 3sg (he . ?s) ?s))\n(<- (NP`\"`3sg (they . ?s) ?s))\n(<- (VP 3sg (sleeps . ?s) ?s))\n(<- (VP`\"`3sg (sleep . ?s) ?s))\n```\n\nThis grammar parses just the right sentences:\n\n```lisp\n> (?- (S (He sleeps) ()))\nYes.\n> (?- (S (He sleep) ()))\nNo.\n```\n\nLet's extend the grammar to allow common nouns as well as pronouns:\n\n```lisp\n(<- (NP ?agr ?s0 ?s2)\n       (Det ?agr ?s0 ?sl)\n       (N ?agr ?sl ?s2))\n(<- (Det ?any (the . ?s) ?s))\n(<- (N 3sg (boy . ?s) ?s))\n(<- (N 3sg (girl . ?s) ?s))\n```\n\nThe same grammar rules can be used to generate sentences as well as parse.\nHere are all possible sentences in this trivial grammar:\n\n```lisp\n> (?- (S ?words ()))\n?WORDS = (HE SLEEPS);\n?W0RDS = (THEY SLEEP);\n?WORDS = (THE BOY SLEEPS);\n?WORDS = (THE GIRL SLEEPS);\nNo.\n```\n\nSo far all we have is a recognizer: a predicate that can separate sentences from nonsentences.\nBut we can add another argument to each predicate to build up the semantics.\nThe result is not just a recognizer but a true parser:\n\n```lisp\n(<- (S (?pred ?subj) ?s0 ?s2)\n       (NP ?agr ?subj ?s0 ?sl)\n        (VP ?agr ?pred ?sl ?s2))\n(<- (NP 3sg (the male) (he . ?s) ?s))\n(<- (NP`\"`3sg (some objects) (they . ?s) ?s))\n(<- (NP ?agr (?det ?n) ?s0 ?s2)\n        (Det ?agr ?det ?s0 ?sl)\n        (N ?agr ?n ?sl ?s2))\n(<- (VP 3sg sleep (sleeps . ?s) ?s))\n(<- (VP`\"`3sg sleep (sleep . ?s) ?s))\n(<- (Det ?any the (the . ?s) ?s))\n(<- (N 3sg (young male human) (boy . ?s) ?s))\n(<- (N 3sg (young female human) (girl . ?s) ?s))\n```\n\nThe semantic translations of individual words is a bit capricious.\nIn fact, it is not too important at this point if the translation of `boy` is `(young male human)` or just `boy`.\nThere are two properties of a semantic representation that are important.\nFirst, it should be unambiguous.\nThe representation of *orange* the fruit should be different from *orange* the color (although the representation of the fruit might well refer to the color, or vice versa).\nSecond, it should express generalities, or allow them to be expressed elsewhere.\nSo either *sleep* and *sleeps* should have the same or similar representation, or there should be an inference rule relating them.\nSimilarly, if the representation of *boy* does not say so explicitly, there should be some other rule saying that a boy is a male and a human.\n\nOnce the semantics of individual words is decided, the semantics of higher-level categories (sentences and noun phrases) is easy.\nIn this grammar, the semantics of a sentence is the application of the predicate (the verb phrase) to the subject (the noun phrase).\nThe semantics of a compound noun phrase is the application of the determiner to the noun.\n\nThis grammar returns the semantic interpretation but does not build a syntactic tree.\nThe syntactic structure is implicit in the sequence of goals: `S` calls `NP` and `VP`, and `NP` can call `Det` and `N`.\nIf we want to make this explicit, we can provide yet another argument to each nonterminal:\n\n```lisp\n(<- (S (?pred ?subj) (s ?np ?vp) ?s0 ?s2)\n       (NP ?agr ?subj ?np ?s0 ?sl)\n        (VP ?agr ?pred ?vp ?sl ?s2))\n(<- (NP 3sg (the male) (np he) (he . ?s) ?s))\n(<- (NP`\"`3sg (some objects) (np they) (they . ?s) ?s))\n(<- (NP ?agr (?det ?n) (np ?det-syn ?n-syn)?s0 ?s2)\n        (Det ?agr ?det ?det-syn ?s0 ?sl)\n        (N ?agr ?n ?n-syn ?sl ?s2))\n(<- (VP 3sg sleep (vp sleeps)(sleeps . ?s) ?s))\n(<- (VP`\"`3sg sleep (vp sleep) (sleep . ?s) ?s))\n(<- (Det ?any the (det the) (the . ?s) ?s))\n(<- (N 3sg (young male human) (n boy) (boy . ?s) ?s))\n(<- (N 3sg (young female human) (n girl) (girl . ?s) ?s))\n```\n\nThis grammar can still be used to parse or generate sentences, or even to enumerate all syntax/semantics/sentence triplets:\n\n```lisp\n;; Parsing:\n> (?- (S ?sem ?syn (He sleeps) ()))\n?SEM = (SLEEP (THE MALE))\n?SYN = (S (NP HE) (VP SLEEPS)).\n;; Generating:\n> (?- (S (sleep (the male)) ? ?words ()))\n?WORDS = (HE SLEEPS)\n;; Enumerating:\n> (?- (S ?sem ?syn ?words ()))\n?SEM = (SLEEP (THE MALE))\n?SYN = (S (NP HE) (VP SLEEPS))\n?WORDS = (HE SLEEPS);\n?SEM = (SLEEP (SOME OBJECTS))\n?SYN = (S (NP THEY) (VP SLEEP))\n?WORDS = (THEY SLEEP);\n?SEM = (SLEEP (THE (YOUNG MALE HUMAN)))\n?SYN = (S (NP (DET THE) (N BOY)) (VP SLEEPS))\n?WORDS = (THE BOY SLEEPS);\n?SEM = (SLEEP (THE (YOUNG FEMALE HUMAN)))\n?SYN = (S (NP (DET THE) (N GIRL)) (VP SLEEPS))\n?WORDS = (THE GIRL SLEEPS);\nNo.\n```\n\n## 20.2 Definite Clause Grammars\n{:#s0015}\n{:.h1hd}\n\nWe now have a powerful and efficient tool for parsing sentences.\nHowever, it is getting to be a very messy tool-there are too many arguments to each goal, and it is hard to tell which arguments represent syntax, which represent semantics, which represent in/out strings, and which represent other features, like agreement.\nSo, we will take the usual step when our bare programming language becomes messy: define a new language.\n\nEdinburgh Prolog recognizes assertions called *definite clause grammar* (DCG) rules.\nThe term *definite clause* is just another name for a Prolog clause, so DCGs are also called \"logic grammars.\" They could have been called \"Horn clause grammars\" or \"Prolog grammars\" as well.\n\nDCG rules are clauses whose main functor is an arrow, usually written -->.\nThey compile into regular Prolog clauses with extra arguments.\nIn normal DCG rules, only the string arguments are automatically added.\nBut we will see later how this can be extended to add other arguments automatically as well.\n\nWe will implement DCG rules with the macro `rule` and an infix arrow.\nThus, we want the expression:\n\n```lisp\n(rule (S) --> (NP) (VP))\n```\n\nto expand into the clause:\n\n```lisp\n(<- (S ?s0 ?s2)\n       (NP ?s0 ?sl)\n       (VP ?sl ?s2))\n```\n\nWhile we're at it, we may as well give `rule` the ability to deal with different types of rules, each one represented by a different type of arrow.\nHere's the `rule` macro:\n\n```lisp\n(defmacro rule (head &optional (arrow ':-) &body body)\n   \"Expand one of several types of logic rules into pure Prolog.\"\n   ;; This is data-driven, dispatching on the arrow\n   (funcall (get arrow 'rule-function) head body))\n```\n\nAs an example of a rule function, the arrow : - will be used to represent normal Prolog clauses.\nThat is, the form (`rule`*head : - body*) will be equivalent to (<- *head body).*\n\n```lisp\n(setf (get ':- 'rule-function)\n          #'(lambda (head body) '(<- ,head .,body)))\n```\n\nBefore writing the rule function for DCG rules, there are two further features of the DCG formalism to consider.\nFirst, some goals in the body of a rule may be normal Prolog goals, and thus do not require the extra pair of arguments.\nIn Edinburgh Prolog, such goals are surrounded in braces.\nOne would write:\n\n```lisp\ns(Sem) --> np(Subj), vp(Pred),\n                  {combi ne(Subj,Pred,Sem)}.\n```\n\nwhere the idea is that `combine` is not a grammatical constituent, but rather a Prolog predicate that could do some calculations on `Subj` and `Pred` to arrive at the proper semantics, `Sem`.\nWe will mark such a test predicate not by brackets but by a list headed by the keyword `:test`, as in:\n\n```lisp\n(rule (S ?sem) --> (NP ?subj) (VP ?pred)\n   (:test (combine ?subj ?pred ?sem)))\n```\n\nSecond, we need some way of introducing individual words on the right-hand side, as opposed to categories of words.\nIn Prolog, brackets are used to represent a word or list of words on the right-hand side:\n\n```lisp\nverb --> [sleeps].\n```\n\nWe will use a list headed by the keyword `:word:`\n\n```lisp\n(rule (NP (the male) 3sg) --> (:word he))\n(rule (VP sleeps 3sg) --> (:word sleeps))\n```\n\nThe following predicates test for these two special cases.\nNote that the cut is also allowed as a normal goal.\n\n```lisp\n(defun dcg-normal-goal-p (x) (or (starts-with x :test) (eq x '!)))\n(defun dcg-word-list-p (x) (starts-with x ':word))\n```\n\nAt last we are in a position to present the rule function for DCG rules.\nThe function `make-dcg` inserts variables to keep track of the strings that are being parsed.\n\n```lisp\n(setf (get '-->'rule-function) 'make-dcg)\n(defun make-dcg (head body)\n  (let ((n (count-if (complement #'dcg-normal-goal-p) body)))\n    '(<- (,@head ?sO .(symbol '?s n))\n            .,(make-deg-body body 0))))\n(defun make-dcg-body (body n)\n  \"Make the body of a Definite Clause Grammar (DCG) clause.\n  Add ?string-in and -out variables to each constituent.\n  Goals like (:test goal) are ordinary Prolog goals,\n  and goals like (:word hello) are literal words to be parsed.\"\n  (if (null body)\n          nil\n          (let ((goal (first body)))\n            (cond\n               ((eq goal '!) (cons '! (make-dcg-body (rest body) n)))\n               ((dcg-normal-goal-p goal)\n                 (append (rest goal)\n                               (make-dcg-body (rest body) n)))\n               ((dcg-word-list-p goal)\n                 (cons\n                    '(= ,(symbol '?s n)\n                          (,@(rest goal) .,(symbol '?s (+ n 1))))\n                   (make-dcg-body (rest body) (+ n 1))))\n         (t (cons\n               (append goal\n                            (list (symbol '?s n)\n                                      (symbol '?s (+ n 1))))\n                (make-dcg-body (rest body) (+ n 1))))))))\n```\n\n**Exercise 20.1 [m]**`make-dcg` violates one of the cardinal rules of macros.\nWhat does it do wrong?\nHow would you fix it?\n\n## 20.3 A Simple Grammar in DCG Format\n{:#s0020}\n{:.h1hd}\n\nHere is the trivial grammar from [page 688](B9780080571157500200.xhtml#p688) in DCG format.\n\n```lisp\n(rule (S (?pred ?subj)) -->\n   (NP ?agr ?subj)\n   (VP ?agr ?pred))\n(rule (NP ?agr (?det ?n)) -->\n   (Det ?agr ?det)\n   (N ?agr ?n))\n(rule (NP 3sg (the male))          --> (:word he))\n(rule (NP`\"`3sg (some objects))      --> (:word they))\n(rule (VP 3sg sleep)               --> (:word sleeps))\n(rule (VP`\"`3sg sleep)               --> (:word sleep))\n(rule (Det ?any the)               --> (:word the))\n(rule (N 3sg (young male human))   --> (:word boy))\n(rule (N 3sg (young female human)) --> (:word girl))\n```\n\nThis grammar is quite limited, generating only four sentences.\nThe first way we will extend it is to allow verbs with objects: in addition to \"The boy sleeps,\" we will allow \"The boy meets the girl.\" To avoid generating ungrammatical sentences like \"* The boy meets,\"[1](#fn0015) we will separate the category of verb into two *subcategories*: transitive verbs, which take an object, and intransitive verbs, which don't.\n\nTransitive verbs complicate the semantic interpretation of sentences.\nWe would like the interpretation of \"Terry kisses Jean\" to be `(kiss Terry Jean)`.\nThe interpretation of the noun phrase \"Terry\" is just `Terry`, but then what should the interpretation of the verb phrase \"kisses Jean\" be?\nTo fit our predicate application model, it must be something equivalent to `(lambda (x) (kiss x Jean))`.\nWhen applied to the subject, we want to get the simplification:\n\n```lisp\n((lambda (x) (kiss x Jean)) Terry)`=> `(kiss Terry Jean)\n```\n\nSuch simplification is not done automatically by Prolog, but we can write a predicate to do it.\nWe will call it `funcall`, because it is similar to the Lisp function of that name, although it only handles replacement of the argument, not full evaluation of the body.\n(Technically, this is the lambda-calculus operation known as *beta-reduction.)* The predicate `funcall` is normally used with two input arguments, a function and its argument, and one output argument, the resulting reduction:\n\n```lisp\n(<- (funcall (lambda (?x) ?body) ?x ?body))\n```\n\nWith this we could write our rule for sentences as:\n\n```lisp\n(rule (S ?sem) -->\n   (NP ?agr ?subj)\n   (VP ?agr ?pred)\n   (:test (funcall ?pred ?subj ?sem)))\n```\n\nAn alternative is to, in effect, compile away the call to `funcall`.\nInstead of having the semantic representation of `VP` be a single lambda expression, we can represent it as two arguments: an input argument, `?subj`, which acts as a parameter to the output argument, `?pred`, which takes the place of the body of the lambda expression.\nBy explicitly manipulating the parameter and body, we can eliminate the call to `funcall`.\nThe trick is to make the parameter and the subject one and the same:\n\n```lisp\n(rule (S ?pred) -->\n   (NP ?agr ?subj)\n   (VP ?agr ?subj ?pred))\n```\n\nOne way of reading this rule is \"To parse a sentence, parse a noun phrase followed by a verb phrase.\nIf they have different agreement features then fail, but otherwise insert the interpretation of the noun phrase, `?subj`, into the proper spot in the interpretation of the verb phrase, `?pred`, and return `?pred` as the final interpretation of the sentence.\"\n\nThe next step is to write rules for verb phrases and verbs.\nTransitive verbs are listed under the predicate `Verb/tr`, and intransitive verbs are listed as `Verb/intr`.\nThe semantics of tenses (past and present) has been ignored.\n\n```lisp\n(rule (VP ?agr ?subj ?pred) -->\n   (Verb/tr ?agr ?subj ?pred ?obj)\n   (NP ?any-agr ?obj))\n(rule (VP ?agr ?subj ?pred) -->\n   (Verb/intr ?agr ?subj ?pred))\n(rule (Verb/tr`\"`3sg ?x (kiss ?x ?y) ?y) --> (:word kiss))\n(rule (Verb/tr 3sg ?x (kiss ?x ?y) ?y) --> (:word kisses))\n(rule (Verb/tr ?any ?x (kiss ?x ?y) ?y) --> (:word kissed))\n(rule (Verb/intr`\"`3sg ?x (sleep ?x)) --> (:word sleep))\n(rule (Verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps))\n(rule (Verb/intr ?any ?x (sleep ?x)) --> (:word slept))\n```\n\nHere are the rules for noun phrases and nouns:\n\n```lisp\n(rule (NP ?agr ?sem) -->\n   (Name ?agr ?sem))\n(rule (NP ?agr (?det-sem ?noun-sem)) -->\n   (Det ?agr ?det-sem)\n   (Noun ?agr ?noun-sem))\n(rule (Name 3sg Terry) --> (:word Terry))\n(rule (Name 3sg Jean) --> (:word Jean))\n(rule (Noun 3sg (young male human)) --> (:word boy))\n(rule (Noun 3sg (young female human)) --> (:word girl))\n(rule (Noun`\"`3sg (group (young male human))) --> (:word boys))\n(rule (Noun`\"`3sg (group (young female human))) --> (:word girls))\n(rule (Det ?any the) --> (:word the))\n(rule (Det 3sg a) --> (:word a))\n```\n\nThis grammar and lexicon generates more sentences, although it is still rather limited.\nHere are some examples:\n\n```lisp\n> (?- (S ?sem (The boys kiss a girl) ()))\n?SEM = (KISS (THE (GROUP (YOUNG MALE HUMAN)))\n                       (A (YOUNG FEMALE HUMAN))).\n> (?- (S ?sem (The girls kissed the girls) ()))\n?SEM = (KISS (THE (GROUP (YOUNG FEMALE HUMAN)))\n                       (THE (GROUP (YOUNG FEMALE HUMAN)))).\n> (?- (S ?sem (Terry kissed the girl) ()))\n?SEM = (KISS TERRY (THE (YOUNG FEMALE HUMAN))).\n> (?- (S ?sem (The girls kisses the boys) ()))\nNo.\n> (?- (S ?sem (Terry kissed a girls) ()))\nNo.\n> (?- (S ?sem (Terry sleeps Jean) ()))\nNo.\n```\n\nThe first three examples are parsed correctly, while the final three are correctly rejected.\nThe inquisitive reader may wonder just what is going on in the interpretation of a sentence like \"The girls kissed the girls.\" Do the subject and object represent the same group of girls, or different groups?\nDoes everyone kiss everyone, or are there fewer kissings going on?\nUntil we define our representation more carefully, there is no way to tell.\nIndeed, it seems that there is a potential problem in the representation, in that the predicate `kiss` sometimes has individuals as its arguments, and sometimes groups.\nMore careful representations of \"The girls kissed the girls\" include the following candidates, using predicate calculus:\n\n```lisp\n&forall;x&forall;y x![f0005](images/B9780080571157500200/f0005.jpg) girls &and; y![f0005](images/B9780080571157500200/f0005.jpg) girls`=> `kiss(x,y)\n&forall;x&forall;y x![f0005](images/B9780080571157500200/f0005.jpg) girls &and; y&epsilon;girls &and; x&ne;y`=> `kiss(x,y)\n&forall;x&exist;y,z x![f0005](images/B9780080571157500200/f0005.jpg) girls &and; y![f0005](images/B9780080571157500200/f0005.jpg) girls &and; z![f0005](images/B9780080571157500200/f0005.jpg) girls`=> `kiss(x,y) &and; kiss(z,x)\n&forall;x&exist;y x![f0005](images/B9780080571157500200/f0005.jpg) girls &and; y![f0005](images/B9780080571157500200/f0005.jpg) girls`=> `kiss(x,y)`&or; `kiss(y,x)\n```\n\nThe first of these says that every girl kisses every other girl.\nThe second says the same thing, except that a girl need not kiss herself.\nThe third says that every girl kisses and is kissed by at least one other girl, but not necessarily all of them, and the fourth says that everbody is in on at least one kissing.\nNone of these interpretations says anything about who \"the girls\" are.\n\nClearly, the predicate calculus representations are less ambiguous than the representation produced by the current system.\nOn the other hand, it would be wrong to choose one of the representations arbitrarily, since in different contexts, \"The girls kissed the girls\" can mean different things.\nMaintaining ambiguity in a concise form is useful, as long as there is some way eventually to recover the proper meaning.\n\n## 20.4 A DCG Grammar with Quantifiers\n{:#s0025}\n{:.h1hd}\n\nThe problem in the representation we have been using becomes more acute when we consider other determiners, such as \"every.\" Consider the sentence \"Every picture paints a story.\" The preceding DCG, if given the right vocabulary, would produce the interpretation:\n\n```lisp\n(paints (every picture) (a story))\n```\n\nThis can be considered ambiguous between the following two meanings, in predicate calculus form:\n\n```lisp\n&forall; x picture(x)`=> `&exist; y story(y) &and; paint(x,y)\n&exist; y story (y) &and; &forall; x picture(x)`=> `paint(x,y)\n```\n\nThe first says that for each picture, there is a story that it paints.\nThe second says that there is a certain special story that every picture paints.\nThe second is an unusual interpretation for this sentence, but for \"Every U.S.\ncitizen has a president,\" the second interpretation is perhaps the preferred one.\nIn the next section, we will see how to produce representations that can be transformed into either interpretation.\nFor now, it is a useful exercise to see how we could produce just the first representation above, the interpretation that is usually correct.\nFirst, we need to transcribe it into Lisp:\n\n```lisp\n(all ?x (-> (picture ?x) (exists ?y (and (story ?y) (paint ?x ?y)))))\n```\n\nThe first question is how the `all` and `exists` forms get in there.\nThey must come from the determiners, \"every\" and \"a.\" Also, it seems that `all` is followed by an implication arrow, `->`, while `exists` is followed by a conjunction, `and`.\nSo the determiners will have translations looking like this:\n\n```lisp\n(rule (Det ?any ?x ?p ?q (the ?x (and ?p ?q)))   --> (:word the))\n(rule (Det 3sg ?x ?p ?q (exists ?x (and ?p ?q))) --> (:word a))\n(rule (Det 3sg ?x ?p ?q (all ?x (-> ?p ?q)))     --> (:word every))\n```\n\nOnce we have accepted these translations of the determiners, everything else follows.\nThe formulas representing the determiners have two holes in them, `?p` and `?q`.\nThe first will be filled by a predicate representing the noun, and the latter will be filled by the predicate that is being applied to the noun phrase as a whole.\nNotice that a curious thing is happening.\nPreviously, translation to logical form was guided by the sentence's verb.\nLinguisticly, the verb expresses the main predicate, so it makes sense that the verb's logical translation should be the main part of the sentence's translation.\nIn linguistic terms, we say that the verb is the *head* of the sentence.\n\nWith the new translations for determiners, we are in effect turning the whole process upside down.\nNow the subject's determiner carries the weight of the whole sentence.\nThe determiner's interpretation is a function of two arguments; it is applied to the noun first, yielding a function of one argument, which is in turn applied to the verb phrase's interpretation.\nThis primacy of the determiner goes against intuition, but it leads directly to the right interpretation.\n\nThe variables `?p` and `?q` can be considered holes to be filled in the final interpretation, but the variable `?x` fills a quite different role.\nAt the end of the parse, `?x` will not be filled by anything; it will still be a variable.\nBut it will be referred to by the expressions filling `?p` and `?q`.\nWe say that `?x` is a *metavariable,* because it is a variable in the representation, not a variable in the Prolog implementation.\nIt just happens that Prolog variables can be used to implement these metavariables.\n\nHere are the interpretations for each word in our target sentence and for each intermediate constituent:\n\n```lisp\nEvery          = (all ?x (-> ?pl ?ql))\npicture        = (picture ?x)\npaints         = (paint ?x ?y)\na              = (exists ?y (and ?p2 ?q2))\nstory          = (story ?y)\nEvery picture  = (all ?x (-> (picture ?x) ?ql))\na story        = (exists ?y (and (story ?y) ?q2))\npaints a story = (exists ?y (and (story ?y) (paint ?x ?y)))\n```\n\nThe semantics of a noun has to fill the `?p` hole of a determiner, possibly using the metavariable `?x`.\nThe three arguments to the Noun predicate are the agreement, the metavariable `?x`, and the assertion that the noun phrase makes about `?x`:\n\n```lisp\n(rule (Noun 3sg ?x (picture ?x)) --> (:word picture))\n(rule (Noun 3sg ?x (story ?x)) --> (:word story))\n(rule (Noun 3sg ?x (and (young ?x) (male ?x) (human ?x))) -->\n   (:word boy))\n```\n\nThe NP predicate is changed to take four arguments.\nFirst is the agreement, then the metavariable `?x`.\nThird is a predicate that will be supplied externally, by the verb phrase.\nThe final argument returns the interpretation of the NP as a whole.\nAs we have stated, this comes from the determiner:\n\n```lisp\n(rule (NP ?agr ?x ?pred ?pred) -->\n   (Name ?agr ?name))\n;(rule (NP ?agr ?x ?pred ?np) -->\n; (Det ?agr ?x ?noun ?pred ?np)\n; (Noun ?agr ?x ?noun))\n```\n\nThe rule for an NP with determiner is commented out because it is convenient to introduce an extended rule to replace it at this point.\nThe new rule accounts for certain relative clauses, such as \"the boy that paints a picture\":\n\n```lisp\n(rule (NP ?agr ?x ?pred ?np) -->\n   (Det ?agr ?x ?noun&rel ?pred ?np)\n   (Noun ?agr ?x ?noun)\n   (rel-clause ?agr ?x ?noun ?noun&rel))\n(rule (rel-clause ?agr ?x ?np ?np) --> )\n(rule (rel-clause ?agr ?x ?np (and ?np ?rel)) -->\n   (:word that)\n   (VP ?agr ?x ?rel))\n```\n\nThe new rule does not account for relative clauses where the object is missing, such as \"the picture that the boy paints.\" Nevertheless, the addition of relative clauses means we can now generate an infinite language, since we can always introduce a relative clause, which introduces a new noun phrase, which in turn can introduce yet another relative clause.\n\nThe rules for relative clauses are not complicated, but they can be difficult to understand.\nOf the four arguments to `rel-clause,` the first two hold the agreement features of the head noun and the metavariable representing the head noun.\nThe last two arguments are used together as an accumulator for predications about the metavariable: the third argument holds the predications made so far, and the fourth will hold the predications including the relative clause.\nSo, the first rule for `rel-clause` says that if there is no relative clause, then what goes in to the accumulator is the same as what goes out.\nThe second rule says that what goes out is the conjunction of what comes in and what is predicated in the relative clause itself.\n\nVerbs apply to either one or two metavariables, just as they did before.\nSo we can use the definitions of `Verb/tr` and `Verb/intr` unchanged.\nFor variety, I've added a few more verbs:\n\n```lisp\n(rule (Verb/tr`\"`3sg ?x ?y (paint ?x ?y)) --> (:word paint))\n(rule (Verb/tr 3sg ?x ?y (paint ?x ?y)) --> (:word paints))\n(rule (Verb/tr ?any ?x ?y (paint ?x ?y)) --> (:word painted))\n(rule (Verb/intr`\"`3sg ?x (sleep ?x)) --> (:word sleep))\n(rule (Verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps))\n(rule (Verb/intr ?any ?x (sleep ?x)) --> (:word slept))\n(rule (Verb/intr 3sg ?x (sells ?x)) --> (:word sells))\n(rule (Verb/intr 3sg ?x (stinks ?x)) --> (:word stinks))\n```\n\nVerb phrases and sentences are almost as before.\nThe only difference is in the call to `NP`, which now has extra arguments:\n\n```lisp\n(rule (VP ?agr ?x ?vp) -->\n   (Verb/tr ?agr ?x ?obj ?verb)\n   (NP ?any-agr ?obj ?verb ?vp))\n(rule (VP ?agr ?x ?vp) -->\n   (Verb/intr ?agr ?x ?vp))\n(rule (S ?np) -->\n   (NP ?agr ?x ?vp ?np)\n   (VP ?agr ?x ?vp))\n```\n\nWith this grammar, we get the following correspondence between sentences and logical forms:\n\n```lisp\nEvery picture paints a story.\n(ALL ?3 (-> (PICTURE ?3)\n                     (EXISTS ?14 (AND (STORY ?14) (PAINT ?3 ?14)))))\nEvery boy that paints a picture sleeps.\n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3))\n                              (EXISTS ?19 (AND (PICTURE ?19)\n                                                            (PAINT ?3 ?19))))\n                  (SLEEP ?3)))\nEvery boy that sleeps paints a picture.\n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3))\n                                (SLEEP ?3))\n                    (EXISTS ?22 (AND (PICTURE ?22) (PAINT ?3 ?22)))))\nEvery boy that paints a picture that sells\npaints a picture that stinks.\n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3))\n                              (EXISTS ?19 (AND (AND (PICTURE ?19) (SELLS ?19))\n                                                    (PAINT ?3 ?19))))\n                    (EXISTS ?39 (AND (AND (PICTURE ?39) (STINKS ?39))\n                                                  (PAINT ?3 ?39)))))\n```\n\n## 20.5 Preserving Quantifier Scope Ambiguity\n{:#s0030}\n{:.h1hd}\n\nConsider the simple sentence \"Every man loves a woman.\" This sentence is ambiguous between the following two interpretations:\n\n```lisp\n&forall;m&exist;w man(m) &and; woman(w) &and; loves(m,w)\n&exist;w&forall;m man(m) &and; woman(w) &and; loves(m,w)\n```\n\nThe first interpretation is that every man loves some woman-his wife, perhaps.\nThe second interpretation is that there is a certain woman whom every man loves-Natassja Kinski, perhaps.\nThe meaning of the sentence is ambiguous, but the structure is not; there is only one syntactic parse.\n\nIn the last section, we presented a parser that would construct one of the two interpretations.\nIn this section, we show how to construct a single interpretation that preserves the ambiguity, but can be disambiguated by a postsyntactic process.\nThe basic idea is to construct an intermediate logical form that leaves the scope of quantifiers unspecified.\nThis intermediate form can then be rearranged to recover the final interpretation.\n\nTo recap, here is the interpretation we would get for \"Every man loves a woman,\" given the grammar in the previous section:\n\n```lisp\n(all ?m (-> (man ?m) (exists ?w) (and (woman ?w) (loves ?m ?w))))\n```\n\nWe will change the grammar to produce instead the intermediate form:\n\n```lisp\n(and (all ?m (man ?m))\n         (exists ?w (wowan ?w))\n         (loves ?m ?w))\n```\n\nThe difference is that logical components are produced in smaller chunks, with unscoped quantifiers.\nThe typical grammar rule will build up an interpretation by conjoining constituents with `and`, rather than by fitting pieces into holes in other pieces.\nHere is the complete grammar and a just-large-enough lexicon in the new format:\n\n```lisp\n(rule (S (and ?np ?vp)) -->\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n(rule (VP ?agr ?x (and ?verb ?obj)) -->\n   (Verb/tr ?agr ?x ?o ?verb)\n   (NP ?any-agr ?o ?obj))\n(rule (VP ?agr ?x ?verb) -->\n   (Verb/intr ?agr ?x ?verb))\n(rule (NP ?agr ?name t) -->\n   (Name ?agr ?name))\n(rule (NP ?agr ?x ?det) -->\n   (Det ?agr ?x (and ?noun ?rel) ?det)\n   (Noun ?agr ?x ?noun)\n   (rel-clause ?agr ?x ?rel))\n(rule (rel-clause ?agr ?x t) --> )\n(rule (rel-clause ?agr ?x ?rel) -->\n   (:word that)\n   (VP ?agr ?x ?rel))\n(rule (Name 3sg Terry)                    --> (:word Terry))\n(rule (Name 3sg Jean)                     --> (:word Jean))\n(rule (Det 3sg ?x ?restr (all ?x ?restr)) --> (:word every))\n(rule (Noun 3sg ?x (man ?x))              --> (:word man))\n(rule (Verb/tr 3sg ?x ?y (love ?x ?y))    --> (:word loves))\n(rule (Verb/intr 3sg ?x (lives ?x))       --> (:word lives))\n(rule (Det 3sg ?x ?res (exists ?x ?res))  --> (:word a))\n(rule (Noun 3sg ?x (woman ?x))            --> (:word woman))\n```\n\nThis gives us the following parse for \"Every man loves a woman\":\n\n```lisp\n(and (all ?4 (and (man ?4) t))\n        (and (love ?4 ?12) (exists ?12 (and (woman ?12) t))))\n```\n\nIf we simplified this, eliminating the ts and joining ands, we would get the desired representation:\n\n```lisp\n(and (all ?m (man ?m))\n        (exists ?w (wowan ?w))\n        (loves ?m ?w))\n```\n\nFrom there, we could use what we know about syntax, in addition to what we know about men, woman, and loving, to determine the most likely final interpretation.\nThis will be covered in the next chapter.\n\n## 20.6 Long-Distance Dependencies\n{:#s0035}\n{:.h1hd}\n\nSo far, every syntactic phenomena we have considered has been expressible in a rule that imposes constraints only at a single level.\nFor example, we had to impose the constraint that a subject agree with its verb, but this constraint involved two immediate constituents of a sentence, the noun phrase and verb phrase.\nWe didn't need to express a constraint between, say, the subject and a modifier of the verb's object.\nHowever, there are linguistic phenomena that require just these kinds of constraints.\n\nOur rule for relative clauses was a very simple one: a relative clause consists of the word \"that\" followed by a sentence that is missing its subject, as in \"every man that loves a woman.\" Not all relative clauses follow this pattern.\nIt is also possible to form a relative clause by omitting the object of the embedded sentence: \"every man that a woman loves ![f0010](images/B9780080571157500200/f0010.jpg) . \" In this sentence, the symbol ![f0010](images/B9780080571157500200/f0010.jpg) indicates a gap, which is understood as being filled by the head of the complete noun phrase, the man.\nThis has been called a *filler-gap dependency.* It is also known as a *long-distance dependency,* because the gap can occur arbitrarily far from the filler.\nFor example, all of the following are valid noun phrases:\n\nThe person that Lee likes ![f0010](images/B9780080571157500200/f0010.jpg)\n\nThe person that Kim thinks Lee likes ![f0010](images/B9780080571157500200/f0010.jpg)\n\nThe person that Jan says Kim thinks Lee likes ![f0010](images/B9780080571157500200/f0010.jpg)\n\nIn each case, the gap is filled by the head noun, the person.\nBut any number of relative clauses can intervene between the head noun and the gap.\n\nThe same kind of filler-gap dependency takes place in questions that begin with \"who,\" \"what,\" \"where,\" and other interrogative pronouns.\nFor example, we can ask a question about the subject of a sentence, as in \"Who likes Lee?\", or about the object, as in \"Who does Kim like ![f0010](images/B9780080571157500200/f0010.jpg) ?\"\n\nHere is a grammar that covers relative clauses with gapped subjects or objects.\nThe rules for `S, VP,` and `NP` are augmented with a pair of arguments representing an accumulator for gaps.\nLike a difference list, the first argument minus the second represents the presence or absence of a gap.\nFor example, in the first two rules for noun phrases, the two arguments are the same, `?g0` and `?g0`.\nThis means that the rule as a whole has no gap, since there can be no difference between the two arguments.\nIn the third rule for NP, the first argument is of the form `(gap ...),` and the second is `nogap.` This means that the right-hand side of the rule, an empty constituent, can be parsed as a gap.\n(Note that if we had been using true difference lists, the two arguments would be `((gap ...) ?g0)` and `?g0`.\nBut since we are only dealing with one gap per rule, we don't need true difference lists.)\n\nThe rule for `S` says that a noun phrase with gap `?g0` minus `?gl` followed by a verb phrase with gap `?gl` minus `?g2` comprise a sentence with gap `?g0` minus `?g2`.\nThe rule for relative clauses finds a sentence with a gap anywhere; either in the subject position or embedded somewhere in the verb phrase.\nHere's the complete grammar:\n\n```lisp\n(rule (S ?g0 ?g2 (and ?np ?vp)) -->\n   (NP ?g0 ?gl ?agr ?x ?np)\n   (VP ?gl ?g2 ?agr ?x ?vp))\n(rule (VP ?g0 ?gl ?agr ?x (and ?obj ?verb)) -->\n   (Verb/tr ?agr ?x ?o ?verb)\n   (NP ?g0 ?gl ?any-agr ?o ?obj))\n(rule (VP ?g0 ?g0 ?agr ?x ?verb) -->\n   (Verb/intr ?agr ?x ?verb))\n(rule (NP ?g0 ?g0 ?agr ?name t) -->\n   (Name ?agr ?name))\n(rule (NP ?g0 ?g0 ?agr ?x ?det) -->\n   (Det ?agr ?x (and ?noun ?rel) ?det)\n   (Noun ?agr ?x ?noun)\n   (rel-clause ?agr ?x ?rel))\n(rule (NP (gap NP ?agr ?x) nogap ?agr ?x t) --> )\n(rule (rel-clause ?agr ?x t) --> )\n(rule (rel-clause ?agr ?x ?rel) -->\n   (:word that)\n   (S (gap NP ?agr ?x) nogap ?rel))\n```\n\nHere are some sentence/parse pairs covered by this grammar:\n\n```lisp\nEvery man that`![f0010](images/B9780080571157500200/f0010.jpg) `loves a woman likes a person.\n(AND (ALL ?28 (AND (MAN ?28)\n      (AND T (AND (LOVE ?28 ?30)\n         (EXISTS ?30 (AND (WOMAN ?30)\n               T))))))\n   (AND (EXISTS ?39 (AND (PERSON ?39) T)) (LIKE ?28 ?39)))\nEvery man that a woman loves`![f0010](images/B9780080571157500200/f0010.jpg) `likes a person.\n(AND (ALL ?37 (AND (MAN ?37)\n      (AND (EXISTS ?20 (AND (WOMAN ?20) T))\n        (AND T (LOVE ?20 ?37)))))\n   (AND (EXISTS ?39 (AND (PERSON ?39) T)) (LIKE ?37 ?39)))\nEvery man that loves a bird that`![f0010](images/B9780080571157500200/f0010.jpg) `flies likes a person.\n(AND (ALL ?28 (AND (MAN ?28)\n      (AND T (AND (EXISTS ?54\n         (AND (BIRD ?54)\n             (AND T (FLY ?54))))\n        (LOVE ?28 ?54)))))\n   (AND (EXISTS ?60 (AND (PERSON ?60) T)) (LIKE ?28 ?60)))\n```\n\nActually, there are limitations on the situations in which gaps can appear.\nIn particular, it is rare to have a gap in the subject of a sentence, except in the case of a relative clause.\nIn the next chapter, we will see how to impose additional constraints on gaps.\n\n## 20.7 Augmenting DCG Rules\n{:#s0040}\n{:.h1hd}\n\nIn the previous section, we saw how to build up a semantic representation of a sentence by conjoining the semantics of the components.\nOne problem with this approach is that the semantic interpretation is often something of the form `(and (and t *a) b),*` when we would prefer `(and *a b)*`.\nThere are two ways to correct this problem: either we add a step that takes the final semantic interpretation and simplifies it, or we complicate each individual rule, making it generate the simplified form.\nThe second choice would be slightly more efficient, but would be very ugly and error prone.\nWe should be doing all we can to make the rules simpler, not more complicated; that is the whole point of the DCG formalism.\nThis suggests a third approach: change the rule interpreter so that it automatically generates the semantic interpretation as a conjunction of the constituents, unless the rule explicitly says otherwise.\nThis section shows how to augment the DCG rules to handle common cases like this automatically.\n\nConsider again a rule from [section 20.4](#s0025):\n\n```lisp\n(rule (S (and ?np ?vp)) -->\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n```\n\nIf we were to alter this rule to produce a simplified semantic interpretation, it would look like the following, where the predicate `and*` simplifies a list of conjunctions into a single conjunction:\n\n```lisp\n(rule (S ?sem) -->\n   (np ?agr ?x ?np)\n   (vp ?agr ?x ?vp)\n   (:test (and*(?np ?vp) ?sem)))\n```\n\nMany rules will have this form, so we adopt a simple convention: if the last argument of the constituent on the left-hand side of a rule is the keyword `:sem`, then we will build the semantics by replacing `:sem` with a conjunction formed by combining all the last arguments of the constituents on the right-hand side of the rule.\n`A==>` arrow will be used for rules that follow this convention, so the following rule is equivalent to the one above:\n\n```lisp\n(rule (S :sem) ==>\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n```\n\nIt is sometimes useful to introduce additional semantics that does not come from one of the constituents.\nThis can be indicated with an element of the right-hand side that is a list starting with `:sem`.\nFor example, the following rule adds to the semantics the fact that `?x` is the topic of the sentence:\n\n```lisp\n(rule (S :sem) ==>\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp)\n   (:sem (topic ?x)))\n```\n\nBefore implementing the rule function for the `==>` arrow, it is worth considering if there are other ways we could make things easier for the rule writer.\nOne possibility is to provide a notation for describing examples.\nExamples make it easier to understand what a rule is designed for.\nFor the `S` rule, we could add examples like this:\n\n```lisp\n(rule (S :sem) ==>\n   (:ex \"John likes Mary\" \"He sleeps\")\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n```\n\nThese examples not only serve as documentation for the rule but also can be stored under `S` and subsequently run when we want to test if `S` is in fact implemented properly.\n\nAnother area where the rule writer could use help is in handling left-recursive rules.\nConsider the rule that says that a sentence can consist of two sentences joined by a conjunction:\n\n```lisp\n(rule (S (?conj ?sl ?s2)) ==>\n   (:ex \"John likes Mary and Mary likes John\")\n   (S ?sl)\n   (Conj ?conj)\n   (S ?s2))\n```\n\nWhile this rule is correct as a declarative statement, it will run into difficulty when run by the standard top-down depth-first DCG interpretation process.\nThe top-level goal of parsing an `S` will lead immediately to the subgoal of parsing an `S`, and the resuit will be an infinite loop.\n\nFortunately, we know how to avoid this kind of infinite loop: split the offending predicate, `S`, into two predicates: one that supports the recursion, and one that is at a lower level.\nWe will call the lower-level predicate `S-`.\nThus, the following rule says that a sentence can consist of two sentences, where the first one is not conjoined and the second is possibly conjoined:\n\n```lisp\n(rule (S (?conj ?sl ?s2)) ==>\n   (S_ ?sl)\n   (Conj ?conj)\n   (S ?s2))\n```\n\nWe also need a rule that says that a possibly conjoined sentence can consist of a nonconjoined sentence:\n\n```lisp\n(rule (S ?sem) ==> (S- ?sem))\n```\n\nTo make this work, we need to replace any mention of `S` in the left-hand side of a rule with `S-`.\nReferences to `S` in the right-hand side of rules remain unchanged.\n\n```lisp\n(rule (S- ?sem) ==>...)\n```\n\nTo make this all automatic, we will provide a macro, `conj-rule`, that declares a category to be one that can be conjoined.\nSuch a declaration will automatically generate the recursive and nonrecursive rules for the category, and will insure that future references to the category on the left-hand side of a rule will be replaced with the corresponding lower-level predicate.\n\nOne problem with this approach is that it imposes a right-branching parse on multiple conjoined phrases.\nThat is, we will get parses like \"spaghetti and (meatballs and salad)\" not \"(spaghetti and meatballs) and salad.\" Clearly, that is the wrong interpretation for this sentence.\nStill, it can be argued that it is best to produce a single canonical parse, and then let the semantic interpretation functions worry about rearranging the parse in the right order.\nWe will not attempt to resolve this debate but will provide the automatic conjunction mechanism as a tool that can be convenient but has no cost for the user who prefers a different solution.\n\nWe are now ready to implement the extended DCG rule formalism that handles `:sem, :ex,` and automatie conjunctions.\nThe function `make-augmented-dcg,` stored under the arrow `==>`, will be used to implement the formalism:\n\n```lisp\n(setf (get '==>'rule-function) 'make-augmented-dcg)\n(defun make-augmented-dcg (head body)\n   \"Build an augmented DCG rule that handles :sem, :ex,\n   and automatie conjunctiontive constituents.\"\n   (if (eq (lastl head) :sem)\n           ;; Handle :sem\n           (let* ((?sem (gensym \"?SEM\")))\n             (make-augmented-dcg\n               '(.@(butlast head) ,?sem)\n               '(,@(remove :sem body :key #'first-or-nil)\n                  (:test ,(collect-sems body ?sem)))))\n      ;; Separate out examples from body\n         (multiple-value-bind (exs new-body)\n         (partition-if #'(lambda (x) (starts-with x :ex)) body)\n        ;; Handle conjunctions\n    (let ((rule '(rule ,(handle-conj head) --> ,@new-body)))\n         (if (null exs) rule\n                rule\n              '(progn (:ex ,head ..(mappend #'rest exs))\n                            ,rule))))))\n```\n\nFirst we show the code that collects together the semantics of each constituent and conjoins them when `:sem` is specified.\nThe function `collect-sems` picks out the semantics and handles the trivial cases where there are zero or one constituents on the right-hand side.\nIf there are more than one, it inserts a call to the predicate `and*`.\n\n```lisp\n(defun collect-sems (body ?sem)\n   \"Get the semantics out of each constituent in body,\n   and combine them together into ?sem.\"\n   (let ((sems (loop for goal in body\n     unless (or (dcg-normal-goal-p goal)\n        (dcg-word-list-p goal)\n        (starts-with goal :ex)\n        (atom goal))\n     collect (lastl goal))))\n   (case (length sems)\n    (0 '(= ,?sem t))\n    (1 '(= ,?sem .(first sems)))\n    (t '(and* ,sems ,?sem)))))\n```\n\nWe could have implemented `and*` with Prolog clauses, but it is slightly more efficient to do it directly in Lisp.\nA call to `conjuncts` collects all the conjuncts, and we then add an and if necessary:\n\n```lisp\n(defun and*/2 (in out cont)\n   \"IN is a list of conjuncts that are conjoined into OUT.\"\n   ;; E.g.: (and* (t (and a b) t (and c d) t) ?x) ==>\n   ;; ?x = (and a b c d)\n   (if (unify! out (maybe-add 'and (conjuncts (cons 'and in)) t))\n          (funcall cont)))\n(defun conjuncts (exp)\n   \"Get all the conjuncts from an expression.\"\n   (deref exp)\n   (cond ((eq exp t) nil)\n             ((atom exp) (list exp))\n              ((eq (deref (first exp)) 'nil) nil)\n              ((eq (first exp) 'and)\n               (mappend #'conjuncts (rest exp)))\n              (t (list exp))))\n```\n\nThe next step is handling example phrases.\nThe code in `make-augmented-dcg` turns examples into expressions of the form:\n\n```lisp\n(:ex (S ?sem) \"John likes Mary\" \"He sleeps\")\n```\n\nTo make this work, :ex will have to be a macro:\n\n```lisp\n(defmacro :ex ((category . args) &body examples)\n   \"Add some example phrases, indexed under the category.\"\n   '(add-examples '.category '.args '.examples))\n```\n\n`:ex calls add-examples` to do all the work.\nEach example is stored in a hash table indexed under the the category.\nEach example is transformed into a two-element list: the example phrase string itself and a call to the proper predicate with all arguments supplied.\nThe function `add-examples` does this transformation and indexing, and `run-examples` retrieves the examples stored under a category, prints each phrase, and calls each goal.\nThe auxiliary functions `get-examples` and `clear-exampl` es are provided to manipulate the example table, and `remove-punction, punctuation-p` and `string->list` are used to map from a string to a list of words.\n\n```lisp\n(defvar *examples* (make-hash-table :test #'eq))\n(defun get-exampl es (category) (gethash category *examples*))\n(defun clear-examples () (clrhash *examples*))\n(defun add-examples (category args examples)\n   \"Add these example strings to this category,\n   and when it cornes time to run them, use the args.\"\n   (dolist (example examples)\n     (when (stringp example)\n        (let ((ex '(,example\n                       (,category ,@args\n                        ,(string->list\n                           (remove-punctuation example)) ()))))\n      (unless (member ex (get-examples category)\n                              :test #'equal )\n       (setf (gethash category *examples*)\n            (nconc (get-examples category) (1ist ex))))))))\n(defun run-examples (&optional category)\n   \"Run all the example phrases stored under a category.\n   With no category, run ALL the examples.\"\n   (prolog-compi1e-symbols)\n   (if (null category)\n      (maphash #'(lambda (cat val)\n            (declare (ignore val ))\n            (format t \"\"2&Examples of \"a:\"&\" cat)\n            (run-examples cat))\n       *examples*)\n   (dolist (example (get-examples category))\n       (format t \"\"2&EXAMPLE: \"{\"a\"&\"9T\"a\"}\" example)\n       (top-level-prove (cdr example)))))\n(defun remove-punctuation (string)\n   \"Replace punctuation with spaces in string.\"\n   (substitute-if #\\space #'punctuation-p string))\n(defun string->list (string)\n   \"Convert a string to a list of words.\"\n   (read-from-string(concatenate 'string \"(\"string \")\")))\n(defun punctuation-p (char) (find char \"*_..,;:'!?#-()\\\\\\\"\"))\n```\n\nThe final part of our augmented DCG formalism is handling conjunctive constituents automatically.\nWe already arranged to translate category symbols on the left-hand side of rules into the corresponding conjunctive category, as specified by the function `handle-conj`.\nWe also want to generate automatically (or as easily as possible) rules of the following form:\n\n```lisp\n(rule (S (?conj ?sl ?s2)) ==>\n   (S_ ?sl)\n   (Conj ?conj)\n   (S ?s2))\n(rule (S ?sem) ==> (S_ ?sem))\n```\n\nBut before we generate these rules, let's make sure they are exactly what we want.\nConsider parsing a nonconjoined sentence with these two rules in place.\nThe first rule would parse the entire sentence as a `S_`, and would then fail to see a `Conj`, and thus fail.\nThe second rule would then duplicate the entire parsing process, thus doubling the amount of time taken.\nIf we changed the order of the two rules we would be able to parse nonconjoined sentences quickly, but would have to backtrack on conjoined sentences.\n\nThe following shows a better approach.\nA single rule for `S` parses a sentence with `S_`, and then calls `Conj_S`, which can be read as \"either a conjunction followed by a sentence, or nothing.\" If the first sentence is followed by nothing, then we just use the semantics of the first sentence; if there is a conjunction, we have to form a combined semantics.\nI have added ... to show where arguments to the predicate other than the semantic argument fit in.\n\n```lisp\n(rule (S ... ?s-combined) ==>\n   (S_ ... ?seml)\n   (Conj_S ?seml ?s-combined))\n(rule (Conj_S ?seml (?conj ?seml ?sem2)) ==>\n   (Conj ?conj)\n   (S ... ?sem2))\n(rule (Conj_S ?seml ?seml) ==>)\n```\n\nNow all we need is a way for the user to specify that these three rules are desired.\nSince the exact method of building up the combined semantics and perhaps even the call to `Conj` may vary depending on the specifics of the grammar being defined, the rules cannot be generated entirely automatically.\nWe will settle for a macro, `conj-rule`, that looks very much like the second of the three rules above but expands into all three, plus code to relate `S_` to `S`.\nSo the user will type:\n\n```lisp\n(conj-rule (Conj_S ?seml (?conj ?seml ?sem2)) ==>\n   (Conj ?conj)\n   (S ?a ?b ?c ?sem2))\n```\n\nHere is the macro definition:\n\n```lisp\n(defmacro conj-rule ((conj-cat sem1 combined-sem) ==>\n          conj (cat . args))\n   \"Define this category as an automatic conjunction.\"\n   '(progn\n   (setf (get ',cat 'conj-cat) ',(symbol cat '_))\n   (rule (.cat ,@(butlast args) ?combined-sem) ==>\n      (,(symbol cat '_) ,@(butlast args) .sem1)\n      (,conj-cat ,seml ?combined-sem))\n   (rule (,conj-cat ,sem1 ,combined-sem) ==>\n      ,conj\n     (,cat .@args))\n   (rule (,conj-cat ?seml ?seml) ==>)))\n```\n\nand here we define `handle-conj` to substitute `S-` for `S` in the left-hand side of rules:\n\n```lisp\n(defun handle-conj (head)\n   \"Replace (Cat ...) with (Cat-...) if Cat is declared\n   as a conjunctive category.\"\n   (if (and (listp head) (conj-category (predicate head)))\n   (cons (conj-category (predicate head)) (args head))\n   head))\n(defun conj-category (predicate)\n   \"If this is a conjunctive predicate, return the Cat- symbol.\"\n   (get predicate 'conj-category))\n```\n\n## 20.8 History and References\n{:#s0045}\n{:.h1hd}\n\nAs we have mentioned, Alain Colmerauer invented Prolog to use in his grammar of French (1973).\nHis *metamorphosis grammar* formalism was more expressive but much less efficient than the standard DCG formalism.\n\nThe grammar in [section 20.4](#s0025) is essentially the same as the one presented in Fernando Pereira and David H.\nD.\nWarren's 1980 paper, which introduced the Definite Clause Grammar formalism as it is known today.\nThe two developed a much more substantial grammar and used it in a very influential question-answering system called Chat-80 ([Warren and Pereira, 1982](B9780080571157500285.xhtml#bb1340)).\nPereira later teamed with Stuart Shieber on an excellent book covering logic grammars in more depth: *Prolog and Natural-Language Analysis* (1987).\nThe book has many strong points, but unfortunately it does not present a grammar anywhere near as complete as the Chat-80 grammar.\n\nThe idea of a compositional semantics based on mathematical logic owes much to the work of the late linguist Richard Montague.\nThe introduction by [Dowty, Wall, and Peters (1981)](B9780080571157500285.xhtml#bb0335) and the collection by [Rich Thomason (1974)](B9780080571157500285.xhtml#bb1235) cover Montague's approach.\n\nThe grammar in [section 20.5](#s0030) is based loosely on Michael McCord's modular logic grammar, as presented in [Walker et al.\n1990](B9780080571157500285.xhtml#bb1295).\n\nIt should be noted that logic grammars are by no means the only approach to natural language processing.\n[Woods (1970)](B9780080571157500285.xhtml#bb1425) presents an approach based on the *augmented transition network*, or ATN.\nA transition network is like a context-free grammar.\nThe *augmentation* is a way of manipulating features and semantic values.\nThis is just like the extra arguments in DCGs, except that the basic operations are setting and testing variables rather than unification.\nSo the choice between ATNs and DCGs is largely a matter of what programming approach you are most comfortable with: procedural for ATNs and declarative for DCGs.\nMy feeling is that unification is a more suitable primitive than assignment, so I chose to present DCGs, even though this required bringing in Prolog's backtracking and unification mechanisms.\n\nIn either approach, the same linguistic problems must be addressed-agreement, long-distance dependencies, topicalization, quantifier-scope ambiguity, and so on.\nComparing [Woods's (1970)](B9780080571157500285.xhtml#bb1425) ATN grammar to [Pereira and Warren's (1980)](B9780080571157500285.xhtml#bb0950) DCG grammar, the careful reader will see that the solutions have much in common.\nThe analysis is more important than the notation, as it should be.\n\n## 20.9 Exercises\n{:#s0050}\n{:.h1hd}\n\n**Exercise 20.2 [m]** Modify the grammar (from [section 20.4](#s0025), [20.5](#s0030), [or 20.6](#s0035)) to allow for adjectives before a noun.\n\n**Exercise 20.3 [m]** Modify the grammar to allow for prepositional phrase modifiers on verb and noun phrases.\n\n**Exercise 20.4 [m]** Modify the grammar to allow for ditransitive verbs-verbs that take two objects, as in \"give the dog a bone.\"\n\n**Exercise 20.5** Suppose we wanted to adopt the Prolog convention of writing DCG tests and words in brackets and braces, respectively.\nWrite a function that will alter the readtable to work this way.\n\n**Exercise 20.6 [m]** Define a rule function for a new type of DCG rule that automatically builds up a syntactic parse of the input.\nFor example, the two rules:\n\n```lisp\n(rule (s) => (np) (vp))\n(rule (np) => (:word he))\n```\n\nshould be equivalent to:\n\n```lisp\n(rule (s (s ?1 ?2)) --> (np ?1) (vp ?2))\n(rule (np (np he)) --> (:word he))\n```\n\n**Exercise 20.7 [m]** There are advantages and disadvantages to the approach that Prolog takes in dividing predicates into clauses.\nThe advantage is that it is easy to add a new clause.\nThe disadvantage is that it is hard to alter an existing clause.\nIf you edit a clause and then evaluate it, the new clause will be added to the end of the clause list, when what you really wanted was for the new clause to take the place of the old one.\nTo achieve that effect, you have to call `clear-predicate`, and then reload all the clauses, not just the one that has been changed.\n\nWrite a macro `named-rule` that is just like `rule`, except that it attaches names to clauses.\nWhen a named rule is reloaded, it replaces the old clause rather than adding a new one.\n\n**Exercise 20.8 [h]** Extend the DCG rule function to allow or goals in the right-hand side.\nTo make this more useful, also allow `and` goals.\nFor example:\n\n```lisp\n(rule (A) --> (B) (or (C) (and (D) (E))) (F))\n```\n\nshould compile into the equivalent of :\n\n```lisp\n(<- (A ?S0 ?S4)\n   (B ?S0 ?S1)\n   (OR (AND (C ?S1 ?S2) (= ?S2 ?S3))\n  (AND (D ?S1 ?S2) (E ?S2 ?S3)))\n   (F ?S3 ?S4))\n```\n\n## 20.10 Answers\n{:#s0055}\n{:.h1hd}\n\n**Answer 20.1** It uses local variables `(?s0, ?sl ...)` that are not guaranteed to be unique.\nThis is a problem if the grammar writer wants to use these symbols anywhere in his or her rules.\nThe fix is to `gensym` symbols that are guaranteed to be unique.\n\n### Answer 20.5\n{:#s0060}\n{:.h2hd}\n\n```lisp\n(defun setup-braces Uoptional (on? t) (readtable *readtable*))\n   \"Make [a b] read as (:word a b) and {a b} as (:test a b c) if ON? is true; otherwise revert {[]} to normal.\"\n   if ON? is true; otherwise revert {[]} to normal.\"\n   (if (not on?)\n   (map nil #'(lambda (c)\n       (set-macro-character c (get-macro-character #\\a)\n            t readtable))\n    \"{[]}\")\n   (progn\n    (set-macro-character\n     #\\] (get-macro-character #\\)) nil readtable)\n    (set-macro-character\n     #\\} (get-macro-character #\\)) nil readtable)\n    (set-macro-character\n     #\\[ #'(lambda (s ignore)\n         (cons :word (read-delimited-1ist #\\] s t)))\n     nil readtable)\n    (set-macro-character\n     #\\{ #'(lambda (s ignore)\n         (cons :test (read-delimited-1ist #\\} s t)))\n     nil readtable))))\n```\n\n----------------------\n\n[1](#xfn0015) The asterisk at the start of a sentence is the standard linguistic notation for an utterance that is ungrammatical or otherwise ill-formed.\n!!!(p) {:.ftnote1}\n\n# Chapter 21\n## A Grammar of English\n{:.chaptitle}\n\n> Prefer geniality to grammar.\n\n> -Henry Watson Fowler\n\n> *The King's English* (1906)\n\nThe previous two chapters outline techniques for writing grammars and parsers based on those grammars.\nIt is quite straightforward to apply these techniques to applications like the CD player problem where input is limited to simple sentences like \"Play 1 to 8 without 3.\" But it is a major undertaking to write a grammar for unrestricted English input.\nThis chapter develops a grammar that covers all the major syntactic constructions of English.\nIt handles sentences of much greater complexity, such as \"Kim would not have been persuaded by Lee to look after the dog.\" The grammar is not comprehensive enough to handle sentences chosen at random from a book, but when augmented by suitable vocabulary it is adequate for a wide variety of applications.\n\nThis chapter is organized as a tour through the English language.\nWe first cover noun phrases, then verb phrases, clauses, and sentences.\nFor each category we introduce examples, analyze them linguistically, and finally show definite clause grammar rules that correspond to the analysis.\n\nAs the last chapter should have made clear, analysis more often results in complication than in simplification.\nFor example, starting with a simple rule like `(S --> NP VP)`, we soon find that we have to add arguments to handle agreement, semantics, and gapping information.\n[Figure 21.1](#f0010) lists the grammatical categories and their arguments.\nNote that the semantic argument, `sem`, is always last, and the gap accumulators, `gap1` and `gap2`, are next-to-last whenever they occur.\nAll single-letter arguments denote metavariables; for example, each noun phrase (category NP) will have a semantic interpretation, `sem`, that is a conjunction of relations involving the variable `x`.\nSimilarly, the `hin modifiers` is a variable that refers to the head-the thing that is being modified.\nThe other arguments and categories will be explained in turn, but it is handy to have this figure to refer back to.\n\n![f21-01-9780080571157](images/B9780080571157500212/f21-01-9780080571157.jpg)     \nFigure 21.1\n!!!(span) {:.fignum}\nGrammatical Categories and their Arguments\n\n## 21.1 Noun Phrases\n{:#s0010}\n{:.h1hd}\n\nThe simplest noun phrases are names and pronouns, such as \"Kim\" and \"them.\" The rules for these cases are simple: we build up a semantic expression from a name or pronoun, and since there can be no gap, the two gap accumulator arguments are the same `(?g1)`.\nPerson and number agreement is propagated in the variable `?agr`, and we also keep track of the *case* of the noun phrase.\nEnglish has three cases that are reflected in certain pronouns.\nIn the first person singular, \"I\" is the *nominative* or *subjective* case, \"me\" is the *accusative* or *objective* case, and \"my\" is the *genitive* case.\nTo distinguish them from the genitive, we refer to the nominative and the objective cases as the *common* cases.\nAccordingly, the three cases will be marked by the expressions `(common nom), (common obj),` and gen, respectively.\nMany languages of the world have suffixes that mark nouns as being one case or another, but English does not.\nThus, we use the expression `(common ?)` to mark nouns.\n\nWe also distinguish between noun phrases that can be used in questions, like \"who,\" and those that cannot.\nThe `?wh` variable has the value `+wh` for noun phrases like \"who\" or \"which one\" and `-wh` for nonquestion phrases.\nHere, then, are the rules for names and pronouns.\nThe predicates name and `pronoun` are used to look up words in the lexicon.\n\n```lisp\n(rule (NP ?agr (common ?) -wh ?x ?g1 ?g1 (the ?x (name ?name ?x))) ==>\n  (name ?agr ?name))\n(rule (NP ?agr ?case ?wh ?x ?g1 ?g1 ?sem) ==>\n  (pronoun ?agr ?case ?wh ?x ?sem))\n```\n\nPlural nouns can stand alone as noun phrases, as in \"dogs,\" but singular nouns need a determiner, as in \"the dog\" or \"Kim's friend's biggest dog.\" Plural nouns can also take a determiner, as in \"the dogs.\" The category Det is used for determiners, and NP2 is used for the part of a noun phrase after the determiner:\n\n```lisp\n(rule (NP (- - - +) ?case -wh ?x ?g1 ?g2 (group ?x ?sem)) ==>\n    (:ex \"dogs\") ; Plural nouns don't need a determiner\n    (NP2 (- - - +) ?case ?x ?g1 ?g2 ?sem))\n(rule (NP ?agr (common ?) ?wh ?x ?g1 ?g2 ?sem) ==>\n    (:ex \"Every man\" \"The dogs on the beach\")\n    (Det ?agr ?wh ?x ?restriction ?sem)\n    (NP2 ?agr (common ?) ?x ?g1 ?g2 ?restriction))\n```\n\nFinally, a noun phrase may appear externally to a construction, in which case the noun phrase passed in by the first gap argument will be consumed, but no words from the input will be.\nAn example is the ![f0005](images/B9780080571157500212/f0005.jpg) in \" Whom does Kim like ![f0005](images/B9780080571157500212/f0005.jpg) ?\"\n\n```lisp\n(rule (NP ? agr ?case ?wh ?x (gap (NP ?agr ?case ?x)) (gap nil) t)\n  ==>;; Gapped NP\n   )\n```\n\nNow we address the heart of the noun phrase, the `NP2` category.\nThe lone rule for `NP2` says that it consists of a noun, optionally preceded and followed by modifiers:\n\n```lisp\n(rule (NP2 ?agr (common ?) ?x ?gl ?g2 :sem) ==>\n    (modifiers pre noun ?agr () ?x (gap nil) (gap nil) ?pre)\n    (noun ?agr ?slots ?x ?noun)\n    (modifiers post noun ?agr ?slots ?x ?g1 ?g2 ?post))\n```\n\n## 21.2 Modifiers\n{:#s0015}\n{:.h1hd}\n\nModifiers are split into type types: *Complements* are modifiers that are expected by the head category that is being modified; they cannot stand alone.\n*Adjuncts* are modifiers that are not required but bring additional information.\nThe distinction is clearest with verb modifiers.\nIn \"Kim visited Lee yesterday,\" \"visited\" is the head verb, \"Lee\" is a complement, and \"yesterday\" is an adjunct.\nReturning to nouns, in \"the former mayor of Boston,\" \"mayor\" is the head noun, \"of Boston\" is a complement (although an optional one) and \"former\" is an adjunct.\n\nThe predicate `modifiers` takes eight arguments, so it can be tricky to understand them all.\nThe first two arguments tell if we are before or after the head (`pre` or `post`) and what kind of head we are modifying (`noun`, `verb`, or whatever).\nNext is an argument that passes along any required information-in the case of nouns, it is the agreement feature.\nThe fourth argument is a list of expected complements, here called `?slots`.\nNext is the metavariable used to refer to the head.\nThe final three arguments are the two gap accumulators and the semantics, which work the same way here as we have seen before.\nNotice that the lexicon entry for each `Noun` can have a list of complements that are considered as postnoun modifiers, but there can be only adjuncts as prenoun modifiers.\nAlso note that gaps can appear in the postmodifiers but not in the premodifiers.\nFor example, we can have \"What is Kevin the former mayor of ![f0005](images/B9780080571157500212/f0005.jpg) `?`,\" where the answer might be \"Boston.\" But even though we can construct a noun phrase like \"the education president,\" where \"education\" is a prenoun modifier of \"president,\" we cannot construct \"* What is George the ![f0005](images/B9780080571157500212/f0005.jpg) president?,\" intending that the answer be \"education.\"\n\nThere are four cases for modification.\nFirst, a complement is a kind of modifier.\nSecond, if a complement is marked as optional, it can be skipped.\nThird, an adjunct can appear in the input.\nFourth, if there are no complements expected, then there need not be any modifiers at all.\nThe following rules implement these four cases:\n\n```lisp\n(rule (modifiers ?pre/post ?cat ?info (?slot . ?slots) ?h\n          ?g1 ?g3 :sem) ==>\n   (complement ?cat ?info ?slot ?h ?g1 ?g2 ?mod)\n   (modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods))\n(rule (modifiers ?pre/post ?cat ?info ((? (?) ?) . ?slots) ?h\n          ?g1 ?g2 ?mods) ==>\n   (modifiers ?pre/post ?cat ?info ?slots ?h ?g1 ?g2 ?mods))\n(rule (modifiers ?pre/post ?cat ?info ?slots ?h ?g1 ?g3 :sem) ==>\n   (adjunct ?pre/post ?cat ?info ?h ?g1 ?g2 ?adjunct)\n   (modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods))\n(rule (modifiers ???()? ?g1 ?g1 t) ==> )\n```\n\nWe need to say more about the list of complements, or slots, that can be associated with words in the lexcion.\nEach slot is a list of the form (*role number form),* where the role refers to some semantic relation, the number indicates the ordering of the complements, and the form is the type of constituent expected: noun phrase, verb phrase, or whatever.\nThe details will be covered in the following section on verb phrases, and `complement` will be covered in the section on XPs.\nFor now, we give a single example.\nThe complement list for one sense of the verb \"visit\" is:\n\n```lisp\n((agt 1 (NP ?)) (obj 2 (NP ?)))\n```\n\nThis means that the first complement, the subject, is a noun phrase that fills the agent role, and the second complement is also a noun phrase that fills the object role.\n\n## 21.3 Noun Modifiers\n{:#s0020}\n{:.h1hd}\n\nThere are two main types of prenoun adjuncts.\nMost common are adjectives, as in \"big slobbery dogs.\" Nouns can also be adjuncts, as in \"water meter\" or \"desk lamp.\" Here it is clear that the second noun is the head and the first is the modifier: a desk lamp is a lamp, not a desk.\nThese are known as noun-noun compounds.\nIn the following rules, note that we do not need to say that more than one adjective is allowed; this is handled by the rules for `modifiers`.\n\n```lisp\n(rule (adjunct pre noun ?info ?x ?gap ?gap ?sem) ==>\n   (adj ?x ?sem))\n(rule (adjunct pre noun ?info ?h ?gap ?gap :sem) ==>\n   (:sem (noun-noun ?h ?x))\n   (noun ?agr () ?x ?sem))\n```\n\nAfter the noun there is a wider variety of modifiers.\nSome nouns have complements, which are primarily prepositional phrases, as in \"mayor of Boston.\" These will be covered when we get to the lexical entries for nouns.\nPrepositional phrases can be adjuncts for nouns or verbs, as in \"man in the middle\" and \"slept for an hour.\" We can write one rule to cover both cases:\n\n```lisp\n(rule (adjunct post ?cat ?info ?x ?g1 ?g2 ?sem) ==>\n   (PP ?prep ?prep ?wh ?np ?x ?g1 ?g2 ?sem))\n```\n\nHere are the rules for prepositional phrases, which can be either a preposition followed by a noun phrase or can be gapped, as in \"to whom are you speaking ![f0005](images/B9780080571157500212/f0005.jpg) ?\" The object of a preposition is always in the objective case: \"with him\" not \"*with he.\"\n\n```lisp\n(rule (PP ?prep ?role ?wh ?np ?x ?gl ?g2 :sem) ==>\n   (prep ?prep t)\n   (:sem (?role ?x ?np))\n   (NP ?agr (common obj) ?wh ?np ?gl ?g2 ?np-sem))\n(rule (PP ?prep ?role ?wh ?np ?x\n        (gap (PP ?prep ?role ?np ?x)) (gap nil) t) ==> )\n```\n\nNouns can be modified by present participles, past participles, and relative clauses.\nExamples are \"the man eating the snack,\" \"the snack eaten by the man,\" and \"the man that ate the snack,\" respectively.\nWe will see that each verb in the lexicon is marked with an inflection, and that the marker `-ing` is used for present participles while `-en` is used for past participles.\nThe details of the `clause` will be covered later.\n\n```lisp\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==>\n   (:ex (the man) \"visiting me\" (the man) \"visited by me\")\n   (:test (member ?infl (- ing passive)))\n   (clause ?infl ?x ? ?v (gap (NP ?agr ? ?x)) (gap nil) ?sem))\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==>\n   (rel-clause ?agr ?x ?sem))\n```\n\nIt is possible to have a relative clause where it is an object, not the subject, that the head refers to: \"the snack that the man ate.\" In this kind of relative clause the relative pronoun is optional: \"The snack the man ate was delicious.\" The following rules say that if the relative pronoun is omitted then the noun that is being modified must be an object, and the relative clause should include a subject internally.\nThe constant `int-subj` indicates this.\n\n```lisp\n(rule (rel-clause ?agr ?x :sem) ==>\n   (:ex (the man) \"that she liked\" \"that liked her\"\n      \"that I know Lee liked\")\n   (opt-rel-pronoun ?case ?x ?int-subj ?rel-sem)\n   (clause (finite ? ?) ? ?int-subj ?v\n        (gap (NP ?agr ?case ?x)) (gap nil) ?clause-sem))\n(rule (opt-rel-pronoun ?case ?x ?int-subj (?type ?x)) ==>\n   (:word ?rel-pro)\n   (:test (word ?rel-pro rel-pro ?case ?type)))\n(rule (opt-rel-pronoun (common obj) ?x int-subj t) ==> )\n```\n\nIt should be noted that it is rare but not impossible to have names and pronouns with modifiers: \"John the Baptist,\" \"lovely Rita, meter maid,\" \"Lucy in the sky with diamonds,\" \"Sylvia in accounting on the 42nd floor,\" \"she who must be obeyed.\" Here and throughout this chapter we will raise the possibility of such rare cases, leaving them as exercises for the reader.\n\n## 21.4 Determiners\n{:#s0025}\n{:.h1hd}\n\nWe will cover three kinds of determiners.\nThe simplest is the article: \"a dog\" or \"the dogs.\" We also allow genitive pronouns, as in \"her dog,\" and numbers, as in \"three dogs.\" The semantic interpretation of a determiner-phrase is of the form (*quantifier variable restriction*).\nFor example, `(a ?x (dog ?x) )` or `((number 3) ?x (dog ?x))`.\n\n```lisp\n(rule (Det ?agr ?wh ?x ?restriction (?art ?x ?restriction)) ==>\n   (:ex \"the\" \"every\")\n   (art ?agr ?art)\n   (:test (if (= ?art wh) (= ?wh +wh) (= ?wh -wh))))\n(rule (Det ?agr ?wh ?x ?r (the ?x irestriction)) ==>\n   (:ex \"his\" \"her\")\n   (pronoun ?agr gen ?wh ?y ?sem)\n   (:test (and* ((genitive ?y ?x) ?sem ?r) ?restriction)))\n(rule (Det ?agr -wh ?x ?r ((number ?n) ?x ?r)) ==>\n   (:ex \"three\")\n   (cardinal ?n ?agr))\n```\n\nThese are the most important determiner types, but there are others, and there are pre- and postdeterminers that combine in restricted combinations.\nPredeterminers include all, both, half, double, twice, and such.\nPostdeterminers include every, many, several, and few.\nThus, we can say \"all her many good ideas\" or \"all the King's men.\" But we can not say \"*all much ideas\" or \"*the our children.\" The details are complicated and are omitted from this grammar.\n\n## 21.5 Verb Phrases\n{:#s0030}\n{:.h1hd}\n\nNow that we have defined `modifiers`, verb phrases are easy.\nIn fact, we only need two rules.\nThe first says a verb phrase consists of a verb optionally preceded and followed by modifiers, and that the meaning of the verb phrase includes the fact that the subject fills some role:\n\n```lisp\n(rule (VP ?infl ?x ?subject-slot ?v ?g1 ?g2 :sem) ==>\n   (:ex \"sleeps\" \"quickly give the dog a bone\")\n   (modifiers pre verb ? () ?v (gap nil) (gap nil) ?pre-sem)\n   (:sem (?role ?v ?x)) (:test (= ?subject-slot (?role 1 ?)))\n   (verb ?verb ?infl (?subject-slot .?slots) ?v ?v-sem)\n   (modifiers post verb ? ?slots ?v ?g1 ?g2 ?mod-sem))\n```\n\nThe `VP` category takes seven arguments.\nThe first is an inflection, which represents the tense of the verb.\nTo describe the possibilities for this argument we need a quick review of some basic linguistics.\nA sentence must have a *finite* verb, meaning a verb in the present or past tense.\nThus, we say \"Kim likes Lee,\" not \"*Kim liking Lee.\" Subject-predicate agreement takes effect for finite verbs but not for any other tense.\nThe other tenses show up as complements to other verbs.\nFor example, the complement to \"want\" is an infinitive: \"Kim wants *to like* Lee\" and the complement to the modal auxiliary verb \"would\" is a nonfinite verb: \"Kim would *like* Lee.\" If this were in the present tense, it would be \"likes,\" not \"like.\" The inflection argument takes on one of the forms in the table here:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Expression | Type | Example |\n| `(finite ?agr present)` | present tense | eat, eats |\n| `(finite ?agr past)` | past tense | ate |\n| `nonfinite` | nonfinite | eat |\n| `infinitive` | infinitive | to eat |\n| `-en` | past participle | eaten |\n| `-ing` | present participle | eating |\n\nThe second argument is a metavariable that refers to the subject, and the third is the subject's complement slot.\nWe adopt the convention that the subject slot must always be the first among the verb's complements.\nThe other slots are handled by the postverb modifiers.\nThe fourth argument is a metavariable indicating the verb phrase itself.\nThe final three are the familiar gap and semantics arguments.\nAs an example, if the verb phrase is the single word \"slept,\" then the semantics of the verb phrase will be `(and (past ?v) (sleep ?v))`.\nOf course, adverbs, complements, and adjuncts will also be handled by this rule.\n\nThe second rule for verb phrases handles auxiliary verbs, such as \"have,\" \"is\" and \"would.\" Each auxiliary verb (or `aux`) produces a verb phrase with a particular inflection when followed by a verb phrase with the required inflection.\nTo repeat an example, \"would\" produces a finite phrase when followed by a nonfinite verb.\n\"Have\" produces a nonfinite when followed by a past participle.\nThus, \"would have liked\" is a finite verb phrase.\n\nWe also need to account for negation.\nThe word \"not\" can not modify a bare main verb but can follow an auxiliary verb.\nThat is, we can't say \"*Kim not like Lee,\" but we can add an auxiliary to get \"Kim does not like Lee.\"\n\n```lisp\n(rule (VP ?infl ?x ?subject-slot ?v ?gl ?g2 :sem) ==>\n   (:ex \"is sleeping\" \"would have given a bone to the dog.\"\n        \"did not sleep\" \"was given a bone by this old man\")\n   ;; An aux verb, followed by a VP\n   (aux ? infl ?needs-infl ?v ?aux)\n   (modifiers post aux ? () ?v (gap nil) (gap nil) ?mod)\n   (VP ?needs-infl ?x ?subject-slot ?v ?g1 ?g2 ?vp))\n(rule (adjunct post aux ? ?v ?gap ?gap (not ?v)) ==>\n   (:word not))\n```\n\n## 21.6 Adverbs\n{:#s0035}\n{:.h1hd}\n\nAdverbs can serve as adjuncts before or after a verb: \"to boldly go,\" \"to go boldly.\" There are some limitations on where they can occur, but it is difficult to come up with firm rules; here we allow any adverb anywhere.\nWe define the category `advp` for adverbial phrase, but currently restrict it to a single adverb.\n\n```lisp\n(rule (adjunct ?pre/post verb ?info ?v ?g1 ?g2 ?sem) ==>\n   (advp ?wh ?v ?g1 ?g2 ?sem))\n(rule (advp ?wh ?v ?gap ?gap ?sem) ==>\n   (adverb ?wh ?v ?sem))\n(rule (advp ?wh ?v (gap (advp ?v)) (gap nil) t) ==> )\n```\n\n## 21.7 Clauses\n{:#s0040}\n{:.h1hd}\n\nA clause consists of a subject followed by a predicate.\nHowever, the subject need not be realized immediately before the predicate.\nFor example, in \"Alice promised Bob to lend him her car\" there is an inf initive clause that consists of the predicate \"to lend him her car\" and the subject \"Alice.\" The sentence as a whole is another clause.\nIn our analysis, then, a clause is a subject followed by a verb phrase, with the possibility that the subject will be instantiated by something from the gap arguments:\n\n```lisp\n(rule (clause ?infl ?x ?int-subj ?v ?gap1 ?gap3 :sem) ==>\n   (subject ?agr ?x ?subj-slot ?int-subj ?gap1 ?gap2 ?subj-sem)\n   (VP ?infl ?x ?subj-slot ?v ?gap2 ?gap3 ?pred-sem)\n   (:test (subj-pred-agree ?agr ?infl)))\n```\n\nThere are now two possibilities for `subject`.\nIn the first case it has already been parsed, and we pick it up from the gap list.\nIf that is so, then we also need to find the agreement feature of the subject.\nIf the subject was a noun phrase, the agreement will be present in the gap list.\nIf it was not, then the agreement is third-person singular.\nAn example of this is \" *That the Red Sox won* surprises me,\" where the italicized phrase is a non-NP subject.\nThe fact that we need to use \"surprises\" and not \"surprise\" indicates that it is third-person singular.\nWe will see that the code `(- - + -)` is used for this.\n\n```lisp\n(rule (subject ?agree ?x ?subj-slot ext-subj\n        (gap ?subj) (gap nil) t) ==>\n   ;; Externally realized subject (the normal case for S)\n   (:test (slot-constituent ?subj-slot ?subj ?x ?)\n        (if (= ?subj (NP ?agr ?case ?x))\n          (= ?agree ?agr)\n          (= ?agree (- - + -))))) ;Non-NP subjects are 3sing\n```\n\nIn the second case we just parse a noun phrase as the subject.\nNote that the fourth argument to `subject` is either `ext-subj` or `int-subj` depending on if the subject is realized internally or externally.\nThis will be important when we cover sentences in the next section.\nIn case it was not already clear, the second argument to both `clause` and `subject` is the metavariable representing the subject.\n\n```lisp\n(rule (subject ?agr ?x (?role 1 (NP ?x)) int-subj ?gap ?gap ?sem)\n   ==>\n    (NP ?agr (common nom) ?wh ?x (gap nil) (gap nil) ?sem))\n```\n\nFinally, the rules for subject-predicate agreement say that only finite predicates need to agree with their subject:\n\n```lisp\n(<- (subj-pred-agree ?agr (finite ?agr ?)))\n(<- (subj-pred-agree ? ?infl) (atom ?infl))\n```\n\n## 21.8 Sentences\n{:#s0045}\n{:.h1hd}\n\nIn the previous chapter we allowed only simple declarative sentences.\nThe current grammar supports commands and four kinds of questions in addition to declarative sentences.\nIt also supports *thematic fronting:* placing a nonsubject at the beginning of a sentence to emphasize its importance, as in \"*Smith* he says his name is\" or *\"Murder,* she wrote\" or *\"ln God* we trust.\" In the last example it is a prepositional phrase, not a noun phrase, that occurs first.\nIt is also possible to have a subject that is not a noun phrase: *\"That the dog didn't bark* puzzled Holmes.\" To support all these possibilities, we introduce a new category, `XP`, which stands for any kind of phrase.\nA declarative sentence is then just an XP followed by a clause, where the subject of the clause may or may not turn out to be the XP:\n\n```lisp\n(rule (S ?s :sem) ==>\n  (:ex \"Kim likes Lee\" \"Lee, I like _\" \"In god, we trust _\"\n      \"Who likes Lee?\" \"Kim likes who?\")\n  (XP ?kind ?constituent ?wh ?x (gap nil) (gap nil) ?topic-sem)\n  (clause (finite ? ?) ?x ? ?s (gap ?constituent) (gap nil) ?sem))\n```\n\nAs it turns out, this rule also serves for two types of questions.\nThe simplest kind of question has an interrogative noun phrase as its subject: \"Who likes Lee?\" or \"What man likes Lee?\" Another kind is the so-called *echo question*, which can be used only as a reply to another statement: if I tell you Kim likes Jerry Lewis, you could reasonably reply \"Kim likes *who*?\" Both these question types have the same structure as declarative sentences, and thus are handled by the same rule.\n\nThe following table lists some sentences that can be parsed by this rule, showing the XP and subject of each.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Sentence | XP | Subject |\n| Kim likes Lee | Kim | Kim |\n| Lee, Kim likes | Lee | Kim |\n| In god, we trust | In god | we |\n| That Kim likes Lee amazes | That Kim likes Lee | That Kim likes Lee |\n| Who likes Lee? | Who | Who |\n\nThe most common type of command has no subject at all: \"Be quiet\" or \"Go to your room.\" When the subject is missing, the meaning is that the command refers to *you*, the addressee of the command.\nThe subject can also be mentioned explicitly, and it can be \"you,\" as in \"You be quiet,\" but it need not be: \"Somebody shut the door\" or \"Everybody sing along.\" We provide a rule only for commands with subject omitted, since it can be difficult to distinguish a command with a subject from a declarative sentence.\nNote that commands are always nonfinite.\n\n```lisp\n(rule (S ?s :sem) ==>\n   ;; Commands have implied second-person subject\n   (:ex \"Give the dog a bone.\")\n   (:sem (command ?s))\n   (:sem (listener ?x))\n   (clause nonfinite ?x ext-subj ?s\n        (gap (NP ? ? ?x)) (gap nil) ?sem))\n```\n\nAnother form of command starts with \"let,\" as in \"Let me see what I can do\" and \"Let us all pray.\" The second word is better considered as the object of \"let\" rather than the subject of the sentence, since the subject would have to be \"I\" or \"we.\" This kind of command can be handled with a lexical entry for \"let\" rather than with an additional rule.\n\nWe now consider questions.\nQuestions that can be answered by yes or no have the subject and auxiliary verb inverted: \"Did you see him?\" or \"Should I have been doing this?\" The latter example shows that it is only the first auxiliary verb that cornes before the subject.\nThe category `aux-inv-S` is used to handle this case:\n\n```lisp\n(rule (S ?s (yes-no ?s ?sem)) ==>\n   (:ex \"Does Kim like Lee?\" \"Is he a doctor?\")\n   (aux-inv-S nil ?s ?sem))\n```\n\nQuestions that begin with a wh-phrase also have the auxiliary verb before the subject, as in \"Who did you see?\" or \"Why should I have been doing this?\" The first constituent can also be a prepositional phrase: \"For whom am I doing this?\" The following rule parses an XP that must have the `+wh` feature and then parses an `aux-inv-S` to arrive at a question:\n\n```lisp\n(rule (S ?s :sem) ==>\n   (:ex \"Who does Kim like _?\" \"To whom did he give it _?\"\n      \"What dog does Kim like _?\")\n   (XP ?slot ?constituent +wh ?x (gap nil) (gap nil) ?subj-sem)\n   (aux-inv-S iconstituent ?s ?sem))\n```\n\nA question can also be signaled by rising intonation in what would otherwise be a declarative statement: \"You want some?\" Since we don't have intonation information, we won't include this kind of question.\n\nThe implementation for `aux-inv-S` is straightforward: parse an auxiliary and then a clause, pausing to look for modifiers in between.\n(So far, a \"not\" is the only modifier allowed in that position.)\n\n```lisp\n(rule (aux-inv-S ?constituent ?v :sem) ==>\n   (:ex \"Does Kim like Lee?\" (who) \"would Kim have liked\")\n   (aux (finite ?agr ?tense) ?needs-infl ?v ?aux-sem)\n   (modifiers post aux ? () ?v (gap nil) (gap nil) ?mod)\n   (clause ?needs-infl ?x int-subj ?v (gap ?constituent) (gap nil)\n        ?clause-sem))\n```\n\nThere is one more case to consider.\nThe verb \"to be\" is the most idiosyncratic in English.\nIt is the only verb that has agreement differences for anything besides third-person singular.\nAnd it is also the only verb that can be used in an `aux-inv-S` without a main verb.\nAn example of this is \"Is he a doctor?,\" where \"is\" clearly is not an auxiliary, because there is no main verb that it could be auxiliary to.\nOther verb can not be used in this way: \"*Seems he happy?\" and \"* Did they it?\" are ungrammatical.\nThe only possibility is \"have,\" as in \"Have you any wool?,\" but this use is rare.\n\nThe following rule parses a verb, checks to see that it is a version of \"be,\" and then parses the subject and the modifiers for the verb.\n\n```lisp\n(rule (aux-inv-S ?ext ?v :sem) ==>\n   (:ex \"Is he a doctor?\")\n   (verb ?be (finite ?agr ?) ((?role ?n ?xp) . ?slots) ?v ?sem)\n   (:test (word ?be be))\n   (subject ?agr ?x (?role ?n ?xp) int-subj\n      (gap nil) (gap nil) ?subj-sem)\n   (:sem (?role ?v ?x))\n   (modifiers post verb ? ?slots ?v (gap ?ext) (gap nil) ?mod-sem))\n```\n\n## 21.9 XPs\n{:#s0050}\n{:.h1hd}\n\nAll that remains in our grammar is the XP category.\nXPs are used in two ways: First, a phrase can be extraposed, as in \"*In god* we trust,\" where \"in god\" will be parsed as an XP and then placed on the gap list until it can be taken off as an adjunct to \"trust.\" Second, a phrase can be a complement, as in \"He wants *to be a fireman,\"* where the infinitive phrase is a complement of \"wants.\"\n\nAs it turns out, the amount of information that needs to appear in a gap list is slightly different from the information that appears in a complement slot.\nFor example, one sense of the verb \"want\" has the following complement list:\n\n```lisp\n((agt 1 (NP ?x)) (con 3 (VP infinitive ?x)))\n```\n\nThis says that the first complement (the subject) is a noun phrase that serves as the agent of the wanting, and the second is an infinitive verb phrase that is the concept of the wanting.\nThe subject of this verb phrase is the same as the subject of the wanting, so in \"She wants to go home\" it is she who both wants and goes.\n(Contrast this to \"He persuaded her to go home,\" where it is he that persuades, but she that goes.)\n\nBut when we put a noun phrase on a gap list, we need to include its number and case as well as the fact that it is an NP and its metavariable, but we don't need to include the fact that it is an agent.\nThis difference means we have two choices: either we can merge the notions of slots and gap lists so that they use a common notation containing all the information that either can use, or we need some way of mapping between them.\nI made the second choice, on the grounds that each notation was complicated enough without bringing in additional information.\n\nThe relation `slot-constituent` maps between the slot notation used for complements and the constituent notation used in gap lists.\nThere are eight types of complements, five of which can appear in gap lists: noun phrases, clauses, prepositional phrases, the word \"it\" (as in \"it is raining\"), and adverbial phrases.\nThe three phrases that are allowed only as complements are verb phrases, particles (such as \"up\" in \"look up the number\"), and adjectives.\nHere is the mapping between the two notations.\nThe *** indicates no mapping:\n\n```lisp\n(<- (slot-constituent (?role ?n (NP ?x))\n          (NP ?agr ?case ?x) ?x ?h))\n(<- (slot-constituent (?role ?n (clause ?word ?infl))\n          (clause ?word ?infl ?v) ?v ?h))\n(<- (slot-constituent (?role ?n (PP ?prep ?np))\n          (PP ?prep ?role ?np ?h) ?np ?h))\n(<- (slot-constituent (?role ?n it)      (it ? ? ?x) ?x ?))\n(<- (slot-constituent (manner 3 (advp ?x))      (advp ?v) ? ?v))\n(<- (slot-constituent (?role ?n (VP ?1nfl ?x)) *** ? ?))\n(<- (slot-constituent (?role ?n (Adj ?x)) *** ?x ?))\n(<- (slot-constituent (?role ?n (P ?particle)) *** ? ?))\n```\n\nWe are now ready to define compi ement.\nIt takes a slot descrption, maps it into a constituent, and then calls `XP` to parse that constituent:\n\n```lisp\n(rule (complement ?cat ?1nfo (?role ?n ?xp) ?h ?gapl ?gap2 :sem) ==>\n   ;; A complement is anything expected by a slot\n   (:sem (?role ?h ?x))\n   (:test (slot-constituent (?role ?n ?xp) iconstituent ?x ?h))\n   (XP ?xp ?constituent ?wh ?x ?gapl ?gap2 ?sem))\n```\n\nThe category `XP` takes seven arguments.\nThe first two are the slot we are trying to fill and the constituent we need to fill it.\nThe third is used for any additional information, and the fourth is the metavariable for the phrase.\nThe last three supply gap and semantic information.\n\nHere are the first five XP categories:\n\n```lisp\n(rule (XP (PP ?prep ?np) (PP ?prep ?role ?np ?h) ?wh ?np\n        ?gap1 ?gap2 ?sem) ==>\n   (PP ?prep ?role ?wh ?np ?h ?gap1 ?gap2 ?sem))\n(rule (XP (NP ?x) (NP ?agr ?case ?x) ?wh ?x ?gap1 ?gap2 ?sem) ==>\n   (NP ?agr ?case ?wh ?x ?gap1 ?gap2 ?sem))\n(rule (XP it (it ? ? ?x) -wh ?x ?gap ?gap t) ==>\n   (:word it))\n(rule (XP (clause ?word ?infl) (clause ?word ?infl ?v) -wh ?v\n        ?gap1 ?gap2 ?sem) ==>\n   (:ex (he thinks) \"that she is tall\")\n   (opt-word ?word)\n   (clause ?infl ?x int-subj ?v ?gap1 ?gap2 ?sem))\n(rule (XP (?role ?n (advp ?v)) (advp ?v) ?wh ?v ?gap1 ?gap2 ?sem)\n  ==>\n (advp ?wh ?v ?gap1 ?gap2 ?sem))\n```\n\nThe category `opt-word` parses a word, which may be optional.\nFor example, one sense of \"know\" subcategorizes for a clause with an optional \"that\": we can say either \"I know that he's here\" or \"I know he's here.\" The complement list for \"know\" thus contains the slot `(con 2 (clause (that) (finite ? ?)))`.\nIf the \"that\" had been obligatory, it would not have parentheses around it.\n\n```lisp\n(rule (opt-word ?word) ==>(:word ?word))\n(rule (opt-word (?word)) ==>(:word ?word))\n(rule (opt-word (?word)) ==>)\n```\n\nFinally, here are the three XPs that can not be extraposed:\n\n```lisp\n(rule (XP (VP ?infl ?x) *** -wh ?v ?gap1 ?gap2 ?sem) ==>\n   (:ex (he promised her) \"to sleep\")\n   (VP ?infl ?x ?subj-slot ?v ?gap1 ?gap2 ?sem))\n(rule (XP (Adj ?x) *** -wh ?x ?gap ?gap ?sem) ==>\n   (Adj ?x ?sem))\n(rule (XP (P iparticle) *** -wh ?x ?gap ?gap t) ==>\n   (prep ?particle t))\n```\n\n## 21.10 Word Categories\n{:#s0055}\n{:.h1hd}\n\nEach word category has a rule that looks words up in the lexicon and assigns the right features.\nThe relation `word` is used for all lexicon access.\nWe will describe the most complicated word class, `verb`, and just list the others.\n\nVerbs are complex because they often are *polysemous-*they have many meanings.\nIn addition, each meaning can have several different complement lists.\nThus, an entry for a verb in the lexicon will consist of the verb form, its inflection, and a list of senses, where each sense is a semantics followed by a list of possible complement lists.\nHere is the entry for the verb \"sees,\" indicating that it is a present-tense verb with three senses.\nThe understand sense has two complement lists, which correspond to \"He sees\" and \"He sees that you are right.\" The `look` sense has one complement list corresponding to \"He sees the picture,\" and the `dating` sense, corresponding to \"He sees her (only on Friday nights),\" has the same complement list.\n\n```lisp\n(?- (word sees verb ?infl ?senses))\n?INFL = (FINITE (--+-) PRESENT)\n?SENSES = ((UNDERSTAND ((AGT 1 (NP ?3)))\n        ((EXP 1 (NP ?4))\n         (CON 2 (CLAUSE (THAT) (FINITE ?5 ?6)))))\n     (LOOK ((AGT 1 (NP ?7)) (OBJ 2 (NP ?8))))\n     (DATING ((AGT 1 (NP ?9)) (OBJ 2 (NP ?10)))))\n```\n\nThe category `verb` takes five arguments: the verb itself, its inflection, its complement list, its metavariable, and its semantics.\nThe `member` relations are used to pick a sense from the list of senses and a complement list from the list of lists, and the semantics is built from semantic predicate for the chosen sense and the metavariable for the verb:\n\n```lisp\n(rule (verb ?verb ?infl ?slots ?v :sem) ==>\n   (:word ?verb)\n   (:test (word ?verb verb ?infl ?senses)\n      (member (?sem . ?subcats) ?senses)\n      (member ?slots ?subcats)\n      (tense-sem ?infl ?v ?tense-sem))\n   (:sem ?tense-sem)\n   (:sem (?sem ?v)))\n```\n\nIt is difficulty to know how to translate tense information into a semantic interpretation.\nDifferent applications will have different models of time and thus will want different interpretations.\nThe relation `tense-sem` gives semantics for each tense.\nHere is a very simple definition of `tense-sem`:\n\n```lisp\n(<- (tense-sem (finite ? ?tense) ?v (?tense ?v)))\n(<- (tense-sem -ing ?v (progressive ?v)))\n(<- (tense-sem -en ?v (past-participle ?v)))\n(<- (tense-sem infinitive ?v t))\n(<- (tense-sem nonfinite ?v t))\n(<- (tense-sem passive ?v (passive ?v)))\n```\n\nAuxiliary verbs and modal verbs are listed separately:\n\n```lisp\n(rule (aux ?infl ?needs-infl ?v ?tense-sem) ==>\n   (:word ?aux)\n   (:test (word ?aux aux ?infl ?needs-infl)\n       (tense-sem ?infl ?v ?tense-sem)))\n(rule (aux (finite ?agr ?tense) nonfinite ?v (?sem ?v)) ==>\n   (:word ?modal)\n   (:test (word ?modal modal ?sem ?tense)))\n```\n\nNouns, pronouns, and names are also listed separately, although they have much in common.\nFor pronouns we use quantifier `wh` or `pro`, depending on if it is a wh-pronoun or not.\n\n```lisp\n(rule (noun ?agr ?slots ?x (?sem ?x)) ==>\n   (:word ?noun)\n   (:test (word ?noun noun ?agr ?slots ?sem)))\n(rule (pronoun ?agr ?case ?wh ?x (?quant ?x (?sem ?x))) ==>\n   (:word ?pro)\n   (:test (word ?pro pronoun ?agr ?case ?wh ?sem)\n      (if (= ?wh +wh) (= ?quant wh) (= ?quant pro))))\n(rule (name ?agr ?name) ==>\n   (:word ?name)\n   (:test (word ?name name ?agr)))\n```\n\nHere are the rules for the remaining word classes:\n\n```lisp\n(rule (adj ?x (?sem ?x)) ==>\n   (:word ?adj)\n   (:test (word ?adj adj ?sem)))\n(rule (adj ?x ((nth ?n) ?x)) ==>(ordinal ?n))\n(rule (art ?agr ?quant) ==>\n   (:word ?art)\n   (:test (word ?art art ?agr ?quant)))\n(rule (prep ?prep t) ==>\n   (:word ?prep)\n   (:test (word ?prep prep)))\n(rule (adverb ?wh ?x ?sem) ==>\n   (:word ?adv)\n   (:test (word ?adv adv ?wh ?pred)\n        (if (= ?wh +wh)\n          (= ?sem (wh ?y (?pred ?x ?y)))\n          (= ?sem (?pred ?x)))))\n(rule (cardinal ?n ?agr) ==>\n   (:ex \"five\")\n   (:word ?num)\n   (:test (word ?num cardinal ?n ?agr)))\n(rule (cardinal ?n ?agr) ==>\n   (:ex \"5\")\n   (:word ?n)\n   (:test (numberp ?n)\n      (if (= ?n 1)\n        (= ?agr (- - + -)) ;3sing\n        (= ?agr (- - + -))))) ;3plur\n(rule (ordinal ?n) ==>\n   (:ex \"fifth\")\n   (:word ?num)\n   (:test (word ?num ordinal ?n)))\n```\n\n## 21.11 The Lexicon\n{:#s0060}\n{:.h1hd}\n\nThe lexicon itself consists of a large number of entries in the `word` relation, and it would certainly be possible to ask the lexicon writer to make a long list of `word` facts.\nBut to make the lexicon easier to read and write, we adopt three useful tools.\nFirst, we introduce a system of abbreviations.\nCommon expressions can be abbreviated with a symbol that will be expanded by `word.` Second, we provide the macros verb and `noun` to cover the two most complex word classes.\nThird, we provide a macro `word` that makes entries into a hash table.\nThis is more efficient than compiling a `word` relation consisting of hundreds of Prolog clauses.\n\nThe implementation of these tools is left for the next section; here we show the actual lexicon, starting with the list of abbreviations.\n\nThe first set of abbreviations defines the agreement features.\nThe obvious way to handle agreement is with two features, one for person and one for number.\nSo first-person singular might be represented (1 `sing`).\nA problem arises when we want to describe verbs.\nEvery verb except \"be\" makes the distinction only between third- person singular and all the others.\nWe don't want to make five separate entries in the lexicon to represent all the others.\nOne alternative is to have the agreement feature be a set of possible values, so all the others would be a single set of five values rather than five separate values.\nThis makes a big difference in cutting down on backtracking.\nThe problem with this approach is keeping track of when to intersect sets.\nAnother approach is to make the agreement feature be a list of four binary features, one each for first-person singular, first-person plural, third-person singular, and third-person plural.\nThen \"all the others\" can be represented by the list that is negative in the third feature and unknown in all the others.\nThere is no way to distinguish second-person singular from plural in this scheme, but English does not make that distinction.\nHere are the necessary abbreviations:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(abbrev 1sing` | `(+---))` |\n| `(abbrev 1plur` | `(-+--))` |\n| `(abbrev 3sing` | `(--+-))` |\n| `(abbrev 3plur` | `(- - - +))` |\n| `(abbrev 2pers` | `(----))` |\n| `(abbrev ~3sing` | `(??-?))` |\n\nThe next step is to provide abbreviations for some of the common verb complement lists:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(abbrev v/intrans` | `((agt 1 (NP ?))))` |\n| `(abbrev v/trans` | `((agt 1 (NP ?)) (obj 2 (NP ?))))` |\n| `(abbrev v/ditrans` | `((agt 1 (NP ?)) (goal 2 (NP ?)) (obj 3 (NP ?))))` |\n| `(abbrev v/trans2` | `((agt 1 (NP ?)) (obj 2 (NP ?)) (goal 2 (PP to ?))))` |\n| `(abbrev v/trans4` | `((agt 1 (NP ?)) (obj 2 (NP ?)) (ben 2 (PP for ?))))` |\n| `(abbrev v/it-null` | `((nil 1 it)))` |\n| `(abbrev v/opt-that` | `((exp 1 (NP ?)) (con 2 (clause (that) (finite ? ?)))))` |\n| `(abbrev v/subj-that` | `((con 1 (clause that (finite ? ?))) (exp 2 (NP ?))))` |\n| `(abbrev v/it-that` | `((nil 1 it) (exp 2 (NP ?))` |\n| | `(con 3 (clause that (finite ? ?)))))` |\n| `(abbrev v/inf` | `((agt 1 (NP ?x)) (con 3 (VP infinitive ?x))))` |\n| `(abbrev v/promise` | `((agt 1 (NP ?x)) (goal (2) (NP ?y))` |\n| | `(con 3 (VP infinitive ?x))))` |\n| `(abbrev v/persuade` | `((agt 1 (NP ?x)) (goal 2 (NP ?y))` |\n| | `(con 3 (VP infinitive ?y))))` |\n| `(abbrev v/want` | `((agt 1 (NP ?x)) (con 3 (VP infinitive ?x))))` |\n| `(abbrev v/p-up` | `((agt 1 (NP ?)) (pat 2 (NP ?)) (nil 3 (P up))))` |\n| `(abbrev v/pp-for` | `((agt 1 (NP ?)) (pat 2 (PP for ?))))` |\n| `(abbrev v/pp-after` | `((agt 1 (NP ?)) (pat 2 (PP after ?))))` |\n\n### Verbs\n{:#s0065}\n{:.h2hd}\n\nThe macro `verb` allows us to list verbs in the form below, where the spellings of each tense can be omitted if the verb is regular:\n\n(`verb` (*base past-tense past-participle present-participle present-plural* ) (*semantics complement-list*...) ...)\n\nFor example, in the following list \"ask\" is regular, so only its base-form spelling is necessary.\n\"Do,\" on the other hand, is irregular, so each form is spelled out.\nThe haphazard list includes verbs that are either useful for examples or illustrate some unusual complement list.\n\n```lisp\n(verb (ask) (query v/ditrans))\n(verb (delete) (delete v/trans))\n(verb (do did done doing does) (perform v/trans))\n(verb (eat ate eaten) (eat v/trans))\n(verb (give gave given giving) (give-1 v/trans2 v/ditrans)\n     (donate v/trans v/intrans))\n(verb (go went gone going goes))\n(verb (have had had having has) (possess v/trans))\n(verb (know knew known) (know-that v/opt-that) (know-of v/trans))\n(verb (like) (like-1 v/trans))\n(verb (look) (look-up v/p-up) (search v/pp-for)\n     (take-care v/pp-after) (look v/intrans))\n(verb (move moved moved moving moves)\n     (self-propel v/intrans) (transfer v/trans2))\n(verb (persuade) (persuade v/persuade))\n(verb (promise) (promise v/promise))\n(verb (put put put putting))\n(verb (rain) (rain v/it-null))\n(verb (saw) (cut-with-saw v/trans v/intrans))\n(verb (see saw seen seeing) (understand v/intrans v/opt-that)\n     (look v/trans)(dating v/trans))\n(verb (sleep slept) (sleep v/intrans))\n(verb (surprise) (surprise v/subj-that v/it-that))\n(verb (tell told) (tell v/persuade))\n(verb (trust) (trust v/trans ((agt 1 (NP ?)) (obj 2 (PP in ?)))))\n(verb (try tried tried trying tries) (attempt v/inf))\n(verb (visit) (visit v/trans))\n(verb (want) (desire v/want v/persuade))\n```\n\n### Auxiliary Verbs\n{:#s0070}\n{:.h2hd}\n\nAuxiliary verbs are simple enough to be described directly with the word macro.\nEach entry lists the auxiliary itself, the tense it is used to construct, and the tense it must be followed by.\nThe auxiliaries \"have\" and \"do\" are listed, along with \"to,\" which is used to construct infinitive clauses and thus can be treated as if it were an auxiliary.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word have` | `aux nonfinite -en)` |\n| `(word have` | `aux (finite ~3sing present) -en)` |\n| `(word has` | `aux (finite 3sing present) -en)` |\n| `(word had` | `aux (finite ? past) -en)` |\n| `(word having` | `aux -ing -en)` |\n| `(word do` | `aux (finite ~3sing present) nonfinite)` |\n| `(word does` | `aux (finite 3sing present) nonfinite)` |\n| `(word did` | `aux (finite    ? past)    nonfinite)` |\n| `(word to` | `aux infinitive nonfinite)` |\n\nThe auxiliary \"be\" is special: in addition to its use as both an auxiliary and main verb, it also is used in passives and as the main verb in aux-inverted sentences.\nThe function `copula` is used to keep track of all these uses.\nIt will be defined in the next section, but you can see it takes two arguments, a list of senses for the main verb, and a list of entries for the auxiliary verb.\nThe three senses correspond to the examples \"He is a fool,\" \"He is a Republican,\" and \"He is in Indiana,\" respectively.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(copula` | |\n|  `'((nil` | `((nil 1 (NP ?x)) (nil 2 (Adj ?x))))` |\n|   `(is-a` | `((exp 1 (NP ?x)) (arg2 2 (NP ?y))))` |\n|   `(is-loc` | `((exp 1 (NP ?x)) (?prep 2 (PP ?prep ?)))))` |\n|  `'((be` | `nonfinite -ing)` |\n|   `(been` | `-en -ing)` |\n|   `(being` | `-ing -en)` |\n|   `(am` | `(finite 1sing present) -ing)` |\n|   `(is` | `(finite 3sing present) -ing)` |\n|   `(are` | `(finite 2pers present) -ing)` |\n|   `(were` | `(finite (- - ? ?) past) -ing) ; 2nd sing or pl` |\n|   `(was` | `(finite (? - ? -) past) -ing))) ; 1st or 3rd sing` |\n\nFollowing are the modal auxiliary verbs.\nAgain, it is difficult to specify semantics for them.\nThe word \"not\" is also listed here; it is not an auxiliary, but it does modify them.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word can` | `modal able` | `past)` |\n| `(word could` | `modal able` | `present)` |\n| `(word may` | `modal possible` | `past)` |\n| `(word might` | `modal possible` | `present)` |\n| `(word shall` | `modal mandatory` | `past)` |\n| `(word should` | `modal mandatory` | `present)` |\n| `(word will` | `modal expected` | `past)` |\n| `(word would` | `modal expected` | `present)` |\n| `(word must` | `modal necessary` | `present)` |\n| `(word not not)` |\n\n![t0040](images/B9780080571157500212/t0040.png)\n\n### Nouns\n{:#s0075}\n{:.h2hd}\n\nNo attempt has been made to treat nouns seriously.\nWe list enough nouns here to make some of the examples work.\nThe first noun shows a complement list that is sufficient to parse \"the destruction of the city by the enemy.\"\n\n```lisp\n(noun destruction * destruction\n     (pat (2) (PP of ?)) (agt (2) (PP by ?)))\n(noun beach)\n(noun bone)\n(noun box boxes)\n(noun city cities)\n(noun color)\n(noun cube)\n(noun doctor)\n(noun dog dogs)\n(noun enemy enemies)\n(noun file)\n(noun friend friends friend (friend-of (2) (PP of ?)))\n(noun furniture *)\n(noun hat)\n(noun man men)\n(noun saw)\n(noun woman women)\n```\n\n### Pronouns\n{:#s0080}\n{:.h2hd}\n\nHere we list the nominative, objective, and genitive pronouns, followed by interrogative and relative pronouns.\nThe only thing missing are reflexive pronouns, such as \"myself.\"\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word I` | `pronoun 1sing (common nom) -wh speaker)` |\n| `(word we` | `pronoun 1plur (common nom) -wh speaker+other)` |\n| `(word you` | `pronoun 2pers (common` ?) `-wh listener)` |\n| `(word he` | `pronoun 3sing (common nom) -wh male)` |\n| `(word she` | `pronoun 3sing (common nom) -wh female)` |\n| `(word it` | `pronoun 3sing (common` ?) `-wh anything)` |\n| `(word they` | `pronoun 3plur (common nom) -wh anything)` |\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word me` | `pronoun 1sing (common obj) -wh speaker)` |\n| `(word us` | `pronoun 1plur (common obj) -wh speaker+other)` |\n| `(word him` | `pronoun 3sing (common obj) -wh male)` |\n| `(word her` | `pronoun 3sing (common obj) -wh female)` |\n| `(word them` | `pronoun 3plur (common obj) -wh anything)` |\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word my` | `pronoun 1sing gen -wh speaker)` |\n| `(word our` | `pronoun 1plur gen -wh speaker+other)` |\n| `(word your` | `pronoun 2pers gen -wh listener)` |\n| `(word his` | `pronoun 3sing gen -wh male)` |\n| `(word her` | `pronoun 3sing gen -wh female)` |\n| `(word its` | `pronoun 3sing gen -wh anything)` |\n| `(word their` | `pronoun 3plur gen -wh anything)` |\n| `(word whose` | `pronoun 3sing gen +wh anything)` |\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word who` | `pronoun ? (common ?) +wh person)` |\n| `(word whom` | `pronoun ? (common obj) +wh person)` |\n| `(word what` | `pronoun ? (common ?) +wh thing)` |\n| `(word which` | `pronoun ? (common ?) +wh thing)` |\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word who` | `rel-pro ? person)` |\n| `(word which` | `rel-pro ? thing)` |\n| `(word that` | `rel-pro ? thing)` |\n| `(word whom` | `rel-pro (common obj) person)` |\n\n### Names\n{:#s0085}\n{:.h2hd}\n\nThe following names were convenient for one example or another:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word God` | `name 3sing)` | `(word Lynn` | `name 3sing)` |\n| `(word Jan` | `name 3sing)` | `(word Mary` | `name 3sing)` |\n| `(word John` | `name 3sing)` | `(word NY` | `name 3sing)` |\n| `(word Kim` | `name 3sing)` | `(word LA` | `name 3sing)` |\n| `(word Lee` | `name 3sing)` | `(word SF` | `name 3sing)` |\n\n![t0050](images/B9780080571157500212/t0050.png)\n\n### Adjectives\n{:#s0090}\n{:.h2hd}\n\nHere are a few adjectives:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word big` | `adj big)` | `(word bad` | `adj bad)` |\n| `(word old` | `adj old)` | `(word smart` | `adj smart)` |\n| `(word green` | `adj green)` | `(word red` | `adj red)` |\n| `(word tall` | `adj tall)` | `(word fun` | `adj fun)` |\n\n![t0055](images/B9780080571157500212/t0055.png)\n\n### Adverbs\n{:#s0095}\n{:.h2hd}\n\nThe adverbs covered here include interrogatives:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word quickly` | `adv -wh quickly)` |\n| `(word slowly` | `adv -wh slowly)` |\n| `(word where` | `adv +wh loc)` |\n| `(word when` | `adv +wh time)` |\n| `(word why` | `adv +wh reason)` |\n| `(word how` | `adv +wh manner)` |\n\n### Articles\n{:#s0100}\n{:.h2hd}\n\nThe common articles are listed here:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word the` | `art 3sing the)` |\n| `(word the` | `art 3plur group)` |\n| `(word a` | `art 3sing a)` |\n| `(word an` | `art 3sing a)` |\n| `(word every` | `art 3sing every)` |\n| `(word each` | `art 3sing each)` |\n| `(word all` | `art 3sing all)` |\n| `(word some` | `art` ? `some)` |\n| `(word this` | `art 3sing this)` |\n| `(word that` | `art 3sing that)` |\n| `(word these` | `art 3plur this)` |\n| `(word those` | `art 3plur that)` |\n| `(word what` | `art` ? `wh)` |\n| `(word which` | `art` ? `wh)` |\n\n### Cardinal and Ordinal Numbers\n{:#s0105}\n{:.h2hd}\n\nWe can take advantage of `format's` capabilities to fill up the lexicon.\nTo go beyond 20, we would need a subgrammar of numbers.\n\n```lisp\n;; This puts in numbers up to twenty, as if by\n;; (word five cardinal 5 3plur)\n;; (word fifth ordinal 5)\n(dotimes (i 21)\n   (add-word (read-from-string (format nil \"~r\" i))\n          'cardinal i (if (= i 1) '3sing '3plur))\n   (add-word (read-from-string (format nil \"~:r\" i)) 'ordinal i))\n```\n\n### Prepositions\n{:#s0110}\n{:.h2hd}\n\nHere is a fairly complete list of prepositions:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `(word above prep)` | `(word about prep)` | `(word around prep)` |\n| `(word across prep)` | `(word after prep)` | `(word against prep)` |\n| `(word along prep)` | `(word at prep)` | `(word away prep)` |\n| `(word before prep)` | `(word behind prep)` | `(word below prep)` |\n| `(word beyond prep)` | `(word by prep)` | `(word down prep)` |\n| `(word for prep)` | `(word from prep)` | `(word in prep)` |\n| `(word of prep)` | `(word off prep)` | `(word on prep)` |\n| `(word out prep)` | `(word over prep)` | `(word past prep)` |\n| `(word since prep)` | `(word through prep)` | `(word throughout prep)` |\n| `(word till prep)` | `(word to prep)` | `(word under prep)` |\n| `(word until prep)` | `(word up prep)` | `(word with prep)` |\n| `(word without prep)` | | |\n\n## 21.12 Supporting the Lexicon\n{:#s0115}\n{:.h1hd}\n\nThis section describes the implementation of the macros `word`, `verb, noun`, and `abbrev.` Abbreviations are stored in a hash table.\nThe macro `abbr`e`v` and the functions `get-abbrev` and `clear-abbrevs` define the interface.\nWe will see how to expand abbreviations later.\n\n```lisp\n(defvar *abbrevs* (make-hash-table))\n(defmacro abbrev (symbol definition)\n   \"Make symbol be an abbreviation for definition.\"\n   '(setf (gethash ',symbol *abbrevs*) ',definition))\n(defun clear-abbrevs () (clrhash *abbrevs*))\n(defun get-abbrev (symbol) (gethash symbol *abbrevs*))\n```\n\nWords are also stored in a hash table.\nCurrently, words are symbols, but it might be a better idea to use strings for words, since then we could maintain capitalization information.\nThe macro `word` or the function `add-word` adds a word to the lexicon.\nWhen used as an index into the hash table, each word returns a list of entries, where the first element of each entry is the word's category, and the other elements depend on the category.\n\n```lisp\n(defvar *words* (make-hash-table :size 500))\n(defmacro word (word cat &rest info)\n   \"Put word, with category and subcat info, into lexicon.\"\n   '(add-word '.word '.cat .,(mapcar #'kwote info)))\n(defun add-word (word cat &rest info)\n   \"Put word, with category and other info, into lexicon.\"\n   (push (cons cat (mapcar #'expand-abbrevs-and-variables info)) (gethash word *words*))\n      (gethash word *words*))\n   word)\n(defun kwote (x) (list 'quote x))\n```\n\nThe function `expand-abbrevs-and-variables` expands abbreviations and substitutes variable structures for symbols beginning with ?.\nThis makes it easier to make a copy of the structure, which will be needed later.\n\n```lisp\n(defun expand-abbrevs-and-variables (exp)\n  \"Replace all variables in exp with vars. and expand abbrevs.\"\n  (let ((bindings nil))\n    (labels\n     ((expand (exp)\n      (cond\n        ((lookup exp bindings))\n        ((eq exp '?) (?))\n        ((variable-p exp)\n         (let ((var (?)))\n            (push (cons exp var) bindings)\n            var))\n        ((consp exp)\n         (reuse-cons (expand (first exp))\n               (expand (rest exp))\n               exp))\n      (t (multiple-value-bind (expansion found?)\n         (get-abbrev exp)\n        (if found?\n            (expand-abbrevs-and-variables expansion)\n            exp))))))\n(expand exp))))\n```\n\nNow we can store words in the lexicon, but we need some way of getting them out.\nThe function `word/n` takes a word (which must be instantiated to a symbol) and a category and optional additional information and finds the entries in the lexicon for that word that unify with the category and additional information.\nFor each match, it calls the supplied continuation.\nThis means that `word/n` is a replacement for a long list of word facts.\nThere are three differences: `word/n` hashes, so it will be faster; it is incremental (you can add a word at a time without needing to recompile); and it can not be used when the word is unbound.\n(It is not difficult to change it to handle an unbound word using `maphash`, but there are better ways of addressing that problem.)\n\n```lisp\n(defun word/n (word cat cont &rest info)\n  \"Retrieve a word from the lexicon.\"\n  (unless (unbound-var-p (deref word))\n    (let ((old-trail (fill-pointer *trail*)))\n      (dolist (old-entry (gethash word *words*))\n        (let ((entry (deref-copy old-entry)))\n          (when (and (consp entry)\n               (unify! cat (first entry))\n               (unify! info (rest entry)))\n            (funcall cont)))\n        (undo-bindings! old-trail)))))\n```\n\nNote that `word/n` does not follow our convention of putting the continuation last.\nTherefore, we will need the following additional functions:\n\n```lisp\n(defun word/2 (w cat cont) (word/n w cat cont))\n(defun word/3 (w cat a cont) (word/n w cat cont a))\n(defun word/4 (w cat a b cont) (word/n w cat cont a b))\n(defun word/5 (w cat a b c cont) (word/n w cat cont a b c))\n(defun word/6 (w cat a b c d cont) (word/n w cat cont a b c d))\n```\n\nWe could create the whole lexicon with the macro `word`, but it is convenient to create specific macros for some classes.\nThe macro `noun` is used to generate two entries, one for the singular and one for the plural.\nThe arguments are the base noun, optionally followed by the plural (which defaults to the base plus \"s\"), the semantics (which defaults to the base), and a list of complements.\nMass nouns, like \"furniture,\" have only one entry, and are marked by an asterisk where the plural would otherwise be.\n\n```lisp\n(defmacro noun (base &rest args)\n  \"Add a noun and its plural to the lexicon.\"\n  '(add-noun-form ',base ,@(mapcar #'kwote args)))\n(defun add-noun-form (base &optional (plural (symbol base 's))\n          (sem base) &rest slots)\n  (if (eq plural '*)\n   (add-word base 'noun '? slots sem)\n   (progn\n     (add-word base 'noun '3sing slots sem)\n     (add-word plural 'noun '3plur slots sem))))\n```\n\nVerbs are more complex.\nEach verb has seven entries: the base or nonfinite, the present tense singular and plural, the past tense, the past-participle, the present-participle, and the passive.\nThe macro `verb` automatically generates all seven entries.\nVerbs that do not have all of them can be handled by individual calls to `word`.\nWe automatically handle the spelling for the simple cases of adding \"s,\" \"ing,\" and \"ed,\" and perhaps stripping a trailing vowel.\nMore irregular spellings have to be specified explicitly.\nHere are three examples of the use of `verb`:\n\n```lisp\n(verb (do did done doing does) (perform v/trans))\n(verb (eat ate eaten) (eat v/trans))\n(verb (trust) (trust v/trans ((agt 1 (NP ?)) (obj 2 (PP in ?)))))\n```\n\nAnd here is the macro definition:\n\n```lisp\n(defmacro verb ((base &rest forms) &body senses)\n  \"Enter a verb into the lexicon.\"\n  '(add-verb ',senses ',base ,@(mapcar #'kwote (mklist forms))))\n(defun add-verb (senses base &optional\n        (past (symbol (strip-vowel base) 'ed))\n        (past-part past)\n        (pres-part (symbol (strip-vowel base) 'ing))\n        (plural (symbol base 's)))\n  \"Enter a verb into the lexicon.\"\n  (add-word base 'verb 'nonfinite senses)\n  (add-word base 'verb '(finite ~3sing present) senses)\n  (add-word past 'verb '(finite ? past) senses)\n  (add-word past-part 'verb '-en senses)\n  (add-word pres-part 'verb '-ing senses)\n  (add-word plural 'verb '(finite 3sing present) senses)\n  (add-word past-part 'verb 'passive\n          (mapcar #'passivize-sense\n            (expand-abbrevs-and-variables senses))))\n```\n\nThis uses a few auxiliary functions.\nFirst, `strip-vowel` removes a vowel if it is the last character of the given argument.\nThe idea is that for a verb like \"fire,\" stripping the vowel yields \"fir,\" from which we can get \"fired\" and \"firing\" automatically.\n\n```lisp\n(defun strip-vowel (word)\n  \"Strip off a trailing vowel from a string.\"\n  (let* ((str (string word))\n      (end (- (length str) 1)))\n  (if (vowel-p (char str end))\n      (subseq str 0 end)\n      str)))\n(defun vowel-p (char) (find char \"aeiou\" :test #'char-equal))\n```\n\nWe also provide a function to generate automatically the passive sense with the proper complement list(s).\nThe idea is that the subject slot of the active verb becomes an optional slot marked by the preposition \"by,\" and any slot that is marked with number 2 can be promoted to become the subject:\n\n```lisp\n(defun passivize-sense (sense)\n  ;; The first element of sense is the semantics; rest are slots\n  (cons (first sense) (mapcan #'passivize-subcat (rest sense))))\n(defun passivize-subcat (slots)\n  \"Return a list of passivizations of this subcat frame.\"\n  ;; Whenever the 1 slot is of the form (?any 1 (NP ?)),\n  ;; demote the 1 to a (3), and promote any 2 to a 1.\n  (when (and (eql (slot-number (first slots)) 1)\n        (starts-with (third (first slots)) 'NP))\n   (let ((old-1 '(,(first (first slots)) (3) (PP by ?))))\n    (loop for slot in slots\n      when (eql (slot-number slot) 2)\n      collect '((,(first slot) 1 .(third slot))\n           ,@(remove slot (rest slots))\n           ,old-1)))))\n(defun slot-number (slot) (first-or-self (second slot)))\n```\n\nFinally, we provide a special function just to define the copula, \"be.\"\n\n```lisp\n(defun copula (senses entries)\n  \"Copula entries are both aux and main verb.\"\n  ;; They also are used in passive verb phrases and aux-inv-S\n  (dolist (entry entries)\n    (add-word (first entry) 'aux (second entry) (third entry))\n    (add-word (first entry) 'verb (second entry) senses)\n    (add-word (first entry) 'aux (second entry) 'passive)\n    (add-word (first entry) 'be)))\n```\n\nThe remaining functions are used for testing, debugging, and extending the grammar.\nFirst, we need functions to clear everything so that we can start over.\nThese functions can be placed at the top of the lexicon and grammar files, respectively:\n\n```lisp\n(defun clear-lexicon ()\n  (clrhash *words*)\n  (clear-abbrevs))\n(defun clear-grammar ()\n  (clear-examples)\n  (clear-db))\n```\n\nTesting could be done with `run-examples`, but it is convenient to provide another interface, the macro `try` (and its corresponding function, `try-dcg`).\nBoth macro and function can be invoked three ways.\nWith no argument, all the examples stored by : ex are run.\nWhen the name of a category is given, all the examples for that category alone are run.\nFinally, the user can supply both the name of a category and a list of words to test whether those words can be parsed as that category.\nThis option is only available for categories that are listed in the definition:\n\n```lisp\n(defmacro try (&optional cat &rest words)\n  \"Tries to parse WORDS as a constituent of category CAT.\n  With no words, runs all the :ex examples for category.\n  With no cat, runs all the examples.\"\n  '(try-dcg ',cat ',words))\n(defun try-dcg (&optional cat words)\n  \"Tries to parse WORDS as a constituent of category CAT.\n  With no words, runs all the :ex examples for category.\n  With no cat, runs all the examples.\"\n  (if (null words)\n    (run-examples cat)\n    (let ((args '((gap nil) (gap nil) ?sem ,words ())))\n      (mapc #'test-unknown-word words)\n      (top-level-prove\n        (ecase cat\n          (np '((np ? ? ?wh ?x ,@args)))\n            (vp '((vp ?infl ?x ?sl ?v ,@args)))\n            (pp '((pp ?prep ?role ?wh ?x ,@args)))\n            (xp '((xp ?slot iconstituent ?wh ?x ,@args)))\n            (s '((s ? ?sem ,words ())))\n            (rel-clause '((rel-clause ? ?x ?sem ,words ())))\n            (clause '((clause ?infl ?x ?int-subj ?v ?g1 ?g2\n                   ?sem ,words ()))))))))\n(defun test-unknown-word (word)\n  \"Print a warning message if this is an unknown word.\"\n  (unless (or (gethash word *words*) (numberp word))\n   (warn \"~&Unknown word: ~a\" word)))\n```\n\n## 21.13 Other Primitives\n{:#s0120}\n{:.h1hd}\n\nTo support the : `test` predicates made in various grammar rules we need definitions of the Prolog predicates `if, member, =, numberp`, and `atom`.\nThey are repeated here:\n\n```lisp\n(<- (if ?test ?then) (if ?then ?else (fail)))\n(<- (if ?test ?then ?else) (call ?test) ! (call ?then))\n(<- (if ?test ?then ?else) (call ?else))\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ?rest)) (member ?item ?rest))\n(<- (= ?x ?x))\n(defun numberp/1 (x cont)\n  (when (numberp (deref x))\n   (funcall cont)))\n(defun atom/1 (x cont)\n  (when (atom (deref x))\n   (funcall cont)))\n(defun call/1 (goal cont)\n  \"Try to prove goal by calling it.\"\n  (deref goal)\n  (apply (make-predicate (first goal)\n          (length (args goal)))\n      (append (args goal) (list cont))))\n```\n\n## 21.14 Examples\n{:#s0125}\n{:.h1hd}\n\nHere are some examples of what the parser can handle.\nI have edited the output by changing variable names like `?168` to more readable names like `?J`.\nThe first two examples show that nested clauses are supported and that we can extract a constituent from a nested clause:\n\n```lisp\n> (try S John promised Kim to persuade Lee to sleep)\n?SEM = (AND (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n      (PAST ?P) (PROMISE ?P)\n      (GOAL ?P ?K) (THE ?K (NAME KIM ?K))\n      (CON ?P ?PER) (PERSUADE ?PER) (GOAL ?PER ?L)\n      (THE ?L (NAME LEE ?L)) (CON ?PER ?S) (SLEEP ?S));\n> (try S Who did John promise Kim to persuade to sleep)\n?SEM = (AND (WH ?W (PERSON ?W)) (PAST ?P)\n      (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n      (PROMISE ?P) (GOAL ?P ?K)\n      (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n      (PERSUADE ?PER) (GOAL ?PER ?W)\n      (CON ?PER ?S) (SLEEP ?S));\n```\n\nIn the next example, the \"when\" can be interpreted as asking about the time of any of the three events: the promising, the persuading, or the sleeping.\nThe grammar finds all three.\n\n```lisp\n>(try S When did John promise Kim to persuade Lee to sleep)\n?SEM = (AND (WH ?W (TIME ?S ?W)) (PAST ?P)\n      (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n      (PROMISE ?P) (GOAL ?P ?K)\n      (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n      (PERSUADE ?PER) (GOAL ?PER ?L)\n      (THE ?L (NAME LEE ?L)) (CON ?PER ?S)\n      (SLEEP ?S));\n?SEM = (AND (WH ?W (TIME ?PER ?W)) (PAST ?P)\n      (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n      (PROMISE ?P) (GOAL ?P ?K)\n      (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n      (PERSUADE ?PER) (GOAL ?PER ?L)\n      (THE ?L (NAME LEE ?L)) (CON ?PER ?S)\n      (SLEEP ?S));\n?SEM = (AND (WH ?W (TIME ?P ?W)) (PAST ?P)\n      (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n      (PROMISE ?P) (GOAL ?P ?K)\n      (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n      (PERSUADE ?PER) (GOAL ?PER ?L)\n      (THE ?L (NAME LEE ?L)) (CON ?PER ?S)\n      (SLEEP ?S)).\n```\n\nThe next example shows auxiliary verbs and negation.\nIt is ambiguous between an interpretation where Kim is searching for Lee and one where Kim is looking at something unspecified, on Lee's behalf.\n\n```lisp\n>(try S Kim would not have been looking for Lee)\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?S ?K)\n      (EXPECTED ?S) (NOT ?S) (PAST-PARTICIPLE ?S)\n      (PROGRESSIVE ?S) (SEARCH ?S) (PAT ?S ?L)\n      (PAT ?S ?L) (THE ?L (NAME LEE ?L)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?2 ?K)\n      (EXPECTED ?2) (NOT ?2) (PAST-PARTICIPLE ?LOOK)\n      (PROGRESSIVE ?LOOK) (LOOK ?LOOK) (FOR ?LOOOK ?L)\n      (THE ?L (NAME LEE ?L)));\n```\n\nThe next two examples are unambiguous:\n\n```lisp\n>(try s It should not surprise you that Kim does not like Lee)\n?SEM = (AND (MANDATORY ?2) (NOT ?2) (SURPRISE ?2) (EXP ?2 ?Y0U)\n      (PRO ?YOU (LISTENER ?YOU)) (CON ?2 ?LIKE)\n      (THE ?K (NAME KIM ?K)) (AGT ?LIKE ?K)\n      (PRESENT ?LIKE) (NOT ?LIKE) (LIKE-1 ?LIKE)\n      (OBJ ?LIKE ?L) (THE ?L (NAME LEE ?L)));\n>(try s Kim did not want Lee to know that the man knew her)\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?W ?K) (PAST ?W)\n      (NOT ?W) (DESIRE ?W) (GOAL ?W ?L)\n      (THE ?L (NAME LEE ?L)) (CON ?W ?KN)\n      (KNOW-THAT ?KN) (CON ?KN ?KN2)\n      (THE ?M (MAN ?M)) (AGT ?KN2 ?M) (PAST ?KN2)\n      (KNOW-OF ?KN2) (OBJ ?KN2 ?HER)\n      (PRO ?HER (FEMALE ?HER))).\n```\n\nThe final example appears to be unambiguous, but the parser finds four separate parses.\nThe first is the obvious interpretation where the looking up is done quickly, and the second has quickly modifying the surprise.\nThe last two interpretations are the same as the first two; they are artifacts of the search process.\nA disambiguation procedure should be equipped to weed out such duplicates.\n\n```lisp\n>(try s That Kim looked her up quickly surprised me)\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU1 ?K) (PAST ?LU1)\n      (LOOK-UP ?LU1) (PAT ?LU1 ?H) (PRO ?H (FEMALE ?H))\n      (QUICKLY ?LU1) (CON ?S ?LU1) (PAST ?S) (SURPRISE ?S)\n      (EXP ?S ?ME1) (PRO ?ME1 (SPEAKER ?ME1)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU2 ?K) (PAST ?LU2)\n      (LOOK-UP ?LU2) (PAT ?LU2 ?H) (PRO ?H (FEMALE ?H))\n      (CON ?S ?LU2) (QUICKLY ?S) (PAST ?S) (SURPRISE ?S)\n      (EXP ?S ?ME2) (PRO ?ME2 (SPEAKER ?ME2)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU3 ?K) (PAST ?LU3)\n      (LOOK-UP ?LU3) (PAT ?LU3 ?H) (PRO ?H (FEMALE ?H))\n      (QUICKLY ?LU3) (CON ?S ?LU3) (PAST ?S) (SURPRISE ?S)\n      (EXP ?S ?ME3) (PRO ?ME3 (SPEAKER ?ME3)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU4 ?K) (PAST ?LU4)\n      (LOOK-UP ?LU4) (PAT ?LU4 ?H) (PRO ?H (FEMALE ?H))\n      (CON ?S ?LU4) (QUICKLY ?S) (PAST ?S) (SURPRISE ?S)\n      (EXP ?S ?ME4) (PRO ?ME4 (SPEAKER ?ME4)));\n```\n\n## 21.15 History and References\n{:#s0130}\n{:.h1hd}\n\n[Chapter 20](B9780080571157500200.xhtml) provides some basic references on natural language.\nHere we will concentrate on references that provide:\n\n1. A comprehensive grammar of English.\n!!!(p) {:.numlist}\n\n2. A complete implementation.\n!!!(p) {:.numlist}\n\nThere are a few good textbooks that partially address both issues.\nBoth [Winograd (1983)](B9780080571157500285.xhtml#bb1395) and [Allen (1987)](B9780080571157500285.xhtml#bb0030) do a good job of presenting the major grammatical features of English and discuss implementation techniques, but they do not provide actual code.\n\nThere are also a few textbooks that concentrate on the second issue.\n[Ramsey and Barrett (1987)](B9780080571157500285.xhtml#bb0975) and [Walker et al.\n(1990)](B9780080571157500285.xhtml#bb1295) provide chapter-length implementations at about the same level of detail as this chapter.\nBoth are recommended.\n[Pereira and Shieber 1987](B9780080571157500285.xhtml#bb0945) and [Gazdar and Mellish 1989](B9780080571157500285.xhtml#bb0445) are book-length treatments, but because they cover a variety of parsing techniques rather than concentrating on one in depth, they are actually less comprehensive.\n\nSeveral linguists have made serious attempts at addressing the first issue.\nThe largest is the aptly named A *Comprehensive Grammar of Contemporary English* by Quirk, Greenbaum, Leech and Svartik (1985).\nMore manageable (although hardly concise) is their abridged edition, *A Concise Grammar of Contemporary English.* Both editions contain a gold mine of examples and facts about the English langauge, but the authors do not attempt to write rigorous rules.\n[Harris (1982)](B9780080571157500285.xhtml#bb0510) and [Huddleston (1984)](B9780080571157500285.xhtml#bb0555) offer less complete grammars with greater linguistic rigor.\n\nNaomi [Sager (1981)](B9780080571157500285.xhtml#bb1035) presents the most complete computerized grammar ever published.\nThe grammar is separated into a simple, neat, context-free component and a rather baroque augmentation that manipulates features.\n\n## 21.16 Exercises\n{:#s0135}\n{:.h1hd}\n\n**Exercise 21.1 [m]** Change the grammar to account better for *mass nouns.* The current grammar treats mass nouns by making them vague between singular and plural, which is incorrect.\nThey should be treated separately, since there are determiners such as \"much\" that work only with mass nouns, and other determiners such as \"these\" that work only with plural count nouns.\n\n**Exercise 21.2 [m]** Change the grammar to make a distinction between *attributive* and *predicative* adjectives.\nMost adjectives fail into both classes, but some can be used only attributively, as in \"an *utter* fool\" but not \" * the fool is *utter.\"* Other adjectives can only be used predicatively, as in \"the woman was *loath* to admit it\" but not \"*a *loath* (to admit it) woman.\"\n\n**Exercise 21.3 [h]** Implement complement lists for adjectives, so that \"loath\" would take an obligatory infinitive complement, and \"proud\" would take an optional (PP of) complement.\nIn connection to the previous exercise, note that it is rare if not impossible for attributive adjectives to take complements: \"he is proud,\" \"he is proud of his country\" and \"a proud citizen\" are all acceptable, but \"*a proud of his country citizen\" is not.\n\n**Exercise 21.4 [m]** Add rules to advp to allow for adverbs to modify other adverbs, as in \"extremely likely\" or \"very strongly.\"\n\n**Exercise 21.5 [h]** Allow adverbs to modify adjectives, as in \"very good\" or \"really delicious.\" The syntax will be easy, but it is harder to get a reasonable semantics.\nWhile you're at it, make sure that you can handle adjectives with so-called *noninter- sective* semantics.\nSome adjectives can be handled by intersective semantics: a red circle is something that is red and is a circle.\nBut for other adjectives, this model does not work: a former senator is not something that is former and is a senator-a former senator is not a senator at all.\nSimilarly, a toy elephant is not an elephant.\n\nThe semantics should be represented by something doser to `((toy elephant) ?x)` rather than `(and (toy ?x) (elephant ?x))`.\n\n**Exercise 21.6 [m]** Write a function that notices punctuation instead of ignoring it.\nIt should work something like this:\n\n```lisp\n(string->words \"Who asked Lee, Kim and John?\")\n(WHO ASKED LEE |,| KIM AND JOHN |?|)\n```\n\n**Exercise 21.7 [m]** Change the grammar to allow optional punctuation marks at the end of sentences and before relative clauses.\n\n**Exercise 21.8 [m]** Change the grammar to allow conjunction with more than two elements, using commas.\nCan these rules be generated automatically by `conj-rule?`\n\n**Exercise 21.9 [h]** Make a distinction between *restrictive* and *nonrestrictive* relative clauses.\nIn \"The truck *that has 4-wheel drive* costs $5000,\" the italicized relative clause is restrictive.\nIt serves to identify the truck and thus would be part of the quantifier's restriction.\nThe complete sentence might be interpreted as:\n\n```lisp\n(and (the ?x (and (truck ?x) (4-wheel-drive ?x)))\n    (costs ?x $5000))\n```\n\nContrast this to \"The truck, which has 4-wheel drive, costs $5000.\" Here the relative clause is nonrestrictive and thus belongs outside the quantifier's restriction:\n\n```lisp\n(and (the ?x (truck ?x))\n   (4-wheel-drive ?x) (costs ?x $5000))\n```\n\nPart V\nThe Rest of Lisp\n!!!(p) {:.parttitle}\n\n# Chapter 22\n## Scheme: An Uncommon Lisp\n{:.chaptitle}\n\n> The best laid schemes o' mice an' men\n\n> -Robert Burns (1759-1796)\n\nThis chapter presents the Scheme dialect of Lisp and an interpreter for it.\nWhile it is not likely that you would use this interpreter for any serious programming, understanding how the interpreter works can give you a better appreciation of how Lisp works, and thus make you a better programmer.\nA Scheme interpreter is used instead of a Common Lisp one because Scheme is simpler, and also because Scheme is an important language that is worth knowing about.\n\nScheme is the only dialect of Lisp besides Common Lisp that is currently flourishing.\nWhere Common Lisp tries to standardize all the important features that are in current use by Lisp programmers, Scheme tries to give a minimal set of very powerful features that can be used to implement the others.\nIt is interesting that among all the programming languages in the world, Scheme is one of the smallest, while Common Lisp is one of the largest.\nThe Scheme manual is only 45 pages (only 38 if you omit the example, bibliography, and index), while *Common Lisp the Language*, 2d edition, is 1029 pages.\nHere is a partial list of the ways Scheme is simpler than Common Lisp:\n\n1. Scheme has fewer built-in functions and special forms.\n!!!(p) {:.numlist}\n\n2. Scheme has no special variables, only lexical variables.\n!!!(p) {:.numlist}\n\n3. Scheme uses the same name space for functions and variables (and everything else).\n!!!(p) {:.numlist}\n\n4. Scheme evaluates the function part of a function call in exactly the same way as the arguments.\n!!!(p) {:.numlist}\n\n5. Scheme functions can not have optional and keyword parameters.\nHowever, they can have the equivalent of a `&rest` parameter.\n!!!(p) {:.numlist}\n\n6. Scheme has no `block, return, go, orthrow`; a single function `(call/cc)` replaces all of these (and does much more).\n!!!(p) {:.numlist}\n\n7. Scheme has no packages.\nLexical variables can be used to implement package-like structures.\n!!!(p) {:.numlist}\n\n8. Scheme, as a standard, has no macros, although most implementations provide macros as an extension.\n!!!(p) {:.numlist}\n\n9. Scheme has no special forms for looping; instead it asks the user to use recursion and promises to implement the recursion efficiently.\n!!!(p) {:.numlist}\n\nThe five main special forms in Scheme are `quote` and `if`, which are just as in Common Lisp; `begin` and `set!`, which are just different spellings for `progn` and `setq`; and `lambda`, which is as in Common Lisp, except that it doesn't require a # 'before it.\nIn addition, Scheme allows variables, constants (numbers, strings, and characters), and function calls.\nThe function call is different because the function itself is evaluated in the same way as the arguments.\nIn Common Lisp, (`f x`) means to look up the function binding of `f` and apply that to the value of `x`.\nIn Scheme, `(f x)` means to evaluate `f` (in this case by looking up the value of the variable `f` ), evaluate `x` (by looking up the value of the variable in exactly the same way) and then apply the function to the argument.\nAny expression can be in the function position, and it is evaluated just like the arguments.\nAnother difference is that Scheme uses `#t` and `#f` for true and false, instead of `t` and `nil`.\nThe empty list is denoted by `()`, and it is distinct from the false value, #f.\nThere are also minor lexical differences in the conventions for complex numbers and numbers in different bases, but these can be ignored for all the programs in this book.\nAlso, in Scheme a single macro, `define`, serves to define both variables and functions.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Scheme | Common Lisp |\n| *var* | *var* |\n| *constant* | *constant* |\n| (`quote`*x*) or '*x* | (`quote`*x*) or '*x* |\n| (`begin`*x*...) | (`progn`*x*...) |\n| (`set!`*var x*) | (`setq`*var x*) |\n| (`if`*pab*) | (`if`*pab*) |\n| (`lambda`*parms x*...) | `#'` (`lambda`*parms x*...) |\n| (*fn arg*...) | (*fn arg*...) or (`funcall`*fn arg*...) |\n| `#t` | `t` |\n| `#f` | `nil` |\n| `( )` | `nil` |\n| (`define`*varexp*) | (`defparameter`*var exp*) |\n| (`define` (*fnparm*...) *body*) | (`defun`*fn* (*parm*...) *body*) |\n\n**Exercise 22**.**1** [**s**] What does the following expression evaluate to in Scheme?\nHow many errors does it have as a Common Lisp expression?\n\n```lisp\n((if (= (+ 2 2) 4)\n   (lambda (x y) (+ (* x y) 12))\n   cons)\n 5\n 6)\n```\n\nA great many functions, such as `car`, `cdr`, `cons`, `append`, +, `*`, and `list` are the same (or nearly the same) in both dialects.\nHowever, Scheme has some spelling conventions that are different from Common Lisp.\nMost Scheme mutators, like `set`!, end in '`!`' Common Lisp has no consistent convention for this; some mutators start with `n` (`nreverse, nsubst, nintersection`) while others have idiosyncratic names (`delete versus remove`).\nScheme would use consistent names-`reverse`!\nand `remove`!\n-if these functions were defined at all (they are not defined in the standard).\nMost Scheme predicates end in '`?`', not '`p`'.\nThis makes predicates more obvious and eliminates the complicated conventions for adding a hyphen before the `p`.[1](#fn0010) The only problem with this convention is in spoken language: is `equal?` pronounced \"equal-question-mark\" or \"equal-q\" or perhaps equal, with rising intonation?\nThis would make Scheme a tone language, like Chinese.\n\nIn Scheme, it is an error to apply `car` or `cdr` to the empty list.\nDespite the fact that Scheme has `cons`, it calls the result a `pair` rather than a cons cell, so the predicate is `pair?`, not `consp`.\n\nScheme recognizes not all lambda expressions will be \"functions\" according to the mathematical definition of function, and so it uses the term \"procedure\" instead.\nHere is a partial list of correspondences between the two dialects:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Scheme Procedure | Common Lisp Function |\n| `char-ready?` | `listen` |\n| `char?` | `characterp` |\n| `eq?` | `eq` |\n| `equal?` | `equal` |\n| `eqv?` | `eql` |\n| `even?` | `evenp` |\n| `for-each` | `mapc` |\n| `integer?` | `integerp` |\n| `list->string` | `coerce` |\n| `list->vector` | `coerce` |\n| `list-ref` | `nth` |\n| `list-tail` | `nthcdr` |\n| `map` | `mapcar` |\n| `negative?` | `minusp` |\n| `pair?` | `consp` |\n| `procedure?` | `functionp` |\n| `set!` | `setq` |\n| `set-car!` | `replaca` |\n| `vector-set!` | `setf` |\n| `string-set!` | `setf` |\n\n## 22.1 A Scheme Interpreter\n{:#s0010}\n{:.h1hd}\n\nAs we have seen, an interpreter takes a program (or expression) as input and returns the value computed by that program.\nThe Lisp function `eval` is thus an interpreter, and that is essentially the function we are trying to write in this section.\nWe have to be careful, however, in that it is possible to confuse the notions of interpreter and compiler.\nA compiler takes a program as input and produces as output a translation of that program into some other language-usually a language that can be directly (or more easily) executed on some machine.\nSo it is also possible to write `eval` by compiling the argument and then interpreting the resulting machine-level program.\nMost modern Lisp systems support both possibilities, although some only interpret code directly, and others compile all code before executing it.\nTo make the distinction clear, we will not write a function called `eval`.\nInstead, we will write versions of two functions: `interp`, a Scheme interpreter, and, in the next chapter, `comp`, a Scheme compiler.\n\nAn interpreter that handles the Scheme primitives is easy to write.\nIn the interpreter `interp`, the main conditional has eight cases, corresponding to the five special forms, symbols, other atoms, and procedure applications (otherwise known as function calls).\nFor the moment we will stick with `t` and `nil` instead of `#t` and `#f`.\nAfter developing a simple interpreter, we will add support for macros, then develop a tail-recursive interpreter, and finally a continuation-passing interpreter.\n(These terms will be defined when the time cornes.).\nThe glossary for `interp` is in [figure 22.1](#f0010).\n\n![f22-01-9780080571157](images/B9780080571157500224/f22-01-9780080571157.jpg)     \nFigure 22.1\n!!!(span) {:.fignum}\nGlossary for the Scheme Interpreter\nThe simple interpreter has eight cases to worry about: (1) If the expression is a symbol, look up its value in the environment.\n(2) If it is an atom that is not a symbol (such as a number), just return it.\nOtherwise, the expression must be a list.\n(3) If it starts with `quote`, return the quoted expression.\n(4) If it starts with `begin`, interpret each subexpression, and return the last one.\n(5) If it starts with `set!`, interpret the value and then set the variable to that value.\n(6) If it starts with `if`, then interpret the conditional, and depending on if it is true or not, interpret the then-part or the else-part.\n(7) If it starts with `lambda`, build a new procedure-a closure over the current environment.\n(8) Otherwise, it must be a procedure application.\nInterpret the procedure and all the arguments, and apply the procedure value to the argument values.\n\n```lisp\n(defun interp (x &optional env)\n \"Interpret (evaluate) the expression x in the environment env.\"\n (cond\n  ((symbolp x) (get-var x env))\n  ((atom x) x)\n  ((case (first x)\n   (QUOTE (second x))\n   (BEGIN (last1 (mapcar #'(lambda (y) (interp y env))\n                (rest x))))\n   (SET! (set-var! (second x) (interp (third x) env) env))\n   (IF   (if (interp (second x) env)\n          (interp (third x) env)\n          (interp (fourth x) env)))\n   (LAMBDA (let ((parms (second x))\n           (code (maybe-add 'begin (rest2 x))))\n         #'(lambda (&rest args)\n           (interp code (extend-env parms args env)))))\n   (t   ;; a procedure application\n        (apply (interp (first x) env)\n           (mapcar #'(lambda (v) (interp v env))\n                (rest x))))))))\n```\n\nAn environment is represented as an association list of variable/value pairs, except for the global environment, which is represented by values on the `global-val` property of symbols.\nIt would be simpler to represent the global environment in the same way as local environments, but it is more efficient to use property lists than one big global a-list.\nFurthermore, the global environment is distinct in that every symbol is implicitly defined in the global environment, while local environments only contain variables that are explicitly mentioned (in a `lambda` expression).\n\nAs an example, suppose we interpret the function call `(f 1 2 3)`, and that the functions `f` has been defined by the Scheme expression:\n\n```lisp\n(set! f (lambda (a b c) (+ a (g b c))))\n```\n\nThen we will interpret `( f 1 2 3 )` by interpreting the body of `f` with the environment:\n\n```lisp\n((a 1) (b 2) (c 3))\n```\n\nScheme procedures are implemented as Common Lisp functions, and in fact all the Scheme data types are implemented by the corresponding Common Lisp types.\nIinclude the function `init-scheme- interp` to initialize a few global values and repeat the definitions of `last1` and `length=1`:\n\n```lisp\n(defun set-var! (var val env)\n \"Set a variable to a value, in the given or global environment.\"\n (if (assoc var env)\n       (setf (second (assoc var env)) val)\n       (set-global-var! var val))\n val)\n(defun get-var (var env)\n \"Get the value of a variable, from the given or global environment.\"\n  (if (assoc var env)\n        (second (assoc var env))\n        (get-global-var var)))\n(defun set-global-var! (var val)\n (setf (get var 'global-val) val))\n(defun get-global-var (var)\n (let* ((default \"unbound\")\n      (val (get var 'global-val default)))\n   (if (eq val default)\n     (error \"Unbound scheme variable: ~ a\" var\n     val)))\n(defun extend-env (vars vals env)\n \"Add some variables and values to an environment.\"\n (nconc (mapcar #' list vars vals) env))\n(defparameter *scheme-procs*\n '(+-*/=<><=>= cons car cdr not append list read member\n  (null? null) (eq? eq) (equal? equal) (eqv? eql)\n  (write prin1) (display princ) (newline terpri)))\n(defun init-scheme-interp ()\n \"Initialize the scheme interpreter with some global variables.\"\n ;; Define Scheme procedures as CL functions:\n (mapc #'init-scheme-proc *scheme-procs*)\n ;; Define the Boolean 'constants'. Unfortunately, this won't\n ;; stop someone from saying: (set! t nil)\n (set-global-var! t t)\n (set-global-var! nil nil))\n(defun init-scheme-proc (f)\n \"Define a Scheme procedure as a corresponding CL function.\"\n (if (listp f)\n       (set-global-var! (first f) (symbol-function (second f)))\n       (set-global-var! f (symbol-function f))))\n(defun maybe-add (op exps &optional if-nil)\n \"For example, (maybe-add 'and exps t) returns\n t if exps is nil, exps if there is only one,\n and (and exp1 exp2...) if there are several exps.\"\n (cond ((null exps) if-nil)\n       ((length=1 exps) (first exps))\n       (t (cons op exps))))\n(defun length=1 (x)\n \"Is x a list of length 1?\"\n (and (consp x) (null (cdr x))))\n(defun lastl (list)\n \"Return the last element (not last cons cell) of list\"\n (first (last list)))\n```\n\nTo test the interpreter, we add a simple read-eval-print loop:\n\n```lisp\n(defun scheme ()\n \"A Scheme read-eval-print loop (using interp)\"\n (init-scheme-interp)\n (loop (format t \"~&==> \")\n    (print (interp (read) nil))))\n```\n\nAnd now we're ready to try out the interpreter.\nNote the Common Lisp prompt is \">,\" while the Scheme prompt is \"==>.\"\n\n```lisp\n> (scheme)\n==> (+ 2 2)\n4\n==> ((if (= 1 2) * +) 3 4)\n7\n==> ((if (= 1 1) * +) 3 4)\n12\n==> (set! fact (lambda (n)\n        (if (= n 0) 1\n          (* n (fact (- n 1))))))\n#<DTP-LEXICAL-CLOSURE 36722615 >\n==> (fact 5)\n120\n==> (set! table (lambda (f start end)\n          (if (<= start end)\n            (begin\n             (write (list start (f start)))\n             (newline)\n             (table f (+ start 1) end)))))\n#<DTP-LEXICAL-CLOSURE 41072172 >\n==> (table fact 1 10)\n(1 1)\n(2 2)\n(3 6)\n(4 24)\n(5 120)\n(6 720)\n(7 5040)\n(8 40320)\n(9 362880)\n(10 3628800)\nNIL\n==> (table (lambda (x) (* x x x)) 5 10)\n(5 125)\n(6 216)\n(7 343)\n(8 512)\n(9 729)\n(10 1000)\nNIL\n==> [ABORT]\n```\n\n## 22.2 Syntactic Extension with Macros\n{:#s0015}\n{:.h1hd}\n\nScheme has a number of other special forms that were not listed above.\nActually, Scheme uses the term \"syntax\" where we have been using \"special form.\" The remaining syntax can be defined as \"derived expressions\" in terms of the five primitives.\nThe Scheme standard does not recognize a concept of macros, but it is clear that a \"derived expression\" is like a macro, and we will implement them using macros.\nThe following forms are used (nearly) identically in Scheme and Common Lisp:\n\n```lisp\nlet let* and or do cond case\n```\n\nOne difference is that Scheme is less lenient as to what counts as a binding in `let`, `let*` and `do`.\nEvery binding must be `(`*var init*`)`; just `(`*var*`)` or *var* is not allowed.\nIn do, a binding can be either (*var init step*) or (*var init*).\nNotice there is no `do*`.\nThe other difference is in `case` and `cond`.\nWhere Common Lisp uses the symbol `t` or `otherwise` to mark the final case, Scheme uses `else`.\nThe final three syntactic extensions are unique to Scheme:\n\n```lisp\n(define *var val*)   *or*     (define (*proc*-*name arg*...) *body*...)\n(delay *expression*)\n(letrec ((*var init*)...) *body*...)\n```\n\n`define` is a combination of `defun` and `defparameter`.\nIn its first form, it assigns a value to a variable.\nSince there are no special variables in Scheme, this is no different than using `set!`.\n(There is a difference when the `define` is nested inside another definition, but that is not yet considered.) In the second form, it defines a function.\n`delay` is used to delay evaluation, as described in [section 9.3](B9780080571157500091.xhtml#s0020), page 281.\n`letrec` is similar to `let`.\nThe difference is that all the *init* forms are evaluated in an environment that includes all the *vars*.\nThus, `letrec` can be used to define local recursive functions, just as `labels` does in Common Lisp.\n\nThe first step in implementing these syntactic extensions is to change `interp` to allow macros.\nOnly one clause has to be added, but we'll repeat the whole definition:\n\n```lisp\n(defun interp (x &optional env)\n  \"Interpret (evaluate) the expression x in the environment env.\n  This version handles macros.\"\n  (cond\n   ((symbolp x) (get-var x env))\n   ((atom x) x)\n   ((scheme-macro (first x)) ;***\n    (interp (scheme-macro-expand x) env)) ;***\n  ((case (first x)\n       (QUOTE (second x))\n(BEGIN (lastl (mapcar #'(lambda (y) (interp y env))\n              (rest x))))\n(SET! (set-var! (second x) (interp (third x) env) env))\n(IF  (if (interp (second x) env)\n        (interp (third x) env)\n        (interp (fourth x) env)))\n(LAMBDA (let ((parms (second x))\n         (code (maybe-add 'begin (rest2 x))))\n     #'(lambda (&rest args)\n         (interp code (extend-env parms args env)))))\n(t     ;; a procedure application\n      (apply (interp (first x) env)\n          (mapcar #'(lambda (v) (interp v env))\n                 (rest x))))))))\n```\n\nNow we provide a mechanism for defining macros.\nThe macro definitions can be in any convenient language; the easiest choices are Scheme itself or Common Lisp.\nI have chosen the latter.\nThis makes it clear that macros are not part of Scheme itself but rather are used to implement Scheme.\nIf we wanted to offer the macro facility to the Scheme programmer, we would make the other choice.\n(But then we would be sure to add the backquote notation, which is so useful in writing macros.) `def-scheme-macro` (which happens to be a macro itself) provides a way of adding new Scheme macros.\nIt does that by storing a Common Lisp function on the `scheme-macro` property of a symbol.\nThis function, when given a list of arguments, returns the code that the macro call should expand into.\nThe function `scheme-macro` tests if a symbol has a macro attached to it, and `scheme-macro-expand` does the actual macro-expansion:\n\n```lisp\n(defun scheme-macro (symbol)\n (and (symbolp symbol) (get symbol 'scheme-macro)))\n(defmacro def-scheme-macro (name parmiist &body body)\n \"Define a Scheme macro.\"\n '(setf (get ',name 'scheme-macro)\n    #'(lambda .parmlist ..body)))\n(defun scheme-macro-expand (x)\n \"Macro-expand this Scheme expression.\"\n (if (and (listp x) (scheme-macro (first x)))\n       (scheme-macro-expand\n        (apply (scheme-macro (first x)) (rest x)))\n       x))\n```\n\nHere are the definitions of nine important macros in Scheme:\n\n```lisp\n(def-scheme-macro let (bindings &rest body)\n '((lambda .(mapcar #'first bindings) . ,body)\n  .,(mapcar #'second bindings)))\n(def-scheme-macro let* (bindings &rest body)\n (if (null bindings)\n       '(begin .,body)\n       '(let (,(first bindings))\n     (let* ,(rest bindings) . ,body))))\n(def-scheme-macro and (&rest args)\n (cond ((null args) 'T)\n     ((length=1 args) (first args))\n     (t '(if ,(first args)\n          (and . ,(rest args))))))\n(def-scheme-macro or (&rest args)\n (cond ((null args) 'nil)\n    ((length=1 args) (first args))\n    (t (let ((var (gensym)))\n        '(let ((,var ,(first args)))\n         (if ,var ,var (or . ,(rest args))))))))\n(def-scheme-macro cond (&rest clauses)\n (cond ((null clauses) nil)\n     ((length=1 (first clauses))\n      '(or ,(first clauses) (cond .,(rest clauses))))\n     ((starts-with (first clauses) 'else)\n      '(begin .,(rest (first clauses))))\n     (t '(if ,(first (first clauses))\n          (begin .,(rest (first clauses)))\n          (cond .,(rest clauses))))))\n(def-scheme-macro case (key &rest clauses)\n (let ((key-val (gensym \"KEY\")))\n  '(let ((,key-val ,key))\n   (cond ,@(mapcar\n        #'(lambda (clause)\n          (if (starts-with clause 'else)\n            clause\n            '((member ,key-val ',(first clause))\n                .,(rest clause))))\n        clauses)))))\n(def-scheme-macro define (name &rest body)\n (if (atom name)\n       '(begin (set! ,name . ,body) ',name)\n       '(define ,(first name)\n     (lambda ,(rest name) . ,body))))\n(def-scheme-macro delay (computation)\n '(lambda () ,computation))\n(def-scheme-macro letrec (bindings &rest body)\n '(let ,(mapcar #'(lambda (v) (list (first v) nil)) bindings)\n    ,@(mapcar #'(lambda (v) '(set! . ,v)) bindings)\n   .,body))\n```\n\nWe can test out the macro facility:\n\n```lisp\n> (scheme-macro-expand '(and p q)) => (IF P (AND Q))\n> (scheme-macro-expand '(and q)) Q\n```\n\n`> (scheme-macro-expand '(let ((x 1) (y 2)) (+ x y)))`=>\n\n```lisp\n((LAMBDA (X Y) (+ X Y)) 1 2)\n> (scheme-macro-expand\n  '(letrec\n    ((even? (lambda (x) (or (= x 0) (odd? (- x 1)))))\n     (odd? (lambda (x) (even? (- x 1)))))\n```\n\n`    (even?\nz)))`=>\n\n```lisp\n(LET ((EVEN? NIL)\n       (ODD? NIL))\n (SET! EVEN? (LAMBDA (X) (OR (= X 0) (ODD? (- X 1)))))\n (SET! ODD? (LAMBDA (X) (EVEN? (- X 1))))\n (EVEN? Z))\n> (scheme)\n==> (define (reverse 1)\n   (if (null? 1) nil\n      (append (reverse (cdr 1)) (list (car 1)))))\nREVERSE\n==> (reverse '(a b c d))\n(D C B A)\n==> (let* ((x 5) (y (+ x x)))\n   (if (or (= x 0) (and (< 0 y) (< y 20)))\n      (list x y)\n      (+ y x)))\n(5 10)\n```\n\nThe macro `define` is just like `set!`, except that it returns the symbol rather than the value assigned to the symbol.\nIn addition, `define` provides an optional syntax for defining functions-it serves the purposes of both `defun` and `defvar`.\nThe syntax (`define` (*fn*.\n*args*).*body*) is an abbreviation for (`define`*fn* (`lambda`*args*.\n*body*)).\n\nIn addition, Scheme provides a notation where `define` can be used inside a function definition in a way that makes it work like `let` rather than `set!.`\n\nThe advantage of the macro-based approach to special forms is that we don't have to change the interpreter to add new special forms.\nThe interpreter remains simple, even while the language grows.\nThis also holds for the compiler, as we see in the next section.\n\n## 22.3 A Properly Tail-Recursive Interpreter\n{:#s0020}\n{:.h1hd}\n\nUnfortunately, the interpreter presented above can not lay claim to the name Scheme, because a true Scheme must be properly tail-recursive.\nOur interpreter is tail- recursive only when run in a Common Lisp that is tail-recursive.\nTo see the problem, consider the following Scheme procedure:\n\n```lisp\n(define (traverse lyst)\n (if lyst (traverse (cdr lyst))))\n```\n\nTrace the function `interp` and execute `(interp '(traverse '(a b c d)))`.\nThe nested calls to `interp` go 16 levels deep.\nIn general, the level of nesting is 4 plus 3 times the length of the list.\nEach call to `interp` requires Common Lisp to allocate some storage on the stack, so for very long lists, we will eventually run out of storage.\nTo earn the name Scheme, a language must guarantee that such a program does not run out of storage.\n\nThe problem, in this example, lies in two places.\nEverytime we interpret an `if` form or a procedure call, we descend another recursive level into `interp`.\nBut that extra level is not necessary.\nConsider the `if` form.\nIt is certainly necessary to call `interp` recursively to decide if the test is true or not.\nFor the sake of argument, let's say the test is true.\nThen we call `interp` again on the *then* part.\nThis recursive call will return a value, which will then be immediately returned as the value of the original call as well.\n\nThe alternative is to replace the recursive call to `interp` with a renaming of variables, followed by a `goto` statement.\nThat is, instead of calling `interp` and thereby binding a new instance of the variable `x` to the *then* part, we just assign the *then* part to `x`, and branch to the top of the `interp` routine.\nThis works because we know we have no more use for the old value of `x`.\nA similar technique is used to eliminate the recursive call for the last expression in a `begin` form.\n(Many programmers have been taught the \"structured programming\" party line that `goto` statements are harmful.\nIn this case, the `goto` is necessary to implement a low-level feature efficiently.)\n\nThe final thing we need to do is explicitly manage Scheme procedures.\nInstead of implementing Scheme procedures as Common Lisp closures, we will define a structure, `proc`, to contain the code, environment, parameter list, and optionally the name of the procedure.\nThen when we are evaluating a procedure call, we can assign the body of the procedure to `x` rather than recursively calling `interp`.\n\n```lisp\n(defstruct (proc (:print-function print-proc))\n \"Represent a Scheme procedure\"\n code (env nil)(name nil) (parms nil))\n```\n\nThe following is a properly tail-recursive interpreter.\nThe macro `prog` sets up a `tagbody` within which we can use `go` statements to branch to labels, and it also sets up a `block` from which we can return a value.\nIt can also bind variables like `let`, although in this usage, the variable list is empty.\nAny symbol within the body of a `prog` is considered a label.\nIn this case, the label : `INTERP` is the target of the branch statements `(GO : INTERP)`.\nI use uppercase to indicate that go-to statements are being used, but this convention has not been widely adopted.\n\n```lisp\n(defun interp (x &optional env)\n \"Evaluate the expression x in the environment env.\n This version is properly tail-recursive.\"\n (prog ()\n  :INTERP\n  (return\n   (cond\n    ((symbolp x) (get-var x env))\n    ((atom x) x)\n    ((scheme-macro (first x))\n     (setf x (scheme-macro-expand x)) (go :INTERP))\n    ((case (first x)\n      (QUOTE (second x))\n      (BEGIN (pop x) ; pop off the BEGIN to get at the args\n           ;; Now interpret all but the last expression\n           (loop while (rest x) do (interp (pop x) env))\n           ;; Finally, rename the last expression as x\n           (setf x (first x))\n           (GO :INTERP))\n      (SET!  (set-var! (second x) (interp (third x) env) env))\n      (IF       (setf x (if (interp (second x) env)\n                (third x)\n                (fourth x)))\n           ;; That is, rename the right expression as x\n           (GO :INTERP))\n      (LAMBDA (make-proc :env env :parms (second x)\n                :code (maybe-add 'begin (rest2 x))))\n      (t   ;; a procedure application\n          (let ((proc (interp (first x) env))\n             (args (mapcar #'(lambda (v) (interp v env))\n                           (rest x))))\n           (if (proc-p proc)\n              ;; Execute procedure with rename+goto\n              (progn\n               (setf x (proc-code proc))\n               (setf env (extend-env (proc-parms proc) args\n                                     (proc-env proc)))\n               (GO :INTERP))\n              ;; else apply primitive procedure\n              (apply proc args))))))))))\n(defun print-proc (proc &optional (stream *standard-output*) depth)\n (declare (ignore depth))\n (format stream \"{~a}\" (or (proc-name proc) '??)))\n```\n\nBy tracing the tail-recursive version of `interp`, you can see that calls to `traverse` descend only three recursive levels of `interp`, regardless of the length of the list traversed.\n\nNote that we are not claiming that this interpreter allocates no storage when it makes tail-recursive calls.\nIndeed, it wastes quite a bit of storage in evaluating arguments and building environments.\nThe claim is that since the storage is allocated on the heap rather than on the stack, it can be reclaimed by the garbage collector.\nSo even if `traverse` is applied to an infinitely long list (i.e., a circular list), the interpreter will never run out of space-it will always be able to garbage-collect and continue.\n\nThere are many improvements that could be made to this interpreter, but effort is better spent in improving a compiler rather than an interpreter.\nThe next chapter does just that.\n\n## 22.4 Throw, Catch, and Call/cc\n{:#s0025}\n{:.h1hd}\n\nTail-recursion is crucial to Scheme.\nThe idea is that when the language is guaranteed to optimize tail-recursive calls, then there is no need for special forms to do iteration.\nAll loops can be written using recursion, without any worry of overflowing the runtime stack.\nThis helps keep the language simple and rules out the `goto` statement, the scourge of the structured programming movement.\nHowever, there are cases where some kind of nonlocal exit is the best alternative.\nSuppose that some unexpected event happens deep inside your program.\nThe best action is to print an error message and pop back up to the top level of your program.\nThis could be done trivially with a goto-like statement.\nWithout it, every function along the calling path would have to be altered to accept either a valid result or an indication of the exceptional condition, which just gets passed up to the next level.\n\nIn Common Lisp, the functions `throw` and `catch` are provided for this kind of nonlocal exit.\nScott Zimmerman, the perennial world Frisbee champion, is also a programmer for a Southern California firm.\nHe once told me, \"I'm starting to learn Lisp, and it must be a good language because it's got `throw` and `catch` in it.\" Unfortunately for `Scott`, `throw` and `catch` don't refer to Frisbees but to transfer of control.\nThey are both special forms, with the following syntax:\n\n```lisp\n(catch tag body...)\n(throw tag value)\n```\n\nThe first argument to `catch` is a tag, or label.\nThe remaining arguments are evaluated one at a time, and the last one is returned.\nThus, `catch` is much like `progn`.\nThe difference is that if any code in the dynamic extent of the body of the `catch` evaluates the special form `throw`, then control is immediately passed to the enclosing `catch` with the same tag.\n\nFor example, the form\n\n```lisp\n(catch 'tag\n (print 1) (throw 'tag 2) (print 3))\n```\n\nprints `1` and returns `2`, without going on to print `3`.\nA more representative example is:\n\n```lisp\n(defun print-table (l)\n (catch 'not-a-number (mapcar #'print-sqrt-abs l)))\n(defun print-sqrt-abs (x)\n (print (sqrt (abs (must-be-number x)))))\n(defun must-be-number (x)\n (if (numberp x) x\n   (throw 'not-a-number \"huh?\")))\n> (print-table '(1 4 -9 x 10 20))\n1\n2\n3\n\"huh?\"\n```\n\nHere `print-table` calls `print-sqrt-abs`, which calls `must-be-number`.\nThe first three times all is fine and the values 1,2,3 get printed.\nThe next time `x` is not a number, so the value `\"huh?\"` gets thrown to the tag `not-a-number` established by `catch` in `f`.\nThe throw bypasses the pending calls to `abs`, `sqrt`, and `print`, as well as the rest of the call to `mapcar`.\n\nThis kind of control is provided in Scheme with a very general and powerful procedure, `call-with-current-continuation`, which is often abbreviated `call/cc.\ncall/cc` is a normal procedure (not a special form like `throw` and `catch`) that takes a single argument.\nLet's call the argument `computation`.\n`computation` must be a procedure of one argument.\nWhen `call/cc` is invoked, it calls `computation`, and whatever `computation` returns is the value of the call to `call/cc`.\nThe trick is that the procedure `computation` also takes an argument (which we'll call `cc`) that is another procedure representing the current continuation point.\nIf `cc` is applied to some value, that value is returned as the value of the call to `call/cc`.\nHere are some examples:\n\n```lisp\n> (scheme)\n=> (+ 1 (call/cc (lambda (cc) (+ 20 300))))\n321\n```\n\nThis example ignores `cc` and just computes `(+ 1 (+ 20 300 ))`.\nMore precisely, it is equivalent to:\n\n```lisp\n((lambda (val) (+ 1 val))\n (+ 20 300))\n```\n\nThe next example does make use of `cc`:\n\n```lisp\n=> (+ 1 (call/cc (lambda (cc) (+ 20 (cc 300)))))\n301\n```\n\nThis passes `300` to `cc`, thus bypassing the addition of `20`.\nIt effectively throws `300` out of the computation to the catch point established by `call/cc`.\nIt is equivalent to:\n\n```lisp\n((lambda (val) (+ 1 val))\n 300)\n```\n\nor to:\n\n```lisp\n((lambda (val) (+ 1 val))\n (catch 'cc\n  ((lambda (v) (+ 20 v))\n   (throw 'cc 300))))\n```\n\nHere's how the `throw/catch` mechanism would look in Scheme:\n\n```lisp\n(define (print-table l )\n (call/cc\n  (lambda (escape)\n   (set! not-a-number escape)\n   (map print-sqrt-abs l))))\n(define (print-sqrt-abs x)\n (write (sqrt (abs (must-be-number x)))))\n(define (must-be-number x)\n (if (numberp x) x\n   (not-a-number \"huh?\")))\n(define (map fn l)\n (if (null? l)\n   '()\n   (cons (fn (first l))\n       (map fn (rest 1)))))\n```\n\nThe ability to return to a pending point in the computation is useful for this kind of error and interrupt handling.\nHowever, the truly amazing, wonderful thing about `call/cc` is the ability to return to a continuation point more than once.\nConsider a slight variation:\n\n```lisp\n=> (+ 1 (call/cc (lambda (cc)\n           (set! old-cc cc)\n           (+ 20 (cc 300)))))\n301\n=> (old-cc 500)\n501\n```\n\nHere, we first computed 301, just as before, but along the way saved `cc` in the global variable `old-cc`.\nAfterward, calling `(old-cc 500)` returns (for the second time) to the point in the computation where 1 is added, this time returning `501`.\nThe equivalent Common Lisp code leads to an error:\n\n```lisp\n> (+ 1 (catch 'tag (+ 20 (throw 'tag 300))))\n301\n> (throw 'tag 500)\n*Error*: *there was no pending CATCH for the tag TAG*\n```\n\nIn other words, `call/cc`'s continuations have indefinite extent, while throw/catch tags only have dynamic extent.\n\nWe can use `cal1/cc` to implement automatic backtracking (among other things).\nSuppose we had a special form, `amb`, the \"ambiguous\" operator, which returns one of its arguments, chosen at random.\nWe could write:\n\n```lisp\n(define (integer) (amb 1 (+ 1 (integer))))\n```\n\nand a call to `integer` would return some random positive integer.\nIn addition, suppose we had a function, `fail`, which doesn't return at all but instead causes execution to continue at a prior `amb` point, with the other choice taken.\nThen we could write succinct[2](#fn0015) backtracking code like the following:\n\n```lisp\n(define (prime)\n (let ((n (integer)))\n (if (prime? n) n (fail))))\n```\n\nIf `prime?` is a predicate that returns true only when its argument is a prime number, then prime will always return some `prime` number, decided by generating random integers.\nWhile this looks like a major change to the language-adding backtracking and nondeterminism-it turns out that `amb` and `fail` can be implemented quite easily with `cal1/cc`.\nFirst, we need to make `amb` be a macro:\n\n```lisp\n(def-scheme-macro amb (x y)\n '(random-choice (lambda () ,x) (lambda () ,y))))\n```\n\nThe rest is pure Scheme.\nWe maintain a list of `backtrack-points`, which are implemented as functions of no arguments.\nTo backtrack, we just call one of these functions.\nThat is what `fail` does.\nThe function `choose-first` takes two functions and pushes the second, along with the proper continuation, on `backtrack-points`, and then calls the first, returning that value.\nThe function `random-choice` is what `amb` expands into: it decides which choice is first, and which is second.\n(Note that the convention in Scheme is to write global variables like `backtrack-points` without asterisks.)\n\n```lisp\n(define backtrack-points nil)\n(define (fail)\n (let ((last-choice (car backtrack-points)))\n  (set! backtrack-points (cdr backtrack-points))\n  (last-choice)))\n(define (random-choice f g)\n (if (= 1 (random 2))\n   (choose-first f g)\n   (choose-first g f)))\n(define (choose-first f g)\n (call/cc\n  (lambda (k)\n   (set! backtrack-points\n      (cons (lambda () (k (g))) backtrack-points))\n   (f))))\n```\n\nThis implements chronological backtracking, as in Prolog.\nHowever, we actually have the freedom to do other kinds of backtracking as well.\nInstead of having `fail` take the first element of `backtrack-points`, we could choose a random element instead.\nOr, we could do some more complex analysis to choose a good backtrack point.\n\n`call/cc` can be used to implement a variety of control structures.\nAs another example, many Lisp implementations provide a `reset` function that aborts the current computation and returns control to the top-level read-eval-print loop.\nreset can be defined quite easily using `call/cc`.\nThe trick is to capture a continuation that is at the top level and save it away for future use.\nThe following expression, evaluated at the top level, saves the appropriate continuation in the value of reset:\n\n```lisp\n(call/cc (lambda (cc) (set! reset (lambda ()\n                (cc \"Back to top level\")))))\n```\n\n**Exercise 22.2 [m]** Can you implement `call/cc` in Common Lisp?\n\n**Exercise 22.3 [s]** Can you implement `amb` and `fail` in Common Lisp?\n\n**Exercise 22.4 [m]**`fail` could be written\n\n`(define (fail) ((pop backtrack-points)))` if we had the pop macro in Scheme.\n\nWrite `pop.`\n\n## 22.5 An Interpreter Supporting Call/cc\n{:#s0030}\n{:.h1hd}\n\nIt is interesting that the more a host language has to offer, the easier it is to write an interpreter.\nPerhaps the hardest part of writing a Lisp interpreter (or compiler) is garbage collection.\nBy writing our interpreter in Lisp, we bypassed the problem all together-the host language automatically collects garbage.\nSimilarly, if we are using a Common Lisp that is properly tail-recursive, then our interpreter will be too, without taking any special steps.\nIf not, the interpreter must be rewritten to take care of tail-recursion, as we have seen above.\n\nIt is the same with `call/cc`.\nIf our host language provides continuations with indefinite extent, then it is trivial to implement `call/cc`.\nIf not, we have to rewrite the whole interpreter, so that it explicitly handles continuations.\nThe best way to do this is to make `interp` a function of three arguments: an expression, an environment, and a continuation.\nThat means the top level will have to change too.\nRather than having `interp` return a value that gets printed, we just pass it the function `print` as a continuation:\n\n```lisp\n(defun scheme ()\n  \"A Scheme read-eval-print loop (using interp).\n  Handles call/cc by explicitly passing continuations.\"\n  (init-scheme-interp)\n  (loop (format t \"~&==> \")\n       (interp (read) nil #'print)))\n```\n\nNow we are ready to tackle `interp`.\nFor clarity, we will base it on the non-tail-recursive version.\nThe cases for symbols, atoms, macros, and `quote` are almost the same as before.\nThe difference is that the result of each computation gets passed to the continuation, `cc`, rather than just being returned.\n\nThe other cases are all more complex, because they all require explicit representation of continuations.\nThat means that calls to `interp` cannot be nested.\nInstead, we call `interp` with a continuation that includes another call to `interp`.\nFor example, to interpret (`if p x y`), we first call `interp` on the second element of the form, the predicate `p`.\nThe continuation for this call is a function that tests the value of `p` and interprets either `x` or `y` accordingly, using the original continuation for the recursive call to `interp`.\nThe other cases are similar.\nOne important change is that Scheme procedures are implemented as Lisp functions where the first argument is the continuation:\n\n```lisp\n(defun interp (x env cc)\n \"Evaluate the expression x in the environment env,\n and pass the result to the continuation cc.\"\n (cond\n  ((symbolp x) (funcall cc (get-var x env)))\n  ((atom x) (funcall cc x))\n  ((scheme-macro (first x))\n   (interp (scheme-macro-expand x) env cc))\n  ((case (first x)\n     (QUOTE (funcall cc (second x)))\n     (BEGIN (interp-begin (rest x) env cc))\n(SET!  (interp (third x) env\n          #'(lambda (val)\n             (funcall cc (set-var! (second x)\n                                    val env)))))\n(IF   (interp (second x) env\n          #'(lambda (pred)\n             (interp (if pred (third x) (fourth x))\n                env cc))))\n(LAMBDA (let ((parms (second x))\n         (code (maybe-add 'begin (rest2 x))))\n       (funcall\n        cc\n        #'(lambda (cont &rest args)\n          (interp code\n               (extend-env parms args env)\n               cont)))))\n(t   (interp-call x env cc))))))\n```\n\nA few auxiliary functions are defined, in the same continuation-passing style:\n\n```lisp\n(defun interp-begin (body env cc)\n \"Interpret each element of BODY, passing the last to CC.\"\n (interp (first body) env\n     #'(lambda (val)\n       (if (null (rest body))\n           (funcall cc val)\n           (interp-begin (rest body) env cc)))))\n(defun interp-call (call env cc)\n \"Interpret the call (f x...) and pass the result to CC.\"\n (map-interp call env\n         #'(lambda (fn-and-args)\n           (apply (first fn-and-args)\n                cc\n                (rest fn-and-args)))))\n(defun map-interp (list env cc)\n \"Interpret each element of LIST, and pass the list to CC.\"\n (if (null list)\n    (funcall cc nil)\n    (interp (first list) env\n         #'(lambda (x)\n           (map-interp (rest list) env\n                #'(lambda (y)\n                (funcall cc (cons x y))))))))\n```\n\nBecause Scheme procedures expect a continuation as the first argument, we need to redefine `init-scheme-proc` to install procedures that accept and apply the continuation:\n\n```lisp\n(defun init-scheme-proc (f)\n \"Define a Scheme primitive procedure as a CL function.\"\n (if (listp f)\n    (set-global-var! (first f)\n               #'(lambda (cont &rest args)\n                (funcall cont (apply (second f) args))))\n    (init-scheme-proc (list f f))))\n```\n\nWe also need to define `call/cc`.\nThink for a moment about what `call/cc` must do.\nLike all Scheme procedures, it takes the current continuation as its first argument.\nThe second argument is a procedure-a computation to be performed.\n`call/cc` performs the computation by calling the procedure.\nThis is just a normal call, so it uses the current continuation.\nThe tricky part is what `call/cc` passes the computation as its argument.\nIt passes an escape procedure, which can be invoked to return to the same point that the original call to `call/cc` would have returned to.\nOnce the working of `call/cc` is understood, the implementation is obvious:\n\n```lisp\n(defun call/cc (cc computation)\n \"Make the continuation accessible to a Scheme procedure.\"\n (funcall computation cc\n      ;; Package up CC into a Scheme function:\n      #'(lambda (cont val)\n        (declare (ignore cont))\n        (funcall cc val))))\n;; Now install call/cc in the global environment\n(set-global-var! 'call/cc #'call/cc)\n(set-global-var! 'call-with-current-continuation #'call/cc)\n```\n\n## 22.6 History and References\n{:#s0035}\n{:.h1hd}\n\nLisp interpreters and AI have a long history together.\nMIT AI Lab Memo No.\n1 ([McCarthy 1958](B9780080571157500285.xhtml#bb0790)) was the first paper on Lisp.\nMcCarthy's students were working on a Lisp compiler, had written certain routines-`read`, `print`, etc.-`in` assembly language, and were trying to develop a full Lisp interpreter in assembler.\nSometime around the end of 1958, McCarthy wrote a theoretical paper showing that Lisp was powerful enough to write the universal function, `eval`.\nA programmer on the project, Steve Russell, saw the paper, and, according to McCarthy:\n\n> Steve Russell said, look, why don't I program this `eval` and-you remember the interpreter-and I said to him, ho, ho, you're confusing theory with practice, this `eval` is intended for reading not for Computing.\nBut he went ahead and did it.\nThat is, he compiled the `eval` in my paper into 704 machine code fixing bugs and then advertised this as a Lisp interpreter, which it certainly was.[3](#fn0020)\n\nSo the first Lisp interpreter was the result of a programmer ignoring his boss's advice.\nThe first compiler was for the Lisp 1.5 system ([McCarthy et al.\n1962](B9780080571157500285.xhtml#bb0815)).\nThe compiler was written in Lisp; it was probably the first compiler written in its own language.\n\nAllen's *Anatomy of lisp* (1978) was one of the first overviews of Lisp implementation techniques, and it remains one of the best.\nHowever, it concentrates on the dynamic-scoping Lisp dialects that were in use at the time.\nThe more modem view of a lexically scoped Lisp was documented in an influential pair of papers by Guy Steele ([1976a](B9780080571157500285.xhtml#bb1130),[b](B9780080571157500285.xhtml#bb1135)).\nHis papers \"Lambda: the ultimate goto\" and \"Compiler optimization based on viewing lambda as rename plus goto\" describe properly tail-recursive interpreters and compilers.\n\nThe Scheme dialect was invented by Gerald Sussman and Guy Steele around 1975 (see their MIT AI Memo 349).\nThe *Revised*4*Report on the Algorithmic Language Scheme* ([Clinger et al.\n1991](B9780080571157500285.xhtml#bb0205)) is the definitive reference manual for the current version of Scheme.\n\n[Abelson and Sussman (1985)](B9780080571157500285.xhtml#bb0010) is probably the best introduction to computer science ever written.\nIt may or may not be a coincidence that it uses Scheme as the programming language.\nIt includes a Scheme interpreter.\nWinston and Horn's *Lisp* (1989) also develops a Lisp interpreter.\n\nThe `amb` operator for nondeterministic choice was proposed by [John McCarthy (1963)](B9780080571157500285.xhtml#bb0800) and used in SCHEMER !!!(span) {:.smallcaps} ([Zabih et al.\n1987](B9780080571157500285.xhtml#bb1440)), a nondeterministic Lisp.\n[Ruf and Weise (1990)](B9780080571157500285.xhtml#bb1015) present another implementation of backtracking in Scheme that incorporates all of logic programming.\n\n## 22.7 Exercises\n{:#s0040}\n{:.h1hd}\n\n**Exercise 22.5 [m]** While Scheme does not provide full-blown support for optional and keyword arguments, it does support rest parameters.\nModify the interpreter to support the Scheme syntax for rest parameters:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Scheme | Common Lisp |\n| (`lambda x`*body*) | (`lambda` (`&rest x`) *body*) |\n| (`lambda (x y . z)`*body*) | (`lambda` (`x y &rest z`) *body*) |\n\n**Exercise 22.6 [h]** The representation of environments is somewhat wasteful.\nCurrently it takes 3*n* cons cells to represent an environment with *n* variables.\nChange the representation to take less space.\n\n**Exercise 22.7 [m]** As we've implemented macros, they need to be expanded each time they are encountered.\nThis is not so bad for the compiler-you expand the source code and compile it, and then never refer to the source code again.\nBut for the interpreter, this treatment of macros is most unsatisfactory: the work of macroexpansion must be done again and again.\nHow can you eliminate this duplicated effort?\n\n**Exercise 22.8 [m]** It turns out Scheme allows some additional syntax in `let` and `cond`.\nFirst, there is the \"named-let\" expression, which binds initial values for variables but also defines a local function that can be called within the body of the `let`.\nSecond, `cond` recognizes the symbol => when it is the second element of a cond clause, and treats it as a directive to pass the value of the test (when it is not false) to the third element of the clause, which must be a function of one argument.\nHere are two examples:\n\n```lisp\n(define (fact n)\n ;; Iterative factorial; does not grow the stack\n (let loop ((result 1) (i n))\n  (if (= i 0) result (loop (* result i) (- i 1)))))\n(define (lookup key alist)\n ;; Find key's value in alist\n (cond ((assoc key alist) => cdr)\n     (else #f)))\n```\n\nThese are equivalent to:\n\n```lisp\n(define (fact n)\n (letrec\n  ((loop (lambda (result i)\n        (if (= i 0)\n          result\n          (loop (* result i) (- i 1))))))\n  (loop 1 n)))\n(define (lookup key alist)\n (let ((g0030 (assoc key alist)))\n  (if g0030\n    (cdr g0030)\n    #f)))\n```\n\nWrite macro definitions for `let` and `cond` allowing these variations.\n\n**Exercise 22.9 [h]** Some Scheme implementations permit `define` statements inside the body of a `lambda` (and thus of a `define`, `let`, `let*`, or `letrec` as well).\nHere is an example:\n\n```lisp\n(define (length l)\n (define (len l n)\n  (if (null? l) n (len (cdr l) (+ n 1))))\n (len l 0))\n```\n\nThe internal definition of len is interpreted not as defining a global name but rather as defining a local name as if with `letrec`.\nThe above definition is equivalent to:\n\n```lisp\n(define (length l)\n (letrec ((len (lambda (l n)\n           (if (null? l) n (len (cdr l) (+ n 1))))))\n  (len l 0)))\n```\n\nMake changes to the interpreter to allow this kind of internal definition.\n\n**Exercise 22.10** Scheme programmers are often disdainful of the `function` or `#`' notation in Common Lisp.\nIs it possible (without changing the compiler) to make Common Lisp accept `(lambda ( ) ... )` instead of `#` ' `(lambda ( ) ... )` and `fn` instead of `#`'`fn?`\n\n**Exercise 22.11 [m]** The top level of the continuation-passing version of `scheme` includes the call: `(interp (read)``nil` #'`print)`.\nWill this always result in some value being printed?\nOr is it possible that the expression read might call some escape function that ignores the value without printing anything?\n\n**Exercise 22.12 [h]** What would have to be added or changed to turn the Scheme interpreter into a Common Lisp interpreter?\n\n**Exercise 22.13 [h]** How would you change the interpreter to allow for multiple values?\nExplain how this would be done both for the first version of the interpreter and for the continuation-passing version.\n\n## 22.8 Answers\n{:#s0045}\n{:.h1hd}\n\n**Answer 22.2** There is no way to implement a full `call/cc` to Common Lisp, but the following works for cases where the continuation is only used with dynamic extent:\n\n```lisp\n(defun call/cc (computation)\n \"Call computation. passing it the current continuation.\n The continuation has only dynamic extent.\"\n (funcall computation #'(lambda (x) (return-from call/cc x))))\n```\n\n**Answer 22.3** No.\n`fail` requires continuations with dynamic extent.\n\n**Answer 22.5** We need only modify `extend` - `env` to know about an atomic `vars` list.\nWhile we're at it, we might as well add some error checking:\n\n```lisp\n(defun extend-env (vars vals env)\n \"Add some variables and values to an environment.\"\n (cond ((null vars)\n     (assert (null vals) ( ) \"Too many arguments supplied\")\n     env)\n     ((atom vars)\n      (cons (list vars vals) env))\n     (t (assert (rest vals) ( ) \"Too few arguments supplied\")\n       (cons (list (first vars) (first vals))\n           (extend-env (rest vars) (rest vals) env)))))\n```\n\n**Answer 22.6** Storing the environment as an association list, `((*var val*)...)`, makes it easy to look up variables with `assoc`.\nWe could save one cons cell per variable just by changing to `((*var* . *val*)...)`.\nBut even better is to switch to a different representation, one presented by Steele and Sussman in *The Art of the Interpreter* (1978).\nIn this representation we switch from a single list of var/val pairs to a list of frames, where each frame is a var-list/val-list pair.\nIt looks like this:\n\n```lisp\n(((*var*...) . (*val*...))\n ((*var*...) . (*val*...))\n...)\n```\n\nNow `extend-env` is trivial:\n\n```lisp\n(defun extend-env (vars vals env)\n \"Add some variables and values to an environment.\"\n (cons (cons vars vals) env))\n```\n\nThe advantage of this approach is that in most cases we already have a list of variables (the procedure's parameter list) and values (from the `mapcar` of `interp` over the arguments).\nSo it is cheaper to just cons these two lists together, rather than arranging them into pairs.\nOf course, `get-var` and `set-var`!\nbecome more complex.\n\n**Answer 22.7** One answer is to destructively alter the source code as it is macro-expanded, so that the next time the source code is interpreted, it will already be expanded.\nThe following code takes care of that:\n\n```lisp\n(defun scheme-macro-expand (x)\n (displace x (apply (scheme-macro (first x)) (rest x))))\n(defun displace (old new)\n \"Destructively change old cons-cell to new value.\"\n (if (consp new)\n    (progn (setf (car old) (car new))\n           (setf (cdr old) (cdr new))\n           old)\n    (displace old '(begin ,new))))\n```\n\nOne drawback to this approach is that the user's source code is actually changed, which may make debugging confusing.\nAn alternative is to expand into something that keeps both the original and macro-expanded code around:\n\n```lisp\n(defun displace (old new)\n \"Destructively change old to a DISPLACED structure.\"\n (setf (car old) 'DISPLACED)\n (setf (cdr old) (list new old))\n old)\n```\n\nThis means that `DISPLACED` is a new special form, and we need a clause for it in the interpreter.\nIt would look something like this:\n\n```lisp\n(case (first x)\n ...\n (DISPLACED (interp (second x) env))\n ...\n```\n\nWe'd also need to modify the printing routines to print just `old` whenever they see `(displaced old new)`.\n\n**Answer 22.8**\n\n```lisp\n(def-scheme-macro let (vars &rest body)\n (if (symbolp vars)\n    ;; named let\n    (let ((f vars) (vars (first body)) (body (rest body)))\n     '(letrec ((,f (lambda ,(mapcar #'first vars) .,body)))\n        (,f .,(mapcar #'second vars))))\n    ;; \"regular\" let\n    '((lambda ,(mapcar #'first vars) . ,body)\n     . ,(mapcar #'second vars)))))\n(def-scheme-macro cond (&rest clauses)\n (cond ((null clauses) nil)\n     ((length=1 (first clauses))\n      '(or ,(first clauses) (cond .,(rest clauses))))\n     ((starts-with (first clauses) 'else)\n      '(begin .,(rest (first clauses))))\n     ((eq (second (first clauses)) '=>)\n      (assert (= (length (first clauses)) 3))\n      (let ((var (gensym)))\n      '(let ((,var ,(first (first clauses))))\n        (if ,var (,(third (first clauses)) ,var)\n             (cond .,(rest clauses))))))\n     (t '(if ,(first (first clauses))\n          (begin .,(rest (first clauses)))\n          (cond .,(rest clauses)))))))\n```\n\n**Answer 22.10** It is easy to define `lambda` as a macro, eliminating the need for `#'(lambda ...)`:\n\n```lisp\n(defmacro lambda (args &rest body)\n '(function (lambda .args .@body)))\n```\n\nIf this were part of the Common Lisp standard, I would gladly use it.\nBut because it is not, I have avoided it, on the grounds that it can be confusing.\n\nIt is also possible to write a new function-defining macro that would do the following type of expansion:\n\n```lisp\n(defn double (x) (* 2 x)) =>\n(defparameter double (defun double (x) (* 2 x)))\n```\n\nThis makes `double` a special variable, so we can write `double` instead of `#'double`.\nBut this approach is not recommended-it is dangerous to define special variables that violate the asterisk convention, and the Common Lisp compiler may not be able to optimize special variable references the way it can `function` special forms.\nAlso, this approach would not interact properly with `flet` and `labels`.\n\n----------------------\n\n[1](#xfn0010) One writes `numberp` because there is no hyphen in `number` but `random-state-p` because there is a hyphen in `random-state`.\nHowever, `defstruct` concatenates `-p` in all its predicates, regardless of the presence of a hyphen in the structure's name.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) although inefficient\n!!!(p) {:.ftnote1}\n\n[3](#xfn0020) McCarthy's words from a talk on the history of Lisp, 1974, recorded by [Stoyan (1984)](B9780080571157500285.xhtml#bb1205).\n!!!(p) {:.ftnote1}\n\n# Chapter 23\n## Compiling Lisp\n{:.chaptitle}\n\nMany textbooks show simple interpreters for Lisp, because they are simple to write, and because it is useful to know how an interpreter works.\nUnfortunately, not as many textbooks show how to write a compiler, even though the same two reasons hold.\nThe simplest compiler need not be much more complex than an interpreter.\n\nOne thing that makes a compiler more complex is that we have to describe the output of the compiler: the instruction set of the machine we are compiling for.\nFor the moment let's assume a stack-based machine.\nThe calling sequence on this machine for a function call with *n* arguments is to push the *n* arguments onto the stack and then push the function to be called.\nA `\"CALL *n*\"` instruction saves the return point on the stack and goes to the first instruction of the called function.\nBy convention, the first instruction of a function will always be `\"ARGS *n*\"`, which pops *n* arguments off the stack, putting them in the new function's environment, where they can be accessed by `LVAR` and `LSET` instructions.\nThe function should return with a `RETURN` instruction, which resets the program counter and the environment to the point of the original `CALL` instruction.\n\nIn addition, our machine has three `JUMP` instructions; one that branches unconditionally, and two that branch depending on if the top of the stack is nil or non-nil.\nThere is also an instruction for popping unneeded values off the stack, and for accessing and altering global variables.\nThe instruction set is shown in [figure 23.1](#f0010).\nA glossary for the compiler program is given in [figure 23.2](#f0015).\nA summary of a more complex version of the compiler appears on [page 795](#p795).\n\n![f23-01-9780080571157](images/B9780080571157500236/f23-01-9780080571157.jpg)     \nFigure 23.1\n!!!(span) {:.fignum}\nInstruction Set for Hypothetical Stack Machine\n![f23-02-9780080571157](images/B9780080571157500236/f23-02-9780080571157.jpg)     \nFigure 23.2\n!!!(span) {:.fignum}\nGlossary for the Scheme Compiler\nAs an example, the procedure\n\n```lisp\n(lambda () (if (= x y) (f (g x)) (h x y (h 1 2))))\n```\n\nshould compile into the following instructions:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | `ARGS` | `0` |\n| | `GVAR` | `X` |\n| | `GVAR` | `Y` |\n| | `GVAR` | `=` |\n| | `CALL` | `2` |\n| | `FJUMP` | `L1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `G` |\n| | `CALL` | `1` |\n| | `GVAR` | `F` |\n| | `CALL` | `1` |\n| | `JUMP` | `L2` |\n| `L1:` | `GVAR` | `X` |\n| | `GVAR` | `Y` |\n| | `CONST` | `1` |\n| | `CONST` | `2` |\n| | `GVAR` | `H` |\n| | `CALL` | `2` |\n| | `GVAR` | `H` |\n| | `CALL` | `3` |\n| `L2:` | `RETURN` | |\n\nThe first version of the Scheme compiler is quite simple.\nIt mimics the structure of the Scheme evaluator.\nThe difference is that each case generates code rather than evaluating a subexpression:\n\n```lisp\n(defun comp (x env)\n  \"Compile the expression x into a list of instructions.\"\n  (cond\n    ((symbolp x) (gen-var x env))\n    ((atom x) (gen 'CONST x))\n    ((scheme-macro (first x)) (comp (scheme-macro-expand x) env))\n    ((case (first x)\n      (QUOTE (gen 'CONST (second x)))\n      (BEGIN (comp-begin (rest x) env))\n      (SET! (seq (comp (third x) env) (gen-set (second x) env)))\n      (IF (comp-if (second x) (third x) (fourth x) env))\n      (LAMBDA (gen 'FN (comp-lambda (second x) (rest (rest x)) env)))\n      ;; Procedure application:\n      ;; Compile args, then fn, then the call\n      (t  (seq (mappend #'(lambda (y) (comp y env)) (rest x))\n               (comp (first x) env)\n          (gen 'call (length (rest x)))))))))\n```\n\nThe compiler `comp` has the same nine cases-in fact the exact same structure-as the interpreter `interp` from [chapter 22](B9780080571157500224.xhtml).\nEach case is slightly more complex, so the three main cases have been made into separate functions: `comp-begin`, `comp-if`, and `comp-lambda.` A `begin` expression is compiled by compiling each argument in turn but making sure to pop each value but the last off the stack after it is computed.\nThe last element in the `begin` stays on the stack as the value of the whole expression.\nNote that the function `gen` generates a single instruction (actually a list of one instruction), and `seq` makes a sequence of instructions out of two or more subsequences.\n\n```lisp\n(defun comp-begin (exps env)\n  \"Compile a sequence of expressions, popping all but the last.\"\n  (cond ((null exps) (gen 'CONST nil))\n        ((length=l exps) (comp (first exps) env))\n        (t (seq (comp (first exps) env)\n                (gen 'POP)\n                (comp-begin (rest exps) env)))))\n```\n\nAn `if` expression is compiled by compiling the predicate, then part, and else part, and by inserting appropriate branch instructions.\n\n```lisp\n(defun comp-if (pred then else env)\n  \"Compile a conditional expression.\"\n  (let ((L1 (gen-label))\n        (L2 (gen-label)))\n    (seq (comp pred env) (gen 'FJUMP L1)\n         (comp then env) (gen 'JUMP L2)\n         (list L1) (comp else env)\n         (list L2))))\n```\n\nFinally, a `lambda` expression is compiled by compiling the body, surrounding it with one instruction to set up the arguments and another to return from the function, and then storing away the resulting compiled code, along with the environment.\nThe data type `fn` is implemented as a structure with slots for the body of the code, the argument list, and the name of the function (for printing purposes only).\n\n```lisp\n(defstruct (fn (:print-function print-fn))\n  code (env nil)(name nil) (args nil))\n(defun comp-lambda (args body env)\n  \"Compile a lambda form into a closure with compiled code.\"\n  (assert (and (listp args) (every #'symbolp args)) ()\n          \"Lambda arglist must be a list of symbols, not ~ a\" args)\n  ;; For now. no &rest parameters.\n  ;; The next version will support Scheme's version of &rest\n  (make-fn\n    :env env :args args\n    :code (seq (gen 'ARGS (length args))\n               (comp-begin body (cons args env))\n               (gen 'RETURN))))\n```\n\nThe advantage of compiling over interpreting is that much can be decided at compile time.\nFor example, the compiler can determine if a variable reference is to a global or lexical variable, and if it is to a lexical variable, exactly where that lexical variable is stored.\nThis computation is done only once by the compiler, but it has to be done each time the expression is encountered by the interpreter.\nSimilarly, the compiler can count up the number of arguments once and for all, while the interpreter must go through a loop, counting up the number of arguments, and testing for the end of the arguments after each one is interpreted.\nSo it is clear that the compiler can be more efficient than the interpreter.\n\nAnother advantage is that the compiler can be more robust.\nFor example, in `comp-lambda,` we check that the parameter list of a lambda expression is a list containing only symbols.\nIt would be too expensive to make such checks in an interpreter, but in a compiler it is a worthwhile trade-off to check once at compile time for error conditions rather than checking repeatedly at run time.\n\nBefore we show the rest of the compiler, here's a useful top-level interface to `comp`:\n\n```lisp\n(defvar *label-num* 0)\n(defun compiler (x)\n  \"Compile an expression as if it were in a parameterless lambda.\"\n  (setf *label-num* 0)\n  (comp-lambda '() (list x) nil))\n(defun comp-show (x)\n  \"Compile an expression and show the resulting code\"\n (show-fn (compiler x))\n  (values))\n```\n\nNow here's the code to generate individual instructions and sequences of instructions.\nA sequence of instructions is just a list, but we provide the function `seq` rather than using `append` directly for purposes of data abstraction.\nA label is just an atom.\n\n```lisp\n(defun gen (opcode &rest args)\n  \"Return a one-element list of the specified instruction.\"\n  (list (cons opcode args)))\n(defun seq (&rest code)\n  \"Return a sequence of instructions\"\n  (apply #'append code))\n(defun gen-label (&optional (label 'L))\n  \"Generate a label (a symbol of the form Lnnn)\"\n  (intern (format nil \"~a~d\" label (incf *label-num*))))\n```\n\nEnvironments are now represented as lists of frames, where each frame is a sequence of variables.\nLocal variables are referred to not by their name but by two integers: the index into the list of frames and the index into the individual frame.\nAs usual, the indexes are zero-based.\nFor example, given the code:\n\n```lisp\n(let ((a 2.0)\n     (b 2.1))\n (let ((c 1.0)\n      (d 1.1))\n  (let ((e 0.0)\n     (f 0.1))\n   (+ a b c d e f))))\n```\n\nthe innermost environment is `((e f) (c d) (a b))`.\nThe function `in-env-p` tests if a variable appears in an environment.\nIf this environment were called `env`, then `(in-env-p 'f env)` would return `(2 1)` and `(in-env-p 'x env)` would return `nil`.\n\n```lisp\n(defun gen-var (var env)\n  \"Generate an instruction to reference a variable's value.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LVAR (first p) (second p) \";\" var)\n        (gen 'GVAR var))))\n(defun gen-set (var env)\n  \"Generate an instruction to set a variable to top-of-stack.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LSET (first p) (second p) \";\" var)\n        (gen 'GSET var))))\n```\n\nFinally, we have some auxiliary functions to print out the results, to distinguish between labels and instructions, and to determine the index of a variable in an environment.\nScheme functions now are implemented as structures, which must have a field for the code, and one for the environment.\nIn addition, we provide a field for the name of the function and for the argument list; these are used only for debugging purposes, We'll adopt the convention that the `define` macro sets the function's name field, by calling `name` ! (which is not part of standard Scheme).\n\n```lisp\n(def-scheme-macro define (name &rest body)\n (if (atom name)\n   '(name! (set! ,name . ,body) ',name)\n  (scheme-macro-expand\n    '(define ,(first name)\n     (lambda ,(rest name) . ,body)))))\n(defun name! (fn name)\n \"Set the name field of fn, if it is an un-named fn.\"\n (when (and (fn-p fn) (null (fn-name fn)))\n  (setf (fn-name fn) name))\n name)\n;; This should also go in init-scheme-interp:\n(set-global-var! 'name! #'name!)\n(defun print-fn (fn &optional (stream *standard-output*) depth)\n (declare (ignore depth))\n (format stream \"{~ a}\" (or (fn-name fn) '??)))\n(defun show-fn (fn &optional (stream *standard-output*) (depth 0))\n  \"Print all the instructions in a function.\n  If the argument is not a function, just princ it,\n  but in a column at least 8 spaces wide.\"\n  (if (not (fn-p fn))\n      (format stream \"~8a\" fn)\n      (progn\n        (fresh-line)\n        (incf depth 8)\n        (dolist (instr (fn-code fn))\n          (if (label-p instr)\n              (format stream \"~a:\" instr)\n              (progn\n                (format stream \"~VT\" depth)\n                (dolist (arg instr)\n                  (show-fn arg stream depth))\n                (fresh-line)))))))\n(defun label-p (x) \"Is x a label?\" (atom x))\n(defun in-env-p (symbol env)\n  \"If symbol is in the environment. return its index numbers.\"\n  (let ((frame (find symbol env :test #'find)))\n    (if frame (list (position frame env) (position symbol frame)))))\n```\n\nNow we are ready to show the compiler at work:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(if (= x y) (f (g x)) (h x y (h 1 2))))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `X` |\n| | `GVAR` | `Y` |\n| | `GVAR` | `=` |\n| | `CALL` | `2` |\n| | `FJUMP` | `L1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `G` |\n| | `CALL` | `1` |\n| | `GVAR` | `F` |\n| | `CALL` | `1` |\n| | `JUMP` | `L2` |\n| `L1:` | `GVAR` | `X` |\n| | `GVAR` | `Y` |\n| | `CONST` | `1` |\n| | `CONST` | `2` |\n| | `GVAR` | `H` |\n| | `CALL` | `2` |\n| | `GVAR` | `H` |\n| | `CALL` | `3` |\n| `L2:` | `RETURN` | |\n\n![t0015](images/B9780080571157500236/t0015.png)\n\nThis example should give the reader a feeling for the code generated by the compiler.\n\nAnother reason a compiler has an advantage over an interpreter is that the compiler can afford to spend some time trying to find a more efficient encoding of an expression, while for the interpreter, the overhead of searching for a more efficient interpretation usually offsets any advantage gained.\nHere are some places where a compiler could do better than an interpreter (although our compiler currently does not):\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin \"doc\" (write x) y))` |\n| | `ARGS` | `0` |\n| | `CONST` | `doc` |\n| | `POP` | |\n| | `GVAR` | `X` |\n| | `GVAR` | `WRITE` |\n| | `CALL` | `1` |\n| | `POP` | |\n| | `GVAR` | `Y` |\n| | `RETURN` | |\n\n![t0020](images/B9780080571157500236/t0020.png)\n\nIn this example, code is generated to push the constant \"`doc`\" on the stack and then immediately pop it off.\nIf we have the compiler keep track of what expressions are compiled \"for value\"-as y is the value of the expression above-and which are only compiled \"for effect,\" then we can avoid generating any code at all for a reference to a constant or variable for effect.\nHere's another example:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin (+ (* a x) (f x)) x))` |\n| `ARGS` | `0` |\n| `GVAR` | `A` |\n| `GVAR` | `X` |\n| `GVAR` | `*` |\n| `CALL` | `2` |\n| `GVAR` | `X` |\n| `GVAR` | `F` |\n| `CALL` | `1` |\n| `GVAR` | `+` |\n| `CALL` | `2` |\n| `POP` | |\n| `GVAR` | `X` |\n| `RETURN` | |\n\n![t0025](images/B9780080571157500236/t0025.png)\n\nIn this expression, if we can be assured that + and * refer to the normal arithmetic functions, then we can compile this as if it were `(begin (f x) x)`.\nFurthermore, it is reasonable to assume that + and * will be instructions in our machine that can be invoked inline, rather than having to call out to a function.\nMany compilers spend a significant portion of their time optimizing arithmetic operations, by taking into account associativity, commutativity, distributivity, and other properties.\n\nBesides arithmetic, compilers often have expertise in conditional expressions.\nConsider the following:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(if (and p q) x y))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `P` |\n| | `FJUMP` | `L3` |\n| | `GVAR` | `Q` |\n| | `JUMP` | `L4` |\n| `L3:` | `GVAR` | `NIL` |\n| `L4:` | `FJUMP` | `L1` |\n| | `GVAR` | `X` |\n| | `JUMP` | `L2` |\n| `L1:` | `GVAR` | `Y` |\n| `L2:` | `RETURN` | |\n\n![t0030](images/B9780080571157500236/t0030.png)\n\nNote that `(and p q)` macro-expands to `(if p q nil)`.\nThe resulting compiled code is correct, but inefficient.\nFirst, there is an unconditional jump to `L4`, which labels a conditional jump to `L1`.\nThis could be replaced with a conditional jump to `L1`.\nSecond, at `L3` we load `NIL` and then jump on nil to `L1`.\nThese two instructions could be replaced by an unconditional jump to `L1`.\nThird, the `FJUMP` to `L3` could be replaced by an `FJUMP` to `L1`, since we now know that the code at `L3` unconditionally goes to `L1`.\n\nFinally, some compilers, particularly Lisp compilers, have expertise in function calling.\nConsider the following:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(f (g x y)))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `X` |\n| | `GVAR` | `Y` |\n| | `GVAR` | `G` |\n| | `CALL` | `2` |\n| | `GVAR` | `F` |\n| | `CALL` | `1` |\n| | `RETURN` | |\n\n![t0035](images/B9780080571157500236/t0035.png)\n\nHere we call `g` and when `g` returns we call `f` , and when `f` returns we return from this function.\nBut this last return is wasteful; we push a return address on the stack, and then pop it off, and return to the next return address.\nAn alternative function-calling protocol involves pushing the return address before calling `g,` but then not pushing a return address before calling `f;` when `f` returns, it returns directly to the calling function, whatever that is.\n\nSuch an optimization looks like a small gain; we basically eliminate a single instruction.\nIn fact, the implications of this new protocol are enormous: we can now invoke a recursive function to an arbitrary depth without growing the stack at all-as long as the recursive call is the last statement in the function (or in a branch of the function when there are conditionals).\nA function that obeys this constraint on its recursive calls is known as a *properly tail-recursive* function.\nThis subject was discussed in [section 22.3.](B9780080571157500224.xhtml#s0020)\n\nAll the examples so far have only dealt with global variables.\nHere's an example using local variables:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '((lambda (x) ((lambda (y z) (f x y z)) 3 x)) 4))` |\n| `ARGS` | `0` | | | | | |\n| `CONST` | `4` | | | | | |\n| `FN` | | | | | | |\n| | `ARGS` | `1` | | | | |\n| | `CONST` | `3` | | | | |\n| | `LVAR` | `0` | `0` | ; | `X` | |\n| | `FN` | | | | | |\n| | | `ARGS` | `2` | | | |\n| | | `LVAR` | `1` | `0` | ; | `X` |\n| | | `LVAR` | `0` | `0` | ; | `Y` |\n| | | `LVAR` | `0` | `1` | `;` | `Z` |\n| | | `GVAR` | `F` | | | |\n| | | `CALL` | `3` | | | |\n| | | `RETURN` | | | | |\n| | `CALL` | `2` | | | | |\n| | `RETURN` | | | | | |\n| `CALL` | `1` | | | | | |\n| `RETURN` | | | | | | |\n\n![t0040](images/B9780080571157500236/t0040.png)\n\nThe code is indented to show nested functions.\nThe top-level function loads the constant 4 and an anonymous function, and calls the function.\nThis function loads the constant 3 and the local variable `x`, which is the first (0th) element in the top (0th) frame.\nIt then calls the double-nested function on these two arguments.\nThis function loads `x, y`, and `z: x` is now the 0th element in the next-to-top (1st) frame, and `y` and `z` are the 0th and 1st elements of the top frame.\nWith all the arguments in place, the function `f` is finally called.\nNote that no continuations are stored-`f` can return directly to the caller of this function.\n\nHowever, all this explicit manipulation of environments is inefficient; in this case we could have compiled the whole thing by simply pushing 4, 3, and 4 on the stack and calling `f`.\n\n## 23.1 A Properly Tail-Recursive Lisp Compiler\n{:#s0010}\n{:.h1hd}\n\nIn this section we describe a new version of the compiler, first by showing examples of its output, and then by examining the compiler itself, which is summarized in [figure 23.3](#f0020).\nThe new version of the compiler also makes use of a different function calling sequence, using two new instructions, `CALLJ` and `SAVE`.\nAs the name implies, `SAVE` saves a return address on the stack.\nThe `CALLJ` instruction no longer saves anything; it can be seen as an unconditional jump-hence the `J` in its name.\n\n![f23-03-9780080571157](images/B9780080571157500236/f23-03-9780080571157.jpg)     \nFigure 23.3\n!!!(span) {:.fignum}\nGlossary of the Scheme Compiler, Second Version\nFirst, we see how nested function calls work:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(f (g x)))` |\n| | `ARGS` | `0` |\n| | `SAVE` | `K1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `G` |\n| | `CALLJ` | `1` |\n| `K1:` | `GVAR` | `F` |\n| | `CALLJ` | `1` |\n\n![t0045](images/B9780080571157500236/t0045.png)\n\nThe continuation point `K1` is saved so that g can return to it, but then no continuation is saved for f, so f returns to whatever continuation is on the stack.\nThus, there is no need for an explicit `RETURN` instruction.\nThe final `CALL` is like an unconditional branch.\n\nThe following example shows that all functions but the last `(f)` need a continuation point:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(f (g (h x) (h y))))` |\n| | `ARGS` | `0` |\n| | `SAVE` | `K1` |\n| | `SAVE` | `K2` |\n| | `GVAR` | `X` |\n| | `GVAR` | `H` |\n| | `CALLJ` | `1` |\n| `K2:` | `SAVE` | `K3` |\n| | `GVAR` | `Y` |\n| | `GVAR` | `H` |\n| | `CALLJ` | `1` |\n| `K3:` | `GVAR` | `G` |\n| | `CALLJ` | `2` |\n| `K1:` | `GVAR` | `F` |\n| | `CALLJ` | `1` |\n\n![t0050](images/B9780080571157500236/t0050.png)\n\nThis code first computes `(h x)` and returns to `K2`.\nThen it computes `(h y)` and returns to `K3`.\nNext it calls `g` on these two values, and returns to `K1` before transferring to `f`.\nSince whatever `f` returns will also be the final value of the function we are compiling, there is no need to save a continuation point for `f` to return to.\n\nIn the next example we see that unneeded constants and variables in `begin` expressions are ignored:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin \"doc\" x (f x) y))` |\n| | `ARGS` | `0` |\n| | `SAVE` | `K1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `F` |\n| | `CALLJ` | `1` |\n| `K1:` | `POP` | |\n| | `GVAR` | `Y` |\n| | `RETURN` | |\n\n![t0055](images/B9780080571157500236/t0055.png)\n\nOne major flaw with the first version of the compiler is that it could pass data around, but it couldn't actually *do* anything to the data objects.\nWe fix that problem by augmenting the machine with instructions to do arithmetic and other primitive operations.\nUnneeded primitive operations, like variables constants, and arithmetic operations are ignored when they are in the nonfinal position within `begins`.\nContrast the following two expressions:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin (+ (* a x) (f x)) x))` |\n| | `ARGS` | `0` |\n| | `SAVE` | `K1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `F` |\n| | `CALLJ` | `1` |\n| `K1:` | `POP` | |\n| | `GVAR` | `X` |\n| | `RETURN` | |\n| `> (comp-show '(begin (+ (* a x) (f x))))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `A` |\n| | `GVAR` | `X` |\n| | `*` | |\n| | `SAVE` | `K1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `F` |\n| | `CALLJ` | `1` |\n| `K1:` | `+` | |\n| | `RETURN` | |\n\n![t0060](images/B9780080571157500236/t0060.png)\n\nThe first version of the compiler was context-free, in that it compiled all equivalent expressions equivalently, regardless of where they appeared.\nA properly tail-recursive compiler needs to be context-sensitive: it must compile a call that is the final value of a function differently than a call that is used as an intermediate value, or one whose value is ignored.\nIn the first version of the compiler, `comp-lambda` was responsible for generating the `RETURN` instruction, and all code eventually reached that instruction.\nTo make sure the `RETURN` was reached, the code for the two branches of `if` expressions had to rejoin at the end.\n\nIn the tail-recursive compiler, each piece of code is responsible for inserting its own `RETURN` instruction or implicitly returning by calling another function without saving a continuation point.\n\nWe keep track of these possibilities with two flags.\nThe parameter `val?` is true when the expression we are compiling returns a value that is used elsewhere.\nThe parameter `more?` is false when the expression represents the final value, and it is true when there is more to compute.\nIn summary, there are three possibilities:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `val?` | `more?` | example: the `X` in: |\n| true | true | `(if X y z)`*or*`(f X y)` |\n| true | false | `(if p X z)`*or*`(begin y X)` |\n| false | true | `(begin X y)` |\n| false | false | *impossible* |\n\nThe code for the compiler employing these conventions follows:\n\n```lisp\n(defun comp (x env val? more?)\n  \"Compile the expression x into a list of instructions.\"\n   (cond\n    ((member x '(t nil)) (comp-const x val? more?))\n    ((symbolp x) (comp-var x env val? more?))\n    ((atom x) (comp-const x val? more?))\n   ((scheme-macro (first x)) (comp (scheme-macro-expand x) env val? more?))\n    ((case (first x)\n       (QUOTE (arg-count x 1)\n              (comp-const (second x) val? more?))\n       (BEGIN (comp-begin (rest x) env val? more?))\n       (SET!  (arg-count x 2)\n              (assert (symbolp (second x)) (x)\n                      \"Only symbols can be set!, not ~ a in ~ a\"\n                      (second x) x)\n              (seq (comp (third x) env t t)\n                   (gen-set (second x) env)\n                   (if (not val?) (gen 'POP))\n                   (unless more? (gen 'RETURN))))\n      (IF  (arg-count x 2 3)\n           (comp-if (second x) (third x) (fourth x)\n                    env val? more?))\n      (LAMBDA (when val?\n               (let ((f (comp-lambda (second x) (rest2 x) env)))\n                 (seq (gen 'FN f) (unless more? (gen 'RETURN))))))\n      (t (comp-funcall (first x) (rest x) env val? more?))))))\n```\n\nHere we've added one more case: `t` and `nil` compile directly into primitive instructions, rather than relying on them being bound as global variables.\n(In real Scheme, the Boolean values are `#t` and `#f`, which need not be quoted, the empty list is `()`, which must be quoted, and `t` and `nil` are ordinary symbols with no special significance.)\n\nI've also added some error checking for the number of arguments supplied to quote, `set!` and `if`.\nNote that it is reasonable to do more error checking in a compiler than in an interpreter, since the checking need be done only once, not each time through.\nThe function to check arguments is as follows:\n\n```lisp\n(defun arg-count (form min &optional (max min))\n  \"Report an error if form has wrong number of args.\"\n  (let ((n-args (length (rest form))))\n    (assert (<= min n-args max) (form)\n      \"Wrong number of arguments for ~ a in ~ a:\n      ~d supplied, ~ d~@[ to ~ d ~] expected\"\n     (first form) form n-args min (if (/= min max) max))))\n```\n\n**Exercise 23.1 [m]** Modify the compiler to check for additional compile-time errors suggested by the following erroneous expression:\n\n```lisp\n(cdr (+ (list x y) 'y (3 x) (car 3 x)))\n```\n\nThe tail-recursive compiler still has the familiar nine cases, but I have introduced `comp-var, comp-const, comp-if,` and `comp-funcall` to handle the increased complexity introduced by the `var?` and `more?` parameters.\n\nLet's go through the `comp-` functions one at a time.\nFirst, `comp-begin` and `comp-list` just handle and pass on the additional parameters.\n`comp-list` will be used in `comp-funcall`, a new function that will be introduced to compile a procedure application.\n\n```lisp\n(defun comp-begin (exps env val? more?)\n  \"Compile a sequence of expressions,\n  returning the last one as the value.\"\n  (cond ((null exps) (comp-const nil val? more?))\n        ((length=l exps) (comp (first exps) env val? more?))\n        (t (seq (comp (first exps) env nil t)\n                (comp-begin (rest exps) env val? more?)))))\n(defun comp-list (exps env)\n  \"Compile a list, leaving them all on the stack.\"\n  (if (null exps) nil\n      (seq (comp (first exps) env t t)\n           (comp-list (rest exps) env))))\n```\n\nThen there are two trivial functions to compile variable access and constants.\nIf the value is not needed, these produce no instructions at all.\nIf there is no more to be done, then these functions have to generate the return instruction.\nThis is a change from the previous version of `comp`, where the caller generated the return instruction.\nNote I have extended the machine to include instructions for the most common constants: t, nil, and some small integers.\n\n```lisp\n(defun comp-const (x val? more?)\n  \"Compile a constant expression.\"\n  (if val? (seq (if (member x '(t nil - 1 0 1 2))\n                    (gen x)\n                    (gen 'CONST x))\n                 (unless more? (gen 'RETURN)))))\n(defun comp-var (x env val? more?)\n  \"Compile a variable reference.\"\n  (if val? (seq (gen-var x env) (unless more? (gen 'RETURN)))))\n```\n\nThe remaining two functions are more complex.\nFirst consider `comp-if` . Rather than blindly generating code for the predicate and both branches, we will consider some special cases.\nFirst, it is clear that `(if t x y)` can reduce to `x` and `(if nil x y)` can reduce to `y`.\nIt is perhaps not as obvious that `(if p x x)` can reduce to `(begin p x)`, or that the comparison of equality between the two branches should be done on the object code, not the source code.\nOnce these trivial special cases have been considered, we're left with three more cases: `(if p x nil), (if p nil y),` and `(if p x y)`.\nThe pattern of labels and jumps is different for each.\n\n```lisp\n(defun comp-if (pred then else env val? more?)\n  \"Compile a conditional (IF) expression.\"\n  (cond\n    ((null pred) ; (if nil x y) ==> y\n     (comp else env val? more?))\n    ((constantp pred) ; (if t x y) ==> x\n     (comp then env val? more?))\n    ((and (listp pred) ; (if (not p) x y) ==> (if p y x)\n          (length=l (rest pred))\n          (primitive-p (first pred) env 1)\n          (eq (prim-opcode (primitive-p (first pred) env 1)) 'not))\n     (comp-if (second pred) else then env val? more?))\n    (t (let ((pcode (comp pred env t t))\n             (tcode (comp then env val? more?))\n             (ecode (comp else env val? more?)))\n         (cond\n           ((equal tcode ecode) ; (if p x x) ==> (begin p x)\n            (seq (comp pred env nil t) ecode))\n           ((null tcode) ; (if p nil y) ==> p (TJUMP L2) y L2:\n            (let ((L2 (gen-label)))\n             (seq pcode (gen 'TJUMP L2) ecode (list L2)\n                  (unless more? (gen 'RETURN)))))\n           ((null ecode) ; (if p x) ==> p (FJUMP L1) x L1:\n            (let ((L1 (gen-label)))\n             (seq pcode (gen 'FJUMP L1) tcode (list L1)\n                  (unless more? (gen 'RETURN)))))\n           (t             ; (if p x y) ==> p (FJUMP L1) x L1: y\n                          ; or p (FJUMP L1) x (JUMP L2) L1: y L2:\n            (let ((L1 (gen-label))\n                  (L2 (if more? (gen-label))))\n              (seq pcode (gen 'FJUMP L1) tcode\n                   (if more? (gen 'JUMP L2))\n                   (list L1) ecode (if more? (list L2))))))))))\n```\n\nHere are some examples of `if` expressions.\nFirst, a very simple example:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(if p (+ x y) (* x y)))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `P` |\n| | `FJUMP` | `L1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `Y` |\n| | `+` | |\n| | `RETURN` | |\n| `L1 :` | `GVAR` | `X` |\n| | `GVAR` | `Y` |\n| | `*` | |\n| | `RETURN` | |\n\n![t0070](images/B9780080571157500236/t0070.png)\n\nEach branch has its own `RETURN` instruction.\nBut note that the code generated is sensitive to its context.\nFor example, if we put the same expression inside a `begin` expression, we get something quite different:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin (if p (+ x y) (* x y)) z))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `Z` |\n| | `RETURN` | |\n\n![t0075](images/B9780080571157500236/t0075.png)\n\nWhat happens here is that `(+ x y)` and `(* x y)`, when compiled in a context where the value is ignored, both resuit in no generated code.\nThus, the `if` expression reduces to `(if p nil nil)`, which is compiled like `(begin p nil)`, which also generates no code when not evaluated for value, so the final code just references `z`.\nThe compiler can only do this optimization because it knows that `+` and `*` are side-effect-free operations.\nConsider what happens when we replace + with `f` :\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin (if p (f x) (* x x)) z))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `P` |\n| | `FJUMP` | `L2` |\n| | `SAVE` | `K1` |\n| | `GVAR` | `X` |\n| | `GVAR` | `F` |\n| | `CALLJ` | `1` |\n| `K1:` | `POP` | |\n| `L2:` | `GVAR` | `Z` |\n| | `RETURN` | |\n\n![t0080](images/B9780080571157500236/t0080.png)\n\nHere we have to call `(f x)` if `p` is true (and then throw away the value returned), but we don't have to compute `(* x x)` when `p` is false.\n\nThese examples have inadvertently revealed some of the structure of `comp-funcall`, which handles five cases.\nFirst, it knows some primitive functions that have corresponding instructions and compiles these instructions inline when their values are needed.\nIf the values are not needed, then the function can be ignored, and just the arguments can be compiled.\nThis assumes true functions with no side effects.\nIf there are primitive operations with side effects, they too can be compiled inline, but the operation can never be ignored.\nThe next case is when the function is a lambda expression of no arguments.\nWe can just compile the body of the lambda expression as if it were a `begin` expression.\nNonprimitive functions require a function call.\nThere are two cases: when there is more to compile we have to save a continuation point, and when we are compiling the final value of a function, we can just branch to the called function.\nThe whole thing looks like this:\n\n```lisp\n(defun comp-funcall (f args env val? more?)\n  \"Compile an application of a function to arguments.\"\n  (let ((prim (primitive-p f env (length args))))\n    (cond\n      (prim ; function compilable to a primitive instruction\n       (if (and (not val?) (not (prim-side-effects prim)))\n            ;; Side-effect free primitive when value unused\n            (comp-begin args env nil more?)\n            ;; Primitive with value or call needed\n            (seq (comp-list args env)\n                 (gen (prim-opcode prim))\n                 (unless val? (gen 'POP))\n                 (unless more? (gen 'RETURN)))))\n      ((and (starts-with f 'lambda) (null (second f)))\n       ;; ((lambda () body)) => (begin body)\n       (assert (null args) () \"Too many arguments supplied\")\n       (comp-begin` (`rest2 f) env val? more?))\n      (more? ; Need to save the continuation point\n       (let ((k (gen-label 'k)))\n         (seq (gen 'SAVE k)\n              (comp-list args env)\n              (comp f env t t)\n              (gen 'CALLJ (length args))\n              (list k)\n              (if (not val?) (gen 'POP)))))\n       (t     ; function call as rename plus goto\n        (seq (comp-list args env)\n             (comp f env t t)\n             (gen 'CALLJ (length args)))))))\n```\n\nThe support for primitives is straightforward.\nThe `prim` data type has five slots.\nThe first holds the name of a symbol that is globally bound to a primitive operation.\nThe second, `n-args`, is the number of arguments that the primitive requires.\nWe have to take into account the number of arguments to each function because we want `(+ x y)` to compile into a primitive addition instruction, while `(+ x y z)` should not.\nIt will compile into a call to the + function instead.\nThe `opcode` slot gives the opcode that is used to implement the primitive.\nThe `always` field is true if the primitive always returns non-nil, `false` if it always returns nil, and nil otherwise.\nIt is used in exercise 23.6.\nFinally, the `side-effects` field says if the function has any side effects, like doing I/O or changing the value of an object.\n\n```lisp\n(defstruct (prim (:type list))\n  symbol n-args opcode always side-effects)\n(defparameter *primitive-fns*\n  '((+ 2 + true) (- 2 - true) (* 2 * true) (/ 2 / true)\n    (< 2 <) (> 2 >) (<= 2 <=) (>= 2 >=) (/= 2 /=) (= 2 =)\n    (eq? 2 eq) (equal? 2 equal) (eqv? 2 eql)\n    (not 1 not) (null? 1 not)\n    (car 1 car) (cdr 1 cdr) (cadr 1 cadr) (cons 2 cons true)\n    (list 1 list1 true) (list 2 list2 true) (list 3 list3 true)\n    (read 0 read nil t) (write 1 write nil t) (display 1 display nil t)\n    (newline 0 newline nil t) (compiler 1 compiler t)\n    (name! 2 name! true t) (random 1 random true nil)))\n(defun primitive-p (f env n-args)\n  \"F is a primitive if it is in the table, and is not shadowed\n  by something in the environment, and has the right number of args.\"\n  (and (not (in-env-p f env))\n       (find f *primitive-fns*\n             :test #'(lambda (f prim)\n                       (and (eq f (prim-symbol prim))\n                            (= n-args (prim-n-args prim)))))))\n(defun list1 (x) (list x))\n(defun list2 (x y) (list x y))\n(defun list3 (x y z) (list x y z))\n(defun display (x) (princ x))\n(defun newline () (terpri))\n```\n\nThese optimizations only work if the symbols are permanently bound to the global values given here.\nWe can enforce that by altering `gen-set` to preserve them as constants:\n\n```lisp\n(defun gen-set (var env)\n  \"Generate an instruction to set a variable to top-of-stack.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LSET (first p) (second p) \";\" var)\n        (if (assoc var *primitive-fns*)\n            (error \"Can't alter the constant ~ a\" var)\n            (gen 'GSET var)))))\n```\n\nNow an expression like `(+ x 1)` will be properly compiled using the + instruction rather than a subroutine call, and an expression like `(set ! + *)` will be flagged as an error when + is a global variable, but allowed when it has been locally bound.\nHowever, we still need to be able to handle expressions like `(set ! add +)` and then `(add x y)`.\nThus, we need some function object that + will be globally bound to, even if the compiler normally optimizes away references to that function.\nThe function `init-scheme-comp` takes care of this requirement:\n\n```lisp\n(defun init-scheme-comp ()\n  \"Initialize the primitive functions.\"\n  (dolist (prim *primitive-fns*)\n     (setf (get (prim-symbol prim) 'global-val)\n           (new-fn :env nil :name (prim-symbol prim)\n                   :code (seq (gen 'PRIM (prim-symbol prim))\n                              (gen 'RETURN))))))\n```\n\nThere is one more change to make-rewriting `comp-lambda`.\nWe still need to get the arguments off the stack, but we no longer generate a `RETURN` instruction, since that is done by `comp-begin`, if necessary.\nAt this point we'll provide a hook for a peephole optimizer, which will be introduced in [section 23.4](#s0025), and for an assembler to convert the assembly language to machine code, `new-fn` provides this interface, but for now, `new-fn` acts just like `make-fn`.\n\nWe also need to account for the possibility of rest arguments in a lambda list.\nA new function, `gen-rgs`, generates the single instruction to load the arguments of the stack.\nIt introduces a new instruction, `ARGS`., into the abstract machine.\nThis instruction works just like `ARGS`, except it also conses any remaining arguments on the stack into a list and stores that list as the value of the rest argument.\nWith this innovation, the new version of `comp-lambda` looks like this:\n\n```lisp\n(defun comp-lambda (args body env)\n  \"Compile a lambda form into a closure with compiled code.\"\n  (new-fn :env env :args args\n          :code (seq (gen-args args 0)\n                     (comp-begin body\n                                 (cons (make-true-list args) env)\n                                 t nil))))\n(defun gen-args (args n-so-far)\n  \"Generate an instruction to load the arguments.\"\n  (cond ((null args) (gen 'ARGS n-so-far))\n        ((symbolp args) (gen 'ARGS. n-so-far))\n        ((and (consp args) (symbolp (first args)))\n         (gen-args (rest args) (+ n-so-far 1)))\n        (t (error \"Illegal argument list\"))))\n(defun make-true-list (dotted-list)\n  \"Convert a possibly dotted list into a true, non-dotted list.\"\n  (cond ((null dotted-list) nil)\n        ((atom dotted-list) (list dotted-list))\n        (t (cons (first dotted-list)\n                 (make-true-list (rest dotted-list))))))\n(defun new-fn (&key code env name args)\n  \"Build a new function.\"\n  (assemble (make-fn :env env :name name :args args\n                     :code (optimize code))))\n```\n\n`new-fn` includes calls to an assembler and an optimizer to generate actual machine code.\nFor the moment, both will be identity functions:\n\n```lisp\n(defun optimize (code) code)\n(defun assemble (fn) fn)\n```\n\nHere are some more examples of the compiler at work:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(if (null? (car l)) (f (+ (* a x) b)) (g (/ x 2))))` |\n| | `ARGS` | `0` | |\n| | `GVAR` | `L` | |\n| | `CAR` | | |\n| | `FJUMP` | `L1` | |\n| | `GVAR` | `X` | |\n| | `2` | | |\n| | / | | |\n| | `GVAR` | `G` | |\n| | `CALLJ` | `1` | |\n| `L1:` | `GVAR` | `A` | |\n| | | `GVAR` | `X` |\n| | | `*` | |\n| | | `GVAR` | `B` |\n| | | `+` | |\n| | | `GVAR` | `F` |\n| | | `CALLJ` | `1` |\n\n![t0085](images/B9780080571157500236/t0085.png)\n\nThere is no need to save any continuation points in this code, because the only calls to nonprimitive functions occur as the final values of the two branches of the function.\n\n```lisp\n> (comp-show '(define (lastl l)\n              (if (null? (cdr l)) (car l)\n                  (last1 (cdr l)))))\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | `ARGS` | `0` | | | | |\n| | `FN` | | | | | |\n| | `ARGS` | `1` | | | | |\n| | `LVAR` | `0` | `0` | `;` | `L` | |\n| | `CDR` | | | | | |\n| | `FJUMP` | `L1` | | | | |\n| | `LVAR` | `0` | `0` | `;` | `L` | |\n| | `CDR` | | | | | |\n| | `GVAR` | `LAST1` | | | | |\n| | `CALLJ` | `1` | | | | |\n| `L1:` | | `LVAR` | `0` | `0` | `;` | `L` |\n| | | `CAR` | | | | |\n| | | `RETURN` | | | | |\n| | `GSET` | `LAST1` | | | | |\n| | `CONST` | `LAST1` | | | | |\n| | `NAME!` | | | | | |\n| | `RETURN` | | | | | |\n\n![t0090](images/B9780080571157500236/t0090.png)\n\nThe top-level function just assigns the nested function to the global variable `last1`.\nSince `last1` is tail-recursive, it has only one return point, for the termination case, and just calls itself without saving continuations until that case is executed.\n\nContrast that to the non-tail-recursive definition of `length` below.\nIt is not tail-recursive because before it calls `length` recursively, it must save a continuation point, `K1`, so that it will know where to return to to add 1.\n\n```lisp\n> (comp-show '(define (length l)\n                (if (null? l) 0 (+ 1 (length (cdr l))))))\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | `ARGS` | `0` | | | | |\n| | `FN` | | | | | |\n| | | `ARGS` | `1` | | | |\n| | | `LVAR` | `0` | `0` | `;` | `L` |\n| | | `FJUMP` | `L2` | | | |\n| | | `1` | | | | |\n| | | `SAVE` | `K1` | | | |\n| | | `LVAR` | `0` | `0` | `;` | `L` |\n| | | `CDR` | | | | |\n| | | `GVAR` | `LENGTH` | | | |\n| | | `CALLJ` | `1` | | | |\n| `K1:` | | `+` | | | | |\n| | | `RETURN` | | | | |\n| `L2` | | `0` | | | | |\n| | | `RETURN` | | | | |\n| | `GSET` | `LENGTH` | | | | |\n| | `CONST` | `LENGTH` | | | | |\n| | `NAME!` | | | | | |\n| | `RETURN` | | | | | |\n\n![t0095](images/B9780080571157500236/t0095.png)\n\nOf course, it is possible to write `length` in tail-recursive fashion:\n\n```lisp\n> (comp-show '(define (length l)\n              (letrec ((len (lambda (l n)\n                              (if (null? l) n\n                                  (len (rest l) (+ n l))))))\n                (len l 0))))\n```\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | `ARGS` | `0` | | | | | | |\n| | `FN` | | | | | | | |\n| | | `ARGS` | `1` | | | | | |\n| | | `NIL` | | | | | | |\n| | | `FN` | | | | | | |\n| | | | `ARGS` | `1` | | | | |\n| | | | `FN` | | | | | |\n| | | | | `ARGS` | `2` | | | |\n| | | | | `LVAR` | `0` | `0` | `;` | `L` |\n| | | | | `FJUMP` | `L2` | | | |\n| | | | | `SAVE` | `K1` | | | |\n| | | | | `LVAR` | `0` | `0` | `;` | `L` |\n| | | | | `GVAR` | `REST` | | | |\n| | | | | `CALLJ` | `1` | | | |\n| `K1:` | | | | `LVAR` | `0` | `1` | `;` | `N` |\n| | | | | `1` | | | | |\n| | | | | `+` | | | | |\n| | | | | `LVAR` | `1` | `0` | `;` | `LEN` |\n| | | | | `CALLJ` | `2` | | | |\n| `L2:` | | | | `LVAR` | `0` | `1` | `;` | `N` |\n| | | | | `RETURN` | | | | |\n| | | | `LSET` | `0` | `0` | `;` | `LEN` | |\n| | | | `POP` | | | | | |\n| | | | `LVAR` | `1` | `0` | `;` | `L` | |\n| | | | `0` | | | | | |\n| | | | `LVAR` | `0` | `0` | `;` | `LEN` | |\n| | | | `CALLJ` | `2` | | | | |\n| | | `CALLJ` | `1` | | | | | |\n| | `GSET` | `LENGTH` | | | | | | |\n| | `CONST` | `LENGTH` | | | | | | |\n| | `NAME!` | | | | | | | |\n| | `RETURN` | | | | | | | |\n\n![t0100](images/B9780080571157500236/t0100.png)\n\nLet's look once again at an example with nested conditionals:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(if (not (and p q (not r))) x y))` |\n| | `ARGS` | `0` |\n| | `GVAR` | `P` |\n| | `FJUMP` | `L3` |\n| | `GVAR` | `Q` |\n| | `FJUMP` | `L1` |\n| | `GVAR` | `R` |\n| | `NOT` | |\n| | `JUMP` | `L2` |\n| `L1:` | `NIL` | |\n| `L2:` | `JUMP` | `L4` |\n| `L3:` | `NIL` | |\n| `L4:` | `FJUMP` | `L5` |\n| | `GVAR` | `Y` |\n| | `RETURN` | |\n| `L5:` | `GVAR` | `X` |\n| | `RETURN` | |\n\n![t0105](images/B9780080571157500236/t0105.png)\n\nHere the problem is with multiple `JUMP`s and with not recognizing negation.\nIf `p` is false, then the and expression is false, and the whole predicate is true, so we should return `x`.\nThe code does in fact return `x`, but it first jumps to `L3`, loads `NIL`, and then does an `FJUMP` that will always jump to `L5`.\nOther branches have similar inefficiencies.\nA sufficiently clever compiler should be able to generate the following code:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| | `ARGS` | `0` |\n| | `GVAR` | `P` |\n| | `FJUMP` | `L1` |\n| | `GVAR` | `Q` |\n| | `FJUMP` | `L1` |\n| | `GVAR` | `R` |\n| | `TJUMP` | `L1` |\n| | `GVAR` | `Y` |\n| | `RETURN` | |\n| `L1:` | `GVAR X` | |\n| | `RETURN` | |\n\n## 23.2 Introducing Call/cc\n{:#s0015}\n{:.h1hd}\n\nNow that the basic compiler works, we can think about how to implement `call/cc` in our compiler.\nFirst, remember that `call/cc` is a normal function, not a special form.\nSo we could define it as a primitive, in the manner of `car` and `cons`.\nHowever, primitives as they have been defined only get to see their arguments, and `call/cc` will need to see the run-time stack, in order to save away the current continuation.\nOne choice is to install `call/cc` as a normal Scheme nonprimitive function but to write its body in assembly code ourselves.\nWe need to introduce one new instruction, `CC`, which places on the stack a function (to which we also have to write the assembly code by hand) that saves the current continuation (the stack) in its environment, and, when called, fetches that continuation and installs it, by setting the stack back to that value.\nThis requires one more instruction, `SET-CC`.\nThe details of this, and of all the other instructions, are revealed in the next section.\n\n## 23.3 The Abstract Machine\n{:#s0020}\n{:.h1hd}\n\nSo far we have defined the instruction set of a mythical abstract machine and generated assembly code for that instruction set.\nIt's now time to actually execute the assembly code and hence have a useful compiler.\nThere are several paths we could pursue: we could implement the machine in hardware, software, or microcode, or we could translate the assembly code for our abstract machine into the assembly code of some existing machine.\nEach of these approaches has been taken in the past.\n\n**Hardware.** If the abstract machine is simple enough, it can be implemented directly in hardware.\nThe Scheme-79 and Scheme-81 Chips ([Steele and Sussman 1980](B9780080571157500285.xhtml#bb1180); [Batali et al.\n1982](B9780080571157500285.xhtml#bb0070)) were VLSI implementations of a machine designed specifically to run Scheme.\n\n**Macro-Assembler.** In the translation or macro-assembler approach, each instruction in the abstract machine language is translated into one or more instructions in the host computer's instruction set.\nThis can be done either directly or by generating assembly code and passing it to the host computer's assembler.\nIn general this will lead to code expansion, because the host computer probably will not provide direct support for Scheme's data types.\nThus, whereas in our abstract machine we could write a single instruction for addition, with native code we might have to execute a series of instructions to check the type of the arguments, do an integer add if they are both integers, a floating-point add if they are both floating-point numbers, and so on.\nWe might also have to check the result for overflow, and perhaps convert to bignum representation.\nCompilers that generate native code often include more sophisticated data-flow analysis to know when such checks are required and when they can be omitted.\n\n**Microcode.** The MIT Lisp Machine project, unlike the Scheme Chip, actually resulted in working machines.\nOne important decision was to go with microcode instead of a single chip.\nThis made it easy to change the system as experienced was gained, and as the host language was changed from ZetaLisp to Common Lisp.\nThe most important architectural feature of the Lisp Machine was the inclusion of tag bits on each word to specify data types.\nAlso important was microcode to implement certain frequently used generic operations.\nFor example, in the Symbolics 3600 Lisp Machine, the microcode for addition simultaneously did an integer add, a floating-point add, and a check of the tag bits.\nIf both arguments turned out to be either integers or floating-point numbers, then the appropriate result was taken.\nOtherwise, a trap was signaled, and a converison routine was entered.\nThis approach makes the compiler relatively simple, but the trend in architecture is away from highly microcoded processors toward simpler (RISC) processors.\n\n**Software.** We can remove many of these problems with a technique known as *byte-code assembly.* Here we translate the instructions into a vector of bytes and then interpret the bytes with a byte-code interpreter.\nThis gives us (almost) the machine we want; it solves the code expansion problem, but it may be slower than native code compilation, because the byte-code interpreter is written in software, not hardware or microcode.\n\nEach opcode is a single byte (we have less than 256 opcodes, so this will work).\nThe instructions with arguments take their arguments in the following bytes of the instruction stream.\nSo, for example, a `CALL` instruction occupies two bytes; one for the opcode and one for the argument count.\nThis means we have imposed a limit of 256 arguments to a function call.\nAn `LVAR` instruction would take three bytes; one for the opcode, one for the frame offset, and one for the offset within the frame.\nAgain, we have imposed 256 as the limit on nesting level and variables per frame.\nThese limits seem high enough for any code written by a human, but remember, not only humans write code.\nIt is possible that some complex macro may expand into something with more than 256 variables, so a full implementation would have some way of accounting for this.\nThe `GVAR` and `CONST` instructions have to refer to an arbitrary object; either we can allocate enough bytes to fit a pointer to this object, or we can add a `constants` field to the `fn` structure, and follow the instructions with a single-byte index into this vector of constants.\nThis latter approach is more common.\n\nWe can now handle branches by changing the program counter to an index into the code vector.\n(It seems severe to limit functions to 256 bytes of code; a two-byte label allows for 65536 bytes of code per function.) In summary, the code is more compact, branching is efficient, and dispatching can be fast because the opcode is a small integer, and we can use a branch table to go to the right piece of code for each instruction.\n\nAnother source of inefficiency is implementing the stack as a list, and consing up new cells every time something is added to the stack.\nThe alternative is to implement the stack as a vector with a fill-pointer.\nThat way a push requires no consing, only a change to the pointer (and a check for overflow).\nThe check is worthwhile, however, because it allows us to detect infinite loops in the user's code.\n\nHere follows an assembler that generates a sequence of instructions (as a vector).\nThis is a compromise between byte codes and the assembly language format.\nFirst, we need some accessor functions to get at parts of an instruction:\n\n```lisp\n(defun opcode (instr) (if (label-p instr) :label (first instr)))\n(defun args (instr) (if (listp instr) (rest instr)))\n(defun arg1 (instr) (if (listp instr) (second instr)))\n(defun arg2 (instr) (if (listp instr) (third instr)))\n(defun arg3 (instr) (if (listp instr) (fourth instr)))\n(defsetf arg1 (instr) (val) '(setf (second ,instr) ,val))\n```\n\nNow we write the assembler, which already is integrated into the compiler with a hook in `new-fn`.\n\n```lisp\n(defun assemble (fn)\n  \"Turn a list of instructions into a vector.\"\n  (multiple-value-bind (length labels)\n     (asm-first-pass (fn-code fn))\n   (setf (fn-code fn)\n         (asm-second-pass (fn-code fn)\n                          length labels))\n   fn))\n(defun asm-first-pass (code)\n  \"Return the labels and the total code length.\"\n  (let ((length 0)\n        (labels nil))\n    (dolist (instr code)\n      (if (label-p instr)\n          (push (cons instr length) labels)\n          (incf length)))\n      (values length labels)))\n(defun asm-second-pass (code length labels)\n  \"Put code into code-vector, adjusting for labels.\"\n  (let ((addr 0)\n        (code-vector (make-array length)))\n    (dolist (instr code)\n      (unless (label-p instr)\n        (if (is instr '(JUMP TJUMP FJUMP SAVE))\n            (setf (arg1 instr)\n                  (cdr (assoc (arg1 instr) labels))))\n        (setf (aref code-vector addr) instr)\n        (incf addr)))\n    code-vector))\n```\n\nIf we want to be able to look at assembled code, we need a new printing function:\n\n```lisp\n(defun show-fn (fn &optional (stream *standard-output*) (indent 2))\n  \"Print all the instructions in a function.\n  If the argument is not a function, just princ it,\n  but in a column at least 8 spaces wide.\"\n  ;; This version handles code that has been assembled into a vector\n  (if (not (fn-p fn))\n      (format stream \"~8a\" fn)\n      (progn\n        (fresh-line)\n        (dotimes (i (length (fn-code fn)))\n          (let ((instr (elt (fn-code fn) i)))\n            (if (label-p instr)\n       (format stream \"~a:\" instr)\n       (progn\n        (format stream \"~VT~2d: \" indent i)\n        (dolist (arg instr)\n         (show-fn arg stream (+ indent 8)))\n        (fresh-line))))))))\n(defstruct ret-addr fn pc env)\n(defun is (instr op)\n   \"True if instr's opcode is OP, or one of OP when OP is a list.\"\n   (if (listp op)\n       (member (opcode instr) op)\n       (eq (opcode instr) op)))\n(defun top (stack) (first stack))\n(defun machine (f)\n   \"Run the abstract machine on the code for f.\"\n   (let* ((code (fn-code f))\n            (pc 0)\n            (env nil )\n            (stack nil)\n            (n-args 0)\n            (instr))\n   (loop\n      (setf instr (elt code pc))\n      (incf pc)\n      (case (opcode instr)\n         ;; Variable/stack manipulation instructions:\n         (LVAR (push (elt (elt env (arg1 instr)) (arg2 instr))\n                                     stack))\n         (LSET (setf (elt (elt env (arg1 instr)) (arg2 instr))\n                                     (top stack)))\n         (GVAR (push (get (arg1 instr) 'global-val) stack))\n         (GSET (setf (get (arg1 instr) 'global-val) (top stack)))\n         (POP (pop stack))\n         (CONST (push (arg1 instr) stack))\n         ;; Branching instructions:\n         (JUMP (setf pc (arg1 instr)))\n         (FJUMP (if (null (pop stack)) (setf pc (arg1 instr))))\n         (TJUMP (if (pop stack) (setf pc (arg1 instr))))\n         ;; Function call/return instructions:\n         (SAVE (push (make-ret-addr :pc (arg1 instr)\n                                                       :fn f :env env)\n                               stack))\n         (RETURN ;; return value is top of stack; ret-addr is second\n           (setf f (ret-addr-fn (second stack))\n                   code (fn-code f)\n                   env (ret-addr-env (second stack))\n                   pc (ret-addr-pc (second stack)))\n           ;; Get rid of the ret-addr, but keep the value\n           (setf stack (cons (first stack) (rest2 stack))))\n         (CALLJ (pop env)                  ; discard the top frame\n                       (setf f (pop stack)\n                       code (fn-code f)\n                       env (fn-env f)\n                       pc 0\n                       n-args (arg1 instr)))\n         (ARGS (assert (= n-args (arg1 instr)) ()\n                                         \"Wrong number of arguments:~\n                                         ~d expected, ~ d supplied\"\n                                         (arg1 instr) n-args)\n                          (push (make-array (arg1 instr)) env)\n                          (loop for i from (- n-args 1) downto 0 do\n                                   (setf (elt (first env) i) (pop stack))))\n        (ARGS. (assert (>= n-args (arg1 instr)) ()\n                                         \"Wrong number of arguments:~\n                                         ~d or more expected, ~ d supplied\"\n                                         (arg1 instr) n-args)\n                          (push (make-array (+ 1 (arg1 instr))) env)\n                          (loop repeat (- n-args (arg1 instr)) do\n                                    (push (pop stack) (elt (first env) (arg1 instr))))\n                          (loop for i from (- (arg1 instr) 1) downto 0 do\n                                    (setf (elt (first env) i) (pop stack))))\n        (FN (push (make-fn :code (fn-code (arg1 instr))\n                                       :env env) stack))\n        (PRIM (push (apply (arg1 instr)\n                                    (loop with args = nil repeat n-args\n                                              do (push (pop stack) args)\n                                              finally (return args)))\n                              stack))\n        ;; Continuation instructions:\n        (SET-CC (setf stack (top stack)))\n        (CC    (push(make-fn\n                             :env (list (vector stack))\n                             :code '((ARGS 1) (LVAR 1 0 \";\" stack) (SET-CC)\n                                        (LVAR 0 0) (RETURN)))\n                              stack))\n        ;; Nullary operations:\n        ((SCHEME-READ NEWLINE)\n          (push (funcall (opcode instr)) stack))\n        ;; Unary operations:\n        ((CAR CDR CADR NOT LIST1 COMPILER DISPLAY WRITE RANDOM)\n        (push (funcall (opcode instr) (pop stack)) stack))\n        ;; Binary operations:\n        ((+-*/<><= >=/== CONS LIST2 NAME! EQ EQUAL EQL)\n         (setf stack (cons (funcall (opcode instr) (second stack)\n                                              (first stack))\n                                    (rest2 stack))))\n        ;; Ternary operations:\n        (LIST3\n         (setf stack (cons (funcall (opcode instr) (third stack)\n                                               (second stack) (first stack))\n                                    (rest3 stack))))\n        ;; Constants:\n        ((T NIL -1 0 12)\n         (push (opcode instr) stack))\n        ;; Other:\n        ((HALT) (RETURN (top stack)))\n        (otherwise (error \"Unknown opcode: ~ a\" instr))))))\n(defun init-scheme-comp ()\n   \"Initialize values (including call/cc) for the Scheme compiler.\"\n   (set-global-var! 'exit\n      (new-fn :name 'exit :args '(val) :code '((HALT))))\n   (set-global-var! 'call/cc\n      (new-fn :name 'call/cc :args '(f)\n                   :code '((ARGS 1) (CC) (LVAR 0 0 \";\" f) (CALLJ 1))))\n   (dolist (prim *primitive-fns*)\n       (setf (get (prim-symbol prim) 'global-val)\n                   (new-fn :env nil :name (prim-symbol prim)\n                                           :code (seq (gen 'PRIM (prim-symbol prim))\n                                                      (gen 'RETURN))))))\n```\n\nHere's the Scheme top level.\nNote that it is written in Scheme itself; we compile the definition of the read-eval-print loop,[1](#fn0010) load it into the machine, and then start executing it.\nThere's also an interface to compile and execute a single expression, `comp-go`.\n\n```lisp\n(defconstant scheme-top-level\n   '(begin(define (scheme)\n                 (newline)\n                 (display \"=> \")\n                 (write ((compiler (read))))\n                 (scheme))\n             (scheme)))\n(defun scheme ( )\n   \"A compiled Scheme read-eval-print loop\"\n   (init-scheme-comp)\n   (machine (compiler scheme-top-level)))\n(defun comp-go (exp)\n   \"Compile and execute the expression.\"\n   (machine (compiler '(exit ,exp))))\n```\n\n**Exercise 23.2 [m]** This implementation of the machine is wasteful in its representation of environments.\nFor example, consider what happens in a tail-recursive function.\nEach `ARG` instruction builds a new frame and pushes it on the environment.\nThen each `CALL` pops the latest frame off the environment.\nSo, while the stack does not grow with tail-recursive calls, the heap certainly does.\nEventually, we will have to garbage-collect all those unused frames (and the cons cells used to make lists out of them).\nHow could we avoid or limit this garbage collection?\n\n## 23.4 A Peephole Optimizer\n{:#s0025}\n{:.h1hd}\n\nIn this section we investigate a simple technique that will generate slightly better code in cases where the compiler gives inefficient sequences of instructions.\nThe idea is to look at short sequences of instructions for prespecified patterns and replace them with equivalent but more efficient instructions.\n\nIn the following example, `comp-if` has already done some source-level optimization, such as eliminating the `(f x)` call.\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin (if (if t 1 (f x)) (set! x 2)) x))` |\n| `0:` | `ARGS` | `0` |\n| 1: | 1 | |\n| `2:` | `FJUMP` | `6` |\n| `3:` | `2` | |\n| `4:` | `GSET` | `X` |\n| `5:` | `POP` | |\n| `6:` | `GVAR` | `X` |\n| `7:` | `RETURN` | |\n\n![t0115](images/B9780080571157500236/t0115.png)\n\nBut the generated code could be made much better.\nThis could be done with more source-level optimizations to transform the expression into `(set!\nx 2)`.\nAlternatively, it could also be done by looking at the preceding instruction sequence and transforming local inefficiencies.\nThe optimizer presented in this section is capable of generating the following code:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| `> (comp-show '(begin (if (if t 1 (f x)) (set! x 2)) x))` |\n| `0:` | `ARGS` | `0` |\n| 1: | 2 | |\n| `2:` | `GSET` | `X` |\n| `3:` | `RETURN` | |\n\n![t0120](images/B9780080571157500236/t0120.png)\n\nThe function `optimize` is implemented as a data-driven function that looks at the opcode of each instruction and makes optimizations based on the following instructions.\nTo be more specific, `optimize` takes a list of assembly language instructions and looks at each instruction in order, trying to apply an optimization.\nIf any changes at all are made, then `optimize` will be called again on the whole instruction list, because further changes might be triggered by the first round of changes.\n\n```lisp\n(defun optimize (code)\n   \"Perform peephole optimization on assembly code.\"\n   (let ((any-change nil))\n       ;; Optimize each tail\n       (loop for code-tail on code do\n                (setf any-change (or (optimize-1 code-tail code)\n                                                any-change)))\n       ;; If any changes were made, call optimize again\n       (if any-change\n           (optimize code)\n           code)))\n```\n\nThe function `optimize-1` is responsible for each individual attempt to optimize.\nIt is passed two arguments: a list of instructions starting at the current one and going to the end of the list, and a list of all the instructions.\nThe second argument is rarely used.\nThe whole idea of a peephole optimizer is that it should look at only a few instructions following the current one.\n`optimize-1` is data-driven, based on the opcode of the first instruction.\nNote that the optimizer functions do their work by destructively modifying the instruction sequence, *not* by consing up and returning a new sequence.\n\n```lisp\n(defun optimize-1 (code all-code)\n   \"Perform peephole optimization on a tail of the assembly code.\n   If a change is made, return true.\"\n   ;; Data-driven by the opcode of the first instruction\n   (let* ((instr (first code))\n             (optimizer (get-optimizer (opcode instr))))\n      (when optimizer\n        (funcall optimizer instr code all-code))))\n```\n\nWe need a table to associate the individual optimizer functions with the opcodes.\nSince opcodes include numbers as well as symbols, an `eql` hash table is an appropriate choice:\n\n```lisp\n(let ((optimizers (make-hash-table :test #'eql)))\n   (defun get-optimizer (opcode)\n       \"Get the assembly language optimizer for this opcode.\"\n       (gethash opcode optimizers))\n   (defun put-optimizer (opcode fn)\n       \"Store an assembly language optimizer for this opcode.\"\n       (setf (gethash opcode optimizers) fn)))\n```\n\nWe could now build a table with `put-optimizer`, but it is worth defining a macro to make this a little neater:\n\n```lisp\n(defmacro def-optimizer (opcodes args &body body)\n   \"Define assembly language optimizers for these opcodes.\"\n   (assert (and (listp opcodes) (listp args) (= (length args) 3)))\n   '(dolist (op '.opcodes)\n        (put-optimizer op #'(lambda .args ..body))))\n```\n\nBefore showing example optimizer functions, we will introduce three auxiliary functions.\n`gen1` generates a single instruction, `target` finds the code sequence that a jump instruction branches to, and `next-instr` finds the next actual instruction in a sequence, skipping labels.\n\n```lisp\n(defun gen1 (&rest args) \"Generate a single instruction\" args)\n(defun target (instr code) (second (member (arg1 instr) code)))\n(defun next-instr (code) (find-if (complement #'label-p) code))\n```\n\nHere are six optimizer functions that implement a few important peephole optimizations.\n\n```lisp\n(def-optimizer (: LABEL) (instr code all-code)\n   ;; ... L ... => ;if no reference to L\n   (when (not (find instr all-code :key #'arg1))\n        (setf (first code) (second code)\n                (rest code) (rest2 code))\n        t))\n(def-optimizer (GSET LSET) (instr code all-code)\n   ;; ex: (begin (set! x y) (if x z))\n   ;; (SET X) (POP) (VAR X) ==> (SET X)\n   (when (and (is (second code) 'POP)\n              (is (third code) '(GVAR LVAR))\n              (eq (arg1 instr) (arg1 (third code))))\n       (setf (rest code) (nthcdr 3 code))\n       t))\n(def-optimizer (JUMP CALL CALLJ RETURN) (instr code all-code)\n   ;; (JUMP L1) ...dead code... L2 ==> (JUMP L1) L2\n   (setf (rest code) (member-if #'label-p (rest code)))\n   ;; (JUMP L1) ... L1 (JUMP L2) ==> (JUMP L2) ... L1 (JUMP L2)\n   (when (and (is instr 'JUMP)\n                      (is (target instr code) '(JUMP RETURN))\n      (setf (first code) (copy-list (target instr code)))\n      t)))\n(def-optimizer (TJUMP FJUMP) (instr code all-code)\n   ;; (FJUMP L1) ... L1 (JUMP L2) ==> (FJUMP L2) ... L1 (JUMP L2)\n   (when (is (target instr code) 'JUMP)\n      (setf (second instr) (arg1 (target instr code)))\n      t))\n(def-optimizer (T -1 0 1 2) (instr code all-code)\n   (case (opcode (second code))\n      (NOT ;; (T) (NOT) ==> NIL\n        (setf (first code) (gen1 'NIL)\n                (rest code) (rest2 code))\n        t)\n      (FJUMP ;; (T) (FJUMP L) ... =>...\n        (setf (first code) (third code)\n                (rest code) (rest3 code))\n        t)\n      (TJUMP ;; (T) (TJUMP L) ... => (JUMP L) ...\n        (setf (first code) (gen1 'JUMP (arg1 (next-instr code))))\n        t)))\n(def-optimizer (NIL) (instr code all-code)\n   (case (opcode (second code))\n     (NOT ;; (NIL) (NOT) ==> T\n        (setf (first code) (gen1 'T)\n              (rest code) (rest2 code))\n        t)\n   (TJUMP ;; (NIL) (TJUMP L) ... =>...\n   (setf (first code) (third code)\n           (rest code) (rest3 code))\n   t)\n   (FJUMP ;; (NIL) (FJUMP L) ==> (JUMP L)\n   (setf (first code) (gen1 'JUMP (arg1 (next-instr code))))\n   t)))\n```\n\n## 23.5 Languages with Different Lexical Conventions\n{:#s0030}\n{:.h1hd}\n\nThis chapter has shown how to evaluate a language with Lisp-like syntax, by writing a read-eval-print loop where only the `eval` needs to be replaced.\nIn this section we see how to make the `read` part slightly more general.\nWe still read Lisp-like syntax, but the lexical conventions can be slightly different.\n\nThe Lisp function `read` is driven by an object called the *readtable,* which is stored in the special variable `*readtable*.` This table associates some action to take with each of the possible characters that can be read.\nThe entry in the readtable for the character `#\\(`, for example, would be directions to read a list.\nThe entry for `#\\;` would be directions to ignore every character up to the end of the line.\n\nBecause the readtable is stored in a special variable, it is possible to alter completely the way read works just by dynamically rebinding this variable.\n\nThe new function `scheme - read` temporarily changes the readtable to a new one, the Scheme readtable.\nIt also accepts an optional argument, the stream to read from, and it returns a special marker on end of file.\nThis can be tested for with the predicate `eof-object?`.\nNote that once `scheme-read` is installed as the value of the Scheme `symbol-read` we need do no more-`scheme-read` will always be called when appropriate (by the top level of Scheme, and by any user Scheme program).\n\n```lisp\n(defconstant eof \"EoF\")\n(defun eof-object? (x) (eq x eof))\n(defvar *scheme-readtable* (copy-readtable))\n(defun scheme-read (&optional (stream *standard-input*))\n   (let ((*readtable* *scheme-readtable*))\n      (read stream nil eof)))\n```\n\nThe point of having a special `eof` constant is that it is unforgeable.\nThe user cannot type in a sequence of characters that will be read as something `eq` to `eof`.\nIn Common Lisp, but not Scheme, there is an escape mechanism that makes `eof` forgable.\nThe user can type `#.eof` to get the effect of an end of file.\nThis is similar to the `^D` convention in UNIX systems, and it can be quite handy.\n\nSo far the Scheme readtable is just a copy of the standard readtable.\nThe next step in implementing `scheme-read` is to alter `*scheme-readtable*`, adding read macros for whatever characters are necessary.\nHere we define macros for `#t` and `#f` (the true and false values), for `#d` (decimal numbers) and for the backquote read macro (called quasiquote in Scheme).\nNote that the backquote and comma characters are defined as read macros, but the `@` in ,`@` is processed by reading the next character, not by a read macro on `@`.\n\n```lisp\n(set-dispatch-macro-character #\\# #\\t\n   #'(lambda (&rest ignore) t)\n   *scheme-readtable*)\n(set-dispatch-macro-character #\\# #\\f\n   #'(lambda (&rest ignore) nil)\n   *scheme-readtable*)\n(set-dispatch-macro-character #\\# #\\d\n   ;; In both Common Lisp and Scheme,\n   ;; #x, #o and #b are hexidecimal, octal, and binary,\n   ;; e.g. #xff - #o377 - #b11111111 - 255\n   ;; In Scheme only, #d255 is decimal 255.\n   #'(lambda (stream &rest ignore)\n          (let ((*read-base* 10)) (scheme-read stream)))\n   *scheme-readtable*)\n(set-macro-character #\\'\n   #'(lambda (s ignore) (list 'quasiquote (scheme-read s)))\n   nil *scheme-readtable*)\n(set-macro-character #\\,\n   #'(lambda (stream ignore)\n          (let ((ch (read-char stream)))\n             (if (char = ch #\\@)\n                 (list 'unquote-splicing (read stream))\n                 (progn (unread-char ch stream)\n                        (list 'unquote (read stream))))))\n   nil *scheme-readtable*)\n```\n\nFinally, we install `scheme-read` and `eof-object?` as primitives:\n\n```lisp\n(defparameter *primitive-fns*\n   '((+ 2 + true nil) (- 2 - true nil) (* 2 * true nil) (/ 2 / true nil)\n    (< 2 < nil nil) (> 2 > nil nil) (<= 2 <= nil nil) (>= 2 >= nil nil)\n    (/= 2 /= nil nil) (= 2 = nil nil)\n    (eq? 2 eq nil nil) (equal? 2 equal nil nil) (eqv? 2 eql nil nil)\n    (not 1 not nil nil) (null? 1 not nil nil) (cons 2 cons true nil)\n    (car 1 car nil nil) (cdr 1 cdr nil nil) (cadr 1 cadr nil nil)\n    (list 1 list1 true nil) (list 2 list2 true nil) (list 3 list3 true nil)\n    (read 0 read nil t) (write 1 write nil t) (display 1 display nil t)\n    (newline 0 newline nil t) (compiler 1 compiler t nil)\n    (name! 2 name! true t) (random 1 random true nil)))\n```\n\nHere we test `scheme-read`.\nThe characters in italics were typed as a response to the `scheme-read`.\n\n```lisp\n> (scheme-read) #*t*\nT\n> (scheme-read) #f\nNIL\n> (scheme-read) *'(a,b,@cd)*\n(QUASIQUOTE (A (UNQUOTE B) (UNQUOTE-SPLICING C) D))\n```\n\nThe final step is to make quasi quote a macro that expands into the proper sequence of calls to `cons`, `list`, and `append`.\nThe careful reader will keep track of the difference between the form returned by `scheme-read` (something starting with `quasiquote`), the expansion of this form with the Scheme macro `quasiquote` (which is implemented with the Common Lisp function `quasi-q`), and the eventual evaluation of the expansion.\nIn an environment where `b` is bound to the number 2 and `c` is bound to the list `(c1 c2)`, we might have:\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| Typed: | `'(a ,b ,@c d)` |\n| Read: | `(quasiquote (a (unquote b) (unquote-splicing c) d))` |\n| Expanded: | `(cons 'a (cons b (append c '(d))))` |\n| Evaluated: | `(a 2 c1 c2 d)` |\n\nThe implementation of the `quasiquote` macro is modeled closely on the one given in Charniak et al.'s *Artificial Intelligence Programming.* I added support for vectors.\nIn `combine-quasiquote` I add the trick of reusing the old cons cell `x` rather than consing together `left` and `right` when that is possible.\nHowever, the implementation still wastes cons cells-a more efficient version would pass back multiple values rather than consing `quote` onto a list, only to strip it off again.\n\n```lisp\n(setf (scheme-macro 'quasiquote) 'quasi-q)\n(defun quasi-q (x)\n   \"Expand a quasiquote form into append, list. and cons calls.\"\n   (cond\n      ((vectorp x)\n       (list 'apply 'vector (quasi-q (coerce x 'list))))\n      ((atom x)\n       (if (constantp x) x (list 'quote x)))\n      ((starts-with x 'unquote)\n       (assert (and (rest x) (null (rest2 x))))\n       (second x))\n      ((starts-with x 'quasiquote)\n       (assert (and (rest x) (null (rest2 x))))\n       (quasi-q (quasi-q (second x))))\n      ((starts-with (first x) 'unquote-splicing)\n       (if (null (rest x))\n           (second (first x))\n           (list 'append (second (first x)) (quasi-q (rest x)))))\n       (t (combine-quasiquote (quasi-q (car x))\n                              (quasi-q (cdr x))\n                              x))))\n(defun combine-quasiquote (left right x)\n   \"Combine left and right (car and cdr), possibly re-using x.\"\n   (cond ((and (constantp left) (constantp right))\n              (if (and (eql (eval left) (first x))\n                          (eql (eval right) (rest x)))\n                     (list 'quote x)\n                     (list 'quote (cons (eval left) (eval right)))))\n              ((null right) (list 'list left))\n              ((starts-with right 'list)\n              (list* 'list left (rest right)))\n              (t (list 'cons left right))))\n```\n\nActually, there is a major problem with the `quasiquote` macro, or more accurately, in the entire approach to macro-expansion based on textual substitution.\nSuppose we wanted a function that acted like this:\n\n```lisp\n(extrema '(3 1 10 5 20 2))\n((max 20) (min 1))\n```\n\nWe could write the Scheme function:\n\n```lisp\n(define (extrema list)\n   ;; Given a list of numbers. return an a-list\n   ;; with max and min values\n   '((max ,(apply max list)) (min ,(apply min list))))\n```\n\nAfter expansion of the quasiquote, the definition of `extrema` will be:\n\n```lisp\n(define extrema\n   (lambda (list)\n     (list (list 'max (apply max list))\n           (list 'min (apply min list)))))\n```\n\nThe problem is that `list` is an argument to the function `extrema`, and the argument shadows the global definition of `list` as a function.\nThus, the function will fail.\nOne way around this dilemma is to have the macro-expansion use the global value of `list` rather than the symbol `list` itself.\nIn other words, replace the `'list` in `quasi-q` with (`get-globa1-var 'list`).\nThen the expansion can be used even in an environment where `list` is locally bound.\nOne has to be careful, though: if this tack is taken, then `comp-funcall` should be changed to recognize function constants, and to do the right thing with respect to primitives.\n\nIt is problems like these that made the designers of Scheme admit that they don't know the best way to specify macros, so there is no standard macro definition mechanism in Scheme.\nSuch problems rarely come up in Common Lisp because functions and variables have different name spaces, and because local function definitions (with `flet` or `labels`) are not widely used.\nThose who do define local functions tend not to use already established names like `list` and `append.`\n\n## 23.6 History and References\n{:#s0035}\n{:.h1hd}\n\nGuy Steele's 1978 MIT master's thesis on the language Scheme, rewritten as Steele 1983, describes an innovative and influential compiler for Scheme, called RABBIT.\n!!!(span) {:.smallcaps} [2](#fn0015) A good article on an \"industrial-strength\" Scheme compiler based on this approach is described in [Kranz et al.'s 1986](B9780080571157500285.xhtml#bb0675) paper on ORBIT, !!!(span) {:.smallcaps} the compiler for the T dialect of Scheme.\n\nAbelson and Sussman's *Structure and Interpretation of Computer Programs* (1985) contains an excellent chapter on compilation, using slightly different techniques and compiling into a somewhat more confusing machine language.\nAnother good text is [John Allen's *Anatomy of Lisp* (1978)](B9780080571157500285.xhtml#bb0040).\nIt presents a very clear, simple compiler, although it is for an older, dynamically scoped dialect of Lisp and it does not address tail-recursion or `call/cc`.\n\nThe peephole optimizer described here is based on the one in [Masinter and Deutsch 1980](B9780080571157500285.xhtml#bb0780).\n\n## 23.7 Exercises\n{:#s0040}\n{:.h1hd}\n\n**Exercise 23.3 [h]** Scheme's syntax for numbers is slightly different from Common Lisp's.\nIn particular, complex numbers are written like `3+4i` rather than `#c(3 4)`.\nHow could you make `scheme-read` account for this?\n\n**Exercise 23.4 [m]** Is it possible to make the core Scheme language even smaller, by eliminating any of the five special forms `(quote, begin, set!, if, lambda)` and replacing them with macros?\n\n**Exercise 23.5 [m]** Add the ability to recognize internal defines (see [page 779](B9780080571157500224.xhtml#p779)).\n\n**Exercise 23.6 [h]** In `comp-if` we included a special case for `(if t x y)` and `(if nil x y)`.\nBut there are other cases where we know the value of the predicate.\nFor example, `(if (*a b) x y)` can also reduce to `x`.\nArrange for these optimizations to be made.\nNote the `prim-always` field of the `prim structure` has been provided for this purpose.\n\n**Exercise 23.7 [m]** Consider the following version of the quicksort algorithm for sorting a vector:\n\n```lisp\n(define (sort-vector vector test)\n   (define (sort lo hi)\n       (if (>= lo hi)\n            vector\n            (let ((pivot (partition vector lo hi test)))\n                (sort lo pivot)\n            (sort (+ pivot 1) hi))))\n   (sort 0 (- (vector-length vector 1))))\n```\n\nHere the function `partition` takes a vector, two indices into the vector, and a comparison function, `test`.\nIt modifies the vector and returns an index, `pivot`, such that all elements of the vector below `pivot` are less than all elements at `pivot` or above.\n\nIt is well known that quicksort takes time proportional to *n* log *n* to sort a vector of *n* elements, if the pivots are chosen well.\nWith poor pivot choices, it can take time proportional to *n*2.\n\nThe question is, what is the space required by quicksort?\nBesides the vector itself, how much additional storage must be temporarily allocated to sort a vector?\n\nNow consider the following modified version of quicksort.\nWhat time and space complexity does it have?\n\n```lisp\n(define (sort-vector vector test)\n   (define (sort lo hi)\n     (if (>= lo hi)\n         vector\n         (let ((pivot (partition vector lo hi)))\n            (if (> (- hi pivot) (- pivot lo))\n                 (begin (sort lo pivot)\n                           (sort (+ pivot 1) hi))\n                 (begin (sort (+ pivot 1) hi)\n                           (sort lo pivot))))))\n   (sort 0 (- (vector-length vector 1))))\n```\n\nThe next three exercises describe extensions that are not part of the Scheme standard.\n\n**Exercise 23.8 [h]** The set!\nspecial form is defined only when its first argument is a symbol.\nExtend `set!` to work like `setf` when the first argument is a list.\nThat is, `(set!\n(car x) y)` should expand into something like `((setter car) y x)`, where `(setter car)` evaluates to the primitive procedure `set-car!`.\nYou will need to add some new primitive functions, and you should also provide a way for the user to define new `set!` procedures.\nOne way to do that would be with a `setter` function for `set!`, for example:\n\n```lisp\n(set! (setter third)\n      (lambda (val list) (set-car! (cdr (cdr list)) val)))\n```\n\n**Exercise 23.9 [m]** It is a curious asymmetry of Scheme that there is a special notation for lambda expressions within `define` expressions, but not within `let`.\nThus, we see the following:\n\n`(define square (lambda (x) (* x x)))`*;is the same as*\n\n```lisp\n(define (square x) (* x x))\n```\n\n`(let ((square (lambda (x) (* x x)))) ...) ;`*is not the same as*\n\n`(let (((square x) (* x x))) ...) ;`*             <= illegal!*\n\nDo you think this last expression should be legal?\nIf so, modify the macros for `let, let*`, and `letrec` to allow the new syntax.\nIf not, explain why it should not be included in the language.\n\n**Exercise 23.10 [m]** Scheme does not define `funcall`, because the normal function-call syntax does the work of funcall.\nThis suggests two problems.\n(1) Is it possible to define `funcall` in Scheme?\nShow a definition or explain why there can't be one.\nWould you ever have reason to use `funcall` in a Scheme program?\n(2) Scheme does define `apply`, as there is no syntax for an application.\nOne might want to extend the syntax to make `(+ . numbers)` equivalent to `(apply + numbers)`.\nWould this bea good idea?\n\n**Exercise 23.11 [d]** Write a compiler that translates Scheme to Common Lisp.\nThis will involve changing the names of some procedures and special forms, figuring out a way to map Scheme's single name space into Common Lisp's distinct function and variable name spaces, and dealing with Scheme's continuations.\nOne possibility is to translate a `call/cc` into a `catch` and `throw`, and disallow dynamic continuations.\n\n## 23.8 Answers\n{:#s0045}\n{:.h1hd}\n\n**Answer 23.2** We can save frames by making a resource for frames, as was done on page 337.\nUnfortunately, we can't just use the def resource macro as is, because we need a separate resource for each size frame.\nThus, a two-dimensional array or a vector of vectors is necessary.\nFurthermore, one must be careful in determining when a frame is no longer needed, and when it has been saved and may be used again.\nSome compilers will generate a special calling sequence for a tail-recursive call where the environment can be used as is, without discarding and then creating a new frame for the arguments.\nSome compilers have varied and advanced representations for environments.\nAn environment may never be represented explicitly as a list of frames; instead it may be represented implicitly as a series of values in registers.\n\n**Answer 23.3** We could read in Scheme expressions as before, and then convert any symbols that looked like complex numbers into numbers.\nThe following routines do this without consing.\n\n```lisp\n(defun scheme-read (&optional (stream *standard-input*))\n   (let ((*readtable* *scheme-readtable*))\n     (convert-numbers (read stream nil eof))))\n(defun convert-numbers (x)\n   \"Replace symbols that look like Scheme numbers with their values.\"\n   ;; Don't copy structure, make changes in place.\n   (typecase x\n     (cons (setf (car x) (convert-numbers (car x)))\n             (setf (cdr x) (convert-numbers (cdr x)))\n             x)\n     (symbol (or (convert-number x) x))\n     (vector (dotimes (i (length x))\n                (setf (aref x i) (convert-numbers (aref x i))))\n               x)\n        (t x)))\n(defun convert-number (symbol)\n   \"If str looks like a complex number, return the number.\"\n   (let* ((str (symbol-name symbol))\n            (pos (position-if #'sign-p str))\n            (end (- (length str) 1)))\n       (when (and pos (char-equal (char str end) #\\i))\n         (let ((re (read-from-string str nil nil :start 0 :end pos))\n                (im (read-from-string str nil nil :start pos rend end)))\n            (when (and (numberp re) (numberp im))\n              (complex re im))))))\n(defun sign-p (char) (find char \"+-\"))\n```\n\nActually, that's not quite good enough, because a Scheme complex number can have multiple signs in it, as in `3.\n4e- 5+6.\n7e+8i`, and it need not have two numbers, as in `3i` or `4+i` or just `+ i`.\nThe other problem is that complex numbers can only have a lowercase `i`, but read does not distinguish between the symbols `3+4i` and `3+4I`.\n\n**Answer 23.4** Yes, it is possible to implement `begin` as a macro:\n\n```lisp\n(setf (scheme-macro 'begin)\n        #'(lambda (&rest exps) '((lambda () .,exps))))\n```\n\nWith some work we could also eliminate quote.\nInstead of `'x`, we could use `(string->symbol \"X\" )`, and instead of `'(1 2)`, wecoulduse something like `(list 1 2)`.\nThe problem is in knowing when to reuse the same list.\nConsider:\n\n```lisp\n=> (define (one-two) '(1 2))\nONE-TWO\n=> (eq? (one-two) (one-two))\nT\n=> (eq? '(1 2) '(1 2))\nNIL\n```\n\nA clever memoized macro for quote could handle this, but it would be less efficient than having `quote` as a special form.\nIn short, what's the point?\n\nIt is also (nearly) possible to replace `if` with alternate code.\nThe idea is to replace:\n\n`(if`*test then-part else-part*)\n\nwith\n\n(*test*`(delay`*then-part*) `(delay`*else-part*))\n\nNow if we are assured that any *test* returns either `#t` or `#f`, then we can make the following definitions:\n\n```lisp\n(define #t (lambda (then-part else-part) (force then-part)))\n(define #f (lambda (then-part else-part) (force else-part)))\n```\n\nThe only problem with this is that any value, not just `#t`, counts as true.\n\nThis seems to be a common phenomenon in Scheme compilers: translating everything into a few very general constructs, and then recognizing special cases of these constructs and compiling them specially.\nThis has the disadvantage (compared to explicit use of many special forms) that compilation may be slower, because all macros have to be expanded first, and then special cases have to be recognized.\nIt has the advantage that the optimizations will be applied even when the user did not have a special construct in mind.\nCommon Lisp attempts to get the advantages of both by allowing implementations to play loose with what they implement as macros and as special forms.\n\n**Answer 23.6** We define the predicate `always` and install it in two places in `comp-if` :\n\n```lisp\n(defun always (pred env)\n   \"Does predicate always evaluate to true or false?\"\n   (cond ((eq pred t) 'true)\n            ((eq pred nil) 'false)\n            ((symbolp pred) nil)\n            ((atom pred) 'true)\n            ((scheme-macro (first pred))\n             (always (scheme-macro-expand pred) env))\n            ((case (first pred)\n                (QUOTE (if (null (second pred)) 'false 'true))\n                (BEGIN (if (null (rest pred)) 'false\n                                  (always (last1 pred) env)))\n                (SET! (always (third pred) env))\n    (IF (let ((test (always (second pred)) env)\n      (then (always (third pred)) env)\n      (else (always (fourth pred)) env))\n                (cond ((eq test 'true) then)\n                                  ((eq test 'false) else)\n                                  ((eq then else) then))))\n    (LAMBDA 'true)\n    (t (let ((prim (primitive-p (first pred) env\n                       (length (rest pred)))))\n           (if prim (prim-always prim))))))))\n(defun comp-if (pred then else env val? more?)\n   (case (always pred env)\n     (true ; (if nil x y) = => y ; ***\n       (comp then env val? more?)) ; ***\n     (false ; (if t x y) = => x ; ***\n       (comp else env val? more?)) ; ***\n     (otherwise\n       (let ((pcode (comp pred env t t))\n              (tcode (comp then env val? more?))\n              (ecode (comp else env val? more?)))\n       (cond\n         ((and (listp pred) ; (if (not p) x y) ==> (if p y x)\n                  (length=1 (rest pred))\n                  (primitive-p (first pred) env 1)\n                  (eq (prim-opcode (primitive-p (first pred) env 1))\n                         'not))\n         (comp-if (second pred) else then env val? more?))\n        ((equal tcode ecode) ; (if p x x) ==> (begin p x)\n         (seq (comp pred env nil t) ecode))\n        ((null tcode) ; (if p nil y) ==> p (TJUMP L2) y L2:\n         (let ((L2 (gen-label)))\n             (seq pcode (gen 'TJUMP L2) ecode (list L2)\n         (unless more? (gen 'RETURN)))))\n      ((null ecode) ; (if p x) ==> p (FJUMP L1) x L1:\n      (let ((L1 (gen-label)))\n          (seq pcode (gen TJUMP L1) tcode (list L1)\n                 (unless more? (gen 'RETURN)))))\n      (t                               ; (if p x y) ==> p (FJUMP L1) x L1: y\n                                       ; or p (FJUMP L1) x (JUMP L2) L1: y L2:\n      (let ((L1 (gen-label))\n             (L2 (if more? (gen-label))))\n        (seq pcode (gen 'FJUMP L1) tcode\n               (if more? (gen 'JUMP L2))\n               (list L1) ecode (if more? (list L2))))))))))\n```\n\nDevelopment note: originally, I had coded `always` as a predicate that took a Boolean value as input and returned true if the expression always had that value.\nThus, you had to ask first if the predicate was always true, and then if it was always false.\nThen I realized this was duplicating much effort, and that the duplication was exponential, not just linear: for a triply-nested conditional I would have to do eight times the work, not twice the work.\nThus I switched to the above formulation, where `always` is a three-valued function, returning `true`, `false`, or `nil` for none-of-the-above.\nBut to demonstrate that the right solution doesn't always appear the first time, I give my original definition as well:\n\n```lisp\n(defun always (boolean pred env)\n   \"Does predicate always evaluate to boolean in env?\"\n   (if (atom pred)\n     (and (constantp pred) (equiv boolean pred))\n     (case (first pred)\n        (QUOTE (equiv boolean pred))\n        (BEGIN (if (null (rest pred)) (equiv boolean nil)\n                          (always boolean (last1 pred) env)))\n        (SET! (always boolean (third pred) env))\n        (IF (or (and (always t (second pred) env)\n                           (always boolean (third pred) env))\n                     (and (always nil (second pred) env)\n                           (always boolean (fourth pred) env))\n                     (and (always boolean (third pred) env)\n                           (always boolean (fourth pred) env))))\n        (LAMBDA (equiv boolean t))\n        (t (let ((prim (primitive-p (first pred) env\n                                             (length (rest pred)))))\n            (and prim\n                    (eq (prim-always prim)\n                          (if boolean 'true 'false))))))))\n(defun equiv (x y) \"Boolean equivalence\" (eq (not x) (not y)))\n```\n\n**Answer 23.7** The original version requires *O*(*n*) stack space for poorly chosen pivots.\nAssuming a properly tail-recursive compiler, the modified version will never require more than *O*(log *n*) space, because at each step at least half of the vector is being sorted tail-recursively.\n\n**Answer 23.10** (1) `(defun (funcall fn . args) (apply fn args))` (2) Suppose you changed the piece of code `(+ . numbers)` to `(+ . (map sqrt numbers))`.\nThe latter is the same expression as (+ `map sqrt numbers),` which is not the intended resuit at all.\nSo there would be an arbitrary restriction: the last argument in an apply form would have to be an atom.\nThis kind of restriction goes against the grain of Scheme.\n\n----------------------\n\n[1](#xfn0010) Strictly speaking, this is a read-compile-funcall-write loop.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) At the time, the MacLisp compiler dealt with something called \"lisp assembly code\" or LAP.\nThe function to input LAP was called `lapin`.\nThose who know French will get the pun.\n!!!(p) {:.ftnote1}\n\n# Chapter 24\n## ANSI Common Lisp\n{:.chaptitle}\n\nThis chapter briefly covers some advanced features of Common Lisp that were not used in the rest of the book.\nThe first topic, packages, is crucial in building large systems but was not covered in this book, since the programs are concise.\nThe next four topics-error handling, pretty printing, series, and the loop macro-are covered in *Common Lisp the Language,* 2d edition, but not in the first edition of the book.\nThus, they may not be applicable to your Lisp compiler.\nThe final topic, sequence functions, shows how to write efficient functions that work for either lists or vectors.\n\n## 24.1 Packages\n{:#s0010}\n{:.h1hd}\n\nA *package* is a symbol table that maps from strings to symbols named by those strings.\nWhen read is confronted with a sequence of characters like `list`, it uses the symbol table to determine that this refers to the symbol `list`.\nThe important point is that every use of the symbol name `list` refers to the same symbol.\nThat makes it easy to refer to predefined symbols, but it also makes it easy to introduce unintended name conflicts.\nFor example, if I wanted to hook up the `emycin` expert system from [chapter 16](B9780080571157500169.xhtml) with the parser from [chapter 19](B9780080571157500194.xhtml), there would be a conflict because both programs use the symbol `defrule` to mean different things.\n\nCommon Lisp uses the package system to help resolve such conflicts.\nInstead of a single symbol table, Common Lisp allows any number of packages.\nThe function `read` always uses the current package, which is defined to be the value of the special variable `*package*`.\nBy default, Lisp starts out in the `common-lisp-user` package.[1](#fn0010) That means that if we type a new symbol, like `zxv!!!(char) ®!?+qw`, it will be entered into that package.\nConverting a string to a symbol and placing it in a package is called *interning.* It is done automatically by `read`, and can be done by the function `intern` if necessary.\nName conflicts arise when there is contention for names within the `common-lisp-user` package.\n\nTo avoid name conflicts, simply create your new symbols in another package, one that is specific to your program.\nThe easiest way to implement this is to split each system into at least two files-one to define the package that the system resides in, and the others for the system itself.\nFor example, the `emycin` system should start with a file that defines the `emycin` package.\nThe following form defines the `emycin` package to use the `lisp` package.\nThat means that when the current package is `emycin`, you can still refer to ail the built-in Lisp symbols.\n\n```lisp\n(make-package \"EMYCIN\" :use '(\"LISP\"))\n```\n\nThe file containing the package definition should always be loaded before the rest of the system.\nThose files should start with the following call, which insures that all new symbols will be interned in the `emycin` package:\n\n```lisp\n(in-package \"EMYCIN\")\n```\n\nPackages are used for information-hiding purposes as well as for avoiding name clashes.\nA distinction is made between *internal* and *external* symbols.\nExternal symbols are those that a user of a system would want to refer to, while internal symbols are those that help implement the system but are not needed by a user of the system.\nThe symbol `rule` would probably be internai to both the `emycin` and `parser` package, but `defrule` would be external, because a user of the `emycin` system uses `defrule` to define new rules.\nThe designer of a system is responsible for advertising which symbols are external.\nThe proper call is:\n\n```lisp\n(export '(emycin defrule defcontext defparm yes/no yes no is))\n```\n\nNow the user who wants to refer to symbols in the `emycin` package has four choices.\nFirst, he or she can use the *package prefix* notation.\nTo refer to the symbol `defrule` in the emycin package, type `emycin:defrule`.\nSecond, the user can make `emycin` be the current package with `(in-package \"EMYCIN\").` Then, of course, we need only type `defrule`.\nThird, if we only need part of the functionality of a system, we can import specific symbols into the current package.\nFor example, we could call `(import ' emycin:defrule)`.\nFrom then on, typing `defrule` (in the current package) will refer to `emycin:defrule`.\nFourth, if we want the full functionality of the system, wecall `(use-package \"EMYCIN\")`.\nThis makes ail the external symbols ofthe `emycin` package accessible in the current package.\n\nWhile packages help eliminate name conflicts, `import` and `use-package` allow them to reappear.\nThe advantage is that there will only be conflicts between external symbols.\nSince a carefully designed package should have far fewer external than internal symbols, the problem has at least been reduced.\nBut if two packages both have an external `defrule` symbol, then we cannot `use-package` both these packages, nor `import` both symbols without producing a genuine name conflict.\nSuch conflicts can be resolved by *shadowing* one symbol or the other; see *Common Lisp the Language* for details.\n\nThe careful reader may be confused by the distinction between `\"EMYCIN\"` and `emycin`.\nIn *Common Lisp the Language*, it was not made clear what the argument to package functions must be.\nThus, some implementations signal an error when given a symbol whose print name is a package.\nIn ANSI Common Lisp, all package functions are specified to take either a package, a package name (a string), or a symbol whose print name is a package name.\nIn addition, ANSI Common Lisp adds the convenient `defpackage` macro.\nIt can be used as a replacement for separate calls to `make-package, use-package, import`, and `export`.\nAlso note that ANSI renames the `lisp package` as `common-lisp`.\n\n```lisp\n(defpackage emycin\n (:use common-lisp)\n (:export emycin defrule defcontext defparm yes/no yes no is))\n```\n\nFor more on packages and building systems, see [section 25.16](B978008057115750025X.xhtml#s0110) or *Common Lisp the Language.*\n\n### The Seven Name Spaces\n{:#s0015}\n{:.h2hd}\n\nOne important fact to remember about packages is that they deal with symbols, and only indirectly deal with the uses those symbols might have.\nFor example, you may think of `(export 'parse)` as exporting the function `parse`, but really it is exporting the symbol `parse`, which may happen to have a function definition associated with it.\nHowever, if the symbol is put to another use-perhaps as a variable or a data type-then those uses are made accessible by the `export` statement as well.\n\nCommon Lisp has at least seven name spaces.\nThe two we think of most often are (1) for functions and macros and (2) for variables.\nWe have seen that Scheme confiates these two name spaces, but Common Lisp keeps them separate, so that in a function application like `(f)` the function/macro name space is consulted for the value of `f`, but in `(+ f)`, f is treated as a variable name.\nThose who understand the scope and extent rules of Common Lisp know that (3) special variables form a distinct name space from lexical variables.\nSo the `f` in `(+ f)` is treated as either a special or lexical variable, depending on if there is an applicable `special` declaration.\nThere is also a name space (4) for data types.\nEven if `f` is defined as a function and/or a variable, it can also be defined as a data type with `defstruct`, `deftype`, or `defclass`.\nIt can also be defined as (5) a label for `go` statements within a `tagbody` or (6) a block name for `return-from` statements within a `block`.\nFinally, symbols inside a quoted expression are treated as constants, and thus form name space (7).\nThese symbols are often used as keys in user-defined tables, and in a sense each such table defines a new name space.\nOne example is the *tag* name space, used by catch and `throw`.\nAnother is the package name space.\n\nIt is a good idea to limit each symbol to only one name space.\nCommon Lisp will not be confused if a symbol is used in multiple ways, but the poor human reader probably will be.\n\nIn the following example `f`, can you identify which of the twelve uses of `f` refer to which name spaces?\n\n```lisp\n(defun f (f)\n (block f\n  (tagbody\n   f (catch 'f\n    (if (typep f 'f)\n     (throw 'f (go f)))\n    (funcall #'f (get (symbol-value 'f) 'f))))))\n```\n\n## 24.2 Conditions and Error Handling\n{:#s0020}\n{:.h1hd}\n\nAn extraordinary feature of ANSI Common Lisp is the facility for handling errors.\nIn most languages it is very difficult for the programmer to arrange to recover from an error.\nAlthough Ada and some implementations of C provide functions for error recovery, they are not generally part of the repertoire of most programmers.\nThus, we find C programs that exit with the ungraceful message `Segmentation violation: core dumped`.\n\nCommon Lisp provides one of the most comprehensive and easy-to-use error-handling mechanism of any programming language, which leads to more robust programs.\nThe process of error handling is divided into two parts: signaling an error, and handling it.\n\n### Signaling Errors\n{:#s0025}\n{:.h2hd}\n\nAn *error* is a condition that the program does not know how to handle.\nSince the program does not know what to do, its only recourse is to announce the occurrence of the error, with the hope that some other program or user will know what to do.\nThis announcement is called *signaling* an error.\nAn error can be signaled by a Common Lisp built-in function, as when `( / 3 0 )` signals a divide-by-zero error.\nErrors can also be signaled explicitly by the programmer, as in a call to `(error \"Illegal value.\")`.\n\nActually, it is a bit of a simplification to talk only of *signaling errors.* The precise term is *signaling a condition.* Some conditions, like end-of-file, are not considered errors, but nevertheless they are unusual conditions that must be dealt with.\nThe condition system in Common Lisp allows for the definition of all kinds of conditions, but we will continue to talk about errors in this brief discussion, since most conditions are in fact error conditions.\n\n### Handling Errors\n{:#s0030}\n{:.h2hd}\n\nBy default, signaling an error invokes the debugger.\nIn the following example, the >> prompt means that the user is in the debugger rather than at the top level.\n\n```lisp\n> (/ 3 0)\nError: An attempt was made to divide by zero.\n>>\n```\n\nANSI Common Lisp provides ways of changing this default behavior.\nConceptually, this is done by setting up an *error handler* which handles the error in some way.\nError handlers are bound dynamically and are used to process signaled errors.\nAn error handler is much like a `catch`, and signaling an error is like a `throw`.\nIn fact, in many systems `catch` and `throw` are implemented with the error-condition system.\n\nThe simplest way of handling an error is with the macro `ignore-errors`.\nIf noerror occurs, `ignore-errors` is just like `progn`.\nBut if an error does occur, `ignore-errors` will return `nil` as its first value and `t` as its second, to indicate that an error has occurred but without doing anything else:\n\n```lisp\n> (ignore-errors (/ 3 1))`=> `3 NIL\n> (ignore-errors (/ 3 0))`=> `NIL T\n```\n\n`ignore-errors` is a very coarse-grain tool.\nIn an interactive interpreter, `ignore-errors` can be used to recover from any and all errors in the response to one input and get back to the read-process-print loop for the next input.\nIf the errors that are ignored are not serious ones, this can be a very effective way of transforming a buggy program into a useful one.\n\nBut some errors are too important to ignore.\nIf the error is running out of memory, then ignoring it will not help.\nInstead, we need to find some way of freeing up memory and continuing.\n\nThe condition-handling system can be used to handle only certain errors.\nThe macro `handler-case`, is a convenient way to do this.\nLike `case`, its first argument is evaluated and used to determine what to do next.\nIf no error is signaled, then the value of the expression is returned.\nBut if an error does occur, the following clauses are searched for one that matches the type of the error.\nIn the following example, `handler-case` is used to handle division by zero and other arithmetic errors (perhaps floating-point underflow), but it allows all other errors to pass unhandled.\n\n```lisp\n(defun div (x y)\n (handler-case (/ x y)\n  (division-by-zero () most-positive-fixnum)\n  (arithmetic-error () 0)))\n> (div 8 2)`=> `4\n> (div 3 0)`=> `16777215\n> (div 'xyzzy 1)\nError: The value of NUMBER, XYZZY, should be a number\n```\n\nThrough judicious use of `handler-case`, the programmer can create robust code that reacts well to unexpected situations.\nFor more details, see chapter 29 of *Common Lisp the Language,* 2d edition.\n\n## 24.3 Pretty Printing\n{:#s0035}\n{:.h1hd}\n\nANSI Common Lisp adds a facility for user-controlled pretty printing.\nIn general, *pretty printing* refers to the process of printing complex expressions in a format that uses indentation to improve readability.\nThe function `pprint` was always available, but before ANSI Common Lisp it was left unspecified, and it could not be extended by the user.\nChapter 27 of *Common Lisp the Language,* 2d edition presents a pretty-printing facility that gives the user fine-grained control over the printing of all types of objects.\nIn addition, the facility is integrated with the `format` function.\n\n## 24.4 Series\n{:#s0040}\n{:.h1hd}\n\nThe functional style of programming with higher-order functions is one of the attractions of Lisp.\nThe following expression to sum the square roots of the positive numbers in the list `nums` is clear and concise:\n\n```lisp\n(reduce #'+ (mapcar #'sqrt (find-all-if #'plusp nums)))\n```\n\nUnfortunately, it is inefficient: both `find-all-if` and `mapcar` cons up intermediate lists that are not needed in the final sum.\nThe following two versions using `loop` and `dolist` are efficient but not as pretty:\n\n```lisp\n;; Using Loop           ;; Using dolist\n(loop for num in nums   (let ((sum 0))\n  when (plusp num)        (dolist (num nums sum)\n  sum (sqrt num))            (when (plusp num)\n                                                            (incf sum num))))\n```\n\nA compromise between the two approaches is provided by the *series* facility, defined in appendix A of *Common Lisp the Language*, 2d edition.\nThe example using series would look like:\n\n```lisp\n(collect-sum (#Msqrt (choose-if #'plusp nums)))\n```\n\nThis looks very much like the functional version: only the names have been changed.\nHowever, it compiles into efficient iterative code very much like the `dolist` version.\n\nLike pipes (see [section 9.3](B9780080571157500091.xhtml#s0015)), elements of a series are only evaluated when they are needed.\nSo we can write `(scan-range :from 0)` to indicate the infinite series of integers starting from 0, but if we only use, say, the first five elements of this series, then only the first five elements will be generated.\n\nThe series facility offers a convenient and efficient alternative to iterative loops and sequence functions.\nAlthough the series proposai has not yet been adopted as an official part of ANSI Common Lisp, its inclusion in the reference manual has made it increasingly popular.\n\n## 24.5 The Loop Macro\n{:#s0045}\n{:.h1hd}\n\nThe original specification of Common Lisp included a simple `loop` macro.\nThe body of the loop was executed repeatedly, until a `return` was encountered.\nANSI Common Lisp officially introduces a far more complex `loop` macro, one that had been used in ZetaLisp and its predecessors for some time.\nThis book has occasionally used the complex `loop` in place of alternatives such as `do, dotimes, dolist`, and the mapping functions.\n\nIf your Lisp does not include the complex `loop` macro, this chapter gives a definition that will run all the examples in this book, although it does not support all the features of `loop`.\nThis chapter also serves as an example of a complex macro.\nAs with any macro, the first thing to do is to look at some macro calls and what they might expand into.\nHere are two examples:\n\n```lisp\n(loop for i from 1 to n do (print (sqrt i))) =\n(LET* ((I 1)\n    (TEMP N))\n (TAGBODY\n   LOOP\n    (IF (> I TEMP)\n       (GO END))\n    (PRINT (SQRT I))\n    (SETF I (+ I 1))\n    (GO LOOP)\n   END))\n(loop for v in list do (print v)) =\n(LET* ((IN LIST)\n    (V (CAR IN)))\n   (TAGBODY\n   LOOP\n    (IF (NULL IN)\n       (GO END))\n    (PRINT V)\n    (SETF IN (CDR IN))\n    (SETF V (CAR IN))\n    (GO LOOP)\n   END))\n```\n\nEach loop initializes some variables, then enters a loop with some exit tests and a body.\nSo the template is something like:\n\n```lisp\n(let* (*variables...*)\n (tagbody\n  loop\n   (if *exit-tests*\n    (go end))\n```\n\n   *`Body`*\n\n```lisp\n   (go loop)\n  end))\n```\n\nActually, there's more we might need in the general case.\nThere may be a prologue that appears before the loop but after the variable initialization, and similarly there may be an epilogue after the loop.\nThis epilogue may involve returning a value, and since we want to be able to return from the loop in any case, we need to wrap a `block` around it.\nSo the complete template is:\n\n```lisp\n(let* (*variables...*)\n (block *name*\n```\n\n  *`Prologue`*\n\n```lisp\n  (tagbody\n   Loop\n```\n\n    *`body`*\n\n```lisp\n    (go loop)\n   end\n```\n\n    *`epilogue`*\n\n```lisp\n    (return *result*))))\n```\n\nTo generate this template from the body of a `loop` form, we will employ a structure with fields for each of the parts of the template:\n\n```lisp\n(defstruct loop\n  \"A structure to hold parts of a loop as it is built.\"\n  (vars nil) (prologue nil) (body nil) (steps nil)\n  (epilogue nil) (result nil) (name nil))\n```\n\nNow the `loop` macro needs to do four things: (1) decide if this is a use of the simple, non-keyword `loop` or the complex ANSI `loop`.\nIf it is the latter, then (2) make an instance of the `loop` structure, (3) process the body of the loop, filling in apprpriate fields of the structure, and (4) place the filled fields into the template.\nHere is the `loop` macro:\n\n```lisp\n(defmacro loop (&rest exps)\n  \"Supports both ANSI and simple LOOP.\n  Warning: Not every loop keyword is supported.\"\n  (if (every #'listp exps)\n    ;; No keywords implies simple loop:\n    '(block nil (tagbody loop ,@exps (go loop)))\n    ;; otherwise process loop keywords:\n    (let ((l (make-loop)))\n      (parse-loop-body l exps)\n      (fill-loop-template l))))\n(defun fill-loop-template (l)\n  \"Use a loop-structure instance to fill the template.\"\n  '(let* .(nreverse (loop-vars l))\n    (block ,(loop-name l)\n     ,@(nreverse (loop-prologue l)\n     (tagbody\n      loop\n        ,@(nreverse (loop-body l))\n        ,@(nreverse (loop-steps l))\n        (go loop)\n      end\n        ,@(nreverse (loop-epilogue l))\n        (return ,(loop-result l))))))\n```\n\nMost of the work is in writing `parse-loop-body`, which takes a list of expressions and parses them into the proper fields of a loop structure.\nIt will use the following auxiliary functions:\n\n```lisp\n(defun add-body (l exp) (push exp (loop-body l)))\n(defun add-test (l test)\n  \"Put in a test for loop termination.\"\n  (push '(if .test (go end)) (loop-body l)))\n(defun add-var (l var init &optional (update nil update?))\n  \"Add a variable, maybe including an update step.\"\n  (unless (assoc var (loop-vars l))\n    (push (list var init) (loop-vars l)))\n  (when update?\n    (push '(setq ,var ,update) (loop-steps l))))\n```\n\nThere are a number of alternative ways of implementing this kind of processing.\nOne would be to use special variables: `*prologue*, *body*, *epilogue*`, and so on.\nThis would mean we wouldn't have to pass around the loop structure `l`, but there would be significant clutter in having seven new special variables.\nAnother possibility is to use local variables and close the definitions of `loop`, along with the `add-` functions in that local environment:\n\n```lisp\n(let (body prologue epilogue steps vars name result)\n  (defmacro loop ...)\n  (defun add-body ...)\n  (defun add-test ...)\n  (defun add-var ...))\n```\n\nThis is somewhat cleaner style, but some early Common Lisp compilers do not support embedded `defuns`, so I chose to write in a style that I knew would work in all implementations.\nAnother design choice would be to return multiple values for each of the components and have `parse-loop-body` put them all together.\nThis is in fact done in one of the Lisp Machine implementations of `loop`, but I think it is a poor decision: seven components are too many to keep track of by positional notation.\n\n### Anatomy of a Loop\n{:#s0050}\n{:.h2hd}\n\nAll this has just been to set up for the real work: parsing the expressions that make up the loop with the function `parse-loop-body`.\nEvery loop consists of a sequence of clauses, where the syntax of each clause is determined by the first expression of the clause, which should be a known symbol.\nThese symbols are called *loop keywords,* although they are not in the keyword package.\n\nThe loop keywords will be defined in a data-driven fashion.\nEvery keyword has a function on its property list under the `loop-fn` indicator.\nThe function takes three arguments: the `loop` structure being built, the very next expression in the loop body, and a list of the remaining expressions after that.\nThe function is responsible for updating the `loop` structure (usually by making appropriate calls to the `add-` functions) and then returning the unparsed expressions.\nThe three-argument calling convention is used because many of the keywords only look at one more expression.\nSo those functions see that expression as their first argument, and they can conveniently return their second argument as the unparsed remainder.\nOther functions will want to look more carefully at the second argument, parsing some of it and returning the rest.\n\nThe macro `defloop` is provided to add new loop keywords.\nThis macro enforces the three-argument calling convention.\nIf the user supplies only two arguments, then a third argument is automatically added and returned as the remainder.\nAlso, if the user specifies another symbol rather than a list of arguments, this is taken as an alias, and a function is constructed that calls the function for that keyword:\n\n```lisp\n(defun parse-loop-body (l exps)\n  \"Parse the exps based on the first exp being a keyword.\n  Continue until all the exps are parsed.\"\n  (unless (null exps)\n    (parse-loop-body\n      l (call-loop-fn l (first exps) (rest exps)))))\n(defun call-loop-fn (l key exps)\n  \"Return the loop parsing function for this keyword.\"\n  (if (and (symbolp key) (get key 'loop-fn))\n    (funcall (get key 'loop-fn) l (first exps) (rest exps))\n    (error \"Unknown loop key: \"a\" key)))\n(defmacro defloop (key args &rest body)\n  \"Define a new LOOP keyword.\"\n  ;; If the args do not have a third arg, one is supplied.\n  ;; Also, we can define an alias with (defloop key other-key)\n  '(setf (get ',key 'loop-fn)\n    ,(cond ((and (symbolp args) (null body))\n      '#'(lambda (1 x y)\n          (call-loop-fn l '.args (cons x y))))\n       ((and (listp args) (= (length args) 2))\n        '#'(lambda (.@args -exps-) ,@body -exps-))\n       (t '#'(lambda .args ,@body)))))\n```\n\nNow we are ready to define some `loop` keywords.\nEach of the following sections refers to (and implements the loop keywords in) a section of chapter 26 of *Common Lisp the Language*, 2d edition.\n\n### Iteration Control (26.6)\n{:#s0055}\n{:.h2hd}\n\nHere we define keywords for iterating over elements of a sequence and for stopping the iteration.\nThe following cases are covered, where uppercase words represent loop keywords:\n\n```lisp\n(LOOP REPEAT n ...)\n(LOOP FOR i FROM s TO e BY inc ...)\n(LOOP FOR v IN l ...)\n(LOOP FOR v ON l ...)\n(LOOP FOR v = expr [THEN step] ...)\n```\n\nThe implementation is straightforward, although somewhat tedious for complex keywords like `for`.\nTake the simpler keyword, `repeat`.\nTo handle it, we generate a new variable that will count down the number of times to repeat.\nWe call `add-var` to add that variable, with its initial value, to the loop structure.\nWe also give this variable an update expression, which decrements the variable by one each time through the loop.\nThen ail we need to do is call `add-test` to insert code that will exit the loop when the variable reaches zero:\n\n```lisp\n(defloop repeat (l times)\n  \"(LOOP REPEAT n ...) does loop body n times.\"\n  (let ((i (gensym \"REPEAT\")))\n    (add-var l i times '(- ,i 1))\n    (add-test l '(<= ,i 0))))\n```\n\nThe loop keyword `for` is more complicated, but each case can be analyzed in the same way as `repeat`:\n\n```lisp\n(defloop as for) ;; AS is the same as FOR\n(defloop for (l var exps)\n  \"4 of the 7 cases for FOR are covered here:\n  (LOOP FOR i FROM s TO e BY inc ...) does arithemtic iteration\n  (LOOP FOR v IN l ...) iterates for each element of l\n  (LOOP FOR v ON l ...) iterates for each tail of l\n  (LOOP FOR v = expr [THEN step]) initializes and iterates v\"\n  (let ((key (first exps))\n      (source (second exps))\n      (rest (rest2 exps)))\n    (ecase key\n      ((from downfrom upfrom to downto upto by)\n     (loop-for-arithmetic l var exps))\n      (in (let ((v (gensym \"IN\")))\n           (add-var l v source '(cdr ,v))\n           (add-var l var '(car ,v) '(car ,v))\n           (add-test l '(null ,v))\n           rest))\n      (on (add-var l var source '(cdr ,var))\n          (add-test l '(null .var))\n          rest)\n      (= (if (eq (first rest) 'then)\n              (progn\n                (pop rest)\n                (add-var l var source (pop rest)))\n              (progn\n                (add-var l var nil)\n                (add-body l '(setq ,var .source))))\n          rest)\n      ;; ACROSS. BEING clauses omitted\n      )))\n(defun loop-for-arithmetic (l var exps)\n  \"Parse loop expressions of the form:\n  (LOOP FOR var [FROM | DOWNFROM | UPFROM exp1] [TO | DOWNTO | UPTO exp2]\n       [BY exp3]\"\n  ;; The prepositions BELOW and ABOVE are omitted\n  (let ((exp1 0)\n       (exp2 nil)\n       (exp3 1)\n       (down? nil))\n    ;; Parse the keywords:\n    (when (member (first exps) '(from downfrom upfrom))\n     (setf exp1 (second exps)\n         down? (eq (first exps) 'downfrom)\n         exps (rest2 exps)))\n    (when (member (first exps) '(to downto upto))\n     (setf exp2 (second exps)\n         down? (or down? (eq (first exps) 'downto))\n         exps (rest2 exps)))\n    (when (eq (first exps) 'by)\n     (setf exp3 (second exps)\n         exps (rest2 exps)))\n    ;; Add variables and tests:\n    (add-var l var exp1\n         '(,(if down? '- '+) ,var ,(maybe-temp l exp3)))\n    (when exp2\n      (add-test l '(,(if down? '< '>) ,var ,(maybe-temp l exp2))))\n    ;; and return the remaining expressions:\n         exps))\n(defun maybe-temp (l exp)\n  \"Generate a temporary variable, if needed.\"\n  (if (constantp exp)\n    exp\n    (let ((temp (gensym \"TEMP\")))\n      (add-var l temp exp)\n      temp)))\n```\n\n### End-Test Control (26.7)\n{:#s0060}\n{:.h2hd}\n\nIn this section we cover the following clauses:\n\n```lisp\n(LOOP UNTIL test ...)\n(LOOP WHILE test ...)\n(LOOP ALWAYS condition ...)\n(LOOP NEVER condition ...)\n(LOOP THEREIS condition ...)\n(LOOP ... (LOOP-FINISH) ...)\n```\n\nEach keyword is quite simple:\n\n```lisp\n(defloop until (l test) (add-test l test))\n(defloop while (l test) (add-test l '(not .test)))\n(defloop always (l test)\n  (setf (loop-result l) t)\n  (add-body l '(if (not ,test) (return nil))))\n(defloop never (l test)\n  (setf (loop-result l) t)\n  (add-body l '(if ,test (return nil))))\n(defloop thereis (l test) (add-body l '(return-if ,test)))\n(defmacro return-if (test)\n  \"Return TEST if it is non-nil.\"\n  (once-only (test)\n    '(if ,test (return ,test))))\n(defmacro loop-finish () '(go end))\n```\n\n### Value Accumulation (26.8)\n{:#s0065}\n{:.h2hd}\n\nThe `collect` keyword poses another challenge.\nHow do you collect a list of expressions presented one at a time?\nThe answer is to view the expressions as a queue, one where we add items to the rear but never remove them from the front of the queue.\nThen we can use the queue functions defined in [section 10.5](B9780080571157500108.xhtml#s0025).\n\nUnlike the other clauses, value accumulation clauses can communicate with each other.\nThere can be, say, two `collect` and an append clause in the same loop, and they all build onto the same list.\nBecause of this, I use the same variable name for the accumulator, rather than gensyming a new variable for each use.\nThe name chosen is stored in the global variable `*acc*`.\nIn the official `loop` standard it is possible for the user to specify the variable with an `into` modifier, but I have not implemented that option.\nThe clauses covered are:\n\n```lisp\n(LOOP COLLECT item ...)\n(LOOP NCONC item ...)\n(LOOP APPEND item ...)\n(LOOP COUNT item ...)\n(LOOP SUM item ...)\n(LOOP MAXIMIZE item ...)\n(LOOP MINIMIZE item ...)\n```\n\nThe implementation is:\n\n```lisp\n(defconstant *acc* (gensym \"ACC\")\n  \"Variable used for value accumulation in LOOP.\")\n;;; INTO preposition is omitted\n(defloop collect (l exp)\n  (add-var l *acc* '(make-queue))\n  (add-body l '(enqueue ,exp .*acc*))\n  (setf (loop-result l) '(queue-contents ,*acc*)))\n(defloop nconc (l exp)\n  (add-var l *acc* '(make-queue))\n  (add-body l '(queue-nconc ,*acc* .exp))\n  (setf (loop-result l) '(queue-contents .*acc*)))\n(defloop append (l exp exps)\n  (call-loop-fn l 'nconc '((copy-list .exp) .,exps)))\n(defloop count (l exp)\n  (add-var l *acc* 0)\n  (add-body l '(when .exp (incf .*acc*)))\n  (setf (loop-result l) *acc*))\n(defloop sum (l exp)\n  (add-var l *acc* 0)\n  (add-body l '(incf ,*acc* .exp))\n  (setf (loop-result l) *acc*))\n(defloop maximize (l exp)\n  (add-var l *acc* nil)\n  (add-body l '(setf ,*acc*\n        (if ,*acc*\n            (max ,*acc* ,exp)\n            ,exp)))\n  (setf (loop-result l) *acc*))\n(defloop minimize (l exp)\n  (add-var 1 *acc* nil)\n  (add-body l '(setf ,*acc*\n        (if ,*acc*\n            (min ,*acc* ,exp)\n            ,exp)))\n  (setf (loop-result l) *acc*))\n(defloop collecting collect)\n(defloop nconcing nconc)\n(defloop appending append)\n(defloop counting count)\n(defloop summing sum)\n(defloop maximizing maximize)\n(defloop minimizing minimize)\n```\n\n**Exercise 24.1**`loop` lets us build aggregates (lists, maximums, sums, etc.) over the body of the loop.\nSometimes it is inconvenient to be restricted to a single-loop body.\nFor example, we might want a list of all the nonzero elements of a two-dimensional array.\nOne way to implement this is with a macro, `with-collection`, that sets up and returns a queue structure that is built by calls to the function `collect`.\nFor example:\n\n```lisp\n> (let ((A '#2a((l 0 0) (0 2 4) (0 0 3))))\n  (with-collection\n    (loop for i from 0 to 2 do\n      (loop for j from 0 to 2 do\n        (if (> (aref a i j) 0)\n          (collect (aref A i j)))))))\n(1 2 4 3)\n```\n\nImplement `with-collection` and `collect`.\n\n### Variable Initialization (26.9)\n{:#s0070}\n{:.h2hd}\n\nThe `with` clause allows local variables-I have included it, but recommend using a `let` instead.\nI have not included the `and` preposition, which allows the variables to nest at different levels.\n\n```lisp\n;;;; 26.9. Variable Initializations (\"and\" omitted)\n(defloop with (l var exps)\n  (let ((init nil))\n    (when (eq (first exps) '=)\n      (setf init (second exps)\n        exps (rest2 exps)))\n    (add-var l var init)\n    exps))\n```\n\n### Conditional Execution (26.10)\n{:#s0075}\n{:.h2hd}\n\n`loop` also provides forms for conditional execution.\nThese should be avoided whenever possible, as Lisp already has a set of perfectly good conditional macros.\nHowever, sometimes you want to make, say, a `collect` conditional on some test.\nIn that case, loop conditionals are acceptable.\nThe clauses covered here are:\n\n(`LOOP WHEN test ... CELSE ...]) ; IF` is asynonym for `WHEN`\n\n```lisp\n(LOOP UNLESS test ... [ELSE ...])\n```\n\nHere is an example of `when`:\n\n```lisp\n> (loop for`x `from 1 to 10\n     when (oddp x)\n         collect x\n     else collect (- x))\n(1 -2 3 -4 5- 6 7 -8 9 -10)\n```\n\nOf course, we could have said `collect (if (oddp x ) x ( - x ) )` and done without the conditional.\nThere is one extra feature in loop's conditionals: the value of the test is stored in the variable it for subsequent use in the THEN or ELSE parts.\n(This is just the kind of feature that makes some people love `loop` and others throw up their hands in despair.) Here is an example:\n\n```lisp\n> (loop for x from 1 to 10\n    when (second (assoc x '((l one) (3 three) (5 five))))\n    collect it)\n(ONE THREE FIVE)\n```\n\nThe conditional clauses are a little tricky to implement, since they involve parsing other clauses.\nThe idea is that `call-loop-fn` parses the THEN and ELSE parts, adding whatever is necessary to the body and to other parts of the loop structure.\nThen `add-body` is used to add labels and go statements that branch to the labels as needed.\nThis is the same technique that is used to compile conditionals in [chapter 23](B9780080571157500236.xhtml); see the function `comp-if` on [page 787](B9780080571157500236.xhtml#p787).\nHere is the code:\n\n```lisp\n(defloop when (l test exps)\n  (loop-unless l '(not ,(maybe-set-it test exps)) exps))\n(defloop unless (l test exps)\n  (loop-unless l (maybe-set-it test exps) exps))\n(defun maybe-set-it (test exps)\n  \"Return value, but if the variable IT appears in exps,\n  then return code that sets IT to value.\"\n  (if (find-anywhere 'it exps)\n    '(setq it .test)\n    test))\n(defloop if when)\n(defun loop-unless (l test exps)\n  (let ((label (gensym \"L\")))\n    (add-var l 'it nil )\n    ;; Emit code for the test and the THEN part\n    (add-body l '(if .test (go ,label)))\n    (setf exps (call-loop-fn l (first exps) (rest exps)))\n    ;; Optionally emit code for the ELSE part\n    (if (eq (first exps) 'else)\n      (progn\n        (let ((label2 (gensym \"L\")))\n          (add-body l '(go ,label2))\n          (add-body l label)\n          (setf exps (call-loop-fn l (second exps) (rest2 exps)))\n          (add-body l label2)))\n        (add-body l label)))\n  exps)\n```\n\n### Unconditional Execution (26.11)\n{:#s0080}\n{:.h2hd}\n\nThe unconditional execution keywords are do and return:\n\n```lisp\n(defloop do (l exp exps)\n  (add-body l exp)\n  (loop (if (symbolp (first exps)) (RETURN exps))\n    (add-body l (pop exps))))\n(defloop return (l exp) (add-body l '(return ,exp)))\n```\n\n### Miscellaneous Features (26.12)\n{:#s0085}\n{:.h2hd}\n\nFinally, the miscellaneous features include the keywords `initially` and `finally`, which define the loop prologue and epilogue, and the keyword named, which gives a name to the loop for use by a `return-from` form.\nI have omitted the data-type declarations and destructuring capabilities.\n\n```lisp\n(defloop initially (l exp exps)\n  (push exp (loop-prologue l))\n  (loop (if (symbolp (first exps)) (RETURN exps))\n    (push (pop exps) (loop-prologue l))))\n(defloop finally (l exp exps)\n  (push exp (loop-epilogue l))\n  (loop (if (symbolp (first exps)) (RETURN exps))\n    (push (pop exps) (loop-epilogue l))))\n(defloop named (l exp) (setf (loop-name l) exp))\n```\n\n## 24.6 Sequence Functions\n{:#s0090}\n{:.h1hd}\n\nCommon Lisp provides sequence functions to make the programmer's life easier: the same function can be used for lists, vectors, and strings.\nHowever, this ease of use comes at a cost.\nSequence functions must be written very carefully to make sure they are efficient.\nThere are three main sources of indeterminacy that can lead to inefficiency: (1) the sequences can be of different types; (2) some functions have keyword arguments; (3) some functions have a `&rest` argument.\nCareful coding can limit or eliminate these sources of inefficiency, by making as many choices as possible at compile time and making the remaining choices outside of the main loop.\n\nIn this section we see how to implement the new ANSI sequence function `map-into` and the updated function reduce efficiently.\nThis is essential for those without an ANSI compiler.\nEven those who do have access to an ANSI compiler will benefit from seeing the efficiency techniques used here.\n\nBefore defining the sequence functions, the macro `once-only` is introduced.\n\n### Once-only: A Lesson in Macrology\n{:#s0095}\n{:.h2hd}\n\nThe macro `once-only` has been around for a long time on various systems, although it didn't make it into the Common Lisp standard.\nI include it here for two reasons: first, it is used in the following `funcall-if` macro, and second, if you can understand how to write and when to use `once-only`, then you truly understand macro.\n\nFirst, you have to understand the problem that `once-only` addresses.\nSuppose we wanted to have a macro that multiplies its input by itself:[2](#fn0015)\n\n```lisp\n(defmacro square (x) '(* ,x ,x))\n```\n\nThis definition works fine in the following case:\n\n```lisp\n> (macroexpand '(square z)) => (* Z Z)\n```\n\nBut it doesn't work as well here:\n\n```lisp\n> (macroexpand '(square (print (incf i))))\n(* (PRINT (INCF I)) (PRINT (INCF I)))\n```\n\nThe problem is that `i` will get incremented twice, not once, and two different values will get printed, not one.\nWe need to bind `(print (incf i))` to a local variable before doing the multiplication.\nOn the other hand, it would be superfluous to bind z to a local variable in the previous example.\nThis is where `once-only` comes in.\nIt allows us to write macro definitions like this:\n\n```lisp\n(defmacro square (x) (once-only (x) '(* ,x ,x)))\n```\n\nand have the generated code be just what we want:\n\n```lisp\n> (macroexpand '(square z))\n(* Z Z)\n> (macroexpand '(square (print (incf i))))\n(LET ((G3811 (PRINT (INCF I))))\n  (* G3811 G3811))\n```\n\nYou have now learned lesson number one of `once-only` : you know how macros differ from functions when it comes to arguments with side effects, and you now know how to handle this.\nLesson number two comes when you try to write (or even understand) a definition of `once-only`-only when you truly understand the nature of macros will you be able to write a correct version.\nAs always, the first thing to determine is what a call to `once-only` should expand into.\nThe generated code should test the variable to see if it is free of side effects, and if so, generate the body as is; otherwise it should generate code to bind a new variable, and use that variable in the body of the code.\nHere's roughly what we want:\n\n```lisp\n> (macroexpand '(once-only (x) '(* ,x ,x)))\n(if (side-effect-free-p x)\n  '(* ,x ,x)\n  '(let ((g00l ,x))\n    , (let ((x 'g00l))\n      '(* x ,x))))\n```\n\nwhere `g001` is a new symbol, to avoid conflicts with the `x` or with symbols in the body.\nNormally, we generate macro bodies using backquotes, but if the macro body itself has a backquote, then what?\nIt is possible to nest backquotes (and [appendix C](B9780080571157500273.xhtml) of *Common Lisp the Language*, 2d edition has a nice discussion of doubly and triply nested backquotes), but it certainly is not trivial to understand.\nI recommend replacing the inner backquote with its equivalent using `list` and `quote`:\n\n```lisp\n(if (side-effect-free-p x)\n  '(* ,x ,x)\n  (list 'let (list (list 'g00l x))\n    (let ((x 'g00l))\n      '(* ,x ,x))))\n```\n\nNow we can write `once-only`.\nNote that we have to account for the case where there is more than one variable and where there is more than one expression in the body.\n\n```lisp\n(defmacro once-only (variables &rest body)\n  \"Returns the code built by BODY. If any of VARIABLES\n  might have side effects. they are evaluated once and stored\n  in temporary variables that are then passed to BODY.\"\n  (assert (every #'symbolp variables))\n  (let ((temps (loop repeat (length variables) collect (gensym))))\n    '(if (every #'side-effect-free-p (list .,variables))\n      (progn .,body)\n      (list 'let\n        ,'(list .@(mapcar #'(lambda (tmp var)\n          '(list '.tmp .var))\n        temps variables))\n         (let .(mapcar #'(lambda (var tmp) '(.var ',tmp))\n      variables temps)\n     .,body)))))\n(defun side-effect-free-p (exp)\n  \"Is exp a constant, variable, or function,\n  or of the form (THE type x) where x is side-effect-free?\"\n  (or (constantp exp) (atom exp) (starts-with exp 'function)\n    (and (starts-with exp 'the)\n      (side-effect-free-p (third exp)))))\n```\n\nHere we see the expansion of the call to `once-only` and a repeat of the expansions of two calls to `square`:\n\n```lisp\n> (macroexpand '(once-only (x) '(* ,x ,x)))\n(IF (EVERY #'SIDE-EFFECT-FREE-P (LIST X))\n    (PROGN\n      '(* ,X ,X))\n    (LIST 'LET (LIST (LIST 'G3763 X))\n          (LET ((X 'G3763))\n            '(* ,X ,X))))\n> (macroexpand '(square z))\n(* Z Z)\n> (macroexpand '(square (print (incf i))))\n(LET ((G3811 (PRINT (INCF I))))\n  (* G3811 G3811))\n```\n\nThis output was produced with `*print-gensym*` setto `nil`.\nWhen this variable is non-nil, uninterned symbols are printed with a prefix `#`:,as in `#:G3811`.\nThis insures that the symbol will not be interned by a subsequent read.\n\nIt is worth noting that Common Lisp automatically handles problems related to multiple evaluation of subforms in setf methods.\nSee [page 884](B978008057115750025X.xhtml#p884) for an example.\n\n### Avoid Overusing Macros\n{:#s0100}\n{:.h2hd}\n\nA word to the wise: don't get carried away with macros.\nUse macros freely to represent your *problem*, but shy away from new macros in the implementation of your *solution,* unless absolutely necessary.\nSo, it is good style to introduce a macro, say, `defrule`, which defines rules for your application, but adding macros to the code itself may just make things harder for others to use.\n\nHere is a story.\nBefore `if` was a standard part of Lisp, I defined my own version of `if`.\nUnlike the simple `if`, my version took any number of test/result pairs, followed by an optional else result.\nIn general, the expansion was:\n\n```lisp\n(if *a b c d...x)* => (cond *(a b)* (*c d*) ... (T *x*))\n```\n\nMy `if` also had one more feature: the symbol `'that'` could be used to refer to the value of the most recent test.\nFor example, I could write:\n\n```lisp\n(if (assoc item a-list)\n  (process (cdr that)))\n```\n\nwhich would expand into:\n\n```lisp\n(LET (THAT)\n  (COND\n    ((SETQ THAT (ASSOC ITEM A-LIST)) (PROCESS (CDR THAT)))))\n```\n\nThis was a convenient feature (compare it to the => feature of Scheme's cond, as discussed on [page 778](B9780080571157500224.xhtml#p778)), but it backfired often enough that I eventually gave up on my version of `if`.\nHere's why.\nI would write code like this:\n\n```lisp\n(if (total-score x)\n  (print (/ that number-of-trials))\n  (error \"No scores\"))\n```\n\nand then make a small change:\n\n```lisp\n(if (total-score x)\n  (if *print-scores* (print (/ that number-of-trials)))\n  (error \"No scores\"))\n```\n\nThe problem is that the variable `that` now refers to `*print-scores*`, not `(total-score x),` as it did before.\nMy macro violates referential transparency.\nIn general, that's the whole point of macros, and it is why macros are sometimes convenient.\nBut in this case, violating referential transparency can lead to confusion.\n\n### MAP-INTO\n{:#s0105}\n{:.h2hd}\n\nThe function `map-into` is used on [page 632](B9780080571157500182.xhtml#p632).\nThis function, added for the ANSI version of Common Lisp, is like `map`, except that instead of building a new sequence, the first argument is changed to hold the results.\nThis section describes how to write a fairly efficient version of `map-into`, using techniques that are applicable to any sequence function.\nWe'll start with a simple version:\n\n```lisp\n(defun map-into (result-sequence function &rest sequences)\n  \"Destructively set elements of RESULT-SEQUENCE to the results\n  of applying FUNCTION to respective elements of SEQUENCES.\"\n  (replace result-sequence (apply #'map 'list function sequences)))\n```\n\nThis does the job, but it defeats the purpose of `map-into`, which is to avoid generating garbage.\nHere's a version that generates less garbage:\n\n```lisp\n(defun map-into (result-sequence function &rest sequences)\n  \"Destructively set elements of RESULT-SEQUENCE to the results\n  of applying FUNCTION to respective elements of SEQUENCES.\"\n  (let ((n (loop for seq in (cons result-sequence sequences)\n              minimize (length seq))))\n    (dotimes (i n)\n      (setf (elt result-sequence i)\n        (apply function\n          (mapcar #'(lambda (seq) (elt seq i))\n            sequences))))))\n```\n\nThere are three problems with this definition.\nFirst, it wastes space: mapcar creates a new argument list each time, only to have the list be discarded.\nSecond, it wastes time: doing a `setf` of the ith element of a list makes the algorithm *O*(*n2*) instead of *O*(*n*), where *n* is the length of the list.\nThird, it is subtly wrong: if `result-sequence` is a vector with a fill pointer, then `map-into` is supposed to ignore `result-sequence's` current length and extend the fill pointer as needed.\nThe following version fixes those problems:\n\n```lisp\n(defun map-into (result-sequence function &rest sequences)\n  \"Destructively set elements of RESULT-SEQUENCE to the results\n  of applying FUNCTION to respective elements of SEQUENCES.\"\n  (let ((arglist (make-list (length sequences)))\n    (n (if (listp result-sequence)\n      most-positive-fixnum\n      (array-dimension result-sequence 0))))\n   ;; arglist is made into a list of args for each call\n   ;; n is the length of the longest vector\n   (when sequences\n     (setf n (min n (loop for seq in sequences\n       minimize (length seq)))))\n   ;; Define some shared functions:\n   (flet\n    ((do-one-call (i)\n      (loop for seq on sequences\n        for arg on arglist\n        do (if (listp (first seq))\n          (setf (first arg)\n            (pop (first seq)))\n          (setf (first arg)\n            (aref (first seq) i))))\n      (apply function arglist))\n    (do-result (i)\n      (if (and (vectorp result-sequence)\n        (array-has-fill-pointer-p result-sequence))\n      (setf (fill-pointer result-sequence)\n  (max i (fill-pointer result-sequence))))))\n   (declare (inline do-one-call))\n   ;; Decide if the result is a list or vector,\n   ;; and loop through each element\n   (if (listp result-sequence)\n    (loop for i from 0 to (- n 1)\n     for r on result-sequence\n     do (setf (first r)\n        (do-one-call i)))\n    (loop for i from 0 to (- n 1)\n     do (setf (aref result-sequence i)\n        (do-one-call i))\n     finally (do-result n))))\n   result-sequence))\n```\n\nThere are several things worth noticing here.\nFirst, I split the main loop into two versions, one where the result is a list, and the other where it is a vector.\nRather than duplicate code, the local functions `do-one-call` and `do-result` are defined.\nThe former is declared inline because it it called often, while the latter is not.\nThe arguments are computed by looking at each sequence in turn, taking the ith element if it is a vector, and popping the sequence if it is a list.\nThe arguments are stored into the list `arglist`, which has been preallocated to the correct size.\nAll in all, we compute the answer fairly efficiently, without generating unnecessary garbage.\n\nThe application could be done more efficiently, however.\nThink what apply must do: scan down the argument list, and put each argument into the location expected by the function-calling conventions, and then branch to the function.\nSome implementations provide a better way of doing this.\nFor example, the TI Lisp Machine provides two low-level primitive functions, `%push` and `%call`, that compile into single instructions to put the arguments into the right locations and branch to the function.\nWith these primitives, the body of `do-one-call` would be:\n\n```lisp\n(loop for seq on sequences\n  do (if (listp (first seq))\n    (%push (pop (first seq)))\n    (%push (aref (first seq) i))))\n(%call function length-sequences)\n```\n\nThere is a remaining inefficiency, though.\nEach sequence is type-checked each time through the loop, even though the type remains constant once it is determined the first time.\nTheoretically, we could code separate loops for each combination of types, just as we coded two loops depending on the type of the result sequence.\nBut that would mean 2*n* loops for *n* sequences, and there is no limit on how large *n* can be.\n\nIt might be worth it to provide specialized functions for small values of *n*, and dispatch to the appropriate function.\nHere's a start at that approach:\n\n```lisp\n(defun map-into (result function &rest sequences)\n  (apply\n   (case (length sequences)\n    (0 (if (listp result) #'map-into-list-0 #'map-into-vect-0))\n    (1 (if (listp result)\n     (if (listp (first sequences))\n       #'map-into-list-l-list #'map-into-list-1-vect)\n     (if (listp (first sequences))\n       #'map-into-vect-l-list #'map-into-vect-l-vect)) )\n    (2 (if (listp result)\n     (if (listp (first sequences))\n      (if (listp (second sequences))\n       #'map-into-list-2-list-list\n       #'map-into-list-2-list-vect)\n      ...)))\n    (t (if (listp result) #'map-into-list-n #'map-into-vect-n)))\n   result function sequences))\n```\n\nThe individual functions are not shown.\nThis approach is efficient in execution time, but it takes up a lot of space, considering that `map-into` is a relatively obscure function.\nIf `map-into` is declared `inline` and the compiler is reasonably good, then it will produce code that just calls the appropriate function.\n\n### REDUCE with :key\n{:#s0110}\n{:.h2hd}\n\nAnother change in the ANSI proposal is to add a : key keyword to `reduce`.\nThis is a useful addition-in fact, for years I had been using a `reduce-by` function that provided just this functionality.\nIn this section we see how to add the : key keyword.\n\nAt the top level, I define reduce as an interface to the keywordless function `reduce*`.\nThey are both proclaimed inline, so there will be no overhead for the keywords in normal uses of reduce.\n\n```lisp\n(proclaim '(inline reduce reduce*))\n (defun reduce* (fn seq from-end start end key init init-p)\n     (funcall (if (listp seq) #'reduce-list #'reduce-vect)\n          fn seq from-end (or start 0) end key init init-p))\n(defun reduce (function sequence &key from-end start end key\n               (initial-value nil initial-value-p))\n    (reduce* function sequence from-end start end\n                  key initial-value initial-value-p))\n```\n\nThe easier case is when the sequence is a vector:\n\n```lisp\n(defun reduce-vect (fn seq from-end start end key init init-p)\n    (when (null end) (setf end (length seq)))\n    (assert (<= 0 start end (length seq)) (start end)\n              \"Illegal subsequence of ~ a --- :start ~ d :end ~ d\"\n                 seq start end)\n   (case (- end start)\n         (0 (if init-p init (funcall fn)))\n         (1 (if init-p\n             (funcall fn init (funcall-if key (aref seq start)))\n             (funcall-if key (aref seq start))))\n         (t (if (not from-end)\n             (let ((result\n                 (if init-p\n                  (funcall fn init\n                   (funcall-if key (aref seq start)))\n                 (funcall\n                      fn\n                          (funcall-if key (aref seq start))\n                          (funcall-if key (aref seq (+ start 1)))))))\n             (loop for i from (+ start (if init-p 1 2))\n                     to (- end 1)\n                     do (setf result\n                       (funcall\n                        fn result\n                        (funcall-if key (aref seq i)))))\n                 result)\n             (let ((result\n                 (if init-p\n               (funcall\n       fn\n       (funcall-if key (aref seq (- end 1)))\n               init)\n          (funcall\n              fn\n               (funcall-if key (aref seq (- end 2)))\n               (funcall-if key (aref seq (- end 1)))))))\n (loop for i from (- end (if init-p 2 3)) downto start\n         do (setf result\n                (funcall\n                                fn\n                                (funcall-if key (aref seq i))\n                                result)))\nresult)))))\n```\n\nWhen the sequence is a list, we go to some trouble to avoid Computing the length, since that is an *O(n)* operation on lists.\nThe hardest decision is what to do when the list is to be traversed from the end.\nThere are four choices:\n\n*  **recurse.** We could recursively walk the list until we hit the end, and then compute the results on the way back up from the recursions.\nHowever, some implementations may have fairly small bounds on the depths of recursive calls, and a system function like reduce should never run afoul of such limitations.\nIn any event, the amount of stack space consumed by this approach would normally be more than the amount of heap space consumed in the next approach.\n\n*  **reverse.** We could reverse the list and then consider `from-end` true.\nThe only drawback is the time and space needed to construct the reversed list.\n\n*  **nreverse.** We could destructively reverse the list in place, do the reduce computation, and then destructively reverse the list back to its original state (perhaps with an unwind-protect added).\nUnfortunately, this is just incorrect.\nThe list may be bound to some variable that is accessible to the function used in the reduction.\nIf that is so, the function will see the reversed list, not the original list.\n\n*  **coerce.** We could convert the list to a vector, and then use `reduce-vect`.\nThis has an advantage over the reverse approach in that vectors generally take only half as much storage as lists.\nTherefore, this is the approach I adopt.\n\n```lisp\n(defmacro funcall-if (fn arg)\n   (once-only (fn)\n       '(if .fn (funcall .fn .arg) .arg)))\n(defun reduce-list (fn seq from-end start end key init init-p)\n    (when (null end) (setf end most-positive-fixnum))\n    (cond ((> start 0)\n             (reduce-list fn (nthcdr start seq) from-end 0\n                   (- end start) key init init-p))\n             ((or (null seq) (eql start end))\n             (if init-p init (funcall fn)))\n             ((= (- end start) 1)\n             (if init-p\n                (funcall fn init (funcall-if key (first seq)))\n                (funcall-if key (first seq))))\n          (from-end\n             (reduce-vect fn (coerce seq 'vector) t start end\n                   key init init-p))\n                ((null (rest seq))\n             (if init-p\n                (funcall fn init (funcall-if key (first seq)))\n                (funcall-if key (first seq))))\n          (t (let ((result\n          (if init-p\n                 (funcall\n                        fn init\n                        (funcall-if key (pop seq)))\n                 (funcall\n                        fn\n                        (funcall-if key (pop seq))\n                        (funcall-if key (pop seq))))))\n          (if end\n                (loop repeat (- end (if init-p 1 2)) while seq\n                 do (setf result\n                        (funcall\n                        fn result\n                     (funcall-if key (pop seq)))))\n             (loop while seq\n                 do (setf result\n               (funcall\n                  fn result\n                  (funcall-if key (pop seq)))))\n             result)))))\n```\n\n## 24.7 Exercises\n{:#s0115}\n{:.h1hd}\n\n**Exercise 24.2 [m]** The function reduce is a very useful one, especially with the key keyword.\nWrite nonrecursive definitions for append and 1 ength using reduce.\nWhat other common functions can be written with reduce?\n\n**Exercise 24.3** The so-called loop keywords are not symbols in the keyword package.\nThe preceding code assumes they are all in the current package, but this is not quite right.\nChange the definition of `loop` so that any symbol with the same name as a loop keyword acts as a keyword, regardless of the symbol's package.\n\n**Exercise 24.4** Can there be a value for *exp* for which the following expressions are not equivalent?\nEither demonstrate such an *exp* or argue why none can exist.\n\n```lisp\n(loop for x in list collect *exp*)\n(mapcar #'(lambda (x) *exp)* list))\n```\n\n**Exercise 24.5** The object-oriented language Eiffel provides two interesting `loop` keywords: `invariant` and `variant`.\nThe former takes a Boolean-valued expression that must remain true on every iteration of the loop, and the latter takes a integervalued expression that must decrease on every iteration, but never becomes negative.\nErrors are signaled if these conditions are violated.\nUse def `loop` to implement these two keywords.\nMake them generate code conditionally, based on a global flag.\n\n## 24.8 Answers\n{:#s0120}\n{:.h1hd}\n\n**Answer 24.1**\n\n```lisp\n(defvar *queue*)\n(defun collect (item) (enqueue item *queue*))\n(defmacro with-collection (&body body)\n     '(let ((*queue* (make-queue)))\n                 ,@body\n           (queue-contents *queue*)))\n```\n\nHere's another version that allows the collection variable to be named.\nThat way, more than one collection can be going on at the same time.\n\n```lisp\n(defun collect (item &optional (queue *queue*))\n      (enqueue item queue))\n(defmacro with-collection ((&optional (queue '*queue*))\n                               &body body)\n      '(let ((,queue (make-queue)))\n       ,@body\n      (queue-contents .queue)))\n```\n\n**Answer 24.2**\n\n```lisp\n(defun append-r (x y)\n      (reduce #'cons x :initial-value y :from-end t))\n(defun length-r (list)\n      (reduce #'+ list :key #'(lambda (x) 1)))\n```\n\n**Answer 24.4** The difference between `loop` and `mapcar` is that the former uses only one variable `x`, while the latter uses a different `x` each time.\nIf `x`'s extent is no bigger than its scope (as it is in most expressions) then this makes no difference.\nBut if any `x` is captured, giving it a longer extent, then a difference shows up.\nConsider *exp =*`#'(lambda () x).`\n\n```lisp\n> (mapcar #'funcall (loop for x in '(1 2 3) collect\n                     #'(lambda O x)))\n(3 3 3)\n>(mapcar #'funcall (mapcar #'(lambda (x) #'(lambda () x))\n                          '(1 2 3)))\n(1 2 3)\n```\n\n**Answer 24.5**\n\n```lisp\n(defvar *check-invariants* t\n      \"Should VARIANT and INVARIANT clauses in LOOP be checked?\")\n(defloop invariant (l exp)\n      (when *check-invariants*\n                (add-body l '(assert .exp () \"Invariant violated.\"))))\n(defloop variant (l exp)\n (when *check-invariants*\n           (let ((var (gensym \"INV\")))\n                (add-var l var nil)\n                (add-body l '(setf ,var (update-variant .var .exp))))))\n     (defun update-variant (old new)\n      (assert (or (null old) (< new old)) ()\n                \"Variant is not monotonically decreasing\")\n      (assert (> new 0) () \"Variant is no longer positive\")\n     new)\n```\n\nHere's an example:\n\n```lisp\n(defun gcd2 (a b)\n      \"Greatest common divisor. For two positive integer arguments.\"\n      (check-type a (integer 1))\n      (check-type b (integer 1))\n      (loop with x = a with y = b\n                invariant (and (> x 0) (> y 0)) ;; (= (gcd x y) (gcd a b))\n                variant (max x y)\n                until (= x y)\n                do (if (> x y) (decf x y) (decf y x))\n                finally (return x)))\n```\n\nHere the invariant is written semi-informally.\nWe could include the calls to `gcd`, but that seems to be defeating the purpose of `gcd2`, so that part is left as a comment.\nThe idea is that the comment should help the reader prove the correctness of the code, and the executable part serves to notify the lazy reader when something is demonstrably wrong at run time.\n\n----------------------\n\n[1](#xfn0010) Or in the user package in non-ANSI systems.\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) As was noted before, the proper way to do this is to proclaim squa re as an inline function, not a macro, but please bear with the example.\n!!!(p) {:.ftnote1}\n\n# Chapter 25\n## Troubleshooting\n{:.chaptitle}\n\n> Perhaps if we wrote programs from childhood on, as adults we'd be able to read them.\n\n> -Alan Perlis\n\nWhen you buy a new appliance such as a television, it comes with an instruction booklet that lists troubleshooting hints in the following form:\n\n**PROBLEM**: Nothing works.\n\n**Diagnosis**: Power is off.\n\n**Remedy:** Plug in outlet and turn on power switch.\n\nIf your Lisp compiler came without such a handy instruction booklet, this chapter may be of some help.\nIt lists some of the most common difficulties that Lisp programmers encounter.\n\n## 25.1 Nothing Happens\n{:#s0010}\n{:.h1hd}\n\n**PROBLEM:** You type an expression to Lisp's read-eval-print loop and get no response-no result, no prompt.\n\n**Diagnosis:** There are two likely reasons why output wasn't printed: either Lisp is still doing read or it is still doing `eval`.\nThese possibilities can be broken down further into four cases:\n\n**Diagnosis:** If the expression you type is incomplete, Lisp will wait for more input to complete it.\nAn expression can be incomplete because you have left off a right parenthesis (or inserted an extra left parenthesis).\nOr you may have started a string, atom, or comment without finishing it.\nThis is particularly hard to spot when the error spans multiple lines.\nA string begins and ends with double-quotes: `\"string\"`; an atom containing unusual characters can be delimited by vertical bars: `| AN ATOM |` ; and a comment can be of the form `# | a comment | #`.\nHere are four incomplete expressions:\n\n```lisp\n(+ (* 3 (sqrt 5) 1)\n(format t \"~&X=~a, Y=~a. x y)\n(get '|strange-atom 'prop)\n(if (= x 0) #1 test if x is zero\n    y\n    x)\n```\n\n**Remedy:** Add a ), \", `|`, and `| #`, respectively.\nOr hit the interrupt key and type the input again.\n\n**Diagnosis:** Your program may be waiting for input.\n\n**Remedy:** Never do a `(read)` without first printing a prompt of some kind.\nIf the prompt does not end with a newline, a call to `finish-output` is also in order.\nIn fact, it is a good idea to call a function that is at a higher level than `read`.\nSeveral systems define the function `prompt-and-read`.\nHere is one version:\n\n```lisp\n(defun prompt-and-read (ctl-string &rest args)\n \"Print a prompt and read a reply.\"\n (apply #'format t ctl-string args)\n (finish-output)\n (read))\n```\n\n**Diagnosis:** The program may be caught in an infinite loop, either in an explicit `loop` or in a recursive function.\n\n**Remedy:** Interrupt the computation, get a back trace, and see what functions are active.\nCheck the base case and loop variant on active functions and loops.\n\n**Diagnosis:** Even a simple expression like (`mapc #'sqrt list`) or (`length list`) will cause an infinite loop if `list` is an infinite list-that is, a list that has some tail that points back to itself.\n\n**Remedy:** Be very careful any time you modify a structure with `nconc`, `delete`, `setf`, and so forth.\n\n**PROBLEM:** You get a new prompt from the read-eval-print loop, but no output was printed.\n\n**Diagnosis:** The expression you evaluated must have returned no values at all, that is, the result `(values)`.\n\n## 25.2 Change to Variable Has No Effect\n{:#s0015}\n{:.h1hd}\n\n**PROBLEM:** You redefined a variable, but the new value was ignored.\n\n**Diagnosis:** Altering a variable by editing and re-evaluating a `defvar` form will not change the variable's value, `defvar` only assigns an initial value when the variable is unbound.\n\n**Remedy:** Use setf to update the variable, or change the `defvar` to a `defparameter`.\n\n**Diagnosis:** Updating a locally bound variable will not affect a like-named variable outside that binding.\nFor example, consider:\n\n```lisp\n(defun check-ops (*ops*)\n (if (null *ops*)\n     (setf *ops* *default-ops*))\n (mapcar #'check-op *ops*))\n```\n\nIf `check - ops` is called with a null argument, the `*ops*` that is a parameter of `check - ops` will be updated, but the global `*ops*` will not be, even if it is declared special.\n\n**Remedy:** Don't shadow variables you want to update.\nUse a different name for the local variable.\nIt is important to distinguish special and local variables.\nStick to the naming convention for special variables: they should begin and end with asterisks.\nDon't forget to introduce a binding for all local variables.\nThe following excerpt from a recent textbook is an example of this error:\n\n```lisp\n(defun test ()\n (setq x 'test-data)   :*Warning!*\n (solve-problem x))    :*Don't do this.*\n```\n\nThis function should have been written:\n\n```lisp\n(defun test ()\n (let ((x 'test-data))   :*Do this instead.*\n   (solve-problem x)))\n```\n\n## 25.3 Change to Function Has No Effect\n{:#s0020}\n{:.h1hd}\n\n**PROBLEM:** You redefined a function, but the change was ignored.\n\n**Diagnosis:** When you change a macro, or a function that has been declared inline, the change will not necessarily be seen by users of the changed function.\n(It depends on the implementation.)\n\n**Remedy:** Recompile after changing a macro.\nDon't use inline functions until everything is debugged.\n(`Use (declare (notinline f)`) to cancel an inline declaration).\n\n**Diagnosis:** If you change a normal (non-inline) function, that change *will* be seen by code that refers to the function by *name*, but not by code that refers to the old value of the function itself.\nConsider:\n\n```lisp\n(defparameter *scorer* #'score-fn)\n(defparameter *printer* 'print-fn)\n(defun show (values)\n (funcall *printer*\n   (funcall *scorer* values)\n   (reduce #'better values)))\n```\n\nNow suppose that the definitions of `score - fn, print - fn`, and `better` are all changed.\nDoes any of the prior code have to be recompiled?\nThe variable *`printer`* can stay as is.\nWhen it is funcalled, the symbol `print-fn` will be consulted for the current functional value.\nWithin show, the expression # ' `better` is compiled into code that will get the current version of `better`, so it too is safe.\nHowever, the variable *`scorer`* must be changed.\nIts value is the old definition of `score-fn`.\n\n**Remedy:** Re-evaluate the definition of *`scorer`*.\nIt is unfortunate, but this problem encourages many programmers to use symbols where they really mean functions.\nSymbols will be coerced to the global function they name when passed to `funcall`or `apply`, but this can be the source of another error.\nIn the following example, the symbol `local - fn` will not refer to the locally bound function.\nOne needs to use `#'local - fn` to refer to it.\n\n```lisp\n(flet ((local-fn (x) ...))\n (mapcar 'local-fn list))\n```\n\n**Diagnosis:** If you changed the name of a function, did you change the name every-where?\nFor example, if you decide to change the name of `print-fn` to `print-function` but forget to change the value of *`printer`*, then the old function will be called.\n\n**Remedy:** Use your editor's global replace command.\nTo be even safer, redefine obsolete functions to call `error`.\nThe following function is handy for this purpose:\n\n```lisp\n(defun make-obsolete (fn-name)\n \"Print an error if an obsolete function is called.\"\n (setf (symbol-function fn-name)\n    #'(lambda (&rest args)\n       (declare (ignore args))\n       (error \"Obsolete function.\"))))\n```\n\n**Diagnosis:** Are you using `labels` and `flet` properly?\nConsider again the function `replace-?-vars`, which was defined in [section 11.3](B978008057115750011X.xhtml#s0025) to replace an anonymous logic variable with a unique new variable.\n\n```lisp\n(defun replace-?-vars (exp)\n \"Replace any ? within exp with a var of the form ?123.\"\n (cond ((eq exp '?) (gensym \"?\"))\n   ((atom exp) exp)\n   (t (cons (replace-?-vars (first exp))\n     (replace-?-vars (rest exp))))))\n```\n\nIt might occur to the reader that gensyming a different variable each time is wasteful.\nThe variables must be unique in each clause, but they can be shared across clauses.\nSo we could generate variables in the sequence `?1, ?2, ...`, intern them, and thus reuse these variables in the next clause (provided we warn the user never to use such variable names).\nOne way to do that is to introduce a local variable to hold the variable number, and then a local function to do the computation:\n\n```lisp\n(defun replace-?-vars (exp)\n \"Replace any ? within exp with a var of the form ?123.\"\n ;;*** Buggy Version ***\n (let ((n 0))\n   (flet\n    ((replace-?-vars (exp)\n     (cond ((eq exp '?) (symbol '? (incf n)))\n     ((atom exp) exp)\n     (t (cons (replace-?-vars (first exp))\n         (replace-?-vars (rest exp)))))))\n   (replace-?-vars exp))))\n```\n\nThis version doesn't work.\nThe problem is that `flet`, like `let`, defines a new function within the body of the `flet` but not within the new function's definition.\nSo two lessons are learned here: use `labels` instead of `flet` to define recursive functions, and don't shadow a function definition with a local definition of the same name (this second lesson holds for variables as well).\nLet's fix the problem by changing `labels` to `flet` and naming the local function `recurse`:\n\n```lisp\n(defun replace-?-vars (exp)\n \"Replace any ? within exp with a var of the form ?123.\"\n ;;*** Buggy Version ***\n (let ((n 0))\n   (labels\n    ((recurse (exp)\n     (cond ((eq exp '?) (symbol '? (incf n)))\n     ((atom exp) exp)\n     (t (cons (replace-?-vars (first exp))\n      (replace-?-vars (rest exp)))))))\n    (recurse exp))))\n```\n\nAnnoyingly, this version still doesn't work!\nThis time, the problem is carelessness; we changed the `replace- ? - vars to recurse` in two places, but not in the two calls in the body of `recurse`.\n\n**Remedy:** In general, the lesson is to make sure you call the right function.\nIf there are two functions with similar effects and you call the wrong one, it can be hard to see.\nThis is especially true if they have similar names.\n\n**PROBLEM:** Your closures don't seem to be working.\n\n**Diagnosis:** You may be erroneously creating a lambda expression by consing up code.\nHere's an example from a recent textbook:\n\n```lisp\n(defun make-specialization (c)\n (let (pred newc)\n  ...\n (setf (get newc 'predicate)\n  '(lambda (obj)  :Warning\n   (and ,(cons pred '(obj))  :Don't do this.\n   (apply '.(get c 'predicate) (list obj)))))\n  ...))\n```\n\nStrictly speaking, this is legal according to *Common Lisp the Language*, although in ANSI Common Lisp it will *not* be legal to use a list beginning with `lambda` as a function.\nBut in either version, it is a bad idea to do so.\nA list beginning with `lambda` is just that: a list, not a closure.\nTherefore, it cannot capture lexical variables the way a closure does.\n\n**Remedy:** The correct way to create a closure is to evaluate a call to the special form `function`, or its abbreviation, # '.\nHere is a replacement for the code beginning with '(`lambda ....` Note that it is a closure, closed over `pred` and `c`.\nAlso note that it gets the `predicate` each time it is called; thus, it is safe to use even when predicates are being changed dynamically.\nThe previous version would not work when a predicate is changed.\n\n```lisp\n#'(lambda (obj)      ; *Do this instead.*\n   (and (funcall pred obj)\n     (funcall (get c 'predicate) obj)))\n```\n\nIt is important to remember that `function` (and thus # ') is a special form, and thus only returns the right value when it is evaluated.\nA common error is to use # ' notation in positions that are not evaluated:\n\n```lisp\n(defvar *obscure-fns* '(#'cis #'cosh #'ash #'bit-orc2)) ; *wrong*\n```\n\nThis does not create a list of four functions.\nRather, it creates a list of four sublists; the first sublist is (`function cis`).\nIt is an error to funcall or apply such an object.\nThe two correct ways to create a list of functions are shown below.\nThe first assures that each function special form is evaluated, and the second uses function names instead of functions, thus relying on `funcall` or `apply` to coerce the names to the actual functions.\n\n```lisp\n(defvar *obscure-fns* (list #'cis #'cosh #'ash #'bit-orc2))\n(defvar *obscure-fns* '(cis cosh ash bit-orc2))\n```\n\nAnother common `error` is to expect # ' `if` or # ' `or` to return a function.\nThis is an error because special forms are just syntactic markers.\nThere is no function named `if` or `or`; they should be thought of as directives that tell the compiler what to do with a piece of code.\n\nBy the way, the function `make` - `specialization` above is bad not only for its lack of `function` but also for its use of backquote.\nThe following is a better use of backquote:\n\n```lisp\n'(lambda (obj)\n  (and (,pred obj)\n    (,(get c 'predicate) obj)))\n```\n\n## 25.4 Values Change \"by Themselves\"\n{:#s0025}\n{:.h1hd}\n\n**PROBLEM:** You deleted/removed something, but it didn't take effect.\nFor example:\n\n```lisp\n> (setf numbers '(1 2 3 4 5))`=> `(1 2 3 4 5)\n> (remove 4 numbers)`=> `(1 2 3 5)\n> numbers`=> `(1 2 3 4 5)\n> (delete 1 numbers)`=> `(2 3 4 5)\n> numbers`=> `(1 2 3 4 5)\n```\n\n**Remedy:** Use (`setf numbers` (`delete 1 numbers`)).\nNote that `remove` is a non-destructive function, so it will never alter its arguments, `delete` is destructive, but when asked to delete the first element of a list, it returns the rest of the list, and thus does not alter the list itself.\nThat is why `setf` is necessary.\nSimilar remarks hold for `nconc`, `sort`, and other destructive operations.\n\n**PROBLEM:** You created a hundred different structures and changed a field in one of them.\nSuddenly, all the other ones magically changed!\n\n**Diagnosis:** Different structures may share identical subfields.\nFor example, suppose you had:\n\n```lisp\n(defstruct block\n (possible-colors '(red green blue))\n ...)\n (setf bl (make-block))\n (setf b2 (make-block))\n ...\n (delete 'green (block-possible-colors bl))\n```\n\nBoth `b1` and `b2` share the initial list of possible colors.\nThe `delete` function modifies this shared list, so `green` is deleted from `b2`'s possible colors list just as surely as it is deleted from `b1`'s.\n\n**Remedy:** Don't share pieces of data that you want to alter individually.\nIn this case, either use `remove` instead of `delete`, or allocate a different copy of the list to each instance:\n\n```lisp\n(defstruct block\n (possible-colors (list 'red 'green 'blue))\n ...)\n```\n\nRemember that the initial value field of a defstruct is an expression that is evaluated anew each time `make-block` is called.\nIt is incorrect to think that the initial form is evaluated once when the `defstruct` is defined.\n\n## 25.5 Built-In Functions Don't Find Elements\n{:#s0030}\n{:.h1hd}\n\n**PROBLEM:** You tried (`find item list`), and you know it is there, but it wasn't found.\n\n**Diagnosis:** By default, many built-in functions use `eql` as an equality test, `find` is one of them.\nIf `item` is, say, a list that is `equal` but not `eql` to one of the elements of `list`, it will not be found.\n\n**Remedy:** Use (`find item list :test #'equal`)\n\n**Diagnosis:** If the `item` is nil, then nil will be returned whether it is found or not.\n\n**Remedy:** Use `member` or `position` instead of `find` whenever the item can be nil.\n\n## 25.6 Multiple Values Are Lost\n{:#s0035}\n{:.h1hd}\n\n**PROBLEM:** You only get one of the multiple values you were expecting.\n\n**Diagnosis:** In certain contexts where a value must be tested by Lisp, multiple values are discarded.\nFor example, consider:\n\n```lisp\n(or (mv-1 x) (mv-2 x))\n(and (mv-1 x) (mv-2 x))\n(cond ((mv-1 x))\n (t (mv-2 x)))\n```\n\nIn each case, if `mv-2` returns multiple values, they will all be passed on.\nBut if `mv-1` returns multiple values, only the first value will be passed on.\nThis is true even in the last clause of a cond.\nSo, while the final clause (`t (mv-2 x)`) passes on multiple values, the final clause (`(mv-2 x )`) would not.\n\n**Diagnosis:** Multiple values can be inadvertently lost in debugging as well.\nSuppose I had:\n\n```lisp\n(multiple-value-bind (a b c)\n (mv-1 x)\n  ...)\n```\n\nNow, if I become curious as to what `mv -1` returns, I might change this code to:\n\n```lisp\n(multiple-value-bind (a b c)\n (print (mv-1 x)) ;*** debugging output\n ...)\n```\n\nUnfortunately, `print` will see only the first value returned by `mv-1`, and will return only that one value to be bound to the variable a.\nThe other values will be discarded, and `b` and `c` will be bound to `nil`.\n\n## 25.7 Declarations Are Ignored\n{:#s0040}\n{:.h1hd}\n\n**PROBLEM:** Your program uses 1024 x 1024 arrays of floating-point numbers.\nBut you find that it takes 15 seconds just to initialize such an array to zeros!\nImagine how inefficient it is to actually do any computation!\nHere is your function that zeroes an array:\n\n```lisp\n(defun zero-array (arr)\n \"Set the 1024x1024 array to all zeros.\"\n (declare (type (array float) arr))\n (dotimes (i 1024)\n  (dotimes (j 1024)\n   (setf (aref arr i j) 0.0))))\n```\n\n**Diagnosis:** The main problem here is an ineffective declaration.\nThe type (`array float`) does not help the compiler, because the array could be displaced to an array of another type, and because `float` encompasses both single- and double-precision floating-point numbers.\nThus, the compiler is forced to allocate storage for a new copy of the number 0.0 for each of the million elements of the array.\nThe function is slow mainly because it generates so much garbage.\n\n**Remedy:** The following version uses a much more effective type declaration: a simple array of single-precision numbers.\nIt also declares the size of the array and turns safety checks off.\nIt runs in under a second on a SPARCstation, which is slower than optimized C, but faster than unoptimized C.\n\n```lisp\n(defun zero-array (arr)\n \"Set the array to all zeros.\"\n (declare (type (simple-array single-float (1024 1024)) arr)\n     (optimize (speed 3) (safety 0)))\n (dotimes (i 1024)\n  (dotimes (j 1024)\n   (setf (aref arr i j) 0.0))))\n```\n\nAnother common error is to use something like (`simple-vector fixnum`) asatype specifier.\nIt is a quirk of Common Lisp that the `simple-vector` type specifier only accepts a size, not a type, while the `array, vector` and `simple-array` specifiers all accept an optional type followed by an optional size or list of sizes.\nTo specify a simple vector of fixnums, use (`simple-array fixnum (*)`).\n\nTo be precise, `simple-vector` means (`simple-array t (*)`).\nThis means that `simple-vector` cannot be used in conjunction with any other type specifier.\nA common mistake is to think that the type (`and simple-vector (vector fixnum)`) is equivalent to (`simple-array fixnum (*)`), a simple, one-dimensional vector of fixnums.\nActually, it is equivalent to (`simple-array t (*)`), a simple one-dimensional array of any type elements.\nTo eliminate this problem, avoid `simple- vector` altogether.\n\n## 25.8 My Lisp Does the Wrong Thing\n{:#s0045}\n{:.h1hd}\n\nWhen all else fails, it is tempting to shift the blame for an error away from your own code and onto the Common Lisp implementation.\nIt is certainly true that errors are found in existing implementations.\nBut it is also true that most of the time, Common Lisp is merely doing something the user did not expect rather than something that is in error.\n\nFor example, a common \"bug report\" is to complain about read - `from- string`.\nA user might write:\n\n```lisp\n(read-from-string \"a b c\" :start 2)\n```\n\nexpecting the expression to start reading at position `2` and thus return `b`.\nIn fact, this expression returns a.\nThe angry user thinks the implementation has erroneously ignored the :`start` argument and files a bug report,[1](#fn0010) only to get back the following explanation:\n\nThe function `read-from-string` takes two optional arguments, `eof-errorp` and `eof-value`, in addition to the keyword arguments.\nThus, in the expression above, : `start` is taken as the value of `eof-errorp`, with `2` as the value of `eof-value`.\nThe correct answer is in fact to read from the start of the string and return the very first form, a.\n\nThe functions `read-from-string` and `parse-namestring` are the only built-in functions that have this problem, because they are the only ones that have both optional and keyword arguments, with an even number of optional arguments.\nThe functions `write-line` and `write-string` have keyword arguments and a single optional argument (the stream), so if the stream is accidently omitted, an error will be signaled.\n(If you type (`write-line str :start 4`), the system will complain either that : `start` is not a stream or that 4 is not a keyword.)\n\nThe moral is this: functions that have both optional and keyword arguments are confusing.\nTake care when using existing functions that have this problem, and abstain from using both in your own functions.\n\n## 25.9 How to Find the Function You Want\n{:#s0050}\n{:.h1hd}\n\nVeteran Common Lisp programmers often experience a kind of software *d&eacute;j&agrave; vu:* they believe that the code they are writing could be done by a built-in Common Lisp function, but they can't remember the name of the function.\n\nHere's an example: while coding up a problem I realized I needed a function that, given the lists (`a b c d`) and (`c d`), would return (`a b`), that is, the part of the first list without the second list.\nI thought that this was the kind of function that might be in the standard, but I didn't know what it would be called.\nThe desired function is similar to `set-difference`, so I looked that up in the index of *Common Lisp the Language* and was directed to page 429.\nI browsed through the section on \"using lists as sets\" but found nothing appropriate.\nHowever, I was reminded of the function `butlast`, which is also similar to the desired function.\nThe index directed me to page 422 for `butlast`, and on the same page I found `ldiff`, which was exactly the desired function.\nIt might have been easier to find (and remember) if it were called `list-difference`, but the methodology of browsing near similar functions paid off.\n\nIf you think you know part of the name of the desired function, then you can use apropos to find it.\nFor example, suppose I thought there was a function to push a new element onto the front of an array.\nLooking under `array, push-array`, and `array - push` in the index yields nothing.\nBut I can turn to Lisp itself and ask:\n\n```lisp\n> (apropos \"push\")\nPUSH               Macro     (VALUE PLACE), plist\nPUSHNEW            Macro     (VALUE PLACE &KEY ...), plist\nVECTOR-PUSH        function  (NEW-ELEMENT VECTOR), plist\nVECTOR-PUSH-EXTEND function  (DATA VECTOR &OPTIONAL ...), plist\n```\n\nThis should be enough to remind me that `vector-push` is the answer.\nIf not, I can get more information from the manual or from the online functions `documentation` or `describe`:\n\n```lisp\n> (documentation 'vector-push 'function)\n\"Add NEW-ELEMENT as an element at the end of VECTOR.\nThe fill pointer (leader element 0) is the index of the next\nelement to be added. If the array is full, VECTOR-PUSH returns\nNIL and the array is unaffected; use VECTOR-PUSH-EXTEND instead\nif you want the array to grow automatically.\"\n```\n\nAnother possibility is to browse through existing code that performs a similar purpose.\nThat way, you may find the exact function you want, and you may get additional ideas on how to do things differently.\n\n## 25.10 Syntax of LOOP\n{:#s0055}\n{:.h1hd}\n\n`loop` by itself is a powerful programming language, one with a syntax quite different from the rest of Lisp.\nIt is therefore important to exercise restraint in using `loop`, lest the reader of your program become lost.\nOne simple rule for limiting the complexity of `loops` is to avoid the `with` and and keywords.\nThis eliminates most problems dealing with binding and scope.\n\nWhen in doubt, macro-expand the loop to see what it actually does.\nBut if you need to macro-expand, then perhaps it would be clearer to rewrite the loop with more primitive constructs.\n\n## 25.11 Syntax of COND\n{:#s0060}\n{:.h1hd}\n\nFor many programmers, the special form cond is responsible for more syntax errors than any other, with the possible exception of `loop`.\nBecause most cond-clause start with two left parentheses, beginners often come to the conclusion that every clause must.\nThis leads to errors like the following:\n\n```lisp\n(let ((entry (assoc item list)))\n (cond ((entry (process entry)))\n     ...))\n```\n\nHere entry is a variable, but the urge to put in an extra parenthesis means that the cond-clause attempts to call entry as a function rather than testing its value as a variable.\n\nThe opposite problem, leaving out a parenthesis, is also a source of error:\n\n```lisp\n(cond (lookup item list)\n (t nil))\n```\n\nIn this case, `lookup` is accessed as a variable, when the intent was to call it as a function.\nIn Common Lisp this will usually lead to an unbound variable error, but in Scheme this bug can be very difficult to pin down: the value of `lookup` is the function itself, and since this is not null, the test will succeed, and the expression will return `list` without complaining.\n\nThe moral is to be careful with cond, especially when using Scheme.\nNote that `if` is much less error prone and looks just as nice when there are no more than two branches.\n\n## 25.12 Syntax of CASE\n{:#s0065}\n{:.h1hd}\n\nIn a `case` special form, each clause consists of a key or list of keys, followed by the value of that case.\nThe thing to watch out for is when the key is `t`, `otherwise`, or `nil`.\nFor example:\n\n```lisp\n(case letter\n (s ...)\n (t ...)\n (u ...))\n```\n\nHere the t is taken as the default clause; it will always succeed, and all subsequent clauses will be ignored.\nSimilarly, using a () `ornil` as a key will not have the desired effect: it will be interpreted as an empty key list.\nIf you want to be completely safe, you can use a list of keys for every clause.[2](#fn0015) This is a particularly good idea when you write a macro that expands into a `case`.\nThe following code correctly tests for `t` and `nil` keys:\n\n```lisp\n(case letter\n ((s) ...)\n ((t) ...)\n ((u) ...)\n ((nil) ...))\n```\n\n## 25.13 Syntax of LET and LET*\n{:#s0070}\n{:.h1hd}\n\nA common error is leaving off a layer of parentheses in `let`, just like in cond.\nAnother error is to refer to a variable that has not yet been bound in a `let`.\nTo avoid this problem, use `let*` whenever a variable's initial binding refers to a previous variable.\n\n## 25.14 Problems with Macros\n{:#s0075}\n{:.h1hd}\n\nIn [section 3.2](B9780080571157500030.xhtml#s0015) we described a four-part approach to the design of macros:\n\n*  Decide if the macro is really necessary.\n\n*  Write down the syntax of the macro.\n\n*  Figure out what the macro should expand into.\n\n*  Use `defmacro` to implement the syntax/expansion correspondence.\nThis section shows the problems that can arise in each part, starting with the first:\n\n*  Decide if the macro is really necessary.\n\nMacros extend the rules for evaluating an expression, while function calls obey the rules.\nTherefore, it can be a mistake to define too many macros, since they can make it more difficult to understand a program.\nA common mistake is to define macros that *do not* violate the usual evaluation rules.\nOne recent book on AI programming suggests the following:\n\n```lisp\n(defmacro binding-of (binding)  ; *Warning!*\n  '(cadr .binding))             ; *Don't do this.*\n```\n\nThe only possible reason for this macro is an unfounded desire for efficiency.\nAlways use an `inline` function instead of a macro for such cases.\nThat way you get the efficiency gain, you have not introduced a spurious macro, and you gain the ability to `apply` or `map` the function # ' `binding - of`, something you could not do with a macro:\n\n```lisp\n(proclaim '(inline binding-of))\n(defun binding-of (binding)  ; *Do this instead.*\n (second binding))\n```\n\n*  Write down the syntax of the macro.\n\nTry to make your macro follow conventions laid down by similar macros.\nFor example, if your macro defines something, it should obey the conventions of `defvar, defstruct, defmacro,` and the rest: start with the letters `def`, take the name of the thing to be defined as the first argument, then a lambda-list if appropriate, then a value or body.\nIt would be nice to allow for optional declarations and documentation strings.\n\nIf your macro binds some variables or variablelike objects, use the conventions laid down by `let, let*,` and `labels`: allow for a list of variable or ( *variable init-val)* pairs.\nIf you are iterating over some kind of sequence, follow `dotimes` and `dolist`.\nFor example, here is the syntax of a macro to iterate over the leaves of a tree of conses:\n\n```lisp\n(defmacro dotree ((var tree &optional result) &body body)\n \"Perform body with var bound to every leaf of tree,\n then return result. Return and Go can be used in body.\"\n ...)\n```\n\n*  Figure out what the macro should expand into.\n\n*  Use defmacro to implement the syntax/expansion correspondence.\n\nThere are a number of things to watch out for in figuring out how to expand a macro.\nFirst, make sure you don't shadow local variables.\nConsider the following definition for `pop - end`, a function to pop off and return the last element of a list, while updating the list to no longer contain the last element.\nThe definition uses `last1`, which was defined on page 305 to return the last element of a list, and the built-in function `nbutlast` returns all but the last element of a list, destructively altering the list.\n\n```lisp\n(defmacro pop-end (place)  ; *Warning!Buggy!*\n \"Pop and return last element of the list in PLACE.\"\n '(let ((result (lastl .place)))\n   (setf .place (nbutlast .place))\n   result))\n```\n\nThis will do the wrong thing for (`pop-end result`), or for other expressions that mention the variable `result`.\nThe solution is to use a brand new local variable that could not possibly be used elsewhere:\n\n```lisp\n(defmacro pop-end (place)  ; *Less buggy*\n \"Pop and return last element of the list in PLACE.\"\n (let ((result (gensym)))\n '(let ((,result (lastl ,place)))\n  (setf ,place (nbutlast ,place))\n   ,result)))\n```\n\nThere is still the problem of shadowing local *functions.* For example, a user who writes:\n\n```lisp\n(flet ((lastl (x) (sqrt x)))\n (pop-end list)\n ...)\n```\n\nwill be in for a surprise, pop-end will expand into code that calls `lastl`, but since `lastl` has been locally defined to be something else, the code won't work.\nThus, the expansion of the macro violates referential transparency.\nTo be perfectly safe, we could try:\n\n```lisp\n(defmacro pop-end (place)  ; *Less buggy*\n \"Pop and return last element of the list in PLACE.\"\n (let ((result (gensym)))\n  '(let ((.result (funcall .#'lastl .place)))\n   (setf .place (funcall .#'nbutlast .place))\n    ,result)))\n```\n\nThis approach is sometimes used by Scheme programmers, but Common Lisp programmers usually do not bother, since it is rarer to define local functions in Common Lisp.\nIndeed, in *Common Lisp the Language*, 2d edition, it was explicitly stated (page 260) that a user function cannot redefine or even bind any built-in function, variable, or macro.\nEven if it is not prohibited in your implementation, redefining or binding a built-in function is confusing and should be avoided.\n\nCommon Lisp programmers expect that arguments will be evaluated in left-to-right order, and that no argument is evaluated more than once.\nOur definition of `pop-end` violates the second of these expectations.\nConsider:\n\n```lisp\n(pop-end (aref lists (incf i))) =\n(LET ((#:G3096 (LAST1 (AREF LISTS (INCF I)))))\n (SETF (AREF LISTS (INCF I)) (NBUTLAST (AREF LISTS (INCF I))))\n #:G3096)\n```\n\nThis increments `i` three times, when it should increment it only once.\nWe could fix this by introducing more local variables into the expansion:\n\n```lisp\n(let* ((templ (incf i))\n   (temp2 (AREF LISTS temp1))\n   (temp3 (LAST1 temp2)))\n (setf (aref lists templ) (nbutlast temp2))\n temp3)\n```\n\nThis kind of left-to-right argument processing via local variables is done automatically by the Common Lisp setf mechanism.\nFortunately, the mechanism is easy to use.\nWe can redefine `pop-end` to call `pop` directly:\n\n```lisp\n(defmacro pop-end (place)\n \"Pop and return last element of the list in PLACE.\"\n '(pop (last ,place)))\n```\n\nNow all we need to do is define the `setf` method for `last`.\nHere is a simple definition.\nIt makes use of the function `last2`, which returns the last two elements of a list.\nIn ANSI Common Lisp we could use (`last list 2`), but with a pre-ANSI compiler we need to define `last2`:\n\n```lisp\n(defsetf last (place) (value)\n '(setf (cdr (last2 .place)) .value))\n(defun last2 (list)\n \"Return the last two elements of a list.\"\n (if (null (rest2 list))\n   list\n   (last2 (rest list))))\n```\n\nHere are some macro-expansions of calls to `pop-end` and to the `setf` method for `last`.\nDifferent compilers will produce different code, but they will always respect the left-to-right, one-evaluation-only semantics:\n\n```lisp\n> (pop-end (aref (foo lists) (incf i))) =\n(LET ((G0128 (AREF (FOO LISTS) (SETQ I (+ I 1)))))\n (PROG1\n (CAR (LAST G0128))\n (SYS:SETCDR (LAST2 G0128) (CDR (LAST G0128)))))\n> (setf (last (append x y)) 'end) =\n(SYS:SETCDR (LAST2 (APPEND X Y)) 'END)\n```\n\nUnfortunately, there is an error in the `setf` method for `last`.\nIt assumes that the list will have at least two elements.\nIf the list is empty, it is probably an error, but if a list has exactly one element, then (`setf` (`last`*list) val)* should have the same effect as (`setf`*list val).* But there is no way to do that with `defsetf`, because the `setf` method defined by `defsetf` never sees *list* itself.\nInstead, it sees a local variable that is automatically bound to the value of *list.* In other words, `defsetf` evaluates the *list* and *val* for you, so that you needn't worry about evaluating the arguments out of order, or more than once.\n\nTo solve the problem we need to go beyond the simple `defsetf` macro and delve into the complexities of `define-setf-method`, one of the trickiest macros in all of Common Lisp.\n`define-setf-method` defines a setf method not by writing code directly but by specifying five values that will be used by Common Lisp to write the code for a call to `setf`.\nThe five values give more control over the exact order in which expressions are evaluated, variables are bound, and results are returned.\nThe five values are: (1) a list of temporary, local variables used in the code; (2) a list of values these variables should be bound to; (3) a list of one variable to hold the value specified in the call to `setf`; (4) code that will store the value in the proper place; (5) code that will access the value of the place.\nThis is necessary for variations of `setf` like `inef` and `pop`, which need to both access and store.\n\nIn the following `setf` method for `last`, then, we are defining the meaning of (`setf` (`last place`) `value`).\nWe keep track of all the variables and values needed to evaluate `place`, and add to that three more local variables: `last2`-var will hold the last two elements of the list, `last2`-p will be true only if there are two or more elements in the list, and `last-var` will hold the form to access the last element of the list.\nWe also make up a new variable, `result`, to hold the `value`.\nThe code to store the value either modifies the cdr of `last2-var`, if the list is long enough, or it stores directly into `place`.\nThe code to access the value just retrieves `last - var`.\n\n```lisp\n(define-setf-method last (place)\n (multiple-value-bind (temps vais stores store-form access-form)\n    (get-setf-method place)\n  (let ((result (gensym))\n     (last2-var (gensym))\n     (last2-p (gensym))\n     (last-var (gensym)))\n    ;; Return 5 vais: temps vais stores store-form access-form\n    (values\n     '(.@temps .last2-var .last2-p .last-var)\n     '(.@vais (last2 .access-form)\n      (= (length .last2-var) 2)\n      (if .last2-p (rest .last2-var) .access-form))\n     (list result)\n     '(if .last2-p\n      (setf (cdr .last2-var) .result)\n      (let ((.(first stores) .result))\n       .store-form))\n     last-var))))\n```\n\nIt should be mentioned that `setf` methods are very useful and powerful things.\nIt is often better to provide a `setf` method for an arbitrary function, `f`, than to define a special setting function, say, `set-f`.\nThe advantage of the `setf` method is that it can be used in idioms like `incf` and `pop`, in addition to `setf` itself.\nAlso, in ANSI Common Lisp, it is permissible to name a function with # ' (`setf f`), so you can also use map or apply the `setf` method.\nMost `setf` methods are for functions that just access data, but it is permissible to define `setf` methods for functions that do any computation whatsoever.\nAs a rather fanciful example, here is a `setf` method for the square-root function.\nIt makes (`setf (sqrt x) 5`) be almost equivalent to (`setf x (* 5 5)`) ; the difference is that the first returns 5 while the second returns 25.\n\n```lisp\n(define-setf-method sqrt (num)\n (multiple-value-bind (temps vals stores store-form access-form)\n    (get-setf-method num)\n  (let ((store (gensym)))\n    (values temps\n          vals\n          (list store)\n          '(let ((,(first stores) (* .store .store)))\n            ,store-form\n            ,store)\n          '(sqrt .access-form)))))\n```\n\nTurning from `setf` methods back to macros, another hard part about writing portable macros is anticipating what compilers might warn about.\nLet's go back to the `dotree` macro.\nIts definition might look in part like this:\n\n```lisp\n(defmacro dotree ((var tree &optional result) &body body)\n \"Perform body with var bound to every leaf of tree.\n then return result. Return and Go can be used in body.\"\n '(let ((.var))\n   ...\n   ,@body))\n```\n\nNow suppose a user decides to count the leaves of a tree with:\n\n```lisp\n(let ((count 0))\n  (dotree (leaf tree count)\n    (incf count)))\n```\n\nThe problem is that the variable `leaf` is not used in the body of the macro, and a compiler may well issue a warning to that effect.\nTo make matters worse, a conscientious user might write:\n\n```lisp\n(let ((count 0))\n (dotree (leaf tree count)\n  (declare (ignore leaf))\n   (incf count)))\n```\n\nThe designer of a new macro must decide if declarations are allowed and must make sure that compiler warnings will not be generated unless they are warranted.\n\nMacros have the full power of Lisp at their disposal, but the macro designer must remember the purpose of a macro is to translate macro code into primitive code, and not to do any computations.\nConsider the following macro, which assumes that `translate - rule-body` is defined elsewhere:\n\n```lisp\n(defmacro defrule (name &body body)  ; Warning! buggy!\n \"Define a new rule with the given name.\"\n (setf (get name 'rule)\n    '#'(lambda O ,(translate-rule-body body))))\n```\n\nThe idea is to store a function under the `rule` property of the rule's name.\nBut this definition is incorrect because the function is stored as a side effect of expanding the macro, rather than as an effect of executing the expanded macro code.\nThe correct definition is:\n\n```lisp\n(defmacro defrule (name &body body)\n \"Define a new rule with the given name.\"\n '(setf (get '.name 'rule)\n #'(lambda () .(translate-rule-body body))))\n```\n\nBeginners sometimes fail to see the difference between these two approaches, because they both have the same result when interpreting a file that makes use of `defrule`.\nBut when the file is compiled and later loaded into a different Lisp image, the difference becomes clear: the first definition erroneously stores the function in the compiler's image, while the second produces code that correctly stores the function when the code is loaded.\n\nBeginning macro users have asked, \"How can I have a macro that expands into code that does more than one thing?\nCan I splice in the results of a macro?\"\n\nIf by this the beginner wants a macro that just *does* two things, the answer is simply to use a progn.\nThere will be no efficiency problem, even if the progn forms are nested.\nThat is, if macro-expansion results in code like:\n\n```lisp\n(progn (progn (progn *a b*) c) (progn *d e))*\n```\n\nthe compiler will treat it the same as `(progn *abc de).*`\n\nOn the other hand, if the beginner wants a macro that *returns* two values, the proper form is val ues, but it must be understood that the calling function needs to arrange specially to see both values.\nThere is no way around this limitation.\nThat is, there is no way to write a macro-or a function for that matter-that will \"splice in\" its results to an arbitrary call.\nFor example, the function `floor` returns two values (the quotient and remainder), as does i ntern (the symbol and whether or not the symbol already existed).\nBut we need a special form to capture these values.\nFor example, compare:\n\n```lisp\n> (list (floor 11 5) (intern 'x))=M2 X)\n> (multiple-value-call #'list\n (floor 11 5) (intern 'x))=>(2 1 X :INTERNAL)\n```\n\n## 25.15 A Style Guide to Lisp\n{:#s0080}\n{:.h1hd}\n\nIn a sense, this whole book is a style guide to writing quality Lisp programs.\nBut this section attempts to distill some of the lessons into a set of guidelines.\n\n### When to Define a Function\n{:#s0085}\n{:.h2hd}\n\nLisp programs tend to consist of many short functions, in contrast to some languages that prefer a style using fewer, longer functions.\nNew functions should be introduced for any of the following reasons:\n\n1. For a specific, easily stated purpose.\n!!!(p) {:.numlist}\n\n2. To break up a function that is too long.\n!!!(p) {:.numlist}\n\n3. When the name would be useful documentation.\n!!!(p) {:.numlist}\n\n4. When it is used in several places.\n!!!(p) {:.numlist}\n\nIn (2), it is interesting to consider what \"too long\" means.\n[Charniak et al.\n(1987)](B9780080571157500285.xhtml#bb0180) suggested that 20 lines is the limit.\nBut now that large bit-map displays have replaced 24-line terminals, function definitions have become longer.\nSo perhaps one screenful is a better limit than 20 lines.\nThe addition of `flet` and `labels` also contributes to longer function definitions.\n\n### When to Define a Special Variable\n{:#s0090}\n{:.h2hd}\n\nIn general, it is a good idea to minimize the use of special variables.\nLexical variables are easier to understand, precisely because their scope is limited.\nTry to limit special variables to one of the following uses:\n\n1. For parameters that are used in many functions spread throughout a program.\n!!!(p) {:.numlist}\n\n2. For global, persistant, mutable data, such as a data base of facts.\n!!!(p) {:.numlist}\n\n3. For infrequent but deeply nested use.\n!!!(p) {:.numlist}\n\nAn example of (3) might be a variable like `*standard-output*`, which is used by low-level priniting functions.\nIt would be confusing to have to pass this variable around among all your high-level functions just to make it available to `print`.\n\n### When to Bind a Lexical Variable\n{:#s0095}\n{:.h2hd}\n\nIn contrast to special variables, lexical variables are encouraged.\nYou should feel free to introduce a lexical variable (with `a let, lambda` or `defun`) for any of the following reasons:\n\n1. To avoid typing in the same expression twice.\n!!!(p) {:.numlist}\n\n2. To avoid Computing the same expression twice.\n!!!(p) {:.numlist}\n\n3. When the name would be useful documentation.\n!!!(p) {:.numlist}\n\n4. To keep the indentation manageable.\n!!!(p) {:.numlist}\n\n### How to Choose a Name\n{:#s0100}\n{:.h2hd}\n\nYour choice of names for functions, variables, and other objects should be clear, meaningful, and consistent.\nSome of the conventions are listed here:\n\n1. Use mostly letters and hyphens, and use full words: `delete-file`.\n!!!(p) {:.numlist}\n\n2. You can introduce an abbreviation if you are consistent: `get-dtree`, `dtree-fetch`.\nFor example, this book uses `fn` consistently as the abbreviation for \"function.\"\n!!!(p) {:.numlist}\n\n3. Predicates end in - `p` (or ? in Scheme), unless the name is already a predicate: `variable-p`, `occurs-in`.\n!!!(p) {:.numlist}\n\n4. Destructive functions start with n (or end in ! in Scheme): nreverse.\n!!!(p) {:.numlist}\n\n5. Generalized variable-setting macros end in `f`: `setf`, `incf`.\n(`Push` is an exception.)\n!!!(p) {:.numlist}\n\n6. Slot selectors created by `defstruct` are of the form *type-slot.* Use this for `non-defstruct` selectors as well: `char-bits`.\n!!!(p) {:.numlist}\n\n7. Many functions have the form *action-object:*`copy-list, delete-file`.\n!!!(p) {:.numlist}\n\n8. Other functions have the form *object-modifier:*`list-length, char-lessp`.\nBe consistent in your choice between these two forms.\nDon't have `print-edge` and `vertex-print` in the same system.\n!!!(p) {:.numlist}\n\n9. A function of the form *modulename-functionname* is an indication that packages are needed.\nUse parser: `print-tree` instead of `parser-print-tree`.\n!!!(p) {:.numlist}\n\n10. Special variables have asterisks: `*db*, *print-length*`.\n!!!(p) {:.numlista}\n\n11. Constants do not have asterisks: `pi, most-positive-fixnum`.\n!!!(p) {:.numlista}\n\n12. Parameters are named by type: (`defun length (sequence) ...)` or by purpose: (`defun subsetp(subset superset) ...`) or both: (`defun / (number &rest denominator-numbers) ...`)\n!!!(p) {:.numlista}\n\n13. Avoid ambiguity.\nA variable named `last-node` could have two meanings; use `previous` -`node` or `final` - `node` instead.\n!!!(p) {:.numlista}\n\n14. A name like `propagate-constraints-to-neighboring-vertexes` is too long, while `prp-con` is too short.\nIn deciding on length, consider how the name will be used: `propagate-constraints` is just right, because a typical call will be `(propagate-const rai nts vertex)`, so it will be obvious what the constraints are propagating to.\n!!!(p) {:.numlista}\n\n### Deciding on the Order of Parameters\n{:#s0105}\n{:.h2hd}\n\nOnce you have decided to define a function, you must decide what parameters it will take, and in what order.\nIn general,\n\n1. Put important parameters first (and optional ones last).\n!!!(p) {:.numlist}\n\n2. Make it read like prose if possible: (`push element stack`).\n!!!(p) {:.numlist}\n\n3. Group similar parameters together.\n!!!(p) {:.numlist}\n\nInterestingly, the choice of a parameter list for top-level functions (those that the user is expected to call) depends on the environment in which the user will function.\nIn many systems the user can type a keystroke to get back the previous input to the top level, and can then edit that input and re-execute it.\nIn these systems it is preferable to have the parameters that are likely to change be at the end of the parameter list, so that they can be easily edited.\nOn systems that do not offer this kind of editing, it is better to either use keyword parameters or make the highly variable parameters first in the list (with the others optional), so that the user will not have to type as much.\n\nMany users want to have *required* keyword parameters.\nIt turns out that all keyword parameters are optional, but the following trick is equivalent to a required keyword parameter.\nFirst we define the function `required` to signal an error, and then we use a call to `required` as the default value for any keyword that we want to make required:\n\n```lisp\n(defun required ()\n (error \"A required keyword argument was not supplied.\"))\n(defun fn (x &key (y (required)))\n ...)\n```\n\n## 25.16 Dealing with Files, Packages, and Systems\n{:#s0110}\n{:.h1hd}\n\nWhile this book has covered topics that are more advanced than any other Lisp text available, it is still concerned only with programming in the small: a single project at a time, capable of being implemented by a single programmer.\nMore challenging is the problem of programming in the large: building multiproject, multiprogrammer systems that interact well.\n\nThis section briefly outlines an approach to organizing a larger project into man-ageable components, and how to place those components in files.\n\nEvery system should have a separate file that defines the other files that comprise the system.\nI recommend defining any packages in that file, although others put package definitions in separate files.\n\nThe following is a sample file for the mythical system Project-X.\nEach entry in the file is discussed in turn.\n\n1. The first line is a comment known as the *mode line.* The text editor emacs will parse the characters between -*- delimiters to discover that the file contains Lisp code, and thus the Lisp editing commands should be made available.\nThe dialect of Lisp and the package are also specified.\nThis notation is becoming widespread as other text editors emulate emacs's conventions.\n!!!(p) {:.numlist}\n\n2. Each file should have a description of its contents, along with information on the authors and what revisions have taken place.\n!!!(p) {:.numlist}\n\n3. Comments with four semicolons (`;;;;`) denote header lines.\nMany text editors supply a command to print all such lines, thus achieving an outline of the major parts of a file.\n!!!(p) {:.numlist}\n\n4. The first executable form in every file should be an `in-package`.\nHere we use the user package.\nWe will soon create the `project-x package`, and it will be used in all subsequent files.\n!!!(p) {:.numlist}\n\n5. We want to define the Project-X system as a collection of files.\nUnfortunately, Common Lisp provides no way to do that, so we have to load our own system-definition functions explicitly with a call to `load`.\n!!!(p) {:.numlist}\n\n6. The call to `define - system` specifies the files that make up Project-X.\nWe provide a name for the system, a directory for the source and object files, and a list of *modules* that make up the system.\nEach module is a list consisting of the module name (a symbol) followed by a one or more files (strings or pathnames).\nWe have used keywords as the module names to eliminate any possible name conflicts, but any symbol could be used.\n!!!(p) {:.numlist}\n\n7. The call to `defpackage` defines the package `project-x`.\nFor more on packages, see section 24.1.\n!!!(p) {:.numlist}\n\n8. The final form prints instructions on how to load and run the system.\n!!!(p) {:.numlist}\n\n```lisp\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: User -*-\n;;; (Brief description of system here.)\n;;;; Define the Project-X system.\n(in-package \"USER\")\n(load \"/usr/norvig/defsys.lisp\") ; load define-system\n(define-system ;; Define the system Project-X\n :name :project-x\n :source-dir \"/usr/norvig/project-x/*.lisp\"\n :object-dir \"/usr/norvig/project-x/*.bin\"\n :modules '((:macros \"header\" \"macros\")\n  (:main \"parser\" \"transformer\" \"optimizer\"\n    \"commands\" \"database\" \"output\")\n  (:windows \"xwindows\" \"clx\" \"client\")))\n(defpackage :project-x ;; Define the package Project-X\n (:export \"DEFINE-X\" \"DO-X\" \"RUN-X\")\n (:nicknames \"PX\")\n (:use common-lisp))\n(format *debug-io* To load the Project-X system, type\n (make-system marne :project-x)\nTo run the system, type\n (project-x:run-x)\")\n```\n\nEach of the files that make up the system will start like this:\n\n```lisp\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: Project-X -*-\n(in-package \"PROJECT-X\")\n```\n\nNow we need to provide the system-definition functions, `define-system` and `make-system`.\nThe idea is that `define-system` is used to define the files that make up a system, the modules that the system is comprised of, and the files that make up each module.\nIt is necessary to group files into modules because some files may depend on others.\nFor example, all macros, special variables, constants, and inline functions need to be both compiled and loaded before any other files that reference them are compiled.\nIn Project-X, all `defvar, defparameter, defconstant,` and `defstruct`[3](#fn0020) forms are put in the file header, and all defmacro forms are put in the file macros.\nTogether these two files form the first module, named : macros, which will be loaded before the other two modules (: `main` and :`windows`) are compiled and loaded.\n\ndefine-system also provides a place to specify a directory where the source and object files will reside.\nFor larger systems spread across multiple directories, `define - system` will not be adequate.\n\nHere is the first part of the file `defsys.lisp`, showing the definition of `define-system` and the structure sys.\n\n```lisp\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: User -*-\n; ; ; ; A Facility for Defining Systems and their Components\n(in-package \"USER\")\n(defvar *systems* nil \"List of all systems defined.\")\n(defstruct sys\n \"A system containing a number of source and object files.\"\n name source-dir object-dir modules)\n(defun define-system (&key name source-dir object-dir modules)\n \"Define a new system.\"\n ;; Delete any old system of this name. and add the new one.\n (setf *systems* (delete name *systems* :test #'string-equal\n   :key #'sys-name))\n (push (make-sys\n   :name (string name)\n   :source-dir (pathname source-dir)\n   :object-dir (pathname object-dir)\n   :modules '((:all ..(mapcar #'first modules)) ..modules))\n  *systems*)\nname)\n```\n\nThe function `make` - `systemis` used to compile and/or load a previously defined system.\nThe name supplied is used to look up the definition of a system, and one of three actions is taken on the system.\nThe keyword : `cload` means to compile and then load files.\n: `load` means to load files; if there is an object (compiled) file and it is newer than the source file, then it will be loaded, otherwise the source file will be loaded.\nFinally, : `update` means to compile just those source files that have been changed since their corresponding source files were last altered, and to load the new compiled version.\n\n```lisp\n(defun make-system (&key (module : al 1 ) (action :cload)\n         (name (sys-name (first *systems*))))\n  \"Compile and/or load a system or one of its modules.\"\n  (let ((system (find name *systems* :key #'sys-name\n      :test #'string-equal)))\n   (check-type system (not null))\n   (check-type action (member : cload : update :load))\n   (with-compilation-unit O (sys-action module system action))\n (defun sys-action (x system action)\n  \"Perform the specified action to x in this system.\n  X can be a module name (symbol). file name (string)\n  or a list.\"\n  (typecase x\n   (symbol (let ((files (rest (assoc x (sys-modules system)))))\n      (if (null files)\n       (warn \"No files for module ~ a\" x)\n       (sys-action files system action))))\n   (list (dolist (file x)\n     (sys-action file system action)))\n   ((string pathname)\n     (let ((source (merge-pathnames\n        x (sys-source-dir system)))\n      (object (merge-pathnames\n        x (sys-object-dir system))))\n     (case action\n (:cload (compile-file source) (load object))\n (:update (unless (newer-file-p object source)\n   (compile-file source))\n  (load object))\n (:load (if (newer-file-p object source)\n   (load object)\n   (load source))))))\n(t (warn \"Don't know how to ~ a \"~a in system ~ a\"\n  action x system))))\n```\n\nTo support this, we need to be able to compare the write dates on files.\nThis is not hard to do, since Common Lisp provides the function `file-write-date`.\n\n```lisp\n(defun newer-file-p (fi 1el file2)\n \"Is fi 1el newer than (written later than) file2?\"\n (>-num (if (probe-file filel) (file-write-date filel))\n (if (probe-file file2) (file-write-date file2))))\n(defun >-num (x y)\n \"True if x and y are numbers. and x > y.\"\n (and (numberp x) (numberp y) (> x y)))\n```\n\n## 25.17 Portability Problems\n{:#s0115}\n{:.h1hd}\n\nProgramming is difficult.\nAll programmers know the frustration of trying to get a program to work according to the specification.\nBut one thing that really defines the professional programmer is the ability to write portable programs that will work on a variety of systems.\nA portable program not only must work on the computer it was tested on but also must anticipate the difference between your computer and other ones.\nTo do this, you must understand the Common Lisp specification in the abstract, not just how it is implemented on your particular machine.\n\nThere are three ways in which Common Lisp systems can vary: in the treatment of \"is an error\" situations, in the treatment of unspecified results, and in extensions to the language.\n\n*Common Lisp the Language* specifies that it \"is an error\" to pass a non-number to an arithmetic function.\nFor example, it is an error to evaluate (`+ nil 1`).\nHowever, it is not specified what should be done in this situation.\nSome implementations may signal an error, but others may not.\nAn implementation would be within its right to return 1, or any other number or non-number as the result.\n\nAn unsuspecting programmer may code an expression that is an error but still computes reasonable results in his or her implementation.\nA common example is applying get to a non-symbol.\nThis is an error, but many implementations will just return nil, so the programmer may write (`get x ' prop`) when `(if ( symbol p x) (get x 'prop) nil`) is actually needed for portable code.\nAnother common problem is with subseq and the sequence functions that take : end keywords.\nIt is an error if the : end parameter is not an integer less than the length of the sequence, but many implementations will not complain if : end is nil or is an integer greater than the length of the sequence.\n\nThe Common Lisp specification often places constraints on the result that a function must compute, without fully specifying the result.\nFor example, both of the following are valid results:\n\n```lisp\n> (union '(a b c) '(b c d))`=>`(A B C D)\n> (union '(a b c) '(b c d))`=>`(D A B C)\n```\n\nA program that relies on one order or the other will not be portable.\nThe same warning applies to `intersection` and `set-difference`.\nMany functions do not specify how much the result shares with the input.\nThe following computation has only one possible printed result:\n\n```lisp\n> (remove 'x'(a b c d)) (A B C D)\n```\n\nHowever, it is not specified whether the output is `eq` or only `equal` to the second input.\n\nInput/output is particularly prone to variation, as different operating systems can have very different conceptions of how I/O and the file system works.\nThings to watch out for are whether `read-char` echoes its input or not, the need to include `finish-output`, and variationin where newlines are needed, particularly with respect to the top level.\n\nFinally, many implementations provide extensions to Common Lisp, either by adding entirely new functions or by modifying existing functions.\nThe programmer must be careful not to use such extensions in portable code.\n\n## 25.18 Exercises\n{:#s0120}\n{:.h1hd}\n\n**Exercise 251 [h]** On your next programming project, keep a log of each bug you detect and its eventual cause and remedy.\nClassify each one according to the taxon-omy given in this chapter.\nWhat kind of mistakes do you make most often?\nHow could you correct that?\n\n**Exercise 25.2 [s-d]** Take a Common Lisp program and get it to work with a different compiler on a different computer.\nMake sure you use conditional compilation read macros (#+ and #-) so that the program will work on both systems.\nWhat did you have to change?\n\n**Exercise 25.3 [m]** Write a `setf` method for `if` that works like this:\n\n```lisp\n(setf (if test (first x) y) (+ 2 3))=\n(let ((temp (+ 2 3)))\n (if test\n  (setf (first x) temp)\n  (setf y temp)))\n```\n\nYou will need to use `define-setf-method`, not `defsetf`.\n(Why?) Make sure you handle the case where there is no else part to the `if`.\n\n**Exercise 25.4 [h]** Write a `setf` method for `lookup`, a function to get the value for a key in an association list.\n\n```lisp\n(defun lookup (key alist)\n \"Get the cdr of key's entry in the association list.\"\n (cdr (assoc key alist)))\n```\n\n## 25.19 Answers\n{:#s0125}\n{:.h1hd}\n\n**Answer 25.4** Here is the setf method for `lookup`.\nIt looks for the key in the a-list, and if the key is there, it modifies the cdr of the pair containing the key; otherwise it adds a new key/value pair to the front of the a-list.\n\n```lisp\n(define-setf-method lookup (key alist-place)\n (multiple-value-bind (temps vais stores store-form access-form)\n   (get-setf-method alist-place)\n (let ((key-var (gensym))\n     (pair-var (gensym))\n     (result (gensym)))\n   (values\n    '(.key-var .@temps .pair-var)\n    '(.key .@vais (assoc .key-var ,access-form))\n    '(.result)\n    '(if .pair-var\n      (setf (cdr .pair-var) .result)\n      (let ((.(first stores)\n        (acons ,key-var .result .access-form)))\n       .store-form\n       ,result))\n    '(cdr .pair-var)))))\n```\n\n----------------------\n\n[1](#xfn0010) This misunderstanding has shown up even in published articles, such as [Baker 1991](B9780080571157500285.xhtml#bb0060).\n!!!(p) {:.ftnote1}\n\n[2](#xfn0015) Scheme requires a list of keys in each clause.\nNow you know why.\n!!!(p) {:.ftnote1}\n\n[3](#xfn0020) def struct forms are put here because they may create inline functions.\n!!!(p) {:.ftnote1}\n\n\n\n# Appendix\n## Obtaining the Code in this Book\n{:#app0005}\n{:.fmtitle}\n\n## FTP: The File Transfer Protocol\n{:#s0010}\n{:.h1hd}\n\nFTP is a file transfer protocol that is widely accepted by computers around the world.\nFTP makes it easy to transfer files between two computers on which you have accounts.\nBut more importantly, it also allows a user on one computer to access files on a computer on which he or she does not have an account, as long as both computers are connected to the Internet.\nThis is known as *anonymous FTP.*\n\nAll the code in this book is available for anonymous FTP from the computer `mkp.com` in files in the directory `pub/norvig`.\nThe file `README` in that directory gives further instructions on using the files.\n\nIn the session below, the user `smith` retrieves the files from `mkp.com`.\nSmith's input is in *slanted font.* The login name must be *anonymous*, and Smith's own mail address is used as the password.\nThe command *cd pub/norvig* changes to that directory, and the command *ls* lists all the files.\nThe command *mget* * retrieves ail files (the *m* stands for \"multiple\").\nNormally, there would be a prompt before each file asking if you do indeed want to copy it, but the *prompt* command disabled this.\nThe command *bye* ends the FTP session.\n\n```lisp\n% *ftp mkp.com* (or *ftp 199.182.55.2*)\nName (mkp.com:smith): *anonymous*\n331 Guest login ok, send ident as password\nPassword: *smith@cs.stateu.edu*\n230 Guest login ok, access restrictions apply\nftp>*cd pub/norvig*\n250 CWD command successful.\nftp>*ls*\n...\nftp>*prompt*\nInteractive mode off.\nftp>*mget**\n...\nftp> bye\n%\n```\n\nAnonymous FTP is a privilege, not a right.\nThe site administrators at `mkp.com` and at other sites below have made their systems available out of a spirit of sharing, but there are real costs that must be paid for the connections, storage, and processing that makes this sharing possible.\nTo avoid overloading these systems, do not FTP from 7:00 a.m.\nto 6:00 p.m.\nlocal time.\nThis is especially true for sites not in your country.\nIf you are using this book in a class, ask your professor for a particular piece of software before you try to FTP it; it would be wasteful if everybody in the class transferred the same thing.\nUse common sense and be considerate: none of us want to see sites start to close down because a few are abusing their privileges.\n\nIf you do not have FTP access to the Internet, you can still obtain the files from this book by contacting Morgan Kaufmann at the following:\n\nMorgan Kaufmann Publishers, Inc.\n\n340 Pine Street, Sixth Floor\n\nSan Francisco, CA 94104-3205\n\nUSA\n\nTelephone 415/392-2665\n\nFacsimile 415/982-2665\n\nInternet mkp@mkp.com\n\n(800) 745-7323\n\nMake sure to specify which format you want:\n\nMacintosh diskette ISBN 1-55860-227-5\n\nDOS 5.25 diskette ISBN 1-55860-228-3\n\nDOS 3.5 diskette ISBN 1-55860-229-1\n\n## Available Software\n{:#s0015}\n{:.h1hd}\n\nIn addition to the program from this book, a good deal of other software is available.\nThe tables below list some of the relevant AI/Lisp programs.\nEach entry lists the name of the system, an address, and some comments.\nThe address is either a computer from which you can FTP, or a mail address of a contact.\nUnless it is stated that distribution is by *email* or *Floppy* or requires a *license,* then you can FTP from the contact's home computer.\nIn some cases the host computer and/or directory have been provided in italics in the comments field.\nHowever, in most cases it should be obvious what files to transfer.\nFirst do an `ls` command to see what files and directories are available.\nIf there is a file called `README`, follow its advice: do a get `README` and then look at the file.\nIf you still haven't found what you are looking for, be aware that most hosts keep their public software in the directory pub.\nDo a `cd pub` and then another `ls`, and you should find the desired files.\n\nIf a file ends in the suffix `.Z`, then you should give the FTP command `binary` before transferring it, and then give the UNIX command `uncompress` to recover the original file.\nFiles with the suffix `.tar` contain several files that can be unpacked with the `tar` command.\nIf you have problems, consult your local documentation or system administrator.\n\n**Knowledge Representation**\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| Babbler | [rsfl@ra.msstate.edu](mailto:rsfl@ra.msstate.edu) | *email;*Markov chains/NLP |\n| BACK | [peltason@tubvm.cs.tu-berlin.de](mailto:peltason@tubvm.cs.tu-berlin.de) | *3.5\" floppy;* KL-ONE family |\n| Belief | [almond@stat.washington.edu](mailto:almond@stat.washington.edu) | belief networks |\n| Classic | [dlm@research.att.com](mailto:dlm@research.att.com) | *license;* KL-ONE family |\n| Fol Getfol | [fausto@irst.it](mailto:fausto@irst.it) | *tape;* Weyrauch's FOL system |\n| Framekit | [ehn+@cs.cmu.edu](mailto:ehn+@cs.cmu.edu) | *floppy;* frames |\n| Framework | [mkant+@cs.cmu.edu](mailto:mkant+@cs.cmu.edu) | *a.gp.cs.cmu.edu:/usr/mkant/Public;* frames |\n| Frobs | [kessler@cs.utah.edu](mailto:kessler@cs.utah.edu) | frames |\n| Knowbel | [kramer@ai.toronto.edu](mailto:kramer@ai.toronto.edu) | sorted/temporal logic |\n| MVL | [ginsberg@t.stanford.edu](mailto:ginsberg@t.stanford.edu) | multivalued logics |\n| OPS | [slisp-group@b.gp.cs.cmu.edu](mailto:slisp-group@b.gp.cs.cmu.edu) | Forgy's OPS-5 language |\n| PARKA | [spector@cs.umd.edu](mailto:spector@cs.umd.edu) | frames (designed for connection machine) |\n| Parmenides | [pshell@cs.cmu.edu](mailto:pshell@cs.cmu.edu) | frames |\n| Rhetorical | [miller@cs.rochester.edu](mailto:miller@cs.rochester.edu) | planning, time logic |\n| SB-ONE | [kobsa@cs.uni-sb.de](mailto:kobsa@cs.uni-sb.de) | *license;* in German; KL-ONE family |\n| SNePS | [shapiro@cs.buffalo.edu](mailto:shapiro@cs.buffalo.edu) | *license;* semantic net/NLP |\n| SPI | [cs.orst.edu](mailto:cs.orst.edu) | Probabilistic inference |\n| YAK | [franconi@irst.it](mailto:franconi@irst.it) | KL-ONE family |\n\n**Planning and Learning**\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| COBWEB/3 | [cobweb@ptolemy.arc.nasa.gov](mailto:cobweb@ptolemy.arc.nasa.gov) | *email;* concept formation |\n| MATS | [kautz@research.att.com](mailto:kautz@research.att.com) | *license;* temporal constraints |\n| MICRO-xxx | [waander@cs.ume.edu](mailto:waander@cs.ume.edu) | case-based reasoning |\n| Nonlin | [nonlin-users-request@cs.umd.edu](mailto:nonlin-users-request@cs.umd.edu) | Tate's planner in Common Lisp |\n| Prodigy | [prodigy@cs.cmu.edu](mailto:prodigy@cs.cmu.edu) | *license;* planning and learning |\n| PROTOS | [porter@cs.utexas.edu](mailto:porter@cs.utexas.edu) | knowledge acquisition |\n| SNLP | [weld@cs.washington.edu](mailto:weld@cs.washington.edu) | nonlinear planner |\n| SOAR | [soar-requests/@cs.cmu.edu](mailto:soar-requests/@cs.cmu.edu) | *license*; integrated architecture |\n| THEO | [tom.mitchell@cs.cmu.edu](mailto:tom.mitchell@cs.cmu.edu) | frames, learning |\n| Tileworld | [pollack@ai.sri.com](mailto:pollack@ai.sri.com) | planning testbed |\n| TileWorld | [tileworld@ptolemy.arc.nasa.gov](mailto:tileworld@ptolemy.arc.nasa.gov) | planning testbed |\n\n**Mathematics**\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| JACAL | [jaffer@altdorf.ai.mit.edu](mailto:jaffer@altdorf.ai.mit.edu) | algebraic manipulation |\n| Maxima | [rascal.ics.utexas.edu](mailto:rascal.ics.utexas.edu) | version of Macsyma; also proof-checker, nqthm |\n| MMA | [fateman@cs.berkeley.edu](mailto:fateman@cs.berkeley.edu) | *peoplesparc.berkeley.edu:pub/mma.* *; algebra |\n| XLispStat | [umnstat.stat.umn.edu](mailto:umnstat.stat.umn.edu) | Statistics; also S Bayes |\n\n**Compilers and Utilities**\n\n!!!(table)\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| AKCL | [rascal.ics.utexas.edu](mailto:rascal.ics.utexas.edu) | Austin Koyoto Common Lisp |\n| CLX, CLUE | [export.lcs.mit.edu](mailto:export.lcs.mit.edu) | Common Lisp interface to X Windows |\n| Gambit | [gambit@cs.brandeis.edu](mailto:gambit@cs.brandeis.edu) | *acorn.cs.brandeis.edu:dist/gambit**; Scheme compiler |\n| ISI Grapher | [isi.edu](mailto:isi.edu) | Graph displayer; also NLP word lists |\n| PCL | [arisia.xerox.com](mailto:arisia.xerox.com) | Implementation of CLOS |\n| Prolog | [aisun1.ai.uga.edu](mailto:aisun1.ai.uga.edu) | Prolog-based utilities and NLP programs |\n| PYTHON | [ram+@cs.cmu.edu](mailto:ram+@cs.cmu.edu) | *a.gp.cs.cmu.edu:* Common Lisp Compiler and tools |\n| SBProlog | [arizona.edu](mailto:arizona.edu) | Stony Brook Prolog, Icon, Snobol |\n| Scheme | [altdorf.ai.mit.edu](mailto:altdorf.ai.mit.edu) | Scheme utilities and compilers |\n| Scheme | [scheme@nexus.yorku.ca](mailto:scheme@nexus.yorku.ca) | Scheme utilities and programs |\n| SIOD | [bu.edu](mailto:bu.edu) | *users/gjc;* small scheme interpreter |\n| Utilities | [a.gp.cs.cmu.edu](mailto:a.gp.cs.cmu.edu) | */usr/mkant/Public*; profiling, def system, etc. |\n| XLisp | [cs.orst.edu](mailto:cs.orst.edu) | Lisp interpreter |\n| XScheme | [tut.cis.ohio-state.edu](mailto:tut.cis.ohio-state.edu) | Also mitscheme compiler; sbprolog |\n\n\n\n# Bibliography\n{:#bib0005}\n{:.fmtitle}\n\nAbelson Harold, Sussman Gerald J., Sussman Julie.\n*Structure and Interpretation of Computer Programs.* MIT Press; 1985.\n!!!(p) {:.reflist}\n\nAho A.V., Ullman J.D.\n*The Theory of Parsing, Translation, and Compiling.* Prentice-Hall; 1972.\n!!!(p) {:.reflist}\n\nA&iuml;t-Kaci Hassan.\n*Warren's Abstract Machine: A Tutorial Reconstruction.* MIT Press; 1991 An earlier version was published as \"The WAM: A (Real) Tutorial.\" Digital Equipment Corporation Paris Research Lab, Report no.\n5.\n!!!(p) {:.reflist}\n\nA&iuml;t-Kaci Hassan, Lincoln Patrick, Nasr Roger.\nLe Fun: Logic, Equations and Functions.\n1987.\n*Proceedings of the IEEE.* CH2472-9/87.\n!!!(p) {:.reflist}\n\nAllen James.\n*Natural Language Understanding.* Benjamin/Cummings; 1987.\n!!!(p) {:.reflist}\n\nAllen James, Hendler James, Tate Austin.\n*Readings in Planning.* Morgan Kaufmann; 1990.\n!!!(p) {:.reflist}\n\nAllen John.\n*Anatomy of Lisp.* McGraw-Hill; 1978.\n!!!(p) {:.reflist}\n\nAmarel Saul.\nOn Representation of Problems of Reasoning about Actors.\nIn: Michie Donald, ed.\n*Machine Intelligence 3.* Edinburgh University Press; 1968.\n!!!(p) {:.reflist}\n\nAnderson James A.D.W.\n*Pop-11 Comes of Age: the advancement of an AI programming language.* Ellis Horwood; 1989.\n!!!(p) {:.reflist}\n\nAnderson John Robert.\n*Language, Memory, and Thought.* Lawrence Erlbaum; 1976.\n!!!(p) {:.reflist}\n\nBaker Henry G.\nPragmatic Parsing in Common Lisp; or, Putting defmacro on Steroids.\n*Lisp Pointers.* 1991;4(no.\n2).\n!!!(p) {:.reflist}\n\nBarr Avron, Feigenbaum Edward A.\nMorgan Kaufmann; . *The Handbook of Artificial Intelligence.* 1981;3 vols.\n!!!(p) {:.reflist}\n\nBatali John, Goodhue Edmund, Hanson Chris, Shrobe Howie, Stallman Richard M., Sussman Gerald Jay.\n*The Scheme-81 Architecture-System and Chip.* In: Proceedings, Conference on Advanced Research in VLSI; 1982:69-77.\n!!!(p) {:.reflist}\n\nBennett James S.\nRoget: A Knowledge-Based System for Acquiring the Conceptual Structure of a Diagnostic Expert System.\n*Journal of Automated Reasoning.* 1985;1:49-74.\n!!!(p) {:.reflist}\n\nBerlekamp E.R., Conway J.H., Guy R.K.\nAcademic Press; . *Winning Ways.* 1982;2 vols.\n!!!(p) {:.reflist}\n\nBerlin Andrew, Weise Daniel.\nCompiling scientific code using partial evaluation.\nIn: *IEEE Computer.* 1990:25-37.\n!!!(p) {:.reflist}\n\nBobrow Daniel G.\n*Natural Language Input for a Computer Problem-Solving System.* 1968 In Minsky 1968.\n!!!(p) {:.reflist}\n\nBobrow Daniel G.\n*LOOPS: An Object-Oriented Programming System for Interlisp.* Xerox PARC; 1982.\n!!!(p) {:.reflist}\n\nBobrow Daniel G.\nIf Prolog is the Answer, What is the Question?\nor What It Takes to Support AI Programming Paradigms.\n*IEEE Transactions on Software Engineering.* 1985;SE-11:.\n!!!(p) {:.reflist}\n\nBobrow Daniel G., Kahn Kenneth, Kiczales Gregor, Masinter Larry, Stefik Mark, Zdybel Frank.\n*Common Loops: Merging Lisp and Object-Oriented Programming.* In: Proceedings of the ACM Conference on Object-Oriented Systems, Languages, and Applications; 1986.\n!!!(p) {:.reflist}\n\nBoyer R.S., Moore J.S.\nThe Sharing of Structure in Theorem Proving Programs.\nIn: Meltzer B., Michie D., eds.\n*Machine Intelligence 7.* Wiley; 1972.\n!!!(p) {:.reflist}\n\nBrachman Ronald J., Levesque Hector J.\n*Readings in Knowledge Representation.* Morgan Kaufmann; 1985.\n!!!(p) {:.reflist}\n\nBrachman Ronald J., Fikes Richard E., Levesque Hector J.\n*KRYPTON: A Functional Approach to Knowledge Representation.* 1983 FLAIR Technical Report no.\n16, Fairchild Laboratory for Artificial Intelligence.\nReprinted in Brachman and Levesque 1985.\n!!!(p) {:.reflist}\n\nBratko Ivan.\n*Prolog Programming for Artificial Intelligence.* Addison-Wesley; 1990.\n!!!(p) {:.reflist}\n\nBromley Hank, Lamson Richard.\n*A Guide to Programming the Lisp Machine.* 2d ed Kluwer Academic; 1987.\n!!!(p) {:.reflist}\n\nBrooks Rodney A.\n*Programming in Common Lisp.* Wiley; 1985.\n!!!(p) {:.reflist}\n\nBrownston L., Farrell R., Kant E., Martin N.\n*Programming Expert Systems in OPS5.* Addison-Wesley; 1985.\n!!!(p) {:.reflist}\n\nBuchanan Bruce G., Shortliffe Edward Hance.\n*Rule-based Expert Systems: The Mycin Experiments of the Stanford Heuristic Programming Project.* Addison-Wesley; 1984.\n!!!(p) {:.reflist}\n\nBundy Alan.\n*Catalogue of Artificial Intelligence Tools.* Springer-Verlag; 1984.\n!!!(p) {:.reflist}\n\nCannon Howard I.\n*Flavors.* 1980 AI Lab Technical Report, MIT.\n!!!(p) {:.reflist}\n\nCarbonell Jamie A.\n*Subjective Understanding: Computer Models of Belief Systems.* UMI Research Press; 1981.\n!!!(p) {:.reflist}\n\nCardelli Luca, Wegner Peter.\nOn Understanding Types, Data Abstraction and Polymorphism.\n*ACM Computing Surveys.* 1986;17:.\n!!!(p) {:.reflist}\n\nChapman David.\nPlanning for Conjunctive Goals.\n*Artificial Intelligence.* 1987;32:333-377 Reprinted in Allen, Hendler, and Tate 1990.\n!!!(p) {:.reflist}\n\nCharniak Eugene, McDermott Drew.\n*Introduction to Artificial Intelligence.* Addison-Wesley; 1985.\n!!!(p) {:.reflist}\n\nCharniak Eugene, Riesbeck Christopher, McDermott Drew, Meehan James.\n*Artificial Intelligence Programming.* 2d ed Lawrence Erlbaum; 1987.\n!!!(p) {:.reflist}\n\nCheeseman Peter.\n*In Defense of Probability.* In: Proceedings of the Ninth IJCAI; 1985:1002-1009.\n!!!(p) {:.reflist}\n\nChomsky Noam.\n*Language and Mind.* Harcourt Brace Jovanovich; 1972.\n!!!(p) {:.reflist}\n\nChurch Alonzo.\nThe Calculi of Lambda-Conversion.\nIn: Princeton University Press; . *Annals of Mathematical Studies.* 1941;Vol.\n6.\n!!!(p) {:.reflist}\n\nChurch Kenneth, Patil Ramesh.\nCoping with Syntactic Ambiguity, or How to Put the Block in the Box on the Table.\n*American Journal of Computational Linguistics.* 1982;8(nos.\n3-4):139-149.\n!!!(p) {:.reflist}\n\nClinger William, Rees Jonathan.\n*Revised4 Report on the Algorithmic Language Scheme.* 1991 Unpublished document available online on cs.voregin.edu.\n!!!(p) {:.reflist}\n\nClocksin William F., Mellish Christopher S.\n*Programming in Prolog.* 3d ed Springer-Verlag; 1987.\n!!!(p) {:.reflist}\n\nClowes Maxwell B.\nOn Seeing Things.\n*Artificial Intelligence.* 1971;2:79-116.\n!!!(p) {:.reflist}\n\nCoelho Helder, Cotta Jose C.\n*Prolog by Example.* Springer-Verlag; 1988.\n!!!(p) {:.reflist}\n\nCohen Jacques.\nDescribing Prolog by its interpretation and compilation.\n*Communications of the ACM.* 1985;28(no.\n12):1311-1324.\n!!!(p) {:.reflist}\n\nCohen Jacques.\nConstraint Logic Programming Languages.\n*Communications of the ACM.* 1990;33(no.\n7):52-68.\n!!!(p) {:.reflist}\n\nColby Kenneth.\n*Artificial Paranoia.* Pergamon; 1975.\n!!!(p) {:.reflist}\n\nCollins Allan.\nFragments of a Theory of Human Plausible Reasoning.\nIn: Waltz David, ed.\n*Theoretical Issues in Natural Language Processing.* ACM; 1978 Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nColmerauer Alain.\nProlog in 10 figures.\n*Communications of the ACM.* 1985;28(no.\n12):1296-1310.\n!!!(p) {:.reflist}\n\nColmerauer Alain.\nAn Introduction to Prolog III.\n*Communications of the ACM.* 1990;33(no.\n7):69-90.\n!!!(p) {:.reflist}\n\nColmerauer Alain, Kanoui Henri, Pasero Robert, Roussel Phillipe.\n*Un Syst&egrave;me de Communication Homme-Machine en Fran&ccedil;ais.* 1973 Rapport, Groupe d'Intelligence Artificielle, Universit&eacute; d'Aix-Marseille II.\n!!!(p) {:.reflist}\n\nCooper Thomas A., Wogrin Nancy.\n*Rule-Based Programming with OPS5.* Morgan Kaufmann; 1988.\n!!!(p) {:.reflist}\n\nDahl Ole-Johan, Nygaard Kristen.\nSIMULA-An Algol-based Simulation Language.\n*Communications of the ACM.* 1966;9(no.\n9):671-678.\n!!!(p) {:.reflist}\n\nDavenport J.H., Siret Y., Tournier E.\n*Computer Algebra: Systems and Algorithms for Algebraic Computation.* Academic Press; 1988.\n!!!(p) {:.reflist}\n\nDavis Ernest.\n*Representations of Commonsense Reasoning.* Morgan Kaufmann; 1990.\n!!!(p) {:.reflist}\n\nDavis Lawrence.\n*Genetic Algorithms and Simulated Annealing.* Morgan Kaufmann; 1987.\n!!!(p) {:.reflist}\n\nDavis Lawrence.\n*Handbook of Genetic Algorithms.* van Nostrand Reinhold; 1991.\n!!!(p) {:.reflist}\n\nDavis Randall.\n*Meta-Level Knowledge.* In: Proceedings of the Fifth IJCAI; 1977:920-928 Reprinted in Buchanan and Shortliffe 1984.\n!!!(p) {:.reflist}\n\nDavis Randall.\nInteractive Transfer of Expertise.\n*Artificial Intelligence.* 1979;12:121-157 Reprinted in Buchanan and Shortliffe 1984.\n!!!(p) {:.reflist}\n\nDavis Randall, Lenat Douglas B.\n*Knowledge-Based Systems in Artificial Intelligence.* McGraw-Hill; 1982.\n!!!(p) {:.reflist}\n\nDeGroot AD.\n*Thought and Choice in Chess.* Mouton; 1965 (English translation, with additions, of the Dutch edition, 1946.).\n!!!(p) {:.reflist}\n\nDeGroot A.D.\nPerception and Memory versus Thought: Some Old Ideas and Recent Findings.\nIn: Kleinmuntz B., ed.\n*Problem Solving.* Wiley; 1966.\n!!!(p) {:.reflist}\n\nde Kleer Johan.\nAn Assumption-Based Truth Maintenance System.\n*Artificial Intelligence.* 1986a;28:127-162 Reprinted in Ginsberg 1987.\n!!!(p) {:.reflist}\n\nde Kleer Johan.\nExtending the ATMS.\n*Artificial Intelligence.* 1986b;28:163-196.\n!!!(p) {:.reflist}\n\nde Kleer Johan.\nProblem-Solving with the ATMS.\n*Artificial Intelligence.* 1986c;28:197-224.\n!!!(p) {:.reflist}\n\nde Kleer Johan.\nA General Labelling Algorithm for Assumption-Based Truth Maintenance.\nIn: *Proceedings of the AAAI.* 1988:188-192.\n!!!(p) {:.reflist}\n\nDowty David R., Wall Robert E., Peters Stanley.\nIntroduction to Montague Semantics.\nIn: D.\nReidel; . *Synthese Language Library.* 1981;vol.\n11.\n!!!(p) {:.reflist}\n\nDoyle Jon.\nA Truth Maintenance System.\n*Artificial Intelligence.* 1979;12:231-272.\n!!!(p) {:.reflist}\n\nDoyle Jon.\n*The Ins and Outs of Reason Maintenance.* In: Proceedings of the Eighth IJCAI; 1983:349-351.\n!!!(p) {:.reflist}\n\nDubois Didier, Prade Henri.\nAn Introduction to Possibilistic and Fuzzy Logics.\n*Non-Standard Logics for Automated Reasoning.* Academic Press; 1988 Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nEarley Jay.\nAn Efficient Context-Free Parsing Algorithm.\n*CACM.* 1970;6(no.\n2):451-455 Reprinted in Grosz et al.\n1986.\n!!!(p) {:.reflist}\n\nElcock E.W., Hoddinott P.\n*Comments on Kornfeld's 'Equality for Prolog': E-Unification as a Mechanism for Augmenting the Prolog Search Strategy.* In: Proceedings of the AAAI; 1986:766-775.\n!!!(p) {:.reflist}\n\nEmanuelson P., Haraldsson A.\n*On Compiling Embedded Languages in Lisp.* In: Lisp Conference, Stanford, Calif; 1980:208-215.\n!!!(p) {:.reflist}\n\nErnst G.W., Newell Alan.\n*GPS: A Case Study in Generality and Problem Solving.* Academic Press; 1969.\n!!!(p) {:.reflist}\n\nFateman Richard J.\nReply to an Editorial.\n*ACM SIGSAM Bulletin.* 1973;25(March):9-11.\n!!!(p) {:.reflist}\n\nFateman Richard J.\nPolynomial Multiplication, Powers and Asymptotic Analysis: Some Comments.\n*SIAM Journal of Computation.* 1974;no.\n3(3):196-213.\n!!!(p) {:.reflist}\n\nFateman Richard J.\n*MACSYMA's general simplifier: philosophy and operation.* In: Lewis VE, ed.\n*Proceedings of the 1979 MACSYMA Users' Conference* (MUC-79); MIT: Lab for Computer Science; 1979:563-582.\n!!!(p) {:.reflist}\n\nFateman Richard J.\nFRPOLY: A Benchmark Revisited.\n*Lisp and Symbolic Computation.* 1991;4:155-164.\n!!!(p) {:.reflist}\n\nFeigenbaum Edward A., Feldman Julian.\n*Computers and Thought.* McGraw-Hill; 1963.\n!!!(p) {:.reflist}\n\nField A.J., Harrison P.G.\n*Functional Programming.* Addison-Wesley; 1988.\n!!!(p) {:.reflist}\n\nFikes Richard E., Nilsson Nils J.\nSTRIPS: A New Approach to the Application of Theorem Proving to Problem Solving.\n*Artificial Intelligence.* 1971;2:189-208 Reprinted in Allen, Hendler, and Tate 1990.\n!!!(p) {:.reflist}\n\nFodor Jerry A.\n*The Language of Thought.* Harvard University Press; 1975.\n!!!(p) {:.reflist}\n\nForgy Charles L.\nOPS5 User's Manual.\n*Report CMU-CS-81-135.* Carnegie Mellon University; 1981.\n!!!(p) {:.reflist}\n\nForgy Charles L.\nRETE: A Fast Algorithm for the Many Pattern/Many Object Pattern Match Problem.\n*Artificial Intelligence.* 1982;19:17-37.\n!!!(p) {:.reflist}\n\nFranz Inc.\n*Common Lisp: the Reference.* Addison-Wesley; 1988.\n!!!(p) {:.reflist}\n\nGabriel Richard P.\n*Performance and evaluation of Lisp systems.* MIT Press; 1985.\n!!!(p) {:.reflist}\n\nGabriel Richard P.\nLisp.\nIn: Shapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n!!!(p) {:.reflist}\n\nGaller B.A., Fisher M.J.\nAn Improved Equivalence Algorithm.\n*Communications of the ACM.* 1964;7(no.\n5):301-303.\n!!!(p) {:.reflist}\n\nGazdar Richard, Mellish Chris.\n*Natural Language Processing in Lisp.* Addison-Wesley; 1989 Also published simultaneously: Natural Language Processing in Prolog.\n!!!(p) {:.reflist}\n\nGenesereth Michael R., Ginsberg Matthew L.\nLogic Programming.\n*Communications of the ACM.* 1985;28(no.\n9):933-941.\n!!!(p) {:.reflist}\n\nGenesereth Michael R., Nilsson Nils J.\n*Logical Foundations of Artificial Intelligence.* Morgan Kaufmann; 1987.\n!!!(p) {:.reflist}\n\nGiannesini Francis, Kanoui H., Pasero R., van Caneghem M.\n*Prolog.* Addison-Wesley; 1986.\n!!!(p) {:.reflist}\n\nGinsberg Matthew L.\n*Readings in NonMonotonic Reasoning.* Morgan Kaufmann; 1987.\n!!!(p) {:.reflist}\n\nGinsberg Matthew L., Harvey William D.\n*Iterative Broadening.* In: Proceedings, Eighth National Conference on AI; 1990:216-220.\n!!!(p) {:.reflist}\n\nGoldberg Adele, Robinson David.\n*Smalltalk-80: The Language and its Implementation.* Addison-Wesley; 1983.\n!!!(p) {:.reflist}\n\nGoldberg David E.\n*Genetic Algorithms in Search, Optimization and Machine Learning.* Addison-Wesley; 1989.\n!!!(p) {:.reflist}\n\nGordon Jean, Shortliffe Edward H.\n*The Dempster-Shafer Theory of Evidence.* 1984 In Buchanan and Shortliffe 1984.\n!!!(p) {:.reflist}\n\nGreen Cordell.\nTheorem-proving by resolution as a basis for question-answering systems.\nIn: Meltzer Bernard, Michie Donald, eds.\n*Machine Intelligence 4.* Edinburgh University Press; 1968:183-205.\n!!!(p) {:.reflist}\n\nGrosz Barbara J., Sparck-Jones Karen, Webber Bonnie Lynn.\n*Readings in Natural Language Processing.* Morgan Kaufmann; 1986.\n!!!(p) {:.reflist}\n\nGuzman Adolfo.\n*Computer Recognition of Three-Dimensional Objects in a Visual Scene.* 1968 Ph.D.\nthesis, MAC-TR-59, Project MAC, MIT.\n!!!(p) {:.reflist}\n\nHafner Carole, Wilcox Bruce.\n*LISP/MTS Programmer's Guide.* Mental Health Research Institute Communication no.\n302, University of Michigan; 1974.\n!!!(p) {:.reflist}\n\nHarris Zellig S.\n*A Grammar of English on Mathematical Principles.* Wiley; 1982.\n!!!(p) {:.reflist}\n\nHasemer Tony, Domingue John.\n*Common Lisp Programming for Artificial Intelligence.* Addison-Wesley; 1989.\n!!!(p) {:.reflist}\n\nHayes, Patrick.\n\"Naive Physics I: Ontology for Liquids\".\nIn Hobbs and Moore 1985.\n!!!(p) {:.reflist}\n\nHeckerman David.\nProbabilistic Interpretations for Mycin's Certainty Factors.\nIn: Kanal L.N., Lemmer J.F., eds.\n*Uncertainty in Artificial Intelligence.* North-Holland: Elsevier; 1986 Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nHennessey Wade L.\n*Common Lisp.* McGraw-Hill; 1989.\n!!!(p) {:.reflist}\n\nHewitt Carl.\nViewing Control Structures as Patterns of Passing Messages.\n*Artificial Intelligence.* 1977;8(no.\n3):323-384.\n!!!(p) {:.reflist}\n\nHobbs Jerry R., Moore Robert C.\n*Formal Theories of the Commonsense World.* Ablex; 1985.\n!!!(p) {:.reflist}\n\nHofstader Douglas R.\n*Godel, Escher, Bach: An Eternal Golden Braid.* Vintage; 1979.\n!!!(p) {:.reflist}\n\nH&ouml;lldobler Steffen.\n*Foundations of Equational Logic Programming.* Springer-Verlag; 1987 Lecture Notes in Artificial Intelligence.\n!!!(p) {:.reflist}\n\nHuddleston Rodney.\n*Introduction to the Grammar of English.* Cambridge University Press; 1984.\n!!!(p) {:.reflist}\n\nHuffman David A.\nImpossible Objects as Nonsense Pictures.\nIn: Meltzer B., Michie D., eds.\n*Machine Intelligence 6.* Edinburgh University Press; 1971:295-323.\n!!!(p) {:.reflist}\n\nHughes R.J.M.\n*Lazy Memo Functions.* In: Proceedings of the Conference on Functional Programming and Computer Architecture, Nancy; Springer-Verlag; 1985:129-146.\n!!!(p) {:.reflist}\n\nIngerman Peter Z.\nThunks.\n*Communications of the ACM.* 1961;4(no.\n1):55-58.\n!!!(p) {:.reflist}\n\nJaffar Joxan, Lassez Jean-Louis, Maher Michael J.\nA Theory of Complete Logic Programs with Equality.\n*Journal of Logic Programming.* 1984;3:211-223.\n!!!(p) {:.reflist}\n\nJackson Peter.\n*Introduction to Expert Systems.* 2d ed Addison-Wesley; 1990.\n!!!(p) {:.reflist}\n\nJames Glenn, James Robert C.\n*Mathematics Dictionary.* Van Nostrand; 1949.\n!!!(p) {:.reflist}\n\nKanal L.N., Lemmer J.F.\n*Uncertainty in Artificial Intelligence.* North-Holland; 1986.\n!!!(p) {:.reflist}\n\nKanal L.N., Lemmer J.F.\n*Uncertainty in Artificial Intelligence 2.* North-Holland; 1988.\n!!!(p) {:.reflist}\n\nKay Alan.\n*The Reactive Engine.* 1969 Ph.D.\nthesis, University of Utah.\n!!!(p) {:.reflist}\n\nKay Martin.\n*Algorithm schemata and data structures in syntactic processing.* 1980 Xerox Palo Alto Research Center Report CSL-80-12.\nReprinted in Grosz et al.\n1986.\n!!!(p) {:.reflist}\n\nKernighan B.W., Plauger P.J.\n*The Elements of Programming Style.* McGraw-Hill; 1974.\n!!!(p) {:.reflist}\n\nKernighan B.W., Plauger P.J.\n*Software Tools in Pascal.* Addison-Wesley; 1981.\n!!!(p) {:.reflist}\n\nKeene Sonya.\n*Object-Oriented Programming in Common Lisp: A Programmer's Guide to CLOS.* Addison-Wesley; 1989.\n!!!(p) {:.reflist}\n\nKnight K.\nUnification: A Multidisciplinary Survey.\n*ACM Computing Surveys.* 1989;21(no.\n1):93-121.\n!!!(p) {:.reflist}\n\nKnuth Donald E., Moore Robert W.\nAn Analysis of Alpha-Beta Pruning.\n*Artificial Intelligence.* 1975;6(no.\n4):293-326.\n!!!(p) {:.reflist}\n\nKohlbecker Jr.\nEugene Edmund.\n*Syntactic Extensions in the Programming Language Lisp.* 1986 Ph.D.\nthesis, Indiana University.\n!!!(p) {:.reflist}\n\nKorf RE.\nDepth-first Iterative Deepening: an Optimal Admissible Tree Search.\n*Artificial Intelligence.* 1985;27:97-109.\n!!!(p) {:.reflist}\n\nKornfeld WA.\nEquality for Prolog.\nIn: 1983:514-519.\n*Proceedings of the Seventh IJCAI.*.\n!!!(p) {:.reflist}\n\nKoschman Timothy.\n*The Common Lisp Companion.* Wiley; 1990.\n!!!(p) {:.reflist}\n\nKowalski Robert.\n*Predicate logic as a programming language.* In: Proceedings of the IFIP-74 Congress; North-Holland; 1974:569-574.\n!!!(p) {:.reflist}\n\nKowalski Robert.\nAlgorithm = Logic + Control.\n*Communications of the ACM.* 1979;22:424-436.\n!!!(p) {:.reflist}\n\nKowalski Robert.\n*Logic for Problem Solving.* North-Holland; 1980.\n!!!(p) {:.reflist}\n\nKowalski Robert.\nThe Early Years of Logic Programming.\n*Communications of the ACM.* 1988;31:38-43.\n!!!(p) {:.reflist}\n\nKranz David, Kelsey Richard, Rees Jonathan, Hudak Paul, Philbin James, Adams Norman.\n*ORBIT: An optimizing compiler for Scheme.* In: SIGPLAN Compiler Construction Conference; 1986.\n!!!(p) {:.reflist}\n\nKreutzer Wolfgang, McKenzie Bruce.\n*Programming for Artificial Intelligence: Methods, Tools and Applications.* Addison-Wesley; 1990.\n!!!(p) {:.reflist}\n\nLakoff George.\n*Women, Fire and Dangerous Things: What Categories Reveal About the Mind.* University of Chicago Press; 1987.\n!!!(p) {:.reflist}\n\nLandin Peter.\nA Correspondence Between Algol 60 and Church's Lambda Notation.\n*Communications of the ACM.* 1965;8(no.\n2):89-101.\n!!!(p) {:.reflist}\n\nLang Kevin J., Perlmutter Barak A.\nOaklisp: An Object-Oriented Dialect of Scheme.\n*Lisp and Symbolic Computing.* 1988;1:39-51.\n!!!(p) {:.reflist}\n\nLangacker Ronald W.\n*Language and its Structure.* Harcourt, Brace & World; 1967.\n!!!(p) {:.reflist}\n\nLassez J.-L., Maher M.J., Marriott K.\nUnification Revisited.\nIn: Minker J., ed.\n*Foundations of Deductive Databases and Logic Programming.* Morgan Kaufmann; 1988:587-625.\n!!!(p) {:.reflist}\n\nLee Kai-Fu, Mahajan Sanjoy.\n*Bill: A Table-Based, Knowledge-Intensive Othello Program.* 1986 Technical Report CMU-CS-86-141, Carnegie Mellon University.\n!!!(p) {:.reflist}\n\nLee Kai-Fu., Mahajan Sanjoy.\nThe Development of a World Class Othello Program.\n*Artificial Intelligence.* 1990;43:21-36.\n!!!(p) {:.reflist}\n\nLevesque Hector.\nMaking Believers out of Computers.\n*Artificial Intelligence.* 1986;30:81-108.\n!!!(p) {:.reflist}\n\nLevy David N.L.\n*Computer Chess.* Batsford; 1976.\n!!!(p) {:.reflist}\n\nLevy David N.L.\n*Computer Games.* Springer-Verlag; 1988a.\n!!!(p) {:.reflist}\n\nLevy David N.L.\n*Computer Chess Compendium.* Springer-Verlag; 1988b.\n!!!(p) {:.reflist}\n\nLevy David N.L.\n*Heuristic Programming in Artificial Intelligence: the First Computer Olympiad.* Ellis Horwood; 1990.\n!!!(p) {:.reflist}\n\nLloyd JW.\n*Foundations of Logic Programming.* Springer-Verlag; 1987.\n!!!(p) {:.reflist}\n\nLoomis Lynn.\n*Calculus.* Addison-Wesley; 1974.\n!!!(p) {:.reflist}\n\nLoveland DW.\n*Near-Horn Prolog.* In: Proceedings of the Fourth International Conference on Logic Programming; 1987:456-469.\n!!!(p) {:.reflist}\n\nLuger George F., Stubblefield William A.\n*Artificial Intelligence and the Design of Expert Systems.* Benjamin/Cummings; 1989.\n!!!(p) {:.reflist}\n\nMaier David, Warren David S.\n*Computing with Logic.* Benjamin/Cummings; 1988.\n!!!(p) {:.reflist}\n\nMarsland T.A.\nComputer Chess Methods.\nIn: Shapiro Stuart C., ed.\n*Entry in Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n!!!(p) {:.reflist}\n\nMartin William A., Fateman Richard J.\n*The MACSYMA System.* In: Proceedings of the Second Symposium on Symbolic and Algebraic Manipulation; ACM SIGSAM; 1971:59-75.\n!!!(p) {:.reflist}\n\nMasinter Larry, Deutsch Peter.\n*Local Optimization in a Compiler for Stack-Based Lisp Machines.* In: Proceedings of the Lisp and Functional Programming Conference; 1980.\n!!!(p) {:.reflist}\n\nMcAllester David.\n*Reasoning Utility Package User's Manual.* 1982 AI Memo 667, AI Lab, MIT.\n!!!(p) {:.reflist}\n\nMcCarthy John.\n*An Algebraic Language for the Manipulation of Symbolic Expressions.* 1958 AI Lab Memo no.\n1, MIT.\n!!!(p) {:.reflist}\n\nMcCarthy John.\nRecursive functions of symbolic expressions and their computation by machine.\n*Communications of the ACM.* 1960;3(no.\n3):184-195.\n!!!(p) {:.reflist}\n\nMcCarthy John.\nA basis for a mathematical theory of computation.\nIn: Braffort P., Hirschberg D., eds.\n*Computer Programming and Formal Systems.* North-Holland; 1963.\n!!!(p) {:.reflist}\n\nMcCarthy John.\n*Programs with Common Sense.* 1968 In Minsky 1968.\nReprinted in Brachman and Levesque 1985.\n!!!(p) {:.reflist}\n\nMcCarthy John.\nHistory of Lisp.\nIn: Wexelblat Richard W., ed.\n*History of Programming Languages.* Academic Press; 1978 Also in ACM SIGPLAN Notices 13, no.\n8.\n!!!(p) {:.reflist}\n\nMcCarthy John, Abrahams P.W., Edwards D.J., Fox P.A., Hart T.P., Levin M.J.\n*Lisp 1.5 Programmer's Manual.* MIT Press; 1962.\n!!!(p) {:.reflist}\n\nMcDermott Drew.\nTarskian Semantics, or No Notation without Denotation!.\n*Cognitive Science.* 1978;2:277-282 Reprinted in Grosz, Sparck-Jones and Webber 1986.\n!!!(p) {:.reflist}\n\nMcDermott Drew.\nA Critique of Pure Reason.\n*Computational Intelligence.* 1987;3:151-160.\n!!!(p) {:.reflist}\n\nMeyer Bertrand.\n*Object-oriented Software Construction.* Prentice-Hall; 1988.\n!!!(p) {:.reflist}\n\nMichie Donald.\nMemo Functions and Machine Learning.\n*Nature.* 1968;218:19-22.\n!!!(p) {:.reflist}\n\nMiller Molly M., Benson Eric.\n*Lisp Style & Design.* Digital Press; 1990.\n!!!(p) {:.reflist}\n\nMinsky Marvin.\n*Semantic Information Processing.* MIT Press; 1968.\n!!!(p) {:.reflist}\n\nMiranker Daniel.\n*TREAT: A New and Efficient Match Algorithm for AI Production Systems.* Pitman; 1990.\n!!!(p) {:.reflist}\n\nMoon David.\n*Object-Oriented Programming with Flavors.* In: Proceedings of the ACM Conference on Object-Oriented Systems, Languages and Applications; 1986.\n!!!(p) {:.reflist}\n\nMoon David, Stallman Richard, Weinreb Daniel.\n*The Lisp Machine Manual.* AI Lab, MIT; 1983.\n!!!(p) {:.reflist}\n\nMoore Robert C.\nThe Role of Logic in Knowledge Representation and Commonsense Reasoning.\n*Proceedings of the AAAI-82.* 1982 Reprinted in Brachman and Levesque 1985.\n!!!(p) {:.reflist}\n\nMoses Joel.\n*Symbolic Integration.* 1967 Report no.\nMAC-TR-47, Project MAC, MIT.\n!!!(p) {:.reflist}\n\nMoses Joel.\n*A MACSYMA Primer.* 1975 Mathlab Memo no.\n2, Computer Science Lab, MIT.\n!!!(p) {:.reflist}\n\nMueller Robert A., Page Rex L.\n*Symbolic Computing with Lisp and Prolog.* Wiley; 1988.\n!!!(p) {:.reflist}\n\nMusser David R., Stepanov Alexander A.\n*The ADA Generic Library.* Springer-Verlag; 1989.\n!!!(p) {:.reflist}\n\nNaish Lee.\n*Negation and Control in Prolog.* Springer-Verlag; 1986 Lecture Notes in Computer Science 238.\n!!!(p) {:.reflist}\n\nNewell Alan, Shaw J.C., Simon Herbert A.\nChess-Playing Programs and the Problem of Complexity.\nIn: *In Feigenbaum and Feldman 1963.* 1963:39-70.\n!!!(p) {:.reflist}\n\nNewell Alan, Simon Herbert A.\nGPS, A Program that Simulates Human Thought.\nIn: *In Feigenbaum and Feldman 1963.* 1963:279-293 Reprinted in Allen, Hendler, and Tate 1990.\n!!!(p) {:.reflist}\n\nNewell Alan, Simon Herbert A.\n*Human Problem Solving.* Prentice-Hall; 1972.\n!!!(p) {:.reflist}\n\nNilsson Nils.\n*Problem-Solving Methods in Artificial Intelligence.* McGraw-Hill; 1971.\n!!!(p) {:.reflist}\n\nNorvig Peter.\nCorrecting a Widespread Error in Unification Algorithms.\n*Software Practice and Experience.* 1991;21(no.\n2):231-233.\n!!!(p) {:.reflist}\n\nNygaard Kristen, Dahl Ole-Johan.\nSIMULA 67.\nIn: Wexelblat Richard W., ed.\n*History of Programming Languages.* 1981.\n!!!(p) {:.reflist}\n\nO'Keefe Richard.\n*The Craft of Prolog.* MIT Press; 1990.\n!!!(p) {:.reflist}\n\nPearl Judea.\n*Heuristics: Intelligent Search Strategies for Computer Problem Solving.* Addison-Wesley; 1984.\n!!!(p) {:.reflist}\n\nPearl Judea.\n*Probabilistic Reasoning in Intelligent Systems: Networks of Plausible Inference.* Morgan Kaufmann; 1988.\n!!!(p) {:.reflist}\n\nPearl Judea.\n*Bayesian and Belief-Functions Formalisms for Evidential Reasoning: A Conceptual Analysis.* In: Proceedings, Fifth Israeli Symposium on Artificial Intelligence; 1989 Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nPereira Fernando C.N., Shieber Stuart M.\n*Prolog and Natural-Language Analysis.* Center for the Study of Language and Information; 1987 Lecture Notes no.\n10.\n!!!(p) {:.reflist}\n\nPereira Fernando C.N., Warren David H.D.\nDefinite clause grammars for language analysis-a survey of the formalism and a comparison with augmented transition networks.\n*Artificial Intelligence.* 1980;13:231-278 Reprinted in Grosz et al.\n1986.\n!!!(p) {:.reflist}\n\nPerlis Alan.\nEpigrams on Programming.\n*ACM SIGPLAN Notices.* 1982;17(no.\n9).\n!!!(p) {:.reflist}\n\nPlaisted David A.\nNon-Horn Clause Logic Programming Without Contra-positives.\n*Journal of Automated Reasoning.* 1988;4:287-325.\n!!!(p) {:.reflist}\n\nQuillian M.\nRoss.\nWord Concepts: A Theory of Simulation of Some Basic Semantic Capabilities.\n*Behavioral Science.* 1967;12:410-430 Reprinted in Brachman and Levesque 1985.\n!!!(p) {:.reflist}\n\nQuirk Randolph, Greenbaum Sidney, Leech Geoffrey, Svartik Jan.\n*A Comprehensive Grammar of the English Language.* Longman; 1985.\n!!!(p) {:.reflist}\n\nRamsey Allan, Barrett Rosalind.\n*AI in Practice: Examples in Pop-11.* Halstead Press; 1987.\n!!!(p) {:.reflist}\n\nRich Elaine, Knight Kevin.\n*Artificial Intelligence.* McGraw-Hill; 1991.\n!!!(p) {:.reflist}\n\nRisch RH.\nThe Problem of Integration in Finite Terms.\n*Translations of the A.M.S.* 1969;139:167-189.\n!!!(p) {:.reflist}\n\nRisch RH.\nAlgebraic Properties of the Elementary Functions of Analysis.\n*American Journal of Mathematics.* 1979;101:743-759.\n!!!(p) {:.reflist}\n\nRobinson JA.\nA Machine-Oriented Logic Based on the Resolution Principle.\n*Journal of the ACM.* 1965;12(no.\n1):23-41.\n!!!(p) {:.reflist}\n\nRosenbloom Paul S.\nA World-Championship-Level Othello Program.\n*Artificial Intelligence.* 1982;19:279-320.\n!!!(p) {:.reflist}\n\nRoussel Phillipe.\n*Prolog: manual de reference et d'utilization.* Groupe d'Intelligence Artificielle, Universit&eacute; d'Aix-Marseille; 1975.\n!!!(p) {:.reflist}\n\nRowe Neal.\n*Artificial Intelligence Through Prolog.* Prentice-Hall; 1988.\n!!!(p) {:.reflist}\n\nRuf Erik, Weise Daniel.\nLogScheme: Integrating Logic Programming into Scheme.\n*Lisp and Symbolic Computation.* 1990;3(no.\n3):245-288.\n!!!(p) {:.reflist}\n\nRussell Stuart.\n*The Compleat Guide to MRS.* Stanford University; 1985 Computer Science Dept.\nReport no.\nSTAN-CS-85-1080,\n!!!(p) {:.reflist}\n\nRussell Stuart, Wefald Eric.\n*On Optimal Game-Tree Search using Rational Meta-Reasoning.* In: Proceedings of the International Joint Conference on Artificial Intelligence; 1989:334-340.\n!!!(p) {:.reflist}\n\nSacerdoti Earl.\nPlanning in a Hierarchy of Abstraction Spaces.\n*Artificial Intelligence.* 1974;5:115-135 Reprinted in Allen, Hendler, and Tate 1990.\n!!!(p) {:.reflist}\n\nSager Naomi.\n*Natural Language Information Processing.* Addison-Wesley; 1981.\n!!!(p) {:.reflist}\n\nSamuel AL.\nSome Studies in Machine Learning Using the Game of Checkers.\n*IBM Journal of Research and Development.* 1959;3:210-229 Reprinted in Feigenbaum and Feldman 1963.\n!!!(p) {:.reflist}\n\nSangal Rajeev.\n*Programming Paradigms in Lisp.* McGraw Hill; 1991.\n!!!(p) {:.reflist}\n\nSchank Roger C., Colby Kenneth Mark.\n*Computer Models of Thought and Language.* Freeman; 1973.\n!!!(p) {:.reflist}\n\nSchank Roger C., Riesbeck Christopher.\n*Inside Computer Understanding.* Lawrence Erlbaum; 1981.\n!!!(p) {:.reflist}\n\nSchmolze J.G., Lipkis T.A.\n*Classification in the KL-ONE Knowledge Representation System.* In: Proceedings of the Eighth IJCAI; 1983:330-332.\n!!!(p) {:.reflist}\n\nSedgewick Robert.\n*Algorithms.* Addison-Wesley; 1988.\n!!!(p) {:.reflist}\n\nShannon Claude E.\nProgramming a Digital Computer for Playing Chess.\n*Philosophy Magazine.* 1950a;41:356-375.\n!!!(p) {:.reflist}\n\nShannon Claude E.\nAutomatic Chess Player.\nIn: *Scientific American.* 1950b:182 Feb.,\n!!!(p) {:.reflist}\n\nShebs Stan T., Kessler Robert R.\nAutomatic Design and Implementation of Language Data Types.\n*SIGPLAN 87 Symposium on Interpreters and Interpretive Techniques (ACM SIGPLAN Notices.* 1987;22(no.\n7):26-37.\n!!!(p) {:.reflist}\n\nShapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n!!!(p) {:.reflist}\n\nShafer Glenn, Pearl Judea.\n*Readings in Uncertain Reasoning.* Morgan Kaufmann; 1990.\n!!!(p) {:.reflist}\n\nSheil BA.\nPower Tools for Programmers.\nIn: *Datamation.* 1983:131-144 Feb.,\n!!!(p) {:.reflist}\n\nShortliffe Edward H.\n*Computer-Based Medical Consultation: MYCIN.* American Elsevier; 1976.\n!!!(p) {:.reflist}\n\nShortliffe Edward H., Buchanan Bruce G.\nA Model of Inexact reasoning in Medicine.\n*Mathematical Biosciences.* 1975;23:351-379 Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nSlade Richard.\n*The T Programming Language: A Dialect of Lisp.* Prentice Hall; 1987.\n!!!(p) {:.reflist}\n\nSlagle J.R.\nA heuristic program that solves symbolic integration problems in freshman calculus.\nIn: Feigenbaum and Feldman, eds.\n*Computers and Thought.* 1963:191-203 Also in journal of the ACM 10:507-520.\n!!!(p) {:.reflist}\n\nSpiegelhalter David J.\nA Statistical View of Uncertainty in Expert Systems.\nIn: Gale W., ed.\nAddison-Wesley; 1986:.\n*Artificial Intelligence and Statistics.* Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nStaples John, Robinson Peter J.\nEfficient Unification of Quantified Terms.\n*Journal of Logic Programming.* 1988;5:133-149.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L.\n*LAMBDA: The Ultimate Imperative.* 1976a AI Lab Memo 353, MIT.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L.\n*LAMBDA: The Ultimate Declarative.* 1976b AI Lab Memo 379, MIT.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L.\n*Debunking the 'Expensive Procedure Call' Myth or, Procedure Call Implementations Considered Harmful or, LAMBDA: The Ultimate GOTO.* 1977 AI Lab Memo 443, MIT.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L.\n*Rabbit: a Compiler for Scheme (A Study in Compiler Optimization).* 1978 AI Lab Technical Report 474, MIT.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L.\nCompiler optimization based on viewing lambda as Rename Plus Goto.\nIn: MIT Press; . *AI: An MIT Perspective.* 1983;vol.\n2.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L.\n*Common Lisp the Language.* Digital Press; 1984.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L.\n*Common Lisp the Language.* 2d edition Digital Press; 1990.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L., Sussman Gerald J.\n*The revised report on Scheme, a dialect of Lisp.* 1978a AI Lab Memo 452, MIT.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L., Sussman Gerald J.\n*The art of the interpreter, or the modularity complex (parts zero, one, and two).* 1978b AI Lab Memo 453, MIT.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L., Jay Sussman Gerald.\n*Design of LISP-Based Processors or, SCHEME: A Dielectric LISP or, Finite Memories Considered Harmful or, LAMBDA: The Ultimate Opcode.* 1979 AI Lab Memo 379, MIT.\n!!!(p) {:.reflist}\n\nSteele Jr.\nGuy L., Sussman Gerald J.\nDesign of a Lisp-Based Processor.\n*Communications of the ACM.* 1980;23(no.\n11):628-645.\n!!!(p) {:.reflist}\n\nStefik Mark, Bobrow Daniel G.\nObject-Oriented Programming: Themes and Variations.\n*AI Magazine.* 1986;6(no.\n4).\n!!!(p) {:.reflist}\n\nSterling Leon, Shapiro Ehud.\n*The Art of Prolog.* MIT Press; 1986.\n!!!(p) {:.reflist}\n\nSterling L., Bundy A., Byrd L., O'Keefe R., Silver B.\nSolving Symbolic Equations with PRESS.\nIn: Calmet J., ed.\n*Computer Algebra, Lecture Notes in Computer Science No.\n144.* Springer-Verlag; 1982:109-116 Also in Journal of Symbolic Computation 7 (1989):71-84.\n!!!(p) {:.reflist}\n\nStickel Mark.\nA Prolog Technology Theorem Prover: Implementation by an Extended Prolog Compiler.\n*Journal of Automated Reasoning.* 1988;4:353-380.\n!!!(p) {:.reflist}\n\nStoyan Herbert.\n*Early Lisp History.* In: Proceedings of the Lisp and Functional Programming Conference; 1984:299-310.\n!!!(p) {:.reflist}\n\nStroustrup Bjarne.\n*The C++ Programming Language.* Addison-Wesley; 1986.\n!!!(p) {:.reflist}\n\nSussman Gerald J.\n*A Computer Model of Skill Acquisition.* Elsevier; 1973.\n!!!(p) {:.reflist}\n\nTanimoto Steven.\n*The Elements of Artificial Intelligence using Common Lisp.* Computer Science Press; 1990.\n!!!(p) {:.reflist}\n\nTate Austin.\nGenerating Project Networks.\n*IJCAI-77.* Boston; 1977 Reprinted in Allen, Hendler, and Tate 1990.\n!!!(p) {:.reflist}\n\nTater Deborah G.\n*A Programmees Guide to Common Lisp.* Digital Press; 1987.\n!!!(p) {:.reflist}\n\nThomason Richmond.\n*Formal Philosophy-Selected Papers of Richard Montague.* Yale University Press; 1974.\n!!!(p) {:.reflist}\n\nTouretzky David.\n*Common Lisp: A Gentle Introduction to Symbolic Computation.* Benjamin/Cummings; 1989.\n!!!(p) {:.reflist}\n\nTversky Amos, Kahneman Daniel.\nJudgement Under Uncertainty: Heuristics and Biases.\n*Science.* 1974;185:1124-1131 Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nTversky Amos, Kahneman Daniel.\nExtensional Versus Intuitive Reasoning: The Conjunction Fallacy in Probability Judgement.\n*Psychological Review.* 1983;90:29-315.\n!!!(p) {:.reflist}\n\nTversky Amos, Kahneman Daniel.\nRational Choices and the Framing of Decisions.\n*Journal of Business.* 1986;59:S251-S278 Reprinted in Shafer and Pearl 1990.\n!!!(p) {:.reflist}\n\nUngar David.\n*Generation Scavenging: A Non-Disruptive High Performance Storage Reclamation Algorithm.* In: Proceedings of the ACM SIGSOFT/ SIGPLAN Software Engineering Symposium on Practical Software Development En vironments (Pittsburgh, Pa., April); 1984:157-167 ACM SIGPLAN Notices 19, no.\n5.\n!!!(p) {:.reflist}\n\nvan Emden Maarten H., Yukawa Keitaro.\nLogic Programming with Equations.\n*Journal of Logic Programming.* 1987;4:265-288.\n!!!(p) {:.reflist}\n\nvan Melle WJ.\n*System Aids in Constructing Consultation Programs.* UMI Research Press; 1980.\n!!!(p) {:.reflist}\n\nVan Roy, Peter L.\n*Can Logic Programming Execute as Fast as Imperative Programming?.* Report UCB/CSD 90/600 Berkeley: University of California; 1990.\n!!!(p) {:.reflist}\n\nVygotsky Lev Semenovich.\n*Thought and Language.* MIT Press; 1962.\n!!!(p) {:.reflist}\n\nWaibel Alex, Lee Kai-Fu.\n*Readings in Speech Understanding.* Morgan Kaufmann; 1991.\n!!!(p) {:.reflist}\n\nWaldinger Richard.\nAchieving Several Goals Simultaneously.\nIn: *Machine Intelligence 8.* Ellis Horwood Limited; 1977.\n!!!(p) {:.reflist}\n\nWalker Adrian, McCord Michael, Sowa John F., Wilson Walter G.\n*Knowledge Systems and Prolog.* Addison-Wesley; 1990.\n!!!(p) {:.reflist}\n\nWaltz David I.\nUnderstanding Line Drawings of Scenes with Shadows.\nIn: Winston Patrick H., ed.\n*The Psychology of Computer Vision.* McGraw-Hill; 1975.\n!!!(p) {:.reflist}\n\nWaltz David I.\nWaltz Filtering.\nIn: Shapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n!!!(p) {:.reflist}\n\nWand Mitchell.\nContinuation-Based Program Transformation Strategies.\n*Journal of the ACM.* 1980;27(no.\n1):174-180.\n!!!(p) {:.reflist}\n\nWarren David H.D.\n*WARPLAN: A System for Generating Plans.* 1974a Department of Computational Logic Memo 76, AI, Edinburgh University.\n!!!(p) {:.reflist}\n\nWarren David H.D.\n*Extract from APIC Studies in Data Processing, No.\n24.* 1974b Reprinted in Allen, Hendler, and Tate, 1990.\n!!!(p) {:.reflist}\n\nWarren David H.D.\nProlog on the DECsystem-10.\nIn: Michie Donald, ed.\n*Expert Systems in the Micro-Electronic Age.* Edinburgh University Press; 1979.\n!!!(p) {:.reflist}\n\nWarren David H.D.\n*An abstract Prolog instruction set.* 1983 Technical Note 309, SRI International.\n!!!(p) {:.reflist}\n\nWarren David H.D., Pereira L.M., Pereira Fernando C.N.\n*Prolog-the Language and its Implementation Compared with Lisp.* In: Proceedings of the ACM SIGART-SIGPLAN Symposium on AI and Programming Languages; 1977.\n!!!(p) {:.reflist}\n\nWarren David H.D., Pereira Fernando C.N.\nAn Efficient Easily Adaptable System for Interpreting Natural Language Queries.\n*American Journal of Computational Linguistics.* 1982;8(nos.3-4):110-122.\n!!!(p) {:.reflist}\n\nWaterman David A.\n*A Guide to Expert Systems.* Addison-Wesley; 1986.\n!!!(p) {:.reflist}\n\nWaters Richard C.\nSupporting the Regression Testing of Lisp Programs.\n*Lisp Pointers.* 1991;4(no.\n2):47-53.\n!!!(p) {:.reflist}\n\nWegner Peter.\nDimensions of object-based language design.\nIn: *ACM SIG-PLAN Notices.* 1987:168-182.\n!!!(p) {:.reflist}\n\nWeinreb Daniel, Moon David A.\n*Flavors: Message Passing in the Lisp Machine.* 1980 AI Memo no.\n602, Project MAC, MIT.\n!!!(p) {:.reflist}\n\nWeiss Sholom M., Kulikowski Casimar A.\n*A Practical Guide to Designing Expert Systems.* Rowman & Allanheld; 1984.\n!!!(p) {:.reflist}\n\nWeissman Clark.\n*Lisp 1.5 Primer.* Dickenson; 1967.\n!!!(p) {:.reflist}\n\nWeizenbaum Joseph.\nELIZA-A computer program for the study of natural language communication between men and machines.\n*Communications of the ACM.* 1966;9:36-45.\n!!!(p) {:.reflist}\n\nWeizenbaum Joseph.\n*Computer Power and Human Reason.* Freeman; 1976.\n!!!(p) {:.reflist}\n\nWhorf Benjamin Lee.\n*Language, Thought, and Reality.* MIT Press; 1956.\n!!!(p) {:.reflist}\n\nWilensky Robert.\n*Common LISPcraft.* Norton; 1986.\n!!!(p) {:.reflist}\n\nWinograd Terry.\n*Language as a Cognitive Process.* Addison-Wesley; 1983.\n!!!(p) {:.reflist}\n\nWinston Patrick H.\n*The Psychology of Computer Vision.* McGraw-Hill; 1975.\n!!!(p) {:.reflist}\n\nWinston Patrick H.\n*Artificial Intelligence.* Addison-Wesley; 1984.\n!!!(p) {:.reflist}\n\nWinston Patrick H., Horn Bertold K.P.\n*Lisp.* 3d ed Addison-Wesley; 1988.\n!!!(p) {:.reflist}\n\nWirth N.\n*Algorithms + Data Structures = Programs.* Prentice Hall; 1976.\n!!!(p) {:.reflist}\n\nWong Douglas.\n*Language Comprehension in a Problem Solver.* In: Proceedings of the International Joint Conference on Artificial Intelligence; 1981:7-12.\n!!!(p) {:.reflist}\n\nWoods William A.\nTransition Network Grammars for Natural Language Analysis.\n*Communications of the ACM.* 1970;13:591-606 Reprinted in Grosz et al.\n1986.\n!!!(p) {:.reflist}\n\nWoods William A.\nWhat's in a Link: Foundations for Semantic Networks.\nIn: Bobrow D.G., Collins A.M., eds.\n*Representation and Understanding.* Academic Press; 1975.\n!!!(p) {:.reflist}\n\nWoods William A.\nLunar Rocks on Natural English: Explorations in Natural Language Question Answering.\nIn: Zamponi A., ed.\n*Linguistic Structures Processing.* Elsevier-North-Holland; 1977.\n!!!(p) {:.reflist}\n\nZabih Ramin, McAllester David, Chapman David.\n*Non-Deterministic Lisp with Dependency-Directed Backtracking.* In: Proceedings of the AAAI; 1987.\n!!!(p) {:.reflist}\n\nZadeh Lotfi.\nFuzzy Sets as a Basis for a Theory of Possibility.\n*Fuzzy Sets Systems.* 1978;1:3-28.\n!!!(p) {:.reflist}\n\nZucker S.W.\nVision, Early.\nIn: Shapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n!!!(p) {:.reflist}\n\n\n\n# Index\n{:#in0010}\n{:.indextitle}\n\nSymbols and 0-9\n!!!(p) {:.idxletter}\n\n`!` [420](B9780080571157500121.xhtml#p420)\n`&allow-other-keys` [101](B9780080571157500030.xhtml#p101)\n`&aux` [102](B9780080571157500030.xhtml#p102)\n`&body` [102](B9780080571157500030.xhtml#p102)\n`&key` [98](B9780080571157500030.xhtml#p98)\n`&optional` [98](B9780080571157500030.xhtml#p98)\n`&rest` [101](B9780080571157500030.xhtml#p101)\n`()` [10](B9780080571157500017.xhtml#p10)\n`*abbrevs*` [740](B9780080571157500212.xhtml#p740)\n`*acc*` [848](B9780080571157500248.xhtml#p848)\n`*bigger-grammar*` [43](B9780080571157500029.xhtml#p43)\n`*bindings*` [300](B9780080571157500091.xhtml#p300)\n`*board*` [623](B9780080571157500182.xhtml#p623),[624](B9780080571157500182.xhtml#p624)\n`*cities*` [197](B9780080571157500066.xhtml#p197)\n`*clock*` [623](B9780080571157500182.xhtml#p623),[624](B9780080571157500182.xhtml#p624)\n`*db-predicates*` [360](B978008057115750011X.xhtml#p360),[361](B978008057115750011X.xhtml#p361)\n`*dbg-ids*` [124](B9780080571157500042.xhtml#p124)\n`*debug-io*` [124](B9780080571157500042.xhtml#p124)\n`*depth-incr*` [484](B9780080571157500145.xhtml#p484)\n`*depth-max*` [484](B9780080571157500145.xhtml#p484)\n`*depth-start*` [484](B9780080571157500145.xhtml#p484)\n`*edge-table*` [639](B9780080571157500182.xhtml#p639)\n`*examples*` [708](B9780080571157500200.xhtml#p708)\n`*grammar*` [657](B9780080571157500194.xhtml#p657)\n`*grammar1*` [657](B9780080571157500194.xhtml#p657)\n`*grammar3*` [657](B9780080571157500194.xhtml#p657)\n`*grammar4*` [661](B9780080571157500194.xhtml#p661)\n`*infix->prefix-rules*` [249](B978008057115750008X.xhtml#p249)\n`*label-num*` [786](B9780080571157500236.xhtml#p786),[788](B9780080571157500236.xhtml#p788)\n`*maze-ops*` [134](B9780080571157500042.xhtml#p134)\n`*move-number*` [623](B9780080571157500182.xhtml#p623),[624](B9780080571157500182.xhtml#p624)\n`*occurs-check*` [356](B978008057115750011X.xhtml#p356),[361](B978008057115750011X.xhtml#p361)\n`*open-categories*` [664](B9780080571157500194.xhtml#p664)\n`*ops*` [114](B9780080571157500042.xhtml#p114),[127](B9780080571157500042.xhtml#p127)\n`*package*` [835](B9780080571157500248.xhtml#p835)\n`*ply-boards*` [623](B9780080571157500182.xhtml#p623),[634](B9780080571157500182.xhtml#p634)\n`*predicate*` [421](B9780080571157500121.xhtml#p421)\n`*primitive-fns*` [786](B9780080571157500236.xhtml#p786),[823](B9780080571157500236.xhtml#p823)\n`*primitives*` [489](B9780080571157500145.xhtml#p489)\n`*print-gensym*` [855](B9780080571157500248.xhtml#p855)\n`*print-level*` [379](B978008057115750011X.xhtml#p379)\n`*profiled-functions*` [290](B9780080571157500091.xhtml#p290)\n`*readtable*` [821](B9780080571157500236.xhtml#p821)\n`*rules-for*` [297](B9780080571157500091.xhtml#p297)\n`*scheme-procs*` [757](B9780080571157500224.xhtml#p757),[759](B9780080571157500224.xhtml#p759)\n`*scheme-readtable*` [821](B9780080571157500236.xhtml#p821)\n`*school-ops*` [117](B9780080571157500042.xhtml#p117)\n`*search-cut-off*` [483](B9780080571157500145.xhtml#p483)\n`*simple-grammar*` [39](B9780080571157500029.xhtml#p39)\n`*simplification-rules*` [243](B978008057115750008X.xhtml#p243),[247](B978008057115750008X.xhtml#p247),[249](B978008057115750008X.xhtml#p249)\n`*standard-output*` [124](B9780080571157500042.xhtml#p124),[888](B978008057115750025X.xhtml#p888)\n`*state*` [114](B9780080571157500042.xhtml#p114)\n`*static-edge-table*` [643](B9780080571157500182.xhtml#p643)\n`*student-rules*` [221](B9780080571157500078.xhtml#p221)\n`*systems*` [892](B978008057115750025X.xhtml#p892)\n`*trail*` [379](B978008057115750011X.xhtml#p379),[391](B9780080571157500121.xhtml#p391)\n`*uncompiled*` [408](B9780080571157500121.xhtml#p408)\n`*uniq-atom-table*` [334](B9780080571157500108.xhtml#p334)\n`*uniq-cons-table*` [334](B9780080571157500108.xhtml#p334)\n`*var-counter*` [379](B978008057115750011X.xhtml#p379)\n`*vars*` [340](B9780080571157500108.xhtml#p340)\n`*weights*` [609](B9780080571157500182.xhtml#p609)\n`*world*` [498](B9780080571157500145.xhtml#p498),[500](B9780080571157500145.xhtml#p500)\n`,` [68](B9780080571157500030.xhtml#p68)\n`,@` [68](B9780080571157500030.xhtml#p68)\n`-->` [690](B9780080571157500200.xhtml#p690)\n`-if` [61](B9780080571157500030.xhtml#p61)\n`-if-not` [61](B9780080571157500030.xhtml#p61)\n`:-` [690](B9780080571157500200.xhtml#p690)\n`:LABEL` [819](B9780080571157500236.xhtml#p819)\n`:after` [447](B9780080571157500133.xhtml#p447)\n`:before` [447](B9780080571157500133.xhtml#p447)\n`:end keywords` [895](B978008057115750025X.xhtml#p895)\n`:ex` [708](B9780080571157500200.xhtml#p708),[744](B9780080571157500212.xhtml#p744)\n`:pass` [394](B9780080571157500121.xhtml#p394)\n`:print-function` [379](B978008057115750011X.xhtml#p379),[499](B9780080571157500145.xhtml#p499)\n`:sem` [705](B9780080571157500200.xhtml#p705)\n`:test` [128](B9780080571157500042.xhtml#p128)\n`:test-not` [100](B9780080571157500030.xhtml#p100)\n`<-` [351](B978008057115750011X.xhtml#p351),[360](B978008057115750011X.xhtml#p360),[361](B978008057115750011X.xhtml#p361),[373](B978008057115750011X.xhtml#p373),[399](B9780080571157500121.xhtml#p399)\n`=` [374](B978008057115750011X.xhtml#p374),[395](B9780080571157500121.xhtml#p395),[406](B9780080571157500121.xhtml#p406),[745](B9780080571157500212.xhtml#p745)\n`=/2` [414](B9780080571157500121.xhtml#p414)\n`==>` [705](B9780080571157500200.xhtml#p705),[707](B9780080571157500200.xhtml#p707)\n`>-num` [894](B978008057115750025X.xhtml#p894)\n`?` [379](B978008057115750011X.xhtml#p379)\n`?*` [183](B9780080571157500066.xhtml#p183)\n`?+` [183](B9780080571157500066.xhtml#p183)\n`?-` [361](B978008057115750011X.xhtml#p361),[363](B978008057115750011X.xhtml#p363),[364](B978008057115750011X.xhtml#p364),[373](B978008057115750011X.xhtml#p373),[391](B9780080571157500121.xhtml#p391)\n`??` [183](B9780080571157500066.xhtml#p183),[494](B9780080571157500145.xhtml#p494)\n`?and` [183](B9780080571157500066.xhtml#p183)\n`?if` [183](B9780080571157500066.xhtml#p183)\n`?is` [183](B9780080571157500066.xhtml#p183)\n`?not` [183](B9780080571157500066.xhtml#p183)\n`?or` [183](B9780080571157500066.xhtml#p183)\n`#'` [14](B9780080571157500017.xhtml#p14),[92](B9780080571157500030.xhtml#p92)\n`#+` [292](B9780080571157500091.xhtml#p292)\n`#-` [292](B9780080571157500091.xhtml#p292)\n`#.` [340](B9780080571157500108.xhtml#p340),[645](B9780080571157500182.xhtml#p645)\n`#d` [822](B9780080571157500236.xhtml#p822)\n`#f` [754](B9780080571157500224.xhtml#p754),[822](B9780080571157500236.xhtml#p822)\n`#t` [754](B9780080571157500224.xhtml#p754),[822](B9780080571157500236.xhtml#p822)\n`&rest` [754](B9780080571157500224.xhtml#p754)\n`\\+` [415](B9780080571157500121.xhtml#p415)\n`^` [243](B978008057115750008X.xhtml#p243)\n`~&` [84](B9780080571157500030.xhtml#p84)\n`~{...~}` [85](B9780080571157500030.xhtml#p85),[230](B9780080571157500078.xhtml#p230)\n`~^` [85](B9780080571157500030.xhtml#p85)\n`~a` [84](B9780080571157500030.xhtml#p84),[230](B9780080571157500078.xhtml#p230)\n`~f` [84](B9780080571157500030.xhtml#p84)\n`~r` [84](B9780080571157500030.xhtml#p84)\n`~s` [84](B9780080571157500030.xhtml#p84)\n`10*N+D` [670](B9780080571157500194.xhtml#p670)\n`68000 assembler` [319](B9780080571157500108.xhtml#p319)\n`88->h8` [622](B9780080571157500182.xhtml#p622),[623](B9780080571157500182.xhtml#p623)\nA\n!!!(p) {:.idxletter}\n\nA [660](B9780080571157500194.xhtml#p660)\n`a` [494](B9780080571157500145.xhtml#p494)\n`a*-search` [209](B9780080571157500066.xhtml#p209)\nA+ [660](B9780080571157500194.xhtml#p660)\na-lists [74](B9780080571157500030.xhtml#p74)\nA&iuml;t-Kaci, Hassan [385](B978008057115750011X.xhtml#p385),[426](B9780080571157500121.xhtml#p426),[504](B9780080571157500145.xhtml#p504)\nabbrev [740](B9780080571157500212.xhtml#p740)\nabbreviations [732](B9780080571157500212.xhtml#p732),[739](B9780080571157500212.xhtml#p739)\nAbelson, Harold [213](B9780080571157500066.xhtml#p213),[307](B9780080571157500091.xhtml#p307),[367](B978008057115750011X.xhtml#p367),[383](B978008057115750011X.xhtml#p383),[511](B9780080571157500157.xhtml#p511),[777](B9780080571157500224.xhtml#p777),[825](B9780080571157500236.xhtml#p825)\nabstract machine [810](B9780080571157500236.xhtml#p810)\nabstraction [423](B9780080571157500121.xhtml#p423)\nABSTRIPS [147](B9780080571157500042.xhtml#p147)\n`account` [436](B9780080571157500133.xhtml#p436),[445](B9780080571157500133.xhtml#p445)\n`account-deposit` [437](B9780080571157500133.xhtml#p437)\n`account-interest` [437](B9780080571157500133.xhtml#p437)\n`account-withdraw` [437](B9780080571157500133.xhtml#p437)\naccumulator [329](B9780080571157500108.xhtml#p329),[686](B9780080571157500200.xhtml#p686),[698](B9780080571157500200.xhtml#p698)\naccumulators [63](B9780080571157500030.xhtml#p63)\naccusative case [717](B9780080571157500212.xhtml#p717)\n`achieve` [114](B9780080571157500042.xhtml#p114),[140](B9780080571157500042.xhtml#p140)\n`achieve-all` [120](B9780080571157500042.xhtml#p120),[128](B9780080571157500042.xhtml#p128),[139](B9780080571157500042.xhtml#p139)\n`achieve-each` [139](B9780080571157500042.xhtml#p139)\n`acons` [50](B9780080571157500030.xhtml#p50)\n`action-p` [136](B9780080571157500042.xhtml#p136)\nActors [457](B9780080571157500133.xhtml#p457)\nAda [27](B9780080571157500017.xhtml#p27),[459](B9780080571157500133.xhtml#p459),[837](B9780080571157500248.xhtml#p837)\n`add-body` [843](B9780080571157500248.xhtml#p843)\n`add-clause` [360](B978008057115750011X.xhtml#p360),[361](B978008057115750011X.xhtml#p361),[408](B9780080571157500121.xhtml#p408)\n`add-examples` [709](B9780080571157500200.xhtml#p709)\n`add-fact` [486](B9780080571157500145.xhtml#p486),[490](B9780080571157500145.xhtml#p490)\n`add-noun-form` [742](B9780080571157500212.xhtml#p742)\n`add-test` [843](B9780080571157500248.xhtml#p843)\n`add-var` [843](B9780080571157500248.xhtml#p843)\n`add-verb` [742](B9780080571157500212.xhtml#p742)\n`adder` [92](B9780080571157500030.xhtml#p92)\n`Adj` [38](B9780080571157500029.xhtml#p38)\n`adj` [716](B9780080571157500212.xhtml#p716),[731](B9780080571157500212.xhtml#p731)\n`Adj*` [38](B9780080571157500029.xhtml#p38)\n`adjectives` [738](B9780080571157500212.xhtml#p738)\n`adjunct` [716](B9780080571157500212.xhtml#p716),[719](B9780080571157500212.xhtml#p719),[720](B9780080571157500212.xhtml#p720),[723](B9780080571157500212.xhtml#p723)\n`adjuncts` [718](B9780080571157500212.xhtml#p718)\n`adverb` [716](B9780080571157500212.xhtml#p716),[732](B9780080571157500212.xhtml#p732)\nadverbial phrase [723](B9780080571157500212.xhtml#p723)\nadverbs [723](B9780080571157500212.xhtml#p723),[738](B9780080571157500212.xhtml#p738)\n`advp` [716](B9780080571157500212.xhtml#p716)\nAho, A.V. [307](B9780080571157500091.xhtml#p307)\n`air-distance` [201](B9780080571157500066.xhtml#p201)\nM [60](B9780080571157500030.xhtml#p60),[678](B9780080571157500194.xhtml#p678)\n`all-directions` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\n`all-parses` [675](B9780080571157500194.xhtml#p675)\n`all-squares` [602](B9780080571157500182.xhtml#p602),[603](B9780080571157500182.xhtml#p603),[631](B9780080571157500182.xhtml#p631)\nAllen, James [748](B9780080571157500212.xhtml#p748)\nAllen, John [148](B9780080571157500042.xhtml#p148),[777](B9780080571157500224.xhtml#p777),[825](B9780080571157500236.xhtml#p825)\nalpha cutoff [615](B9780080571157500182.xhtml#p615)\n`alpha-beta` [602](B9780080571157500182.xhtml#p602),[616](B9780080571157500182.xhtml#p616)\n`alpha-beta-searcher` [602](B9780080571157500182.xhtml#p602),[616](B9780080571157500182.xhtml#p616)\n`alpha-beta-searcher2` [623](B9780080571157500182.xhtml#p623),[631](B9780080571157500182.xhtml#p631)\n`alpha-beta-searcher3` [623](B9780080571157500182.xhtml#p623),[636](B9780080571157500182.xhtml#p636)\n`alpha-beta2` [623](B9780080571157500182.xhtml#p623),[631](B9780080571157500182.xhtml#p631)\n`alpha-beta3` [623](B9780080571157500182.xhtml#p623),[635](B9780080571157500182.xhtml#p635)\n`always` [832](B9780080571157500236.xhtml#p832),[847](B9780080571157500248.xhtml#p847)\nAmarel, Saul [132](B9780080571157500042.xhtml#p132)\nambiguity [669](B9780080571157500194.xhtml#p669)\n`ambiguous-vertex-p` [569](B9780080571157500170.xhtml#p569),[570](B9780080571157500170.xhtml#p570)\n`and` [53](B9780080571157500030.xhtml#p53),[415](B9780080571157500121.xhtml#p415),[429](B9780080571157500121.xhtml#p429),[485](B9780080571157500145.xhtml#p485),[764](B9780080571157500224.xhtml#p764)\n`and*/2` [708](B9780080571157500200.xhtml#p708)\nAnderson, John [655](B9780080571157500194.xhtml#p655)\n`anon-vars-in` [433](B9780080571157500121.xhtml#p433)\n`anonymous-variables-in` [391](B9780080571157500121.xhtml#p391),[400](B9780080571157500121.xhtml#p400),[433](B9780080571157500121.xhtml#p433)\nantecedent rules [561](B9780080571157500169.xhtml#p561)\n`any-legal-move?` [602](B9780080571157500182.xhtml#p602),[606](B9780080571157500182.xhtml#p606)\n`append` [11](B9780080571157500017.xhtml#p11),[69](B9780080571157500030.xhtml#p69),[848](B9780080571157500248.xhtml#p848)\n`append-pipes` [285](B9780080571157500091.xhtml#p285)\n`append1` [659](B9780080571157500194.xhtml#p659)\n`applicable-ops` [213](B9780080571157500066.xhtml#p213)\n`apply` [18](B9780080571157500017.xhtml#p18),[91](B9780080571157500030.xhtml#p91)\n`apply-op` [115](B9780080571157500042.xhtml#p115),[129](B9780080571157500042.xhtml#p129)\n`apply-scorer` [672](B9780080571157500194.xhtml#p672)\n`apply-semantics` [668](B9780080571157500194.xhtml#p668)\n`appropriate-ops` [141](B9780080571157500042.xhtml#p141)\n`appropriate-p` [114](B9780080571157500042.xhtml#p114),[129](B9780080571157500042.xhtml#p129)\n`apropos` [86](B9780080571157500030.xhtml#p86),[878](B978008057115750025X.xhtml#p878)\n`arch` [587](B9780080571157500170.xhtml#p587),[589](B9780080571157500170.xhtml#p589),[590](B9780080571157500170.xhtml#p590),[593](B9780080571157500170.xhtml#p593)\n`aref` [73](B9780080571157500030.xhtml#p73)\n`arg-count` [795](B9780080571157500236.xhtml#p795),[799](B9780080571157500236.xhtml#p799)\n`arg1` [812](B9780080571157500236.xhtml#p812)\n`arg2` [674](B9780080571157500194.xhtml#p674),[812](B9780080571157500236.xhtml#p812)\n`arg3` [812](B9780080571157500236.xhtml#p812)\n`arg`*i* [795](B9780080571157500236.xhtml#p795)\n`ARGS` [785](B9780080571157500236.xhtml#p785),[805](B9780080571157500236.xhtml#p805),[814](B9780080571157500236.xhtml#p814),[815](B9780080571157500236.xhtml#p815)\n`args` [390](B9780080571157500121.xhtml#p390),[391](B9780080571157500121.xhtml#p391),[795](B9780080571157500236.xhtml#p795),[812](B9780080571157500236.xhtml#p812)\n`args->prefix` [513](B9780080571157500157.xhtml#p513),[520](B9780080571157500157.xhtml#p520)\nargument \nkeyword [322](B9780080571157500108.xhtml#p322),[877](B978008057115750025X.xhtml#p877)\noptional [322](B9780080571157500108.xhtml#p322),[412](B9780080571157500121.xhtml#p412),[877](B978008057115750025X.xhtml#p877)\nrest [322](B9780080571157500108.xhtml#p322),[805](B9780080571157500236.xhtml#p805)\nAristotle [111](B9780080571157500042.xhtml#p111),[147](B9780080571157500042.xhtml#p147)\narrow (=>) [5](B9780080571157500017.xhtml#p5)\n`art` [716](B9780080571157500212.xhtml#p716),[731](B9780080571157500212.xhtml#p731)\n`Article` [36](B9780080571157500029.xhtml#p36)\narticles [738](B9780080571157500212.xhtml#p738)\n`as` [845](B9780080571157500248.xhtml#p845)\n`ask-vals` [533](B9780080571157500169.xhtml#p533),[539](B9780080571157500169.xhtml#p539)\n`asm-first-pass` [795](B9780080571157500236.xhtml#p795),[812](B9780080571157500236.xhtml#p812)\n`asm-second-pass` [795](B9780080571157500236.xhtml#p795),[813](B9780080571157500236.xhtml#p813)\n`assemble` [795](B9780080571157500236.xhtml#p795),[812](B9780080571157500236.xhtml#p812)\n`assembler` [805](B9780080571157500236.xhtml#p805)\n`assert` [88](B9780080571157500030.xhtml#p88)\n`assert-equal` [295](B9780080571157500091.xhtml#p295)\n`assoc` [73](B9780080571157500030.xhtml#p73)\nasymptotic complexity [274](B9780080571157500091.xhtml#p274)\n`atom/1` [745](B9780080571157500212.xhtml#p745)\nattributive adjectives [749](B9780080571157500212.xhtml#p749)\n`audited-account` [447](B9780080571157500133.xhtml#p447)\naugmented transition network (ATN) [712](B9780080571157500200.xhtml#p712)\nAutoLisp [ix](B9780080571157500261.xhtml#pix)\n`aux` [716](B9780080571157500212.xhtml#p716),[731](B9780080571157500212.xhtml#p731)\n`aux-inv-S` [716](B9780080571157500212.xhtml#p716),[727](B9780080571157500212.xhtml#p727)\nauxiliary verb [735](B9780080571157500212.xhtml#p735)\n`average` [87](B9780080571157500030.xhtml#p87)\nB\n!!!(p) {:.idxletter}\n\nbackquote [68](B9780080571157500030.xhtml#p68)\n`backquote` [822](B9780080571157500236.xhtml#p822)\nbacktrack points [420](B9780080571157500121.xhtml#p420)\n`backtrack-points` [772](B9780080571157500224.xhtml#p772)\nbacktracking [349](B978008057115750011X.xhtml#p349),[367](B978008057115750011X.xhtml#p367),[372](B978008057115750011X.xhtml#p372),[772](B9780080571157500224.xhtml#p772)\nautomatic [349](B978008057115750011X.xhtml#p349)\nchronological [773](B9780080571157500224.xhtml#p773)\nBackus-Naur Form (BNF) [678](B9780080571157500194.xhtml#p678)\nbackward-chaining [351](B978008057115750011X.xhtml#p351),[536](B9780080571157500169.xhtml#p536),[543](B9780080571157500169.xhtml#p543)\nBacon, Francis [460](B9780080571157500145.xhtml#p460)\nbag [416](B9780080571157500121.xhtml#p416)\nbagof/3 [416](B9780080571157500121.xhtml#p416)\nbananas [132](B9780080571157500042.xhtml#p132)\nbank-account [92](B9780080571157500030.xhtml#p92)\nBarrett, Rosalind [xv](B9780080571157500261.xhtml#pxv),[594](B9780080571157500170.xhtml#p594),[748](B9780080571157500212.xhtml#p748)\nBatali, John [810](B9780080571157500236.xhtml#p810)\nBayes's law [557](B9780080571157500169.xhtml#p557)\nBayesian classification [652](B9780080571157500182.xhtml#p652)\nbe [735](B9780080571157500212.xhtml#p735)\n`beam-problem` [452](B9780080571157500133.xhtml#p452)\n`beam-search` [196](B9780080571157500066.xhtml#p196)\n`begin` [754](B9780080571157500224.xhtml#p754)\nbelief functions [557](B9780080571157500169.xhtml#p557)\nbenchmark [295](B9780080571157500091.xhtml#p295),[411](B9780080571157500121.xhtml#p411),[522](B9780080571157500157.xhtml#p522)\nBerkeley, California [633](B9780080571157500182.xhtml#p633)\nBerlin, Andrew [267](B9780080571157500091.xhtml#p267)\n`best-first-search` [194](B9780080571157500066.xhtml#p194)\n`best-problem` [452](B9780080571157500133.xhtml#p452)\nbeta cutoff [615](B9780080571157500182.xhtml#p615)\n`better-path` [210](B9780080571157500066.xhtml#p210)\n`bfs-problem` [450](B9780080571157500133.xhtml#p450)\nBill [597](B9780080571157500182.xhtml#p597),[636](B9780080571157500182.xhtml#p636),[651](B9780080571157500182.xhtml#p651)\n`binary-exp-p` [229](B9780080571157500078.xhtml#p229),[242](B978008057115750008X.xhtml#p242)\n`binary-tree` [192](B9780080571157500066.xhtml#p192)\n`binary-tree-eql-best-beam-problem` [452](B9780080571157500133.xhtml#p452)\n`binary-tree-problem` [451](B9780080571157500133.xhtml#p451)\n`bind-new-variables` [391](B9780080571157500121.xhtml#p391),[405](B9780080571157500121.xhtml#p405)\n`bind-unbound-vars` [391](B9780080571157500121.xhtml#p391),[398](B9780080571157500121.xhtml#p398)\n`bind-variables-in` [391](B9780080571157500121.xhtml#p391),[404](B9780080571157500121.xhtml#p404)\n`binding-val` [157](B9780080571157500054.xhtml#p157),[391](B9780080571157500121.xhtml#p391)\nbinomial theorem [524](B9780080571157500157.xhtml#p524)\n`bit` [73](B9780080571157500030.xhtml#p73)\nbit sequence [79](B9780080571157500030.xhtml#p79)\nbit vector [79](B9780080571157500030.xhtml#p79)\n`black` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\nblock [65](B9780080571157500030.xhtml#p65)\n`block` [754](B9780080571157500224.xhtml#p754),[767](B9780080571157500224.xhtml#p767)\nblocks world [136](B9780080571157500042.xhtml#p136),[211](B9780080571157500066.xhtml#p211)\nblood test [558](B9780080571157500169.xhtml#p558)\nBOA constructor [221](B9780080571157500078.xhtml#p221)\n`board` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\nBobrow, Daniel [219](B9780080571157500078.xhtml#p219),[234](B9780080571157500078.xhtml#p234),[458](B9780080571157500133.xhtml#p458)\nbody [351](B978008057115750011X.xhtml#p351)\n`bound-p` [377](B978008057115750011X.xhtml#p377)\nboundary line [566](B9780080571157500170.xhtml#p566)\nBoyer, R. S. [425](B9780080571157500121.xhtml#p425)\nBrachman, Ronald J. [503](B9780080571157500145.xhtml#p503)\n`bracketing` [675](B9780080571157500194.xhtml#p675)\nBratko, Ivan [383](B978008057115750011X.xhtml#p383)\n`breadth-first-search` [192](B9780080571157500066.xhtml#p192)\n`break` [87](B9780080571157500030.xhtml#p87)\n`bref` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\nBrooks, Rodney A. [259](B978008057115750008X.xhtml#p259)\nBrown, Allen [142](B9780080571157500042.xhtml#p142)\nBuchanan, Bruce G. [557](B9780080571157500169.xhtml#p557),[558](B9780080571157500169.xhtml#p558)\n`build-cases` [276](B9780080571157500091.xhtml#p276)\n`build-code` [276](B9780080571157500091.xhtml#p276)\n`build-exp` [302](B9780080571157500091.xhtml#p302)\n`butlast` [877](B978008057115750025X.xhtml#p877)\nButler, Nicholas Murray [530](B9780080571157500169.xhtml#p530)\nbyte-code assembly [811](B9780080571157500236.xhtml#p811)\nC\n!!!(p) {:.idxletter}\n\nC [ix](B9780080571157500261.xhtml#pix),[837](B9780080571157500248.xhtml#p837)\nC++ [459](B9780080571157500133.xhtml#p459)\ncache [536](B9780080571157500169.xhtml#p536)\ncalculus [252](B978008057115750008X.xhtml#p252)\n`CALL` [785](B9780080571157500236.xhtml#p785),[811](B9780080571157500236.xhtml#p811),[820](B9780080571157500236.xhtml#p820)\n`call-loop-fn` [844](B9780080571157500248.xhtml#p844)\n`call-next-method` [445](B9780080571157500133.xhtml#p445)\n`call-with-current-continuation` [372](B978008057115750011X.xhtml#p372),[770](B9780080571157500224.xhtml#p770)\n`call/1` [414](B9780080571157500121.xhtml#p414),[745](B9780080571157500212.xhtml#p745)\n`call/cc` [425](B9780080571157500121.xhtml#p425),[754](B9780080571157500224.xhtml#p754),[757](B9780080571157500224.xhtml#p757),[776](B9780080571157500224.xhtml#p776),[780](B9780080571157500224.xhtml#p780),[810](B9780080571157500236.xhtml#p810)\n`CALLJ` [814](B9780080571157500236.xhtml#p814),[820](B9780080571157500236.xhtml#p820)\nCannon, Howard [457](B9780080571157500133.xhtml#p457)\n`canon` [513](B9780080571157500157.xhtml#p513),[521](B9780080571157500157.xhtml#p521)\n`canon->prefix` [513](B9780080571157500157.xhtml#p513),[520](B9780080571157500157.xhtml#p520)\n`canon-simplifier` [513](B9780080571157500157.xhtml#p513),[521](B9780080571157500157.xhtml#p521)\ncanonical simplification [510](B9780080571157500157.xhtml#p510)\n`car` [14](B9780080571157500017.xhtml#p14),[69](B9780080571157500030.xhtml#p69)\nCarbonell, Jamie [167](B9780080571157500054.xhtml#p167)\n`cardinal` [716](B9780080571157500212.xhtml#p716),[732](B9780080571157500212.xhtml#p732)\nCarlyle, Thomas [175](B9780080571157500066.xhtml#p175)\n`case` [53](B9780080571157500030.xhtml#p53),[764](B9780080571157500224.xhtml#p764),[879](B978008057115750025X.xhtml#p879)\ncase sensitive [8](B9780080571157500017.xhtml#p8)\nCassio [597](B9780080571157500182.xhtml#p597)\nCatalan Numbers [663](B9780080571157500194.xhtml#p663)\ncatch [623](B9780080571157500182.xhtml#p623),[769](B9780080571157500224.xhtml#p769),[837](B9780080571157500248.xhtml#p837)\ncatch point [410](B9780080571157500121.xhtml#p410)\ncategories [485](B9780080571157500145.xhtml#p485)\nclosed-class [664](B9780080571157500194.xhtml#p664)\nopen-class [664](B9780080571157500194.xhtml#p664)\ncategory names [660](B9780080571157500194.xhtml#p660)\n`CC` [810](B9780080571157500236.xhtml#p810),[815](B9780080571157500236.xhtml#p815)\n`ccase` [88](B9780080571157500030.xhtml#p88)\n`cdr` [14](B9780080571157500017.xhtml#p14),[69](B9780080571157500030.xhtml#p69)\ncdr-coding [522](B9780080571157500157.xhtml#p522)\nCerf, Jonathan [637](B9780080571157500182.xhtml#p637)\n`cerror` [87](B9780080571157500030.xhtml#p87)\ncertainty factors [532](B9780080571157500169.xhtml#p532)\n`cf->english` [533](B9780080571157500169.xhtml#p533),[551](B9780080571157500169.xhtml#p551)\n`cf-and` [533](B9780080571157500169.xhtml#p533),[535](B9780080571157500169.xhtml#p535)\n`cf-cut-off` [533](B9780080571157500169.xhtml#p533),[536](B9780080571157500169.xhtml#p536)\n`cf-or` [533](B9780080571157500169.xhtml#p533),[535](B9780080571157500169.xhtml#p535)\n`cf-p` [533](B9780080571157500169.xhtml#p533),[536](B9780080571157500169.xhtml#p536)\nchange a field [873](B978008057115750025X.xhtml#p873)\nChapman, David [148](B9780080571157500042.xhtml#p148)\n`char` [73](B9780080571157500030.xhtml#p73)\n`char-ready?` [756](B9780080571157500224.xhtml#p756)\n`char?` [756](B9780080571157500224.xhtml#p756)\nCharniak, Eugene [xiii](B9780080571157500261.xhtml#pxiii),[xv](B9780080571157500261.xhtml#pxv),[345](B9780080571157500108.xhtml#p345),[383](B978008057115750011X.xhtml#p383),[504](B9780080571157500145.xhtml#p504),[586](B9780080571157500170.xhtml#p586),[594](B9780080571157500170.xhtml#p594),[823](B9780080571157500236.xhtml#p823),[887](B978008057115750025X.xhtml#p887)\nchart parsers [679](B9780080571157500194.xhtml#p679)\nChat-80 [711](B9780080571157500200.xhtml#p711)\n`check-conditions` [533](B9780080571157500169.xhtml#p533),[549](B9780080571157500169.xhtml#p549)\n`check-diagram` [569](B9780080571157500170.xhtml#p569),[588](B9780080571157500170.xhtml#p588)\n`check-reply` [533](B9780080571157500169.xhtml#p533),[540](B9780080571157500169.xhtml#p540)\n`check-type` [88](B9780080571157500030.xhtml#p88)\ncheckers [651](B9780080571157500182.xhtml#p651)\nCheeseman, Peter [558](B9780080571157500169.xhtml#p558)\nchess [652](B9780080571157500182.xhtml#p652)\nchoice of names [888](B978008057115750025X.xhtml#p888)\nChomsky, Noam [655](B9780080571157500194.xhtml#p655)\n`choose-first` [773](B9780080571157500224.xhtml#p773)\nChurch, Alonzo [20](B9780080571157500017.xhtml#p20)\nChurch, Kenneth [663](B9780080571157500194.xhtml#p663)\n`city` [197](B9780080571157500066.xhtml#p197),[198](B9780080571157500066.xhtml#p198)\nclass [436](B9780080571157500133.xhtml#p436)\nvariable [436](B9780080571157500133.xhtml#p436)\nclause [350](B978008057115750011X.xhtml#p350),[723](B9780080571157500212.xhtml#p723)\n`clause` [361](B978008057115750011X.xhtml#p361),[716](B9780080571157500212.xhtml#p716),[724](B9780080571157500212.xhtml#p724)\n`clause-body` [360](B978008057115750011X.xhtml#p360)\n`clause-head` [360](B978008057115750011X.xhtml#p360)\n`clauses-with-arity` [390](B9780080571157500121.xhtml#p390),[391](B9780080571157500121.xhtml#p391)\n`clear-abbrevs` [740](B9780080571157500212.xhtml#p740)\n`clear-db` [361](B978008057115750011X.xhtml#p361),[362](B978008057115750011X.xhtml#p362),[533](B9780080571157500169.xhtml#p533),[537](B9780080571157500169.xhtml#p537)\n`clear-dtrees` [476](B9780080571157500145.xhtml#p476)\n`clear-examples` [708](B9780080571157500200.xhtml#p708)\n`clear-grammar` [744](B9780080571157500212.xhtml#p744)\n`clear-lexicon` [744](B9780080571157500212.xhtml#p744)\n`clear-m-array` [318](B9780080571157500108.xhtml#p318)\n`clear-memoize` [275](B9780080571157500091.xhtml#p275)\n`clear-predicate` [361](B978008057115750011X.xhtml#p361),[362](B978008057115750011X.xhtml#p362)\n`clear-rules` [533](B9780080571157500169.xhtml#p533),[545](B9780080571157500169.xhtml#p545)\ncliche [60](B9780080571157500030.xhtml#p60),[176](B9780080571157500066.xhtml#p176)\nClinger, William [777](B9780080571157500224.xhtml#p777)\nClocksin, William F. [382](B978008057115750011X.xhtml#p382)\nCLOS [xii](B9780080571157500261.xhtml#pxii),[30](B9780080571157500017.xhtml#p30),[435](B9780080571157500133.xhtml#p435),[439](B9780080571157500133.xhtml#p439),[445-446](B9780080571157500133.xhtml#p445),[448](B9780080571157500133.xhtml#p448),[453-454](B9780080571157500133.xhtml#p453),[456](B9780080571157500133.xhtml#p456),[458-459](B9780080571157500133.xhtml#p458)\nflaw in [448](B9780080571157500133.xhtml#p448)\nclosed world assumption [466](B9780080571157500145.xhtml#p466)\nclosure [92](B9780080571157500030.xhtml#p92),[457](B9780080571157500133.xhtml#p457)\nClowes, Maxwell B. [594](B9780080571157500170.xhtml#p594)\n`clrhash` [74](B9780080571157500030.xhtml#p74)\nCMU Lisp [327](B9780080571157500108.xhtml#p327)\n`coef` [512-514](B9780080571157500157.xhtml#p512)\ncoefficients of a polynomial [510](B9780080571157500157.xhtml#p510)\nCoelho, Helder [147](B9780080571157500042.xhtml#p147),[383](B978008057115750011X.xhtml#p383)\nCohen, Jacques [426](B9780080571157500121.xhtml#p426),[504](B9780080571157500145.xhtml#p504)\nColby, Kenneth [153](B9780080571157500054.xhtml#p153),[167](B9780080571157500054.xhtml#p167),[655](B9780080571157500194.xhtml#p655)\n`collect` [848](B9780080571157500248.xhtml#p848),[863](B9780080571157500248.xhtml#p863)\n`collect-sems` [707](B9780080571157500200.xhtml#p707)\n`collecting` [849](B9780080571157500248.xhtml#p849)\nCollins, Allan [167](B9780080571157500054.xhtml#p167)\nColmerauer, Alain [382](B978008057115750011X.xhtml#p382),[504](B9780080571157500145.xhtml#p504),[684](B9780080571157500200.xhtml#p684),[711](B9780080571157500200.xhtml#p711)\n`combine-all` [45](B9780080571157500029.xhtml#p45)\n`combine-all-pipes` [286](B9780080571157500091.xhtml#p286)\n`combine-edge-moves` [642](B9780080571157500182.xhtml#p642)\n`combine-quasiquote` [824](B9780080571157500236.xhtml#p824)\n`combine-rules` [304](B9780080571157500091.xhtml#p304)\ncommand [725](B9780080571157500212.xhtml#p725)\ncomment [6](B9780080571157500017.xhtml#p6)\ncommon cases [717](B9780080571157500212.xhtml#p717)\nCommon Lisp [vii-xiv](B9780080571157500261.xhtml#pvii),[4](B9780080571157500017.xhtml#p4),[7-9](B9780080571157500017.xhtml#p7),[12](B9780080571157500017.xhtml#p12),[20](B9780080571157500017.xhtml#p20),[24](B9780080571157500017.xhtml#p24),[25](B9780080571157500017.xhtml#p25),[27](B9780080571157500017.xhtml#p27),[29](B9780080571157500017.xhtml#p29),[30](B9780080571157500017.xhtml#p30),[48-51](B9780080571157500030.xhtml#p48),[55](B9780080571157500030.xhtml#p55),[57](B9780080571157500030.xhtml#p57),[62](B9780080571157500030.xhtml#p62),[66](B9780080571157500030.xhtml#p66),[68](B9780080571157500030.xhtml#p68),[72](B9780080571157500030.xhtml#p72),[74](B9780080571157500030.xhtml#p74),[76](B9780080571157500030.xhtml#p76),[78](B9780080571157500030.xhtml#p78),[79](B9780080571157500030.xhtml#p79),[81](B9780080571157500030.xhtml#p81),[82](B9780080571157500030.xhtml#p82),[84](B9780080571157500030.xhtml#p84),[85](B9780080571157500030.xhtml#p85),[88](B9780080571157500030.xhtml#p88),[91](B9780080571157500030.xhtml#p91),[93](B9780080571157500030.xhtml#p93),[94](B9780080571157500030.xhtml#p94),[97](B9780080571157500030.xhtml#p97),[98](B9780080571157500030.xhtml#p98),[101-103](B9780080571157500030.xhtml#p101),[106](B9780080571157500030.xhtml#p106),[110](B9780080571157500042.xhtml#p110),[112](B9780080571157500042.xhtml#p112),[113](B9780080571157500042.xhtml#p113),[115](B9780080571157500042.xhtml#p115),[120](B9780080571157500042.xhtml#p120),[122](B9780080571157500042.xhtml#p122),[155](B9780080571157500054.xhtml#p155),[156](B9780080571157500054.xhtml#p156),[161](B9780080571157500054.xhtml#p161),[165](B9780080571157500054.xhtml#p165),[178](B9780080571157500066.xhtml#p178),[182](B9780080571157500066.xhtml#p182),[203](B9780080571157500066.xhtml#p203),[245](B978008057115750008X.xhtml#p245),[246](B978008057115750008X.xhtml#p246),[266-268](B9780080571157500091.xhtml#p266),[278](B9780080571157500091.xhtml#p278),[279](B9780080571157500091.xhtml#p279),[281](B9780080571157500091.xhtml#p281),[292](B9780080571157500091.xhtml#p292),[317](B9780080571157500108.xhtml#p317),[318](B9780080571157500108.xhtml#p318),[321](B9780080571157500108.xhtml#p321),[322](B9780080571157500108.xhtml#p322),[330](B9780080571157500108.xhtml#p330),[346](B9780080571157500108.xhtml#p346),[372](B978008057115750011X.xhtml#p372),[411](B9780080571157500121.xhtml#p411),[419](B9780080571157500121.xhtml#p419),[435](B9780080571157500133.xhtml#p435),[438](B9780080571157500133.xhtml#p438),[439](B9780080571157500133.xhtml#p439),[445](B9780080571157500133.xhtml#p445),[504](B9780080571157500145.xhtml#p504),[514](B9780080571157500157.xhtml#p514),[522](B9780080571157500157.xhtml#p522),[574](B9780080571157500170.xhtml#p574),[623](B9780080571157500182.xhtml#p623),[632](B9780080571157500182.xhtml#p632),[652](B9780080571157500182.xhtml#p652),[666](B9780080571157500194.xhtml#p666),[678](B9780080571157500194.xhtml#p678),[753-755](B9780080571157500224.xhtml#p753),[759](B9780080571157500224.xhtml#p759),[760](B9780080571157500224.xhtml#p760),[762](B9780080571157500224.xhtml#p762),[766](B9780080571157500224.xhtml#p766),[767](B9780080571157500224.xhtml#p767),[769](B9780080571157500224.xhtml#p769),[771](B9780080571157500224.xhtml#p771),[774](B9780080571157500224.xhtml#p774),[780](B9780080571157500224.xhtml#p780),[783](B9780080571157500224.xhtml#p783),[811](B9780080571157500236.xhtml#p811),[822](B9780080571157500236.xhtml#p822),[823](B9780080571157500236.xhtml#p823),[825](B9780080571157500236.xhtml#p825),[826](B9780080571157500236.xhtml#p826),[828](B9780080571157500236.xhtml#p828),[830](B9780080571157500236.xhtml#p830),[834-840](B9780080571157500248.xhtml#p834),[843](B9780080571157500248.xhtml#p843),[852](B9780080571157500248.xhtml#p852),[853](B9780080571157500248.xhtml#p853),[855](B9780080571157500248.xhtml#p855),[857](B9780080571157500248.xhtml#p857),[872](B978008057115750025X.xhtml#p872),[876](B978008057115750025X.xhtml#p876),[877](B978008057115750025X.xhtml#p877),[879](B978008057115750025X.xhtml#p879),[882-885](B978008057115750025X.xhtml#p882),[891](B978008057115750025X.xhtml#p891),[894](B978008057115750025X.xhtml#p894),[895](B978008057115750025X.xhtml#p895),[900](B9780080571157500273.xhtml#p900)\nCommonLoops [458](B9780080571157500133.xhtml#p458)\n`commutative-p` [229](B9780080571157500078.xhtml#p229)\n`comp` [786](B9780080571157500236.xhtml#p786),[798](B9780080571157500236.xhtml#p798)\n`comp-begin` [786](B9780080571157500236.xhtml#p786),[787](B9780080571157500236.xhtml#p787),[800](B9780080571157500236.xhtml#p800)\n`comp-const` [795](B9780080571157500236.xhtml#p795),[800](B9780080571157500236.xhtml#p800)\n`comp-funcall` [795](B9780080571157500236.xhtml#p795),[803](B9780080571157500236.xhtml#p803)\n`comp-go` [795](B9780080571157500236.xhtml#p795)\n`comp-if` [786](B9780080571157500236.xhtml#p786),[787](B9780080571157500236.xhtml#p787),[801](B9780080571157500236.xhtml#p801),[831](B9780080571157500236.xhtml#p831)\n`comp-lambda` [786](B9780080571157500236.xhtml#p786),[788](B9780080571157500236.xhtml#p788)\n`comp-list` [795](B9780080571157500236.xhtml#p795),[800](B9780080571157500236.xhtml#p800)\n`comp-show` [786](B9780080571157500236.xhtml#p786),[789](B9780080571157500236.xhtml#p789)\n`comp-var` [795](B9780080571157500236.xhtml#p795),[800](B9780080571157500236.xhtml#p800)\ncompact disc player [665](B9780080571157500194.xhtml#p665)\ncompilation [526](B9780080571157500157.xhtml#p526)\n`compile-all-rules-indexed` [306](B9780080571157500091.xhtml#p306)\n`compile-arg` [391](B9780080571157500121.xhtml#p391),[395](B9780080571157500121.xhtml#p395),[399](B9780080571157500121.xhtml#p399),[404](B9780080571157500121.xhtml#p404)\n`compile-args` [302](B9780080571157500091.xhtml#p302)\n`compile-body` [391](B9780080571157500121.xhtml#p391),[394](B9780080571157500121.xhtml#p394),[405](B9780080571157500121.xhtml#p405),[422](B9780080571157500121.xhtml#p422)\n`compile-call` [391](B9780080571157500121.xhtml#p391),[394](B9780080571157500121.xhtml#p394)\n`compile-clause` [391](B9780080571157500121.xhtml#p391),[394](B9780080571157500121.xhtml#p394),[397](B9780080571157500121.xhtml#p397),[406](B9780080571157500121.xhtml#p406)\n`compile-exp` [301](B9780080571157500091.xhtml#p301)\n`compile-file` [645](B9780080571157500182.xhtml#p645)\n`compile-if` [391](B9780080571157500121.xhtml#p391),[403](B9780080571157500121.xhtml#p403)\n`compile-indexed-rule` [304](B9780080571157500091.xhtml#p304)\n`compile-predicate` [391](B9780080571157500121.xhtml#p391),[392](B9780080571157500121.xhtml#p392),[397](B9780080571157500121.xhtml#p397),[422](B9780080571157500121.xhtml#p422)\n`compile-rule` [276](B9780080571157500091.xhtml#p276),[300](B9780080571157500091.xhtml#p300)\n`compile-rule-set` [304](B9780080571157500091.xhtml#p304)\n`compile-unify` [391](B9780080571157500121.xhtml#p391),[395](B9780080571157500121.xhtml#p395),[402](B9780080571157500121.xhtml#p402)\n`compile-unify-variable` [391](B9780080571157500121.xhtml#p391),[403](B9780080571157500121.xhtml#p403)\ncompiled \nfor effect [792](B9780080571157500236.xhtml#p792)\nfor value [792](B9780080571157500236.xhtml#p792)\ncompiler [275](B9780080571157500091.xhtml#p275),[298](B9780080571157500091.xhtml#p298)\ncontext-free [798](B9780080571157500236.xhtml#p798)\ncontext-sensitive [798](B9780080571157500236.xhtml#p798)\nversus interpreter [277](B9780080571157500091.xhtml#p277)\n`compiler` [786](B9780080571157500236.xhtml#p786),[788](B9780080571157500236.xhtml#p788)\n`complement` [101](B9780080571157500030.xhtml#p101),[716](B9780080571157500212.xhtml#p716),[728](B9780080571157500212.xhtml#p728)\n`complements` [718](B9780080571157500212.xhtml#p718)\n`complete-parses` [658](B9780080571157500194.xhtml#p658)\n`compose` [177](B9780080571157500066.xhtml#p177),[217](B9780080571157500066.xhtml#p217)\ncomputation on lists [6](B9780080571157500017.xhtml#p6)\ncomputer vision [565](B9780080571157500170.xhtml#p565)\n`concat` [411](B9780080571157500121.xhtml#p411),[686](B9780080571157500200.xhtml#p686)\nconcave line [566](B9780080571157500170.xhtml#p566)\n`conclude` [533](B9780080571157500169.xhtml#p533),[547](B9780080571157500169.xhtml#p547)\n`cond` [53](B9780080571157500030.xhtml#p53),[764](B9780080571157500224.xhtml#p764),[782](B9780080571157500224.xhtml#p782),[878](B978008057115750025X.xhtml#p878)\n`conj-category` [711](B9780080571157500200.xhtml#p711)\n`conj-rule` [710](B9780080571157500200.xhtml#p710)\n`conjuncts` [708](B9780080571157500200.xhtml#p708)\n`cons` [11](B9780080571157500017.xhtml#p11),[69](B9780080571157500030.xhtml#p69),[328](B9780080571157500108.xhtml#p328)\ncons cells [69](B9780080571157500030.xhtml#p69)\nconsistency [464](B9780080571157500145.xhtml#p464)\nconsistency checker [90](B9780080571157500030.xhtml#p90)\n`consistent-labelings` [569](B9780080571157500170.xhtml#p569),[572](B9780080571157500170.xhtml#p572)\n`consp` [69](B9780080571157500030.xhtml#p69)\n`CONST` [785](B9780080571157500236.xhtml#p785),[812](B9780080571157500236.xhtml#p812),[814](B9780080571157500236.xhtml#p814)\nconstants [889](B978008057115750025X.xhtml#p889)\nconstraint propagation [568](B9780080571157500170.xhtml#p568)\n`construct-diagram` [569](B9780080571157500170.xhtml#p569),[576](B9780080571157500170.xhtml#p576)\n`construct-vertex` [569](B9780080571157500170.xhtml#p569),[576](B9780080571157500170.xhtml#p576)\n`context` [533](B9780080571157500169.xhtml#p533),[542](B9780080571157500169.xhtml#p542)\ncontexts [538](B9780080571157500169.xhtml#p538),[541](B9780080571157500169.xhtml#p541)\ncontinuation [300](B9780080571157500091.xhtml#p300),[367](B978008057115750011X.xhtml#p367)\n`continue-p` [369](B978008057115750011X.xhtml#p369)\n`convert-number` [829](B9780080571157500236.xhtml#p829)\n`convert-numbers` [829](B9780080571157500236.xhtml#p829)\n`convert-op` [126](B9780080571157500042.xhtml#p126)\nconvex line [566](B9780080571157500170.xhtml#p566)\nCooper, Thomas A. [266](B9780080571157500091.xhtml#p266)\n`copula` [735](B9780080571157500212.xhtml#p735),[744](B9780080571157500212.xhtml#p744)\n`copy-board` [602](B9780080571157500182.xhtml#p602),[603](B9780080571157500182.xhtml#p603)\n`copy-poly` [516](B9780080571157500157.xhtml#p516)\n`copy-tree` [76](B9780080571157500030.xhtml#p76)\n`corner-for` [642](B9780080571157500182.xhtml#p642)\n`corner-p` [642](B9780080571157500182.xhtml#p642)\n`cost-fn` [452](B9780080571157500133.xhtml#p452),[453](B9780080571157500133.xhtml#p453)\nCotta, Jose [147](B9780080571157500042.xhtml#p147),[383](B978008057115750011X.xhtml#p383)\n`count` [62](B9780080571157500030.xhtml#p62),[848](B9780080571157500248.xhtml#p848)\n`count-difference` [602](B9780080571157500182.xhtml#p602),[603](B9780080571157500182.xhtml#p603)\n`count-edge-neighbors` [643](B9780080571157500182.xhtml#p643)\n`count-if` [60](B9780080571157500030.xhtml#p60)\n`counting` [849](B9780080571157500248.xhtml#p849)\n`create-1ist-of-equations` [224](B9780080571157500078.xhtml#p224)\n`cross-product` [622](B9780080571157500182.xhtml#p622),[623](B9780080571157500182.xhtml#p623)\n`cube` [575](B9780080571157500170.xhtml#p575)\n`cube-on-plate` [581](B9780080571157500170.xhtml#p581)\n`current-state` [449](B9780080571157500133.xhtml#p449)\ncut [420](B9780080571157500121.xhtml#p420)\nD\n!!!(p) {:.idxletter}\n\nD [660](B9780080571157500194.xhtml#p660)\ndag [345](B9780080571157500108.xhtml#p345)\nDahl, Ole-Johan [456](B9780080571157500133.xhtml#p456)\ndata-driven dispatch [394](B9780080571157500121.xhtml#p394)\nDavenport, J. H. [259](B978008057115750008X.xhtml#p259),[260](B978008057115750008X.xhtml#p260),[528](B9780080571157500157.xhtml#p528)\nDavis, Ernest [503](B9780080571157500145.xhtml#p503)\nDavis, Lawrence [652](B9780080571157500182.xhtml#p652)\nDavis, Randall [549](B9780080571157500169.xhtml#p549)\n`dbg` [124](B9780080571157500042.xhtml#p124)\n`dbg-indent` [124](B9780080571157500042.xhtml#p124)\n`dcg-normal-goal-p` [691](B9780080571157500200.xhtml#p691)\n`dcg-word-list-p` [691](B9780080571157500200.xhtml#p691)\nde Moivre [310](B9780080571157500091.xhtml#p310)\n`debug` [124](B9780080571157500042.xhtml#p124)\ndebugging [85](B9780080571157500030.xhtml#p85)\n`decf` [56](B9780080571157500030.xhtml#p56)\ndecidability [464](B9780080571157500145.xhtml#p464)\ndeclaration [875](B978008057115750025X.xhtml#p875)\ndeclarative languages [435](B9780080571157500133.xhtml#p435)\ndeclared inline [869](B978008057115750025X.xhtml#p869)\n`def-attached-fn` [490](B9780080571157500145.xhtml#p490)\n`def-cons-struct` [347](B9780080571157500108.xhtml#p347)\n`def-optimizer` [819](B9780080571157500236.xhtml#p819)\n`def-optimizer` [819](B9780080571157500236.xhtml#p819)\n`def-prolog-compiler-macro` [391](B9780080571157500121.xhtml#p391),[395](B9780080571157500121.xhtml#p395)\n`def-scheme-macro` [757](B9780080571157500224.xhtml#p757),[763](B9780080571157500224.xhtml#p763)\ndefault rules [561](B9780080571157500169.xhtml#p561)\n`defclass` [445](B9780080571157500133.xhtml#p445)\n`defconstant` [51](B9780080571157500030.xhtml#p51),[157](B9780080571157500054.xhtml#p157)\n`defcontext` [533](B9780080571157500169.xhtml#p533),[542](B9780080571157500169.xhtml#p542)\n`defdiagram` [569](B9780080571157500170.xhtml#p569),[575](B9780080571157500170.xhtml#p575),[588](B9780080571157500170.xhtml#p588)\n`define` [754](B9780080571157500224.xhtml#p754),[762](B9780080571157500224.xhtml#p762),[764](B9780080571157500224.xhtml#p764),[790](B9780080571157500236.xhtml#p790)\n`define-class` [440](B9780080571157500133.xhtml#p440)\n`define-enumerated-type` [654](B9780080571157500182.xhtml#p654)\n`define-setf-method` [514](B9780080571157500157.xhtml#p514),[884](B978008057115750025X.xhtml#p884)\n`define-system` [891](B978008057115750025X.xhtml#p891),[893](B978008057115750025X.xhtml#p893)\ndefining enumerated [652](B9780080571157500182.xhtml#p652)\ndefinite clause grammar (DCG) [690](B9780080571157500200.xhtml#p690),[711](B9780080571157500200.xhtml#p711)\ndefinite integrals [519](B9780080571157500157.xhtml#p519)\n`defloop` [844](B9780080571157500248.xhtml#p844),[849](B9780080571157500248.xhtml#p849)\n`defmacro` [51](B9780080571157500030.xhtml#p51),[66](B9780080571157500030.xhtml#p66)\n`defmethod` [445](B9780080571157500133.xhtml#p445),[446](B9780080571157500133.xhtml#p446)\n`defpackage` [836](B9780080571157500248.xhtml#p836),[891](B978008057115750025X.xhtml#p891)\n`defparameter` [15](B9780080571157500017.xhtml#p15),[39](B9780080571157500029.xhtml#p39),[51](B9780080571157500030.xhtml#p51)\n`defparm` [533](B9780080571157500169.xhtml#p533),[541](B9780080571157500169.xhtml#p541)\n`defresource` [337](B9780080571157500108.xhtml#p337)\n`defrule` [277](B9780080571157500091.xhtml#p277),[533](B9780080571157500169.xhtml#p533),[549](B9780080571157500169.xhtml#p549),[886](B978008057115750025X.xhtml#p886)\n`defsetf` [514](B9780080571157500157.xhtml#p514)\n`defstruct` [51](B9780080571157500030.xhtml#p51)\n`defun` [12](B9780080571157500017.xhtml#p12),[51](B9780080571157500030.xhtml#p51)\n`defun*` [327](B9780080571157500108.xhtml#p327)\n`defun-memo` [273](B9780080571157500091.xhtml#p273)\n`defvar` [39](B9780080571157500029.xhtml#p39),[51](B9780080571157500030.xhtml#p51)\n`deg->radians` [201](B9780080571157500066.xhtml#p201)\n`degree` [512](B9780080571157500157.xhtml#p512),[513](B9780080571157500157.xhtml#p513)\ndegree of a polynomial [510](B9780080571157500157.xhtml#p510)\nDeGroot, A. D. [652](B9780080571157500182.xhtml#p652)\n`delay` [281](B9780080571157500091.xhtml#p281),[762](B9780080571157500224.xhtml#p762),[765](B9780080571157500224.xhtml#p765)\ndelay decisions [25](B9780080571157500017.xhtml#p25)\ndelegation [436](B9780080571157500133.xhtml#p436),[442](B9780080571157500133.xhtml#p442)\n`delete` [62](B9780080571157500030.xhtml#p62)\n`delete-trie` [344](B9780080571157500108.xhtml#p344)\nDempster [557](B9780080571157500169.xhtml#p557)\ndense polynomials [511](B9780080571157500157.xhtml#p511)\n`depth-first-search` [191](B9780080571157500066.xhtml#p191)\n`dequeue` [342](B9780080571157500108.xhtml#p342)\n`deref` [378](B978008057115750011X.xhtml#p378)\n`deref-copy` [417](B9780080571157500121.xhtml#p417),[430](B9780080571157500121.xhtml#p430)\n`deref-equal` [414](B9780080571157500121.xhtml#p414)\n`deref-exp` [410](B9780080571157500121.xhtml#p410)\n`deriv` [257](B978008057115750008X.xhtml#p257)\n`deriv-divides` [257](B978008057115750008X.xhtml#p257)\n`deriv-poly` [513](B9780080571157500157.xhtml#p513),[518](B9780080571157500157.xhtml#p518)\nderivative-divides technique [252](B978008057115750008X.xhtml#p252)\n`describe` [86](B9780080571157500030.xhtml#p86),[878](B978008057115750025X.xhtml#p878)\ndestructive operations [328](B9780080571157500108.xhtml#p328)\n`Det` [687-689](B9780080571157500200.xhtml#p687),[693](B9780080571157500200.xhtml#p693),[695](B9780080571157500200.xhtml#p695),[697](B9780080571157500200.xhtml#p697),[701](B9780080571157500200.xhtml#p701),[716](B9780080571157500212.xhtml#p716),[721](B9780080571157500212.xhtml#p721)\n`determine-winner` [57](B9780080571157500030.xhtml#p57)\nDeutsch, Peter [826](B9780080571157500236.xhtml#p826)\ndeveloping an AI computer program [110](B9780080571157500042.xhtml#p110)\n`dfs-problem` [450](B9780080571157500133.xhtml#p450)\n`diagram` [569](B9780080571157500170.xhtml#p569),[576](B9780080571157500170.xhtml#p576)\n`diff` [194](B9780080571157500066.xhtml#p194)\ndifference between relations and functions [350](B978008057115750011X.xhtml#p350)\ndifference list [702](B9780080571157500200.xhtml#p702)\ndifferentiable field [528](B9780080571157500157.xhtml#p528)\ndifferentiation [248](B978008057115750008X.xhtml#p248)\ndirected acyclic graph (dag) [345](B9780080571157500108.xhtml#p345),[649](B9780080571157500182.xhtml#p649)\n`disassemble` [318](B9780080571157500108.xhtml#p318)\ndisassembled code [318](B9780080571157500108.xhtml#p318)\ndiscrimination net [345](B9780080571157500108.xhtml#p345)\ndiscrimination tree [472](B9780080571157500145.xhtml#p472)\ndisjunction [485](B9780080571157500145.xhtml#p485)\n`displace` [781](B9780080571157500224.xhtml#p781)\n`display` [804](B9780080571157500236.xhtml#p804)\n`distance` [201](B9780080571157500066.xhtml#p201)\ndistinguish unknown from false [496](B9780080571157500145.xhtml#p496)\nditransitive verbs [712](B9780080571157500200.xhtml#p712)\n`div` [839](B9780080571157500248.xhtml#p839)\n`divide-factors` [255](B978008057115750008X.xhtml#p255)\ndividing by zero [233](B9780080571157500078.xhtml#p233)\n`do` [59](B9780080571157500030.xhtml#p59),[852](B9780080571157500248.xhtml#p852)\n`documentation` [87](B9780080571157500030.xhtml#p87),[878](B978008057115750025X.xhtml#p878)\ndocumentation string [12](B9780080571157500017.xhtml#p12)\n`dolist` [58](B9780080571157500030.xhtml#p58)\n`dotimes` [59](B9780080571157500030.xhtml#p59)\ndotted pair notation [69](B9780080571157500030.xhtml#p69)\n`double-float` [320](B9780080571157500108.xhtml#p320)\nDowty, David R. [711](B9780080571157500200.xhtml#p711)\nDoyle, Jon [504](B9780080571157500145.xhtml#p504)\n*Drosophila melanogaster* [596](B9780080571157500182.xhtml#p596)\n`dtree` [476](B9780080571157500145.xhtml#p476)\n`dtree-atom-fetch` [479](B9780080571157500145.xhtml#p479)\n`dtree-fetch` [479](B9780080571157500145.xhtml#p479)\n`dtree-index` [477](B9780080571157500145.xhtml#p477),[498](B9780080571157500145.xhtml#p498)\nDubois, Didier [558](B9780080571157500169.xhtml#p558)\ndynamic extent [771](B9780080571157500224.xhtml#p771)\ndynamic typing [27](B9780080571157500017.xhtml#p27)\nE\n!!!(p) {:.idxletter}\n\n`each` [494](B9780080571157500145.xhtml#p494)\nEarley, Jay [679](B9780080571157500194.xhtml#p679)\n`earth-diameter` [201](B9780080571157500066.xhtml#p201)\n`eat-porridge` [89](B9780080571157500030.xhtml#p89)\n`ecase` [88](B9780080571157500030.xhtml#p88)\necho question [725](B9780080571157500212.xhtml#p725)\n`edge-and-x-lists` [639](B9780080571157500182.xhtml#p639)\n`edge-index` [639](B9780080571157500182.xhtml#p639)\n`edge-move-probability` [642](B9780080571157500182.xhtml#p642)\n`edge-stabi1ity` [639](B9780080571157500182.xhtml#p639)\nEdinburgh Prolog [425](B9780080571157500121.xhtml#p425),[690](B9780080571157500200.xhtml#p690)\nefficiency [461](B9780080571157500145.xhtml#p461)\n`efficient-pat-match` [332](B9780080571157500108.xhtml#p332),[333](B9780080571157500108.xhtml#p333)\nEiffel [455](B9780080571157500133.xhtml#p455),[459](B9780080571157500133.xhtml#p459),[863](B9780080571157500248.xhtml#p863)\nElcock, E. W. [504](B9780080571157500145.xhtml#p504)\nELIZA\n!!!(span) {:.smallcaps}\n [xi](B9780080571157500261.xhtml#pxi),[151-154](B9780080571157500054.xhtml#p151),[159](B9780080571157500054.xhtml#p159),[163-166](B9780080571157500054.xhtml#p163),[168](B9780080571157500054.xhtml#p168),[169](B9780080571157500054.xhtml#p169),[175](B9780080571157500066.xhtml#p175),[178](B9780080571157500066.xhtml#p178),[181](B9780080571157500066.xhtml#p181),[184](B9780080571157500066.xhtml#p184),[187](B9780080571157500066.xhtml#p187),[219-222](B9780080571157500078.xhtml#p219),[234](B9780080571157500078.xhtml#p234),[239](B978008057115750008X.xhtml#p239),[240](B978008057115750008X.xhtml#p240),[309](B9780080571157500091.xhtml#p309),[330](B9780080571157500108.xhtml#p330),[435](B9780080571157500133.xhtml#p435)\n`eliza` [164](B9780080571157500054.xhtml#p164),[177](B9780080571157500066.xhtml#p177)\n`elt` [73](B9780080571157500030.xhtml#p73)\nElvis [536](B9780080571157500169.xhtml#p536)\nEmanuelson, P. [307](B9780080571157500091.xhtml#p307)\n`empty` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\n`empty-pipe` [282](B9780080571157500091.xhtml#p282)\n`empty-queue-p` [342](B9780080571157500108.xhtml#p342)\nEMYCIN\n!!!(span) {:.smallcaps}\n [xii](B9780080571157500261.xhtml#pxii),[532-534](B9780080571157500169.xhtml#p532),[536-538](B9780080571157500169.xhtml#p536),[541](B9780080571157500169.xhtml#p541),[543](B9780080571157500169.xhtml#p543),[544](B9780080571157500169.xhtml#p544),[548-550](B9780080571157500169.xhtml#p548),[559-563](B9780080571157500169.xhtml#p559)\n`emycin` [533](B9780080571157500169.xhtml#p533),[548](B9780080571157500169.xhtml#p548)\nencapsulate information [448](B9780080571157500133.xhtml#p448)\nend game [649](B9780080571157500182.xhtml#p649)\nend of file [822](B9780080571157500236.xhtml#p822)\n`enqueue` [342](B9780080571157500108.xhtml#p342)\n`ensure-generic-fn` [440](B9780080571157500133.xhtml#p440)\n`ensure-generic-function` [445](B9780080571157500133.xhtml#p445)\n`enumerate` [284](B9780080571157500091.xhtml#p284)\nenumerated type [599](B9780080571157500182.xhtml#p599)\nenvironment [758](B9780080571157500224.xhtml#p758)\nglobal [758](B9780080571157500224.xhtml#p758)\n`eof` [821](B9780080571157500236.xhtml#p821)\n`eof-object?` [821](B9780080571157500236.xhtml#p821)\n`eq` [72](B9780080571157500030.xhtml#p72)\n`eq?` [756](B9780080571157500224.xhtml#p756)\n`eql` [72](B9780080571157500030.xhtml#p72)\n`eql-problem` [450](B9780080571157500133.xhtml#p450)\n`equal` [69](B9780080571157500030.xhtml#p69),[72](B9780080571157500030.xhtml#p72)\n`equal?` [756](B9780080571157500224.xhtml#p756)\n`equal p` [72](B9780080571157500030.xhtml#p72)\n`equiv` [832](B9780080571157500236.xhtml#p832)\n`eqv?` [756](B9780080571157500224.xhtml#p756)\nEratosthenes [285](B9780080571157500091.xhtml#p285)\nErnst, G. W. [147](B9780080571157500042.xhtml#p147)\nerror [838](B9780080571157500248.xhtml#p838)\nhandler [838](B9780080571157500248.xhtml#p838)\nsignaling [838](B9780080571157500248.xhtml#p838)\n`error` [87](B9780080571157500030.xhtml#p87)\nerror in transcribing [588](B9780080571157500170.xhtml#p588)\nerrors \nhandling [837](B9780080571157500248.xhtml#p837)\n`eval` [91](B9780080571157500030.xhtml#p91),[245](B978008057115750008X.xhtml#p245)\n`eval-condition` [533](B9780080571157500169.xhtml#p533),[546](B9780080571157500169.xhtml#p546)\n`evaluable` [245](B978008057115750008X.xhtml#p245)\nevaluation [24](B9780080571157500017.xhtml#p24)\nlazy [307](B9780080571157500091.xhtml#p307)\nrule for Lisp [22](B9780080571157500017.xhtml#p22)\n`even?` [756](B9780080571157500224.xhtml#p756)\n`every` [62](B9780080571157500030.xhtml#p62)\nexamples of rules [705](B9780080571157500200.xhtml#p705)\n`executing-p` [126](B9780080571157500042.xhtml#p126)\nexercises \nlevel of difficulty [xv](B9780080571157500261.xhtml#pxv)\nexistentials [467](B9780080571157500145.xhtml#p467)\nexit \nnonlocal [768](B9780080571157500224.xhtml#p768)\n`exp` [242](B978008057115750008X.xhtml#p242)\n`exp-args` [242](B978008057115750008X.xhtml#p242)\n`exp-p` [242](B978008057115750008X.xhtml#p242)\n`expand-pat-match-abbrev` [187](B9780080571157500066.xhtml#p187)\nexpert system [461](B9780080571157500145.xhtml#p461),[530](B9780080571157500169.xhtml#p530)\nexpert-system shells [531](B9780080571157500169.xhtml#p531)\nexplanation [531](B9780080571157500169.xhtml#p531)\n`exponent->prefix` [513](B9780080571157500157.xhtml#p513),[520](B9780080571157500157.xhtml#p520)\nexponentiation [523](B9780080571157500157.xhtml#p523)\nexpression [5](B9780080571157500017.xhtml#p5)\nderived [762](B9780080571157500224.xhtml#p762)\nlambda [21](B9780080571157500017.xhtml#p21)\nrational [526](B9780080571157500157.xhtml#p526)\nreading and evaluating [24](B9780080571157500017.xhtml#p24)\nspecial form [9](B9780080571157500017.xhtml#p9),[22](B9780080571157500017.xhtml#p22)\nexpressiveness [461](B9780080571157500145.xhtml#p461),[464](B9780080571157500145.xhtml#p464)\n`extend-bindings` [158](B9780080571157500054.xhtml#p158),[159](B9780080571157500054.xhtml#p159),[361](B978008057115750011X.xhtml#p361)\n`extend-env` [757](B9780080571157500224.xhtml#p757),[759](B9780080571157500224.xhtml#p759)\n`extend-parse` [659](B9780080571157500194.xhtml#p659),[668](B9780080571157500194.xhtml#p668),[671](B9780080571157500194.xhtml#p671),[681](B9780080571157500194.xhtml#p681),[682](B9780080571157500194.xhtml#p682)\nextensibility [29](B9780080571157500017.xhtml#p29)\nextent [93](B9780080571157500030.xhtml#p93)\nF\n!!!(p) {:.idxletter}\n\n`fact-present-p` [490](B9780080571157500145.xhtml#p490)\n`factorize` [254](B978008057115750008X.xhtml#p254)\nfacts [350](B978008057115750011X.xhtml#p350)\n`fail` [157](B9780080571157500054.xhtml#p157),[361](B978008057115750011X.xhtml#p361),[430](B9780080571157500121.xhtml#p430),[772](B9780080571157500224.xhtml#p772)\nfailure continuations [425](B9780080571157500121.xhtml#p425)\n`false` [532](B9780080571157500169.xhtml#p532),[533](B9780080571157500169.xhtml#p533)\n`false-p` [533](B9780080571157500169.xhtml#p533),[536](B9780080571157500169.xhtml#p536)\n`fast-time->seconds` [292](B9780080571157500091.xhtml#p292)\n`fast-time-difference` [292](B9780080571157500091.xhtml#p292)\nFateman, Richard [259](B978008057115750008X.xhtml#p259),[265](B9780080571157500091.xhtml#p265),[267](B9780080571157500091.xhtml#p267),[511](B9780080571157500157.xhtml#p511),[522](B9780080571157500157.xhtml#p522),[524](B9780080571157500157.xhtml#p524)\nFateman, Richard J. [528](B9780080571157500157.xhtml#p528)\nFeigenbaum, Edward [460](B9780080571157500145.xhtml#p460)\n`fetch` [478](B9780080571157500145.xhtml#p478)\n`fib` [269](B9780080571157500091.xhtml#p269)\nFibonacci [269](B9780080571157500091.xhtml#p269)\nField, A. J. [307](B9780080571157500091.xhtml#p307)\nFikes, Richard [147](B9780080571157500042.xhtml#p147),[503](B9780080571157500145.xhtml#p503)\nfill pointer [330](B9780080571157500108.xhtml#p330)\n`fill-loop-template` [842](B9780080571157500248.xhtml#p842)\nfiller-gap dependency [702](B9780080571157500200.xhtml#p702)\n`filter` [285](B9780080571157500091.xhtml#p285)\n`final-value` [602](B9780080571157500182.xhtml#p602)\n`finally` [852](B9780080571157500248.xhtml#p852)\n`find` [62](B9780080571157500030.xhtml#p62)\n`find-all` [101](B9780080571157500030.xhtml#p101)\n`find-all-if` [100](B9780080571157500030.xhtml#p100)\n`find-anywhere` [255](B978008057115750008X.xhtml#p255),[391](B9780080571157500121.xhtml#p391)\n`find-bracketing-piece` [602](B9780080571157500182.xhtml#p602),[605](B9780080571157500182.xhtml#p605)\n`find-if` [61](B9780080571157500030.xhtml#p61)\n`find-labelings` [569](B9780080571157500170.xhtml#p569),[586](B9780080571157500170.xhtml#p586)\n`find-out` [533](B9780080571157500169.xhtml#p533),[545](B9780080571157500169.xhtml#p545)\n`find-path` [210](B9780080571157500066.xhtml#p210)\n`find-trie` [344](B9780080571157500108.xhtml#p344)\n`find-vertex` [569](B9780080571157500170.xhtml#p569),[573](B9780080571157500170.xhtml#p573)\n`finish-output` [895](B978008057115750025X.xhtml#p895)\nfinite verb [722](B9780080571157500212.xhtml#p722)\n`finite-binary-tree` [193](B9780080571157500066.xhtml#p193)\n`first` [10](B9780080571157500017.xhtml#p10),[69](B9780080571157500030.xhtml#p69)\n`first-class` [27](B9780080571157500017.xhtml#p27)\n`first-match-pos` [185](B9780080571157500066.xhtml#p185)\n`first-name` [13](B9780080571157500017.xhtml#p13),[16](B9780080571157500017.xhtml#p16)\n`first-or-nil` [658](B9780080571157500194.xhtml#p658)\nFischer, Sylvia [554](B9780080571157500169.xhtml#p554)\nFisher, M. J. [504](B9780080571157500145.xhtml#p504)\n`FJUMP` [785](B9780080571157500236.xhtml#p785),[814](B9780080571157500236.xhtml#p814),[820](B9780080571157500236.xhtml#p820)\n`flatten` [165](B9780080571157500054.xhtml#p165),[329](B9780080571157500108.xhtml#p329),[347](B9780080571157500108.xhtml#p347)\nflavors [438](B9780080571157500133.xhtml#p438),[457](B9780080571157500133.xhtml#p457)\n`flet` [870](B978008057115750025X.xhtml#p870)\nflexible flow of control [531](B9780080571157500169.xhtml#p531)\n`float` [320](B9780080571157500108.xhtml#p320)\nfloating-point numbers [875](B978008057115750025X.xhtml#p875)\n`FN` [815](B9780080571157500236.xhtml#p815)\n`fn` [786](B9780080571157500236.xhtml#p786),[788](B9780080571157500236.xhtml#p788),[790](B9780080571157500236.xhtml#p790)\nFodor, Jerry A. [655](B9780080571157500194.xhtml#p655)\n`follow-arc` [344](B9780080571157500108.xhtml#p344)\n`follow-binding` [391](B9780080571157500121.xhtml#p391),[404](B9780080571157500121.xhtml#p404)\n`for` [845](B9780080571157500248.xhtml#p845)\n`for-each` [756](B9780080571157500224.xhtml#p756)\n`force` [281](B9780080571157500091.xhtml#p281)\n`format` [84](B9780080571157500030.xhtml#p84),[230](B9780080571157500078.xhtml#p230),[739](B9780080571157500212.xhtml#p739),[839](B9780080571157500248.xhtml#p839)\noption [625](B9780080571157500182.xhtml#p625)\nformat directives [84](B9780080571157500030.xhtml#p84)\nFORTRAN [84](B9780080571157500030.xhtml#p84),[266](B9780080571157500091.xhtml#p266),[267](B9780080571157500091.xhtml#p267),[434](B9780080571157500133.xhtml#p434),[655](B9780080571157500194.xhtml#p655)\nforward chaining [351](B978008057115750011X.xhtml#p351),[485](B9780080571157500145.xhtml#p485)\nforward pruning [647](B9780080571157500182.xhtml#p647)\nfour semicolons [891](B978008057115750025X.xhtml#p891)\n`fourth` [10](B9780080571157500017.xhtml#p10)\nFowler, Henry Watson [715](B9780080571157500212.xhtml#p715)\nframes [493](B9780080571157500145.xhtml#p493)\nFrancis [355](B978008057115750011X.xhtml#p355)\nFRANZ\n!!!(span) {:.smallcaps}\nLISP\n!!!(span) {:.smallcaps}\n [ix](B9780080571157500261.xhtml#pix)\n`free-of` [255](B978008057115750008X.xhtml#p255)\n`fresh-line` [84](B9780080571157500030.xhtml#p84)\nFrisbee [769](B9780080571157500224.xhtml#p769)\n`front` [342](B9780080571157500108.xhtml#p342)\n`frpoly` [522](B9780080571157500157.xhtml#p522),[528](B9780080571157500157.xhtml#p528)\n`funcall` [91](B9780080571157500030.xhtml#p91),[693](B9780080571157500200.xhtml#p693),[828](B9780080571157500236.xhtml#p828)\n`funcall-if` [861](B9780080571157500248.xhtml#p861)\nfunction [79](B9780080571157500030.xhtml#p79)\napplication [23](B9780080571157500017.xhtml#p23)\ndata-driven [818](B9780080571157500236.xhtml#p818)\ndestructive [80](B9780080571157500030.xhtml#p80),[888](B978008057115750025X.xhtml#p888)\nfirst-class [27](B9780080571157500017.xhtml#p27)\ngeneric [322](B9780080571157500108.xhtml#p322),[436](B9780080571157500133.xhtml#p436),[439](B9780080571157500133.xhtml#p439)\nhigher-order [18](B9780080571157500017.xhtml#p18),[194](B9780080571157500066.xhtml#p194),[839](B9780080571157500248.xhtml#p839)\nlist processing [10](B9780080571157500017.xhtml#p10)\nnew [92](B9780080571157500030.xhtml#p92),[887](B978008057115750025X.xhtml#p887)\nproperly tail-recursive [794](B9780080571157500236.xhtml#p794)\nproving correctness [227](B9780080571157500078.xhtml#p227)\nrecursive [523](B9780080571157500157.xhtml#p523)\nsequence [852](B9780080571157500248.xhtml#p852)\nshort [887](B978008057115750025X.xhtml#p887)\ntail-recursive [63](B9780080571157500030.xhtml#p63)\n`function` [92](B9780080571157500030.xhtml#p92),[872](B978008057115750025X.xhtml#p872)\nfunctional programming [435](B9780080571157500133.xhtml#p435)\n`functionp` [283](B9780080571157500091.xhtml#p283)\nfuzzy set theory [461](B9780080571157500145.xhtml#p461),[558](B9780080571157500169.xhtml#p558)\nG\n!!!(p) {:.idxletter}\n\nGabriel, Richard [522](B9780080571157500157.xhtml#p522)\nGaller, B. A. [504](B9780080571157500145.xhtml#p504)\ngame playing [596](B9780080571157500182.xhtml#p596)\ngarbage collector [328](B9780080571157500108.xhtml#p328)\nephemeral [330](B9780080571157500108.xhtml#p330),[336](B9780080571157500108.xhtml#p336)\ngenerational [330](B9780080571157500108.xhtml#p330)\nGazdar, Richard [679](B9780080571157500194.xhtml#p679),[748](B9780080571157500212.xhtml#p748)\n`gen` [786](B9780080571157500236.xhtml#p786),[789](B9780080571157500236.xhtml#p789)\n`gen-args` [795](B9780080571157500236.xhtml#p795)\n`gen-label` [786](B9780080571157500236.xhtml#p786),[789](B9780080571157500236.xhtml#p789)\n`gen-set` [786](B9780080571157500236.xhtml#p786),[790](B9780080571157500236.xhtml#p790),[804](B9780080571157500236.xhtml#p804)\n`gen-var` [786](B9780080571157500236.xhtml#p786),[790](B9780080571157500236.xhtml#p790)\n`gen1` [795](B9780080571157500236.xhtml#p795),[819](B9780080571157500236.xhtml#p819)\n`generate` [40](B9780080571157500029.xhtml#p40),[41](B9780080571157500029.xhtml#p41)\n`generate-all` [45](B9780080571157500029.xhtml#p45),[286](B9780080571157500091.xhtml#p286)\n`generate-tree` [44](B9780080571157500029.xhtml#p44)\ngeneration scavenging [336](B9780080571157500108.xhtml#p336)\ngeneric function [436](B9780080571157500133.xhtml#p436),[439](B9780080571157500133.xhtml#p439)\ngeneric operations [811](B9780080571157500236.xhtml#p811)\n`generic-fn-p` [440](B9780080571157500133.xhtml#p440)\ngenetic learning [651](B9780080571157500182.xhtml#p651)\n`gensym` [363](B978008057115750011X.xhtml#p363)\n`get` [894](B978008057115750025X.xhtml#p894)\n`get-abbrev` [740](B9780080571157500212.xhtml#p740)\n`get-binding` [157](B9780080571157500054.xhtml#p157),[361](B978008057115750011X.xhtml#p361)\n`get-cf` [533](B9780080571157500169.xhtml#p533),[537](B9780080571157500169.xhtml#p537)\n`get-clauses` [360](B978008057115750011X.xhtml#p360),[361](B978008057115750011X.xhtml#p361)\n`get-context-data` [533](B9780080571157500169.xhtml#p533),[548](B9780080571157500169.xhtml#p548)\n`get-db` [533](B9780080571157500169.xhtml#p533),[537](B9780080571157500169.xhtml#p537)\n`get-dtree` [476](B9780080571157500145.xhtml#p476)\n`get-examples` [708](B9780080571157500200.xhtml#p708)\n`get-fast-time` [292](B9780080571157500091.xhtml#p292)\n`get-global-var` [757](B9780080571157500224.xhtml#p757),[759](B9780080571157500224.xhtml#p759)\n`get-method` [438](B9780080571157500133.xhtml#p438)\n`get-move` [602](B9780080571157500182.xhtml#p602),[607](B9780080571157500182.xhtml#p607),[625](B9780080571157500182.xhtml#p625)\n`get-optimizer` [819](B9780080571157500236.xhtml#p819)\n`get-parm` [533](B9780080571157500169.xhtml#p533),[541](B9780080571157500169.xhtml#p541)\n`get-rules` [533](B9780080571157500169.xhtml#p533),[545](B9780080571157500169.xhtml#p545)\n`get-trie` [344](B9780080571157500108.xhtml#p344)\n`get-vals` [533](B9780080571157500169.xhtml#p533),[537](B9780080571157500169.xhtml#p537)\n`get-var` [757](B9780080571157500224.xhtml#p757),[759](B9780080571157500224.xhtml#p759)\n`get-world` [500](B9780080571157500145.xhtml#p500)\n`gethash` [74](B9780080571157500030.xhtml#p74)\nGinsberg, Matthew L. [214](B9780080571157500066.xhtml#p214)\n`go` [754](B9780080571157500224.xhtml#p754),[837](B9780080571157500248.xhtml#p837)\n`goal-p` [450](B9780080571157500133.xhtml#p450)\nGoldberg, Adele [457](B9780080571157500133.xhtml#p457)\nGoldberg, David E. [652](B9780080571157500182.xhtml#p652)\nGordon, [558](B9780080571157500169.xhtml#p558)\n`goto` [766](B9780080571157500224.xhtml#p766),[768](B9780080571157500224.xhtml#p768)\nGPS [xi](B9780080571157500261.xhtml#pxi),[109-121](B9780080571157500042.xhtml#p109),[123](B9780080571157500042.xhtml#p123),[125](B9780080571157500042.xhtml#p125),[127](B9780080571157500042.xhtml#p127),[129](B9780080571157500042.xhtml#p129),[130](B9780080571157500042.xhtml#p130),[132](B9780080571157500042.xhtml#p132),[133](B9780080571157500042.xhtml#p133),[135](B9780080571157500042.xhtml#p135),[136](B9780080571157500042.xhtml#p136),[142](B9780080571157500042.xhtml#p142),[143](B9780080571157500042.xhtml#p143),[145-147](B9780080571157500042.xhtml#p145),[149](B9780080571157500042.xhtml#p149),[175](B9780080571157500066.xhtml#p175),[189](B9780080571157500066.xhtml#p189),[190](B9780080571157500066.xhtml#p190),[211](B9780080571157500066.xhtml#p211),[213](B9780080571157500066.xhtml#p213),[215](B9780080571157500066.xhtml#p215),[239](B978008057115750008X.xhtml#p239),[470](B9780080571157500145.xhtml#p470)\n`GPS` [114](B9780080571157500042.xhtml#p114),[127](B9780080571157500042.xhtml#p127),[130](B9780080571157500042.xhtml#p130),[135](B9780080571157500042.xhtml#p135)\n`gps` [367](B978008057115750011X.xhtml#p367)\n`gps-successors` [212](B9780080571157500066.xhtml#p212)\ngrammar \ncontext-free [678](B9780080571157500194.xhtml#p678)\ncontext-free phrase-structure [35](B9780080571157500029.xhtml#p35),[686](B9780080571157500200.xhtml#p686)\ndefinite clause (DCG) [690](B9780080571157500200.xhtml#p690),[711](B9780080571157500200.xhtml#p711)\nrule [685](B9780080571157500200.xhtml#p685)\nunification [678](B9780080571157500194.xhtml#p678)\ngrandfather [385](B978008057115750011X.xhtml#p385)\n`graph-search` [206](B9780080571157500066.xhtml#p206)\nGreen, Cordell [382](B978008057115750011X.xhtml#p382)\nGreenbaum, Sidney [748](B9780080571157500212.xhtml#p748)\n`ground` [569](B9780080571157500170.xhtml#p569),[579](B9780080571157500170.xhtml#p579)\n`grundy` [312](B9780080571157500091.xhtml#p312)\n`GSET` [785](B9780080571157500236.xhtml#p785),[814](B9780080571157500236.xhtml#p814),[820](B9780080571157500236.xhtml#p820)\nGuzman, Adolfo [594](B9780080571157500170.xhtml#p594)\n`GVAR` [785](B9780080571157500236.xhtml#p785),[812](B9780080571157500236.xhtml#p812),[814](B9780080571157500236.xhtml#p814)\nH\n!!!(p) {:.idxletter}\n\n`h8->88` [622](B9780080571157500182.xhtml#p622),[623](B9780080571157500182.xhtml#p623)\nH&ouml;lldobler, Steffen [504](B9780080571157500145.xhtml#p504)\nHafner, Carole [30](B9780080571157500017.xhtml#p30)\n`HALT` [816](B9780080571157500236.xhtml#p816)\nhalting problem [511](B9780080571157500157.xhtml#p511)\n`handle-conj` [711](B9780080571157500200.xhtml#p711)\n`handler-case` [178](B9780080571157500066.xhtml#p178),[839](B9780080571157500248.xhtml#p839)\nHaraldsson, A. [307](B9780080571157500091.xhtml#p307)\nHarrell, Steve [457](B9780080571157500133.xhtml#p457)\nHarris, Zellig S. [749](B9780080571157500212.xhtml#p749)\nHarrison, P. G. [307](B9780080571157500091.xhtml#p307)\nHarvey, William D. [214](B9780080571157500066.xhtml#p214)\n`has-variable-p` [391](B9780080571157500121.xhtml#p391),[396](B9780080571157500121.xhtml#p396)\nhash table [74](B9780080571157500030.xhtml#p74),[296](B9780080571157500091.xhtml#p296),[477](B9780080571157500145.xhtml#p477)\nHayes, Patrick [469](B9780080571157500145.xhtml#p469)\nhead [351](B978008057115750011X.xhtml#p351)\n`head` [282](B9780080571157500091.xhtml#p282)\nHeckerman, David [558](B9780080571157500169.xhtml#p558)\n`help-string` [538](B9780080571157500169.xhtml#p538)\nHendler, James [148](B9780080571157500042.xhtml#p148)\nHennessey, Wade L. [xiv](B9780080571157500261.xhtml#pxiv),[259](B978008057115750008X.xhtml#p259),[383](B978008057115750011X.xhtml#p383)\nHewitt, Carl [382](B978008057115750011X.xhtml#p382),[457](B9780080571157500133.xhtml#p457)\nhigher-order predications [485](B9780080571157500145.xhtml#p485)\nHoare, C. A. R. [66](B9780080571157500030.xhtml#p66)\nHockney, David [509](B9780080571157500157.xhtml#p509)\nHoddinott, P. [504](B9780080571157500145.xhtml#p504)\nHorn clauses [684](B9780080571157500200.xhtml#p684)\nHorn, Bertold [xiv](B9780080571157500261.xhtml#pxiv),[213](B9780080571157500066.xhtml#p213),[367](B978008057115750011X.xhtml#p367),[383](B978008057115750011X.xhtml#p383),[777](B9780080571157500224.xhtml#p777)\nHuddleston, Rodney [749](B9780080571157500212.xhtml#p749)\nHuffman, David A. [594](B9780080571157500170.xhtml#p594)\nHughes, R. J. M. [307](B9780080571157500091.xhtml#p307)\n`human` [602](B9780080571157500182.xhtml#p602),[607](B9780080571157500182.xhtml#p607),[622](B9780080571157500182.xhtml#p622)\nhungry monkey [132](B9780080571157500042.xhtml#p132)\nhyphen before the p [755](B9780080571157500224.xhtml#p755)\nI\n!!!(p) {:.idxletter}\n\nIago [597](B9780080571157500182.xhtml#p597),[652](B9780080571157500182.xhtml#p652)\n`Iago` [623](B9780080571157500182.xhtml#p623),[646](B9780080571157500182.xhtml#p646)\n`Iago-eval` [623](B9780080571157500182.xhtml#p623),[645](B9780080571157500182.xhtml#p645)\nIBM 704 [14](B9780080571157500017.xhtml#p14)\n`identity` [669](B9780080571157500194.xhtml#p669)\n`idiom` [176](B9780080571157500066.xhtml#p176)\n`if` [16](B9780080571157500017.xhtml#p16),[424](B9780080571157500121.xhtml#p424),[745](B9780080571157500212.xhtml#p745),[754](B9780080571157500224.xhtml#p754),[851](B9780080571157500248.xhtml#p851)\n`ignore` [391](B9780080571157500121.xhtml#p391)\nignore declaration [410](B9780080571157500121.xhtml#p410)\n`ignore-errors` [838](B9780080571157500248.xhtml#p838)\nimperative programming [434](B9780080571157500133.xhtml#p434)\n`import` [836](B9780080571157500248.xhtml#p836)\nimpossible diagram [582](B9780080571157500170.xhtml#p582)\n`impossible-diagram-p` [570](B9780080571157500170.xhtml#p570)\n`impossible-vertex-p` [570](B9780080571157500170.xhtml#p570)\n`in-env-p` [786](B9780080571157500236.xhtml#p786),[791](B9780080571157500236.xhtml#p791)\n`in-exp` [228](B9780080571157500078.xhtml#p228)\n`in-integral-table?` [258](B978008057115750008X.xhtml#p258)\n`in-package` [835](B9780080571157500248.xhtml#p835),[891](B978008057115750025X.xhtml#p891)\n`inc-profile-time` [294](B9780080571157500091.xhtml#p294)\n`incf` [56](B9780080571157500030.xhtml#p56)\n`ind` [485](B9780080571157500145.xhtml#p485),[490](B9780080571157500145.xhtml#p490)\nindefinite extent [771](B9780080571157500224.xhtml#p771)\n`index` [477](B9780080571157500145.xhtml#p477),[481](B9780080571157500145.xhtml#p481),[498](B9780080571157500145.xhtml#p498)\n`index-new-fact` [492](B9780080571157500145.xhtml#p492)\n`index-rules` [298](B9780080571157500091.xhtml#p298)\nindexing [297](B9780080571157500091.xhtml#p297),[335](B9780080571157500108.xhtml#p335),[526](B9780080571157500157.xhtml#p526)\nindividuals [485](B9780080571157500145.xhtml#p485)\ninfectious blood disease [552](B9780080571157500169.xhtml#p552)\ninfinite set [280](B9780080571157500091.xhtml#p280)\ninfix notation [240](B978008057115750008X.xhtml#p240)\n`infix->prefix` [240](B978008057115750008X.xhtml#p240),[241](B978008057115750008X.xhtml#p241)\n`infix-funcall` [667](B9780080571157500194.xhtml#p667)\n`infix-scorer` [674](B9780080571157500194.xhtml#p674)\ninflection [722](B9780080571157500212.xhtml#p722)\ninformation hiding [436](B9780080571157500133.xhtml#p436),[454](B9780080571157500133.xhtml#p454),[835](B9780080571157500248.xhtml#p835)\nIngalls, Daniel [457](B9780080571157500133.xhtml#p457)\nIngerman, Peter Z. [307](B9780080571157500091.xhtml#p307)\ninheritance [436](B9780080571157500133.xhtml#p436),[499](B9780080571157500145.xhtml#p499)\ndata-driven [443](B9780080571157500133.xhtml#p443)\nfor classes [444](B9780080571157500133.xhtml#p444)\ngeneric [443](B9780080571157500133.xhtml#p443)\nmultiple [436](B9780080571157500133.xhtml#p436),[457](B9780080571157500133.xhtml#p457)\n`init-edge-table` [640](B9780080571157500182.xhtml#p640)\n`init-scheme-comp` [795](B9780080571157500236.xhtml#p795),[805](B9780080571157500236.xhtml#p805),[816](B9780080571157500236.xhtml#p816)\n`init-scheme-interp` [757](B9780080571157500224.xhtml#p757),[760](B9780080571157500224.xhtml#p760)\n`init-scheme-proc` [757](B9780080571157500224.xhtml#p757),[776](B9780080571157500224.xhtml#p776)\n`initial-board` [602](B9780080571157500182.xhtml#p602),[603](B9780080571157500182.xhtml#p603)\n`initially` [852](B9780080571157500248.xhtml#p852)\n`inline` [293](B9780080571157500091.xhtml#p293)\n`insert-path` [210](B9780080571157500066.xhtml#p210)\n`inspect` [87](B9780080571157500030.xhtml#p87)\n`inst-name` [533](B9780080571157500169.xhtml#p533),[540](B9780080571157500169.xhtml#p540)\ninstance [436](B9780080571157500133.xhtml#p436)\ninstance variable [436](B9780080571157500133.xhtml#p436)\ninstrument [265](B9780080571157500091.xhtml#p265)\ninstrumentation [268](B9780080571157500091.xhtml#p268)\n`integer` [772](B9780080571157500224.xhtml#p772)\n`integer`? [756](B9780080571157500224.xhtml#p756)\n`integers` [282](B9780080571157500091.xhtml#p282),[667](B9780080571157500194.xhtml#p667),[674](B9780080571157500194.xhtml#p674)\nintegrals [252](B978008057115750008X.xhtml#p252)\n`integrate` [256](B978008057115750008X.xhtml#p256)\n`integrate-from-table` [258](B978008057115750008X.xhtml#p258)\nintegrating polynomials [519](B9780080571157500157.xhtml#p519)\nintegration by parts [260](B978008057115750008X.xhtml#p260)\n`integration-table` [257](B978008057115750008X.xhtml#p257)\ninteractive environment [28](B9780080571157500017.xhtml#p28)\n`interactive-interpreter` [177](B9780080571157500066.xhtml#p177),[178](B9780080571157500066.xhtml#p178),[216](B9780080571157500066.xhtml#p216)\nINTER\n!!!(span) {:.smallcaps}\nLISP\n!!!(span) {:.smallcaps}\n [ix](B9780080571157500261.xhtml#pix)\n`intern` [835](B9780080571157500248.xhtml#p835)\ninternal definition [779](B9780080571157500224.xhtml#p779)\ninterning [835](B9780080571157500248.xhtml#p835)\n`interp` [757](B9780080571157500224.xhtml#p757),[758](B9780080571157500224.xhtml#p758),[762](B9780080571157500224.xhtml#p762),[767](B9780080571157500224.xhtml#p767),[774](B9780080571157500224.xhtml#p774)\n`interp-begin` [757](B9780080571157500224.xhtml#p757),[775](B9780080571157500224.xhtml#p775)\n`interp-call` [757](B9780080571157500224.xhtml#p757),[775](B9780080571157500224.xhtml#p775)\ninterpretation \ndeclarative [351](B978008057115750011X.xhtml#p351)\nprocedural [351](B978008057115750011X.xhtml#p351)\ninterpreter [275](B9780080571157500091.xhtml#p275)\ntail-recursive [766](B9780080571157500224.xhtml#p766)\nversus compiler [277](B9780080571157500091.xhtml#p277)\n`intersperse` [520](B9780080571157500157.xhtml#p520)\nintractable [461](B9780080571157500145.xhtml#p461)\nintransitive verbs [693](B9780080571157500200.xhtml#p693)\n`inv-span` [674](B9780080571157500194.xhtml#p674)\n`inverse-op` [228](B9780080571157500078.xhtml#p228)\nIPL [110](B9780080571157500042.xhtml#p110)\n`irev` [412](B9780080571157500121.xhtml#p412)\n`iright` [374](B978008057115750011X.xhtml#p374)\n`is` [192](B9780080571157500066.xhtml#p192),[203](B9780080571157500066.xhtml#p203),[533](B9780080571157500169.xhtml#p533),[547](B9780080571157500169.xhtml#p547),[795](B9780080571157500236.xhtml#p795),[813](B9780080571157500236.xhtml#p813)\n`is/2` [418](B9780080571157500121.xhtml#p418)\n`isolate` [227](B9780080571157500078.xhtml#p227)\n`iter-wide-search` [204](B9780080571157500066.xhtml#p204)\niterative deepening [205](B9780080571157500066.xhtml#p205),[482](B9780080571157500145.xhtml#p482),[646](B9780080571157500182.xhtml#p646)\niterative widening [204](B9780080571157500066.xhtml#p204)\nJ\n!!!(p) {:.idxletter}\n\nJackson, Peter [558](B9780080571157500169.xhtml#p558)\nJaffar, Joxan [504](B9780080571157500145.xhtml#p504)\nJames, Glenn [239](B978008057115750008X.xhtml#p239)\nJames, Robert [239](B978008057115750008X.xhtml#p239)\n`JUMP` [785](B9780080571157500236.xhtml#p785),[814](B9780080571157500236.xhtml#p814),[820](B9780080571157500236.xhtml#p820)\nK\n!!!(p) {:.idxletter}\n\n`k*poly` [513](B9780080571157500157.xhtml#p513),[517](B9780080571157500157.xhtml#p517)\n`k+poly` [513](B9780080571157500157.xhtml#p513),[516](B9780080571157500157.xhtml#p516)\nKahneman, Daniel [558](B9780080571157500169.xhtml#p558)\nKay, Alan [457](B9780080571157500133.xhtml#p457)\nKay, Martin [679](B9780080571157500194.xhtml#p679)\nKCL [428](B9780080571157500121.xhtml#p428)\nKeene, Sonya [458](B9780080571157500133.xhtml#p458)\nKernighan, B. W. [viii](B9780080571157500261.xhtml#pviii)\nkeyword [98](B9780080571157500030.xhtml#p98)\nkiller heuristic [634](B9780080571157500182.xhtml#p634)\nKinski, Natassja [700](B9780080571157500200.xhtml#p700)\nKL-ONE [462](B9780080571157500145.xhtml#p462),[503](B9780080571157500145.xhtml#p503)\nKleene star [37](B9780080571157500029.xhtml#p37)\nKleene, Stephen Cole [38](B9780080571157500029.xhtml#p38)\nKlier, Peter [511](B9780080571157500157.xhtml#p511)\nKnight, Kevin [383](B978008057115750011X.xhtml#p383),[594](B9780080571157500170.xhtml#p594)\nknowledge \ntechnical compendium [vii](B9780080571157500261.xhtml#pvii)\nknowledge engineer [548](B9780080571157500169.xhtml#p548)\nknowledge representation [461](B9780080571157500145.xhtml#p461)\nknowledge-based system [530](B9780080571157500169.xhtml#p530)\nKnuth, Donald E. [652](B9780080571157500182.xhtml#p652)\nKorf, R. E. [214](B9780080571157500066.xhtml#p214)\nKornfeld, W. A. [504](B9780080571157500145.xhtml#p504)\nKowalski, Robert [382](B978008057115750011X.xhtml#p382),[465](B9780080571157500145.xhtml#p465)\nKranz, David [825](B9780080571157500236.xhtml#p825)\nKreutzer, Wolfgang [xv](B9780080571157500261.xhtml#pxv),[213](B9780080571157500066.xhtml#p213)\nKRYPTON [503](B9780080571157500145.xhtml#p503)\nKulikowski, Casimir A. [558](B9780080571157500169.xhtml#p558)\nL\n!!!(p) {:.idxletter}\n\n`label-p` [786](B9780080571157500236.xhtml#p786),[791](B9780080571157500236.xhtml#p791)\n`labels` [762](B9780080571157500224.xhtml#p762),[870](B978008057115750025X.xhtml#p870)\n`labels-for` [569](B9780080571157500170.xhtml#p569),[573](B9780080571157500170.xhtml#p573)\nlambda [20](B9780080571157500017.xhtml#p20)\n`lambda` [754](B9780080571157500224.xhtml#p754),[783](B9780080571157500224.xhtml#p783)\nlambda expression [21](B9780080571157500017.xhtml#p21)\nLang, Kevin J. [458](B9780080571157500133.xhtml#p458)\nLangacker, Ronand [655](B9780080571157500194.xhtml#p655)\nlanguage \ndeclarative [435](B9780080571157500133.xhtml#p435)\nframe [462](B9780080571157500145.xhtml#p462)\nhybrid representation [462](B9780080571157500145.xhtml#p462)\nnetwork-based [462](B9780080571157500145.xhtml#p462)\nobject-oriented [462](B9780080571157500145.xhtml#p462)\nprocedural [462](B9780080571157500145.xhtml#p462)\nLassez, Jean-Louis [383](B978008057115750011X.xhtml#p383),[504](B9780080571157500145.xhtml#p504)\n`last` [12](B9780080571157500017.xhtml#p12),[69](B9780080571157500030.xhtml#p69),[884](B978008057115750025X.xhtml#p884)\n`last-name` [12](B9780080571157500017.xhtml#p12)\n`last1` [305](B9780080571157500091.xhtml#p305),[757](B9780080571157500224.xhtml#p757),[760](B9780080571157500224.xhtml#p760)\n`last2` [883](B978008057115750025X.xhtml#p883)\n`ldiff` [877](B978008057115750025X.xhtml#p877)\nleaping before you look [121](B9780080571157500042.xhtml#p121)\nlearning [651](B9780080571157500182.xhtml#p651)\nLee, Kai-Fu [636](B9780080571157500182.xhtml#p636),[637](B9780080571157500182.xhtml#p637),[651](B9780080571157500182.xhtml#p651)\nLeech, Geoffrey [748](B9780080571157500212.xhtml#p748)\nleft-recursive rules [681](B9780080571157500194.xhtml#p681),[705](B9780080571157500200.xhtml#p705)\n`legal-moves` [602](B9780080571157500182.xhtml#p602),[607](B9780080571157500182.xhtml#p607)\n`legal-nodes` [623](B9780080571157500182.xhtml#p623),[632](B9780080571157500182.xhtml#p632)\n`legal-p` [602](B9780080571157500182.xhtml#p602),[604](B9780080571157500182.xhtml#p604)\n`len` [455](B9780080571157500133.xhtml#p455)\n`length` [69](B9780080571157500030.xhtml#p69),[370](B978008057115750011X.xhtml#p370)\n`length1` [58](B9780080571157500030.xhtml#p58)\n`length1.1` [58](B9780080571157500030.xhtml#p58)\n`length10` [63](B9780080571157500030.xhtml#p63)\n`length11` [63](B9780080571157500030.xhtml#p63)\n`length12` [64](B9780080571157500030.xhtml#p64)\n`length2` [58](B9780080571157500030.xhtml#p58)\n`length3` [59](B9780080571157500030.xhtml#p59)\n`length4` [60](B9780080571157500030.xhtml#p60)\n`length5` [60](B9780080571157500030.xhtml#p60)\n`length6` [60](B9780080571157500030.xhtml#p60)\n`length7` [60](B9780080571157500030.xhtml#p60)\n`length8` [61](B9780080571157500030.xhtml#p61)\n`length9` [62](B9780080571157500030.xhtml#p62)\n`length=1` [255](B978008057115750008X.xhtml#p255),[276](B9780080571157500091.xhtml#p276),[496](B9780080571157500145.xhtml#p496),[757](B9780080571157500224.xhtml#p757),[760](B9780080571157500224.xhtml#p760)\n`let` [41](B9780080571157500029.xhtml#p41),[764](B9780080571157500224.xhtml#p764),[782](B9780080571157500224.xhtml#p782)\n`let*` [56](B9780080571157500030.xhtml#p56),[764](B9780080571157500224.xhtml#p764)\n`letrec` [762](B9780080571157500224.xhtml#p762),[765](B9780080571157500224.xhtml#p765)\nLevesque, Hector J. [503](B9780080571157500145.xhtml#p503),[504](B9780080571157500145.xhtml#p504)\nLevy, David [652](B9780080571157500182.xhtml#p652)\nlexical closure [92](B9780080571157500030.xhtml#p92)\n`lexical-rules` [658](B9780080571157500194.xhtml#p658),[664](B9780080571157500194.xhtml#p664)\nlexicon [732](B9780080571157500212.xhtml#p732)\n`likes/2` [389](B9780080571157500121.xhtml#p389)\n`limited-account` [442](B9780080571157500133.xhtml#p442),[444](B9780080571157500133.xhtml#p444),[446](B9780080571157500133.xhtml#p446)\nLincoln, Abraham [75](B9780080571157500030.xhtml#p75)\nline-diagram labeling problem [565](B9780080571157500170.xhtml#p565)\nlinear equations [234](B9780080571157500078.xhtml#p234)\nLipkis, T. A. [503](B9780080571157500145.xhtml#p503)\nLIPS [376](B978008057115750011X.xhtml#p376)\nLisp \nevaluation rule for [22](B9780080571157500017.xhtml#p22)\nlexical rules for [5](B9780080571157500017.xhtml#p5)\nLisp 1.5 [777](B9780080571157500224.xhtml#p777)\n`lisp/2` [418](B9780080571157500121.xhtml#p418)\nlist \nassociation [73](B9780080571157500030.xhtml#p73),[74](B9780080571157500030.xhtml#p74),[343](B9780080571157500108.xhtml#p343),[476](B9780080571157500145.xhtml#p476)\ndifference [702](B9780080571157500200.xhtml#p702)\nprocessing function [10](B9780080571157500017.xhtml#p10)\nproperty [74](B9780080571157500030.xhtml#p74),[476](B9780080571157500145.xhtml#p476)\n`list` [11](B9780080571157500017.xhtml#p11),[69](B9780080571157500030.xhtml#p69)\n`list*` [67](B9780080571157500030.xhtml#p67),[69](B9780080571157500030.xhtml#p69)\n`list->string` [756](B9780080571157500224.xhtml#p756)\n`list->vector` [756](B9780080571157500224.xhtml#p756)\n`list-ref` [756](B9780080571157500224.xhtml#p756)\n`list-tail` [756](B9780080571157500224.xhtml#p756)\n`list1` [804](B9780080571157500236.xhtml#p804)\n`list2` [804](B9780080571157500236.xhtml#p804)\n`list3` [804](B9780080571157500236.xhtml#p804)\n`listp` [69](B9780080571157500030.xhtml#p69)\nLloyd, J. W. [383](B978008057115750011X.xhtml#p383),[415](B9780080571157500121.xhtml#p415)\n`load` [645](B9780080571157500182.xhtml#p645)\nlocal maximum [197](B9780080571157500066.xhtml#p197)\nlogic programming [435](B9780080571157500133.xhtml#p435)\nlogic puzzle [373](B978008057115750011X.xhtml#p373)\nlong-distance dependencies [702](B9780080571157500200.xhtml#p702)\n`lookup` [157](B9780080571157500054.xhtml#p157),[361](B978008057115750011X.xhtml#p361),[896](B978008057115750025X.xhtml#p896)\n`loop` [842](B9780080571157500248.xhtml#p842),[864](B9780080571157500248.xhtml#p864),[878](B978008057115750025X.xhtml#p878)\n`LOOP FOR` [845](B9780080571157500248.xhtml#p845)\nloop keywords [844](B9780080571157500248.xhtml#p844)\ndata-driven [844](B9780080571157500248.xhtml#p844)\n`loop`macro [840](B9780080571157500248.xhtml#p840)\n`LOOP REPEAT` [845](B9780080571157500248.xhtml#p845)\n`loop-finish` [847](B9780080571157500248.xhtml#p847)\n`loop-for-arithmetic` [846](B9780080571157500248.xhtml#p846)\n`loop-unless` [851](B9780080571157500248.xhtml#p851)\n`losing-value` [602](B9780080571157500182.xhtml#p602),[613](B9780080571157500182.xhtml#p613)\n`loss` [311](B9780080571157500091.xhtml#p311),[312](B9780080571157500091.xhtml#p312)\nLoveland, D. W. [504](B9780080571157500145.xhtml#p504)\nLSET [785](B9780080571157500236.xhtml#p785),[814](B9780080571157500236.xhtml#p814),[820](B9780080571157500236.xhtml#p820)\nLuger, George F. [558](B9780080571157500169.xhtml#p558)\n`LVAR` [785](B9780080571157500236.xhtml#p785),[811](B9780080571157500236.xhtml#p811),[814](B9780080571157500236.xhtml#p814)\nM\n!!!(p) {:.idxletter}\n\n`machine` [795](B9780080571157500236.xhtml#p795),[814](B9780080571157500236.xhtml#p814)\nMacLachlan, Rob [327](B9780080571157500108.xhtml#p327)\nMAC\n!!!(span) {:.smallcaps}\nLISP\n!!!(span) {:.smallcaps}\n [ix](B9780080571157500261.xhtml#pix)\nmacro [66](B9780080571157500030.xhtml#p66),[853](B9780080571157500248.xhtml#p853),[760](B9780080571157500224.xhtml#p760)\nconditional read [292](B9780080571157500091.xhtml#p292)\ndefining [763](B9780080571157500224.xhtml#p763)\ndesign [880](B978008057115750025X.xhtml#p880)\nmacro-expansion [778](B9780080571157500224.xhtml#p778)\nMACSYMA\n!!!(span) {:.smallcaps}\n [xi](B9780080571157500261.xhtml#pxi),[xii](B9780080571157500261.xhtml#pxii),[151](B9780080571157500054.xhtml#p151),[239](B978008057115750008X.xhtml#p239),[259](B978008057115750008X.xhtml#p259),[260](B978008057115750008X.xhtml#p260),[297](B9780080571157500091.xhtml#p297),[522](B9780080571157500157.xhtml#p522),[528](B9780080571157500157.xhtml#p528)\nMahajan, Sanjoy [636](B9780080571157500182.xhtml#p636),[651](B9780080571157500182.xhtml#p651)\nMaher, Michael J. [504](B9780080571157500145.xhtml#p504)\nMaier, David [383](B978008057115750011X.xhtml#p383)\nmain variable of a polynomial [510](B9780080571157500157.xhtml#p510)\n`main-op` [297](B9780080571157500091.xhtml#p297)\n`main-var` [512-514](B9780080571157500157.xhtml#p512)\nmaintenance [177](B9780080571157500066.xhtml#p177)\n`make-=` [391](B9780080571157500121.xhtml#p391),[394](B9780080571157500121.xhtml#p394)\n`make-anonymous` [391](B9780080571157500121.xhtml#p391),[399](B9780080571157500121.xhtml#p399)\n`make-augmented-dcg` [707](B9780080571157500200.xhtml#p707)\n`make-block-ops` [137](B9780080571157500042.xhtml#p137)\n`make-clause` [440](B9780080571157500133.xhtml#p440)\n`make-copy-diagram` [569](B9780080571157500170.xhtml#p569),[577](B9780080571157500170.xhtml#p577)\n`make-dcg` [691](B9780080571157500200.xhtml#p691)\n`make-dcg-body` [692](B9780080571157500200.xhtml#p692)\n`make-empty-nlist` [476](B9780080571157500145.xhtml#p476)\n`make-flips` [602](B9780080571157500182.xhtml#p602),[605](B9780080571157500182.xhtml#p605)\n`make-instance` [445](B9780080571157500133.xhtml#p445)\n`make-maze-op` [134](B9780080571157500042.xhtml#p134)\n`make-maze-ops` [134](B9780080571157500042.xhtml#p134)\n`make-move` [602](B9780080571157500182.xhtml#p602),[604](B9780080571157500182.xhtml#p604)\n`make-moves` [312](B9780080571157500091.xhtml#p312)\n`make-obsolete` [870](B978008057115750025X.xhtml#p870)\n`make-parameters` [391](B9780080571157500121.xhtml#p391),[392](B9780080571157500121.xhtml#p392)\n`make-pipe` [282](B9780080571157500091.xhtml#p282),[283](B9780080571157500091.xhtml#p283)\n`make-poly` [513](B9780080571157500157.xhtml#p513),[514](B9780080571157500157.xhtml#p514)\n`make-predicate` [391](B9780080571157500121.xhtml#p391),[392](B9780080571157500121.xhtml#p392)\n`make-queue` [342](B9780080571157500108.xhtml#p342)\n`make-rat` [526](B9780080571157500157.xhtml#p526)\n`make-system` [893](B978008057115750025X.xhtml#p893)\n`make-true-list` [795](B9780080571157500236.xhtml#p795)\n`make-variable` [225](B9780080571157500078.xhtml#p225),[340](B9780080571157500108.xhtml#p340)\n`map` [756](B9780080571157500224.xhtml#p756),[771](B9780080571157500224.xhtml#p771)\n`map-edge-n-pieces` [640](B9780080571157500182.xhtml#p640)\n`map-interp` [757](B9780080571157500224.xhtml#p757),[775](B9780080571157500224.xhtml#p775)\n`map-into` [632](B9780080571157500182.xhtml#p632),[857](B9780080571157500248.xhtml#p857)\n`map-path` [204](B9780080571157500066.xhtml#p204)\n`map-pipe` [285](B9780080571157500091.xhtml#p285)\n`mapc` [62](B9780080571157500030.xhtml#p62)\n`mapc-retrieve` [480](B9780080571157500145.xhtml#p480),[488](B9780080571157500145.xhtml#p488)\n`mapc-retrieve-in-world` [501](B9780080571157500145.xhtml#p501)\n`mapcar` [14](B9780080571157500017.xhtml#p14),[62](B9780080571157500030.xhtml#p62),[864](B9780080571157500248.xhtml#p864)\n`maphash` [74](B9780080571157500030.xhtml#p74)\n`mappend` [19](B9780080571157500017.xhtml#p19),[165](B9780080571157500054.xhtml#p165),[171](B9780080571157500054.xhtml#p171)\n`mappend-pipe` [286](B9780080571157500091.xhtml#p286)\nMarsland, T. A. [652](B9780080571157500182.xhtml#p652)\nMartin, William [259](B978008057115750008X.xhtml#p259),[522](B9780080571157500157.xhtml#p522),[528](B9780080571157500157.xhtml#p528)\nMasinter, Larry [826](B9780080571157500236.xhtml#p826)\nmass nouns [749](B9780080571157500212.xhtml#p749)\n`match-and` [184](B9780080571157500066.xhtml#p184)\n`match-if` [186](B9780080571157500066.xhtml#p186)\n`match-is` [184](B9780080571157500066.xhtml#p184)\n`match-not` [184](B9780080571157500066.xhtml#p184)\n`match-or` [184](B9780080571157500066.xhtml#p184)\n`match-var` [332](B9780080571157500108.xhtml#p332),[333](B9780080571157500108.xhtml#p333)\n`match-variable` [158](B9780080571157500054.xhtml#p158)\n`matching-ifs` [305](B9780080571157500091.xhtml#p305)\n`math-quiz` [97](B9780080571157500030.xhtml#p97),[98](B9780080571157500030.xhtml#p98)\n`matrix-transpose` [569](B9780080571157500170.xhtml#p569),[574](B9780080571157500170.xhtml#p574)\n`max` [420](B9780080571157500121.xhtml#p420)\n`maximize` [849](B9780080571157500248.xhtml#p849)\n`maximize-difference` [602](B9780080571157500182.xhtml#p602),[608](B9780080571157500182.xhtml#p608)\n`maximizer` [602](B9780080571157500182.xhtml#p602),[608](B9780080571157500182.xhtml#p608)\n`maximizing` [849](B9780080571157500248.xhtml#p849)\n`maybe-add` [496](B9780080571157500145.xhtml#p496),[757](B9780080571157500224.xhtml#p757),[760](B9780080571157500224.xhtml#p760)\n`maybe-add-undo-bindings` [391](B9780080571157500121.xhtml#p391),[398](B9780080571157500121.xhtml#p398)\n`maybe-set-it` [851](B9780080571157500248.xhtml#p851)\n`maybe-temp` [847](B9780080571157500248.xhtml#p847)\nMcAllester, Davic [504](B9780080571157500145.xhtml#p504)\nMcCarthy, John [20](B9780080571157500017.xhtml#p20),[248](B978008057115750008X.xhtml#p248),[259](B978008057115750008X.xhtml#p259),[503](B9780080571157500145.xhtml#p503),[652](B9780080571157500182.xhtml#p652),[776](B9780080571157500224.xhtml#p776),[777](B9780080571157500224.xhtml#p777)\nMcCord, Michael [711](B9780080571157500200.xhtml#p711)\nMcDermott, Drew [xv](B9780080571157500261.xhtml#pxv),[147](B9780080571157500042.xhtml#p147),[383](B978008057115750011X.xhtml#p383),[503](B9780080571157500145.xhtml#p503),[586](B9780080571157500170.xhtml#p586),[594](B9780080571157500170.xhtml#p594)\nMcKenzie, Bruce [xv](B9780080571157500261.xhtml#pxv),[213](B9780080571157500066.xhtml#p213)\n`meaning` [676](B9780080571157500194.xhtml#p676)\n`meanings` [669](B9780080571157500194.xhtml#p669)\nMeehan, James [xv](B9780080571157500261.xhtml#pxv)\nMellish, Chris [382](B978008057115750011X.xhtml#p382),[679](B9780080571157500194.xhtml#p679),[748](B9780080571157500212.xhtml#p748)\n`member` [16](B9780080571157500017.xhtml#p16),[62](B9780080571157500030.xhtml#p62),[327](B9780080571157500108.xhtml#p327),[358](B978008057115750011X.xhtml#p358),[374](B978008057115750011X.xhtml#p374),[745](B9780080571157500212.xhtml#p745)\n`member-equal` [129](B9780080571157500042.xhtml#p129)\n`memo` [270](B9780080571157500091.xhtml#p270),[274](B9780080571157500091.xhtml#p274)\nmemoization [270](B9780080571157500091.xhtml#p270),[296](B9780080571157500091.xhtml#p296),[526](B9780080571157500157.xhtml#p526),[662](B9780080571157500194.xhtml#p662)\n`memoize` [271](B9780080571157500091.xhtml#p271),[275](B9780080571157500091.xhtml#p275),[662](B9780080571157500194.xhtml#p662)\nmessage [436](B9780080571157500133.xhtml#p436)\nmetamorphosis grammar [711](B9780080571157500200.xhtml#p711)\nmetareasoning [650](B9780080571157500182.xhtml#p650)\nmetavariable [697](B9780080571157500200.xhtml#p697)\nmethod [436](B9780080571157500133.xhtml#p436),[438](B9780080571157500133.xhtml#p438)\nmethod combinations [458](B9780080571157500133.xhtml#p458)\nMeyer, Bertrand [455](B9780080571157500133.xhtml#p455),[459](B9780080571157500133.xhtml#p459)\nMichie, Donald [307](B9780080571157500091.xhtml#p307),[652](B9780080571157500182.xhtml#p652)\nmicrocode for addition [811](B9780080571157500236.xhtml#p811)\nminimax [612](B9780080571157500182.xhtml#p612)\n`minimax` [602](B9780080571157500182.xhtml#p602),[613](B9780080571157500182.xhtml#p613)\n`minimax-searcher` [602](B9780080571157500182.xhtml#p602),[614](B9780080571157500182.xhtml#p614)\n`minimize` [849](B9780080571157500248.xhtml#p849)\n`minimizing` [849](B9780080571157500248.xhtml#p849)\nMinsky, Marvin [234](B9780080571157500078.xhtml#p234)\nmixins [457](B9780080571157500133.xhtml#p457)\n`mklist` [165](B9780080571157500054.xhtml#p165)\n`mobility` [623](B9780080571157500182.xhtml#p623),[629](B9780080571157500182.xhtml#p629),[637](B9780080571157500182.xhtml#p637)\nmodal auxiliary verbs [735](B9780080571157500212.xhtml#p735)\n`modified-weighted-squares` [602](B9780080571157500182.xhtml#p602),[621](B9780080571157500182.xhtml#p621)\nmodifiers [718](B9780080571157500212.xhtml#p718)\n`modifiers` [716](B9780080571157500212.xhtml#p716),[719](B9780080571157500212.xhtml#p719)\nModula [27](B9780080571157500017.xhtml#p27),[459](B9780080571157500133.xhtml#p459)\nmonitoring function [599](B9780080571157500182.xhtml#p599)\nmonotonicity [464](B9780080571157500145.xhtml#p464)\nMontague, Richard [711](B9780080571157500200.xhtml#p711)\nMoon, David A. [457](B9780080571157500133.xhtml#p457)\nMoore, J. S. [425](B9780080571157500121.xhtml#p425)\nMoore, Robert [466](B9780080571157500145.xhtml#p466),[652](B9780080571157500182.xhtml#p652)\nMoses, Joel [239](B978008057115750008X.xhtml#p239),[259](B978008057115750008X.xhtml#p259)\n`most-negative-fixnum` [613](B9780080571157500182.xhtml#p613)\n`most-positive-fixnum` [195](B9780080571157500066.xhtml#p195)\n`most-positive-fixnum` [613](B9780080571157500182.xhtml#p613)\n`move-ons` [137](B9780080571157500042.xhtml#p137)\n`move-op` [137](B9780080571157500042.xhtml#p137)\n`moves` [311](B9780080571157500091.xhtml#p311)\nMRS [504](B9780080571157500145.xhtml#p504)\nMU-Prolog [383](B978008057115750011X.xhtml#p383)\nmultimethod [436](B9780080571157500133.xhtml#p436),[458](B9780080571157500133.xhtml#p458)\nmultiple goals [145](B9780080571157500042.xhtml#p145)\nmultiple values [96](B9780080571157500030.xhtml#p96),[685](B9780080571157500200.xhtml#p685)\n`multiple-value-bind` [96](B9780080571157500030.xhtml#p96),[875](B978008057115750025X.xhtml#p875)\n`multiple-value-call` [887](B978008057115750025X.xhtml#p887)\nMusser, David R. [27](B9780080571157500017.xhtml#p27)\n`must-be-number` [771](B9780080571157500224.xhtml#p771)\nMYCIN\n!!!(span) {:.smallcaps}\n [xii](B9780080571157500261.xhtml#pxii),[461](B9780080571157500145.xhtml#p461),[531](B9780080571157500169.xhtml#p531),[532](B9780080571157500169.xhtml#p532),[535](B9780080571157500169.xhtml#p535),[541](B9780080571157500169.xhtml#p541),[542](B9780080571157500169.xhtml#p542),[552](B9780080571157500169.xhtml#p552),[553](B9780080571157500169.xhtml#p553),[557-559](B9780080571157500169.xhtml#p557),[903](B9780080571157500285.xhtml#p903)\n`mycin` [533](B9780080571157500169.xhtml#p533),[552](B9780080571157500169.xhtml#p552)\nN\n!!!(p) {:.idxletter}\n\nN [660](B9780080571157500194.xhtml#p660)\n`N` [693](B9780080571157500200.xhtml#p693)\nNaish, Lee [383](B978008057115750011X.xhtml#p383)\n`nalist` [498](B9780080571157500145.xhtml#p498)\n`nalist-push` [499](B9780080571157500145.xhtml#p499)\nName [660](B9780080571157500194.xhtml#p660)\n`Name` [694](B9780080571157500200.xhtml#p694),[701](B9780080571157500200.xhtml#p701)\n`name` [716](B9780080571157500212.xhtml#p716),[731](B9780080571157500212.xhtml#p731)\nname clashes [279](B9780080571157500091.xhtml#p279)\n`name!` [786](B9780080571157500236.xhtml#p786)\n`name-of` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\n`named` [852](B9780080571157500248.xhtml#p852)\nnames [737](B9780080571157500212.xhtml#p737)\n`nconc` [80](B9780080571157500030.xhtml#p80),[848](B9780080571157500248.xhtml#p848)\n`nconcing` [849](B9780080571157500248.xhtml#p849)\n`negate-node` [623](B9780080571157500182.xhtml#p623)\n`negate-value` [632](B9780080571157500182.xhtml#p632)\nnegated predicates [496](B9780080571157500145.xhtml#p496)\nnegation [485](B9780080571157500145.xhtml#p485)\n`negative?` [756](B9780080571157500224.xhtml#p756)\n`neighbors` [198](B9780080571157500066.xhtml#p198),[602](B9780080571157500182.xhtml#p602),[621](B9780080571157500182.xhtml#p621)\nneural nets [651](B9780080571157500182.xhtml#p651)\n`never` [847](B9780080571157500248.xhtml#p847)\nNew Flavors [458](B9780080571157500133.xhtml#p458)\n`new-account` [437](B9780080571157500133.xhtml#p437)\n`new-fn` [795](B9780080571157500236.xhtml#p795)\n`new-instance` [533](B9780080571157500169.xhtml#p533),[543](B9780080571157500169.xhtml#p543)\n`new-parm` [541](B9780080571157500169.xhtml#p541)\n`new-states` [207](B9780080571157500066.xhtml#p207)\n`new-symbol` [302](B9780080571157500091.xhtml#p302),[391](B9780080571157500121.xhtml#p391)\n`new-tree` [658](B9780080571157500194.xhtml#p658),[666](B9780080571157500194.xhtml#p666),[671](B9780080571157500194.xhtml#p671)\nNewell, Alan [109](B9780080571157500042.xhtml#p109),[147](B9780080571157500042.xhtml#p147),[596](B9780080571157500182.xhtml#p596)\n`newer-file-p` [894](B978008057115750025X.xhtml#p894)\n`newline` [804](B9780080571157500236.xhtml#p804)\n`next-instr` [795](B9780080571157500236.xhtml#p795),[819](B9780080571157500236.xhtml#p819)\n`next-to-play` [602](B9780080571157500182.xhtml#p602),[606](B9780080571157500182.xhtml#p606)\n`nextto` [374](B978008057115750011X.xhtml#p374)\n`NIL` [821](B9780080571157500236.xhtml#p821)\n`nil` [10](B9780080571157500017.xhtml#p10)\nNilsson, Nils [147](B9780080571157500042.xhtml#p147),[214](B9780080571157500066.xhtml#p214),[503](B9780080571157500145.xhtml#p503)\n`nim` [311](B9780080571157500091.xhtml#p311)\n`nintersection` [80](B9780080571157500030.xhtml#p80)\n`nl/0` [413](B9780080571157500121.xhtml#p413)\n`nlist` [475](B9780080571157500145.xhtml#p475)\n`nlist-list` [476](B9780080571157500145.xhtml#p476)\n`nlist-n` [476](B9780080571157500145.xhtml#p476)\n`nlist-push` [476](B9780080571157500145.xhtml#p476)\n`no-bindings` [157](B9780080571157500054.xhtml#p157)\n`no-states-p` [449](B9780080571157500133.xhtml#p449)\n`no-unknown` [228](B9780080571157500078.xhtml#p228)\n`node` [623](B9780080571157500182.xhtml#p623),[631](B9780080571157500182.xhtml#p631)\n`noise-word-p` [225](B9780080571157500078.xhtml#p225)\nnominative case [717](B9780080571157500212.xhtml#p717)\nnon-Horn clauses [504](B9780080571157500145.xhtml#p504)\nNONLIN\n!!!(span) {:.smallcaps}\n [147](B9780080571157500042.xhtml#p147)\nnonlocal exit [768](B9780080571157500224.xhtml#p768)\nnonrestrictive clauses [750](B9780080571157500212.xhtml#p750)\nnormalize [518](B9780080571157500157.xhtml#p518)\n`normalize-poly` [513](B9780080571157500157.xhtml#p513),[518](B9780080571157500157.xhtml#p518)\nNorvig, Peter [384](B978008057115750011X.xhtml#p384)\n`not` [415](B9780080571157500121.xhtml#p415),[424](B9780080571157500121.xhtml#p424)\n`not-numberp` [246](B978008057115750008X.xhtml#p246)\n`not/1` [415](B9780080571157500121.xhtml#p415)\nnotation \n*O*(*f*(*n*)) [274](B9780080571157500091.xhtml#p274)\ndotted pair [69](B9780080571157500030.xhtml#p69)\ninfix [240](B978008057115750008X.xhtml#p240)\npackage prefix [835](B9780080571157500248.xhtml#p835)\nprefix [228](B9780080571157500078.xhtml#p228),[240](B978008057115750008X.xhtml#p240)\n`Noun` [36](B9780080571157500029.xhtml#p36),[695](B9780080571157500200.xhtml#p695),[698](B9780080571157500200.xhtml#p698),[701](B9780080571157500200.xhtml#p701)\n`noun` [716](B9780080571157500212.xhtml#p716),[731](B9780080571157500212.xhtml#p731),[742](B9780080571157500212.xhtml#p742)\n`noun-phrase` [36](B9780080571157500029.xhtml#p36),[38](B9780080571157500029.xhtml#p38)\nNP [660](B9780080571157500194.xhtml#p660)\n`NP` [687](B9780080571157500200.xhtml#p687),[688](B9780080571157500200.xhtml#p688),[692](B9780080571157500200.xhtml#p692),[694](B9780080571157500200.xhtml#p694),[698](B9780080571157500200.xhtml#p698),[701](B9780080571157500200.xhtml#p701),[703](B9780080571157500200.xhtml#p703),[716](B9780080571157500212.xhtml#p716),[717](B9780080571157500212.xhtml#p717)\nNP-hard [146](B9780080571157500042.xhtml#p146),[461](B9780080571157500145.xhtml#p461)\n`NP2` [716](B9780080571157500212.xhtml#p716),[718](B9780080571157500212.xhtml#p718)\n`nreverse` [80](B9780080571157500030.xhtml#p80)\n`nset-difference` [80](B9780080571157500030.xhtml#p80)\n`nsubst` [80](B9780080571157500030.xhtml#p80)\n`nth` [69](B9780080571157500030.xhtml#p69),[73](B9780080571157500030.xhtml#p73)\nNU-Prolog [383](B978008057115750011X.xhtml#p383)\n`null` [69](B9780080571157500030.xhtml#p69)\n`number-and-negation` [20](B9780080571157500017.xhtml#p20)\n`number-of-labelings` [569](B9780080571157500170.xhtml#p569),[570](B9780080571157500170.xhtml#p570)\n`numberp/1` [745](B9780080571157500212.xhtml#p745)\n`numbers-and-negations` [20](B9780080571157500017.xhtml#p20)\n`nunion` [80](B9780080571157500030.xhtml#p80)\nNygaard, Krysten [456](B9780080571157500133.xhtml#p456)\nO\n!!!(p) {:.idxletter}\n\nO'Keefe, Richard [383](B978008057115750011X.xhtml#p383),[423](B9780080571157500121.xhtml#p423)\nobject [3](B9780080571157500017.xhtml#p3),[436](B9780080571157500133.xhtml#p436)\nobject-oriented \nprogramming [434](B9780080571157500133.xhtml#p434)\nobjective case [717](B9780080571157500212.xhtml#p717)\noccurs check [356](B978008057115750011X.xhtml#p356),[471](B9780080571157500145.xhtml#p471)\n`occurs-check` [356](B978008057115750011X.xhtml#p356),[361](B978008057115750011X.xhtml#p361)\nomniscience [464](B9780080571157500145.xhtml#p464)\n`once-only` [854](B9780080571157500248.xhtml#p854)\n`one-of` [36](B9780080571157500029.xhtml#p36),[275](B9780080571157500091.xhtml#p275)\n`one-unknown` [229](B9780080571157500078.xhtml#p229)\n`op` [114](B9780080571157500042.xhtml#p114),[126](B9780080571157500042.xhtml#p126),[127](B9780080571157500042.xhtml#p127)\n`op?` [302](B9780080571157500091.xhtml#p302)\n`opcode` [795](B9780080571157500236.xhtml#p795),[812](B9780080571157500236.xhtml#p812)\n`open` [83](B9780080571157500030.xhtml#p83)\nopening book [649](B9780080571157500182.xhtml#p649)\noperator precedence [240](B978008057115750008X.xhtml#p240)\n`operators-and-inverses` [228](B9780080571157500078.xhtml#p228)\n`opponent` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\nOPS5 [266](B9780080571157500091.xhtml#p266)\n`opt-rel-pronoun` [721](B9780080571157500212.xhtml#p721)\n`opt-word` [729](B9780080571157500212.xhtml#p729)\n`optimize` [795](B9780080571157500236.xhtml#p795),[818](B9780080571157500236.xhtml#p818)\n`optimize-1` [818](B9780080571157500236.xhtml#p818)\noptimizing arithmetic operations [793](B9780080571157500236.xhtml#p793)\n`or` [53](B9780080571157500030.xhtml#p53),[415](B9780080571157500121.xhtml#p415),[429](B9780080571157500121.xhtml#p429),[764](B9780080571157500224.xhtml#p764)\nORBIT\n!!!(span) {:.smallcaps}\n [825](B9780080571157500236.xhtml#p825)\n`orderings` [139](B9780080571157500042.xhtml#p139)\n`ordinal` [716](B9780080571157500212.xhtml#p716),[732](B9780080571157500212.xhtml#p732)\nOthello [597](B9780080571157500182.xhtml#p597)\nothello \nbracketing piece [605](B9780080571157500182.xhtml#p605)\ncheat [606](B9780080571157500182.xhtml#p606)\ncorner squares [608](B9780080571157500182.xhtml#p608)\ncurrent mobility [637](B9780080571157500182.xhtml#p637)\nedge squares [608](B9780080571157500182.xhtml#p608)\nedge stability [637](B9780080571157500182.xhtml#p637)\nend game [649](B9780080571157500182.xhtml#p649)\nlegal move [604](B9780080571157500182.xhtml#p604)\nmobility [637](B9780080571157500182.xhtml#p637)\nplausible move generator [647](B9780080571157500182.xhtml#p647)\npotential mobility [637](B9780080571157500182.xhtml#p637)\nstable [643](B9780080571157500182.xhtml#p643)\nunstable [643](B9780080571157500182.xhtml#p643)\nvalid move [604](B9780080571157500182.xhtml#p604)\n`othello` [605](B9780080571157500182.xhtml#p605),[624](B9780080571157500182.xhtml#p624)\nsemistable [643](B9780080571157500182.xhtml#p643)\n`othello-series` [623](B9780080571157500182.xhtml#p623),[626](B9780080571157500182.xhtml#p626),[628](B9780080571157500182.xhtml#p628)\n`outer` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\nP\n!!!(p) {:.idxletter}\n\nP [660](B9780080571157500194.xhtml#p660)\n`p-add-into!` [525](B9780080571157500157.xhtml#p525)\np-lists [74](B9780080571157500030.xhtml#p74)\npackage [754](B9780080571157500224.xhtml#p754),[834](B9780080571157500248.xhtml#p834),[889-890](B978008057115750025X.xhtml#p889)\npackage prefix notation [835](B9780080571157500248.xhtml#p835)\n`pair?` [756](B9780080571157500224.xhtml#p756)\nparameter \nkeyword [98](B9780080571157500030.xhtml#p98)\noptional [98](B9780080571157500030.xhtml#p98)\norder [889](B978008057115750025X.xhtml#p889)\nrest [778](B9780080571157500224.xhtml#p778)\nparameter list [12](B9780080571157500017.xhtml#p12)\n`parm` [533](B9780080571157500169.xhtml#p533),[541](B9780080571157500169.xhtml#p541)\n`parm-type` [533](B9780080571157500169.xhtml#p533),[541](B9780080571157500169.xhtml#p541)\nPARRY\n!!!(span) {:.smallcaps}\n [153](B9780080571157500054.xhtml#p153),[154](B9780080571157500054.xhtml#p154),[167](B9780080571157500054.xhtml#p167)\n`parse` [658](B9780080571157500194.xhtml#p658),[659](B9780080571157500194.xhtml#p659),[668](B9780080571157500194.xhtml#p668),[671](B9780080571157500194.xhtml#p671),[680](B9780080571157500194.xhtml#p680),[681](B9780080571157500194.xhtml#p681)\n`parse-condition` [547](B9780080571157500169.xhtml#p547)\n`parse-lhs` [658](B9780080571157500194.xhtml#p658)\n`parse-loop-body` [844](B9780080571157500248.xhtml#p844)\n`parse-namestring` [877](B978008057115750025X.xhtml#p877)\n`parse-reply` [533](B9780080571157500169.xhtml#p533),[540](B9780080571157500169.xhtml#p540)\n`parser` [658](B9780080571157500194.xhtml#p658),[662](B9780080571157500194.xhtml#p662),[680](B9780080571157500194.xhtml#p680),[681](B9780080571157500194.xhtml#p681)\npartial evaluation [267](B9780080571157500091.xhtml#p267)\n`partition-if` [256](B978008057115750008X.xhtml#p256)\nPascal [ix](B9780080571157500261.xhtml#pix),[26-29](B9780080571157500017.xhtml#p26),[51](B9780080571157500030.xhtml#p51),[55](B9780080571157500030.xhtml#p55),[57](B9780080571157500030.xhtml#p57),[66](B9780080571157500030.xhtml#p66),[98](B9780080571157500030.xhtml#p98),[176](B9780080571157500066.xhtml#p176),[266](B9780080571157500091.xhtml#p266),[434](B9780080571157500133.xhtml#p434),[623](B9780080571157500182.xhtml#p623)\n`passivize-sense` [743](B9780080571157500212.xhtml#p743)\n`passivize-subcat` [743](B9780080571157500212.xhtml#p743)\n`password-account` [441](B9780080571157500133.xhtml#p441)\npast participles [720](B9780080571157500212.xhtml#p720)\npast tense [722](B9780080571157500212.xhtml#p722)\n`pat-match` [155](B9780080571157500054.xhtml#p155),[156](B9780080571157500054.xhtml#p156),[158](B9780080571157500054.xhtml#p158),[160](B9780080571157500054.xhtml#p160),[181](B9780080571157500066.xhtml#p181)\n`pat-match-1` [332](B9780080571157500108.xhtml#p332)\n`pat-match-abbrev` [187](B9780080571157500066.xhtml#p187)\n`path` [200](B9780080571157500066.xhtml#p200)\n`path-states` [210](B9780080571157500066.xhtml#p210)\nPatil, Ramesh [663](B9780080571157500194.xhtml#p663)\npattern matcher [509](B9780080571157500157.xhtml#p509)\npattern matching and unification [352](B978008057115750011X.xhtml#p352)\nPearl, Judea [558](B9780080571157500169.xhtml#p558),[559](B9780080571157500169.xhtml#p559),[648](B9780080571157500182.xhtml#p648),[652](B9780080571157500182.xhtml#p652)\npeephole optimizer [805](B9780080571157500236.xhtml#p805),[818](B9780080571157500236.xhtml#p818)\nPereira, Fernando [383](B978008057115750011X.xhtml#p383),[426](B9780080571157500121.xhtml#p426),[711](B9780080571157500200.xhtml#p711),[748](B9780080571157500212.xhtml#p748)\nPereira, Luis [426](B9780080571157500121.xhtml#p426)\nPerlis, Alan [3](B9780080571157500017.xhtml#p3),[265](B9780080571157500091.xhtml#p265),[348](B978008057115750011X.xhtml#p348),[866](B978008057115750025X.xhtml#p866)\nPerlmutter, Barak A. [458](B9780080571157500133.xhtml#p458)\n`permutations` [150](B9780080571157500042.xhtml#p150)\n`permute` [675](B9780080571157500194.xhtml#p675),[680](B9780080571157500194.xhtml#p680),[682](B9780080571157500194.xhtml#p682)\n`permute-vector!` [682](B9780080571157500194.xhtml#p682)\nPeters, Stanley [711](B9780080571157500200.xhtml#p711)\n`piece` [601](B9780080571157500182.xhtml#p601),[602](B9780080571157500182.xhtml#p602)\n`piece-stability` [644](B9780080571157500182.xhtml#p644)\npipe [281](B9780080571157500091.xhtml#p281)\n`pipe-elt` [282](B9780080571157500091.xhtml#p282)\npipes [840](B9780080571157500248.xhtml#p840)\nplace [55](B9780080571157500030.xhtml#p55)\nPlaisted, David A. [504](B9780080571157500145.xhtml#p504)\nPLANNER\n!!!(span) {:.smallcaps}\n [382](B978008057115750011X.xhtml#p382)\nPlauger, J. [viii](B9780080571157500261.xhtml#pviii)\n`play-game` [313](B9780080571157500091.xhtml#p313)\n`play-games` [312](B9780080571157500091.xhtml#p312)\n`poiuyt` [582](B9780080571157500170.xhtml#p582)\n`poly` [513](B9780080571157500157.xhtml#p513),[514](B9780080571157500157.xhtml#p514)\n`poly*poly` [513](B9780080571157500157.xhtml#p513),[517](B9780080571157500157.xhtml#p517)\n`poly*same` [513](B9780080571157500157.xhtml#p513),[517](B9780080571157500157.xhtml#p517)\n`poly+` [513](B9780080571157500157.xhtml#p513),[515](B9780080571157500157.xhtml#p515)\n`poly+poly` [513](B9780080571157500157.xhtml#p513),[516](B9780080571157500157.xhtml#p516)\n`poly+same` [513](B9780080571157500157.xhtml#p513),[516](B9780080571157500157.xhtml#p516)\n`poly-` [513](B9780080571157500157.xhtml#p513),[515](B9780080571157500157.xhtml#p515)\n`poly/poly` [529](B9780080571157500157.xhtml#p529)\n`poly^2` [523](B9780080571157500157.xhtml#p523)\n`poly^n` [513](B9780080571157500157.xhtml#p513),[518](B9780080571157500157.xhtml#p518),[523](B9780080571157500157.xhtml#p523),[524](B9780080571157500157.xhtml#p524)\npolyhedra [565](B9780080571157500170.xhtml#p565)\n`polynomial` [512](B9780080571157500157.xhtml#p512),[513](B9780080571157500157.xhtml#p513)\npolynomials [510](B9780080571157500157.xhtml#p510)\npolysemous [730](B9780080571157500212.xhtml#p730)\n`POP` [785](B9780080571157500236.xhtml#p785),[814](B9780080571157500236.xhtml#p814)\n`pop` [56](B9780080571157500030.xhtml#p56)\n`pop-end` [881](B978008057115750025X.xhtml#p881),[882](B978008057115750025X.xhtml#p882)\n`pop-state` [449](B9780080571157500133.xhtml#p449)\n`position` [62](B9780080571157500030.xhtml#p62)\n`position-if` [60](B9780080571157500030.xhtml#p60)\npossible worlds [485](B9780080571157500145.xhtml#p485),[496](B9780080571157500145.xhtml#p496),[497](B9780080571157500145.xhtml#p497)\n`possible-edge-move` [641](B9780080571157500182.xhtml#p641)\n`possible-edge-moves-value` [641](B9780080571157500182.xhtml#p641)\n`possible-labelings` [569](B9780080571157500170.xhtml#p569)\npostdeterminers [721](B9780080571157500212.xhtml#p721)\nPP [660](B9780080571157500194.xhtml#p660)\n`PP` [38](B9780080571157500029.xhtml#p38),[716](B9780080571157500212.xhtml#p716),[720](B9780080571157500212.xhtml#p720)\n`PP*` [38](B9780080571157500029.xhtml#p38)\n`pprint` [839](B9780080571157500248.xhtml#p839)\nPrade, Henri [558](B9780080571157500169.xhtml#p558)\npreconditions [112](B9780080571157500042.xhtml#p112)\nprecycling [634](B9780080571157500182.xhtml#p634)\npredeterminers [721](B9780080571157500212.xhtml#p721)\npredicate [888](B978008057115750025X.xhtml#p888)\ncalculus [463](B9780080571157500145.xhtml#p463)\nequality [70](B9780080571157500030.xhtml#p70)\nrecognizer [81](B9780080571157500030.xhtml#p81)\n`predicate` [360](B978008057115750011X.xhtml#p360),[361](B978008057115750011X.xhtml#p361)\npredicative adjectives [749](B9780080571157500212.xhtml#p749)\n`prefer-disjoint` [674](B9780080571157500194.xhtml#p674)\n`prefer-not-singleton` [674](B9780080571157500194.xhtml#p674)\n`prefer-subset` [674](B9780080571157500194.xhtml#p674)\n`prefer<` [674](B9780080571157500194.xhtml#p674)\npreferences [670](B9780080571157500194.xhtml#p670)\nprefix notation [4](B9780080571157500017.xhtml#p4),[228](B9780080571157500078.xhtml#p228),[240](B978008057115750008X.xhtml#p240)\n`prefix->canon` [513](B9780080571157500157.xhtml#p513),[515](B9780080571157500157.xhtml#p515)\n`prefix->infix` [229](B9780080571157500078.xhtml#p229),[242](B978008057115750008X.xhtml#p242),[519](B9780080571157500157.xhtml#p519),[520](B9780080571157500157.xhtml#p520)\n`Prep` [38](B9780080571157500029.xhtml#p38)\n`prep` [716](B9780080571157500212.xhtml#p716),[732](B9780080571157500212.xhtml#p732)\n`prepend` [192](B9780080571157500066.xhtml#p192)\nprepositional phrases [720](B9780080571157500212.xhtml#p720)\nprepositions [739](B9780080571157500212.xhtml#p739)\nprerequisite clobbers sibling goal [120](B9780080571157500042.xhtml#p120),[139](B9780080571157500042.xhtml#p139)\npresent participles [720](B9780080571157500212.xhtml#p720)\npresent tense [722](B9780080571157500212.xhtml#p722)\npretty printing [839](B9780080571157500248.xhtml#p839)\n`price-is-right` [195](B9780080571157500066.xhtml#p195)\n`PRIM` [815](B9780080571157500236.xhtml#p815)\n`prim` [795](B9780080571157500236.xhtml#p795),[804](B9780080571157500236.xhtml#p804)\nprimitive operation [803](B9780080571157500236.xhtml#p803)\n`primitive-p` [795](B9780080571157500236.xhtml#p795),[804](B9780080571157500236.xhtml#p804)\n`prin1` [83](B9780080571157500030.xhtml#p83)\n`princ` [83](B9780080571157500030.xhtml#p83)\n`print-board` [602](B9780080571157500182.xhtml#p602),[603](B9780080571157500182.xhtml#p603),[625](B9780080571157500182.xhtml#p625)\n`print-condition` [533](B9780080571157500169.xhtml#p533),[551](B9780080571157500169.xhtml#p551)\n`print-conditions` [533](B9780080571157500169.xhtml#p533),[551](B9780080571157500169.xhtml#p551)\n`print-equations` [228](B9780080571157500078.xhtml#p228),[236](B9780080571157500078.xhtml#p236)\n`print-fn` [786](B9780080571157500236.xhtml#p786),[790](B9780080571157500236.xhtml#p790)\n`print-labelings` [569](B9780080571157500170.xhtml#p569),[571](B9780080571157500170.xhtml#p571)\n`print-path` [203](B9780080571157500066.xhtml#p203)\n`print-proc` [757](B9780080571157500224.xhtml#p757),[768](B9780080571157500224.xhtml#p768)\n`print-rule` [533](B9780080571157500169.xhtml#p533),[545](B9780080571157500169.xhtml#p545),[551](B9780080571157500169.xhtml#p551)\n`print-sqrt-abs` [771](B9780080571157500224.xhtml#p771)\n`print-table` [771](B9780080571157500224.xhtml#p771)\n`print-variable` [340](B9780080571157500108.xhtml#p340)\n`print-vertex` [569](B9780080571157500170.xhtml#p569),[573](B9780080571157500170.xhtml#p573)\n`print-why` [533](B9780080571157500169.xhtml#p533),[552](B9780080571157500169.xhtml#p552)\n`print-world` [501](B9780080571157500145.xhtml#p501)\npriority queue [459](B9780080571157500133.xhtml#p459)\nPro [660](B9780080571157500194.xhtml#p660)\nprobability theory [557](B9780080571157500169.xhtml#p557)\nproblem \n`(find item list)`failed [874](B978008057115750025X.xhtml#p874)\nchange to function ignored [869](B978008057115750025X.xhtml#p869)\nclosures don't work [871](B978008057115750025X.xhtml#p871)\ndeletion didn't take effect [873](B978008057115750025X.xhtml#p873)\nleaping before you look [121](B9780080571157500042.xhtml#p121)\nline-diagram labling [565](B9780080571157500170.xhtml#p565)\nmultiple values lost [874](B978008057115750025X.xhtml#p874)\nno response [867](B978008057115750025X.xhtml#p867)\nprerequisite clobbers siblinggoal [120](B9780080571157500042.xhtml#p120),[139](B9780080571157500042.xhtml#p139)\nrecursive subgoal [123](B9780080571157500042.xhtml#p123)\n`problem` [449](B9780080571157500133.xhtml#p449)\n`problem-combiner` [450](B9780080571157500133.xhtml#p450),[452](B9780080571157500133.xhtml#p452)\n`problem-combiner :around` [452](B9780080571157500133.xhtml#p452)\n`problem-successors` [451](B9780080571157500133.xhtml#p451),[453](B9780080571157500133.xhtml#p453)\n`proc` [757](B9780080571157500224.xhtml#p757)\nprocedural attachment [463](B9780080571157500145.xhtml#p463)\n`procedure?` [756](B9780080571157500224.xhtml#p756)\n`profile` [290](B9780080571157500091.xhtml#p290)\n`profile-count` [289](B9780080571157500091.xhtml#p289)\n`profile-enter` [293](B9780080571157500091.xhtml#p293)\n`profile-exit` [293](B9780080571157500091.xhtml#p293)\n`profile-report` [289](B9780080571157500091.xhtml#p289),[294](B9780080571157500091.xhtml#p294)\n`profile-time` [294](B9780080571157500091.xhtml#p294)\n`profile1` [289](B9780080571157500091.xhtml#p289),[291](B9780080571157500091.xhtml#p291)\n`profiled-fn` [289](B9780080571157500091.xhtml#p289),[293](B9780080571157500091.xhtml#p293)\nprofiling [288](B9780080571157500091.xhtml#p288)\n`prog` [767](B9780080571157500224.xhtml#p767)\n`progn` [64](B9780080571157500030.xhtml#p64)\nprogramming \ndata-driven [182](B9780080571157500066.xhtml#p182)\nfunctional style [435](B9780080571157500133.xhtml#p435),[839](B9780080571157500248.xhtml#p839)\nidioms [60](B9780080571157500030.xhtml#p60)\nimperative style [434](B9780080571157500133.xhtml#p434)\nin the large [890](B978008057115750025X.xhtml#p890)\nlogic [435](B9780080571157500133.xhtml#p435)\nobject-oriented style [434](B9780080571157500133.xhtml#p434)\nprocedural style [434](B9780080571157500133.xhtml#p434)\nrule-based [435](B9780080571157500133.xhtml#p435)\nProject MAC [239](B978008057115750008X.xhtml#p239)\nProlog [ix](B9780080571157500261.xhtml#pix),[xii](B9780080571157500261.xhtml#pxii),[xv](B9780080571157500261.xhtml#pxv),[63](B9780080571157500030.xhtml#p63),[144](B9780080571157500042.xhtml#p144),[155](B9780080571157500054.xhtml#p155),[287](B9780080571157500091.xhtml#p287),[348-351](B978008057115750011X.xhtml#p348),[355](B978008057115750011X.xhtml#p355),[356](B978008057115750011X.xhtml#p356),[358-360](B978008057115750011X.xhtml#p358),[364](B978008057115750011X.xhtml#p364),[366-368](B978008057115750011X.xhtml#p366),[371-374](B978008057115750011X.xhtml#p371),[376](B978008057115750011X.xhtml#p376),[378](B978008057115750011X.xhtml#p378),[380-382](B978008057115750011X.xhtml#p380),[384-386](B978008057115750011X.xhtml#p384),[388](B9780080571157500121.xhtml#p388),[389](B9780080571157500121.xhtml#p389),[391](B9780080571157500121.xhtml#p391),[407](B9780080571157500121.xhtml#p407),[408](B9780080571157500121.xhtml#p408),[411-413](B9780080571157500121.xhtml#p411),[415-421](B9780080571157500121.xhtml#p415),[423-428](B9780080571157500121.xhtml#p423),[431](B9780080571157500121.xhtml#p431),[435](B9780080571157500133.xhtml#p435),[455](B9780080571157500133.xhtml#p455),[462](B9780080571157500145.xhtml#p462),[464-472](B9780080571157500145.xhtml#p464),[480-482](B9780080571157500145.xhtml#p480),[489](B9780080571157500145.xhtml#p489),[497](B9780080571157500145.xhtml#p497),[504](B9780080571157500145.xhtml#p504),[505](B9780080571157500145.xhtml#p505),[531](B9780080571157500169.xhtml#p531),[532](B9780080571157500169.xhtml#p532),[536](B9780080571157500169.xhtml#p536),[538](B9780080571157500169.xhtml#p538),[541-544](B9780080571157500169.xhtml#p541),[684](B9780080571157500200.xhtml#p684),[685](B9780080571157500200.xhtml#p685),[690](B9780080571157500200.xhtml#p690),[691](B9780080571157500200.xhtml#p691),[693](B9780080571157500200.xhtml#p693),[697](B9780080571157500200.xhtml#p697),[708](B9780080571157500200.xhtml#p708),[711-713](B9780080571157500200.xhtml#p711),[732](B9780080571157500212.xhtml#p732),[745](B9780080571157500212.xhtml#p745)\nProlog II [355](B978008057115750011X.xhtml#p355)\nProlog III [383](B978008057115750011X.xhtml#p383)\n`prolog-compile` [390](B9780080571157500121.xhtml#p390),[391](B9780080571157500121.xhtml#p391)\n`prolog-compi1e-symbols` [391](B9780080571157500121.xhtml#p391),[409](B9780080571157500121.xhtml#p409)\n`prolog-compi1er-macro` [391](B9780080571157500121.xhtml#p391),[395](B9780080571157500121.xhtml#p395)\nProlog-In-Lisp [360](B978008057115750011X.xhtml#p360),[424](B9780080571157500121.xhtml#p424)\nprompt [4](B9780080571157500017.xhtml#p4)\n`prompt-and-read` [867](B978008057115750025X.xhtml#p867)\n`prompt-and-read-vals` [533](B9780080571157500169.xhtml#p533),[539](B9780080571157500169.xhtml#p539)\n`prompt-generator` [178](B9780080571157500066.xhtml#p178)\n`pronoun` [716](B9780080571157500212.xhtml#p716),[731](B9780080571157500212.xhtml#p731)\npronouns [736](B9780080571157500212.xhtml#p736)\n`propagate-constraints` [569](B9780080571157500170.xhtml#p569),[571](B9780080571157500170.xhtml#p571),[590](B9780080571157500170.xhtml#p590)\n`proper-listp` [391](B9780080571157500121.xhtml#p391),[396](B9780080571157500121.xhtml#p396)\nproperty lists [74](B9780080571157500030.xhtml#p74)\nprototypes [469](B9780080571157500145.xhtml#p469)\n`prove` [361](B978008057115750011X.xhtml#p361),[362](B978008057115750011X.xhtml#p362),[367](B978008057115750011X.xhtml#p367),[368](B978008057115750011X.xhtml#p368),[380](B978008057115750011X.xhtml#p380),[483](B9780080571157500145.xhtml#p483)\n`prove-all` [361](B978008057115750011X.xhtml#p361),[362](B978008057115750011X.xhtml#p362),[367](B978008057115750011X.xhtml#p367),[380](B978008057115750011X.xhtml#p380),[483](B9780080571157500145.xhtml#p483)\n`punctuation-p` [709](B9780080571157500200.xhtml#p709)\n`push` [56](B9780080571157500030.xhtml#p56)\n`put-db` [533](B9780080571157500169.xhtml#p533),[537](B9780080571157500169.xhtml#p537)\n`put-diagram` [576](B9780080571157500170.xhtml#p576)\n`put-first` [623](B9780080571157500182.xhtml#p623),[636](B9780080571157500182.xhtml#p636)\n`put-optimizer` [819](B9780080571157500236.xhtml#p819)\n`put-rule` [533](B9780080571157500169.xhtml#p533),[545](B9780080571157500169.xhtml#p545)\n`put-trie` [344](B9780080571157500108.xhtml#p344)\nPygmalion [152](B9780080571157500054.xhtml#p152)\nQ\n!!!(p) {:.idxletter}\n\n`quasi-q` [795](B9780080571157500236.xhtml#p795),[824](B9780080571157500236.xhtml#p824)\n`quasiquote` [822](B9780080571157500236.xhtml#p822)\nQuayle, Dan [735](B9780080571157500212.xhtml#p735)\n`query-bind` [482](B9780080571157500145.xhtml#p482)\n`query-user` [677](B9780080571157500194.xhtml#p677)\nquestions [725](B9780080571157500212.xhtml#p725),[726](B9780080571157500212.xhtml#p726)\nqueue [341](B9780080571157500108.xhtml#p341)\n`queue-contents` [342](B9780080571157500108.xhtml#p342)\n`queue-nconc` [343](B9780080571157500108.xhtml#p343)\nQuillian, M. Ross [503](B9780080571157500145.xhtml#p503)\nQuirk, Randolph [748](B9780080571157500212.xhtml#p748)\n`quote` [427](B9780080571157500121.xhtml#p427),[754](B9780080571157500224.xhtml#p754)\nquote mark (') [6](B9780080571157500017.xhtml#p6)\nR\n!!!(p) {:.idxletter}\n\n`r15-test` [522](B9780080571157500157.xhtml#p522)\nRabbit [825](B9780080571157500236.xhtml#p825)\nRamsey, Allan [xv](B9780080571157500261.xhtml#pxv),[594](B9780080571157500170.xhtml#p594),[748](B9780080571157500212.xhtml#p748)\n`random-choice` [773](B9780080571157500224.xhtml#p773)\n`random-elt` [36](B9780080571157500029.xhtml#p36),[166](B9780080571157500054.xhtml#p166),[276](B9780080571157500091.xhtml#p276),[322](B9780080571157500108.xhtml#p322),[602](B9780080571157500182.xhtml#p602)\n`random-mem` [322](B9780080571157500108.xhtml#p322)\nrandom-ordering strategy [630](B9780080571157500182.xhtml#p630)\n`random-othello-series` [623](B9780080571157500182.xhtml#p623),[627](B9780080571157500182.xhtml#p627)\n`random-strategy` [602](B9780080571157500182.xhtml#p602),[607](B9780080571157500182.xhtml#p607)\nrapid-prototyping [265](B9780080571157500091.xhtml#p265)\n`rat*rat` [513](B9780080571157500157.xhtml#p513),[529](B9780080571157500157.xhtml#p529)\n`rat+rat` [513](B9780080571157500157.xhtml#p513),[529](B9780080571157500157.xhtml#p529)\n`rat-denominator` [513](B9780080571157500157.xhtml#p513),[527](B9780080571157500157.xhtml#p527)\n`rat-numerator` [513](B9780080571157500157.xhtml#p513),[527](B9780080571157500157.xhtml#p527)\n`rat/rat` [513](B9780080571157500157.xhtml#p513),[529](B9780080571157500157.xhtml#p529)\nrational number [526](B9780080571157500157.xhtml#p526)\n`read` [83](B9780080571157500030.xhtml#p83)\n`read-char` [83](B9780080571157500030.xhtml#p83),[895](B978008057115750025X.xhtml#p895)\nread-eval-print loop [176](B9780080571157500066.xhtml#p176),[821](B9780080571157500236.xhtml#p821)\n`read-from-string` [876](B978008057115750025X.xhtml#p876)\n`read-line` [83](B9780080571157500030.xhtml#p83)\n`read-time-case` [313](B9780080571157500091.xhtml#p313)\n`read/1` [413](B9780080571157500121.xhtml#p413)\nreading [24](B9780080571157500017.xhtml#p24)\nreadtable [712](B9780080571157500200.xhtml#p712),[821](B9780080571157500236.xhtml#p821)\nreasoning with uncertainty [531](B9780080571157500169.xhtml#p531)\nrecursion [62](B9780080571157500030.xhtml#p62)\n`recursive` [17](B9780080571157500017.xhtml#p17)\nrecursive subgoal [123](B9780080571157500042.xhtml#p123)\nREDUCE\n!!!(span) {:.smallcaps}\n [259](B978008057115750008X.xhtml#p259)\n`reduce` [62](B9780080571157500030.xhtml#p62),[860](B9780080571157500248.xhtml#p860)\n`reduce*` [860](B9780080571157500248.xhtml#p860)\n`reduce-list` [862](B9780080571157500248.xhtml#p862)\n`reduce-vect` [860](B9780080571157500248.xhtml#p860)\nreferential transparency [423](B9780080571157500121.xhtml#p423),[856](B9780080571157500248.xhtml#p856)\nregression testing [90](B9780080571157500030.xhtml#p90)\n`reject-premise` [533](B9780080571157500169.xhtml#p533),[547](B9780080571157500169.xhtml#p547)\n`rel` [485](B9780080571157500145.xhtml#p485),[491](B9780080571157500145.xhtml#p491)\n`rel-clause` [698](B9780080571157500200.xhtml#p698),[701](B9780080571157500200.xhtml#p701),[703](B9780080571157500200.xhtml#p703),[716](B9780080571157500212.xhtml#p716),[720](B9780080571157500212.xhtml#p720)\n`rel-pro` [716](B9780080571157500212.xhtml#p716)\n`relation-arity` [390](B9780080571157500121.xhtml#p390),[391](B9780080571157500121.xhtml#p391)\nrelations [485](B9780080571157500145.xhtml#p485)\nrelative clauses [720](B9780080571157500212.xhtml#p720)\n`remhash` [74](B9780080571157500030.xhtml#p74)\n`remove` [61](B9780080571157500030.xhtml#p61),[62](B9780080571157500030.xhtml#p62)\n`remove-if` [61](B9780080571157500030.xhtml#p61)\n`remove-if-not` [61](B9780080571157500030.xhtml#p61),[100](B9780080571157500030.xhtml#p100)\n`remove-punctuation` [709](B9780080571157500200.xhtml#p709)\n`remq` [334](B9780080571157500108.xhtml#p334)\n`rename-variables` [361](B978008057115750011X.xhtml#p361),[363](B978008057115750011X.xhtml#p363)\n`repeat` [423](B9780080571157500121.xhtml#p423),[674](B9780080571157500194.xhtml#p674),[845](B9780080571157500248.xhtml#p845)\n`repeat/0` [423](B9780080571157500121.xhtml#p423)\n`repeat/fail loop` [423](B9780080571157500121.xhtml#p423)\n`replace` [624](B9780080571157500182.xhtml#p624),[634](B9780080571157500182.xhtml#p634)\n`replace-?-vars` [373](B978008057115750011X.xhtml#p373),[496](B9780080571157500145.xhtml#p496),[870](B978008057115750025X.xhtml#p870),[871](B978008057115750025X.xhtml#p871)\n`report-findings` [533](B9780080571157500169.xhtml#p533),[550](B9780080571157500169.xhtml#p550)\nrepresentation \nboxed [317](B9780080571157500108.xhtml#p317)\nknowledge [461](B9780080571157500145.xhtml#p461)\nprinted [52](B9780080571157500030.xhtml#p52)\nunboxed [317](B9780080571157500108.xhtml#p317)\n`reset` [773](B9780080571157500224.xhtml#p773)\nresource [336](B9780080571157500108.xhtml#p336)\n`rest` [10](B9780080571157500017.xhtml#p10),[69](B9780080571157500030.xhtml#p69)\nrestrictive clauses [750](B9780080571157500212.xhtml#p750)\n`ret-addr` [795](B9780080571157500236.xhtml#p795),[813](B9780080571157500236.xhtml#p813)\n`retrieve` [480](B9780080571157500145.xhtml#p480),[488](B9780080571157500145.xhtml#p488)\n`retrieve-bagof` [489](B9780080571157500145.xhtml#p489)\n`retrieve-bagof-in-world` [501](B9780080571157500145.xhtml#p501)\n`retrieve-conjunction` [487](B9780080571157500145.xhtml#p487)\n`retrieve-fact` [487](B9780080571157500145.xhtml#p487)\n`retrieve-in-world` [501](B9780080571157500145.xhtml#p501)\n`retrieve-matches` [480](B9780080571157500145.xhtml#p480)\n`retrieve-setof` [489](B9780080571157500145.xhtml#p489)\n`RETURN` [785](B9780080571157500236.xhtml#p785),[798](B9780080571157500236.xhtml#p798),[814](B9780080571157500236.xhtml#p814),[816](B9780080571157500236.xhtml#p816),[820](B9780080571157500236.xhtml#p820)\n`return` [65](B9780080571157500030.xhtml#p65),[754](B9780080571157500224.xhtml#p754),[852](B9780080571157500248.xhtml#p852)\n`return-from` [837](B9780080571157500248.xhtml#p837)\n`return-if` [847](B9780080571157500248.xhtml#p847)\n`reuse-cons` [333](B9780080571157500108.xhtml#p333),[361](B978008057115750011X.xhtml#p361)\n`rev` [411](B9780080571157500121.xhtml#p411)\n`rev-funcall` [674](B9780080571157500194.xhtml#p674)\n`rev-scorer` [674](B9780080571157500194.xhtml#p674)\n`reverse` [69](B9780080571157500030.xhtml#p69),[411](B9780080571157500121.xhtml#p411)\n`reverse-label` [569](B9780080571157500170.xhtml#p569),[573](B9780080571157500170.xhtml#p573)\nReversi [597](B9780080571157500182.xhtml#p597)\nRich, Elaine [594](B9780080571157500170.xhtml#p594)\nRiesbeck, Christopher [xv](B9780080571157500261.xhtml#pxv)\nRISC [811](B9780080571157500236.xhtml#p811)\nRisch, R. [239](B978008057115750008X.xhtml#p239),[528](B9780080571157500157.xhtml#p528),[260](B978008057115750008X.xhtml#p260)\nRobinson, J. A. [382](B978008057115750011X.xhtml#p382)\nRobinson, Peter J. [504](B9780080571157500145.xhtml#p504)\nrobotics [564](B9780080571157500170.xhtml#p564)\nRose, Brian [637](B9780080571157500182.xhtml#p637)\nRosenbloom, Paul [637](B9780080571157500182.xhtml#p637),[645](B9780080571157500182.xhtml#p645),[652](B9780080571157500182.xhtml#p652)\n`round-robin` [623](B9780080571157500182.xhtml#p623),[628](B9780080571157500182.xhtml#p628)\nRoussel, Jacqueline [382](B978008057115750011X.xhtml#p382)\nRuf, Erik [777](B9780080571157500224.xhtml#p777)\n`rule` [242](B978008057115750008X.xhtml#p242),[533](B9780080571157500169.xhtml#p533),[545](B9780080571157500169.xhtml#p545),[658](B9780080571157500194.xhtml#p658),[666](B9780080571157500194.xhtml#p666),[671](B9780080571157500194.xhtml#p671),[690](B9780080571157500200.xhtml#p690)\nrule-based programming [435](B9780080571157500133.xhtml#p435)\nrule-based translation [509](B9780080571157500157.xhtml#p509)\nrule-based translater [224](B9780080571157500078.xhtml#p224)\n`rule-based-translator` [189](B9780080571157500066.xhtml#p189)\n`rule-lhs` [275](B9780080571157500091.xhtml#p275)\n`rule-pattern` [163](B9780080571157500054.xhtml#p163)\n`rule-responses` [163](B9780080571157500054.xhtml#p163)\n`rule-rhs` [275](B9780080571157500091.xhtml#p275)\nrules [350](B978008057115750011X.xhtml#p350)\nexamples [705](B9780080571157500200.xhtml#p705)\nleft-recursive [705](B9780080571157500200.xhtml#p705)\n`rules-for` [298](B9780080571157500091.xhtml#p298),[682](B9780080571157500194.xhtml#p682)\n`rules-starting-with` [658](B9780080571157500194.xhtml#p658)\n`run-attached-fn` [490](B9780080571157500145.xhtml#p490)\n`run-examples` [709](B9780080571157500200.xhtml#p709)\n`run-prolog` [391](B9780080571157500121.xhtml#p391),[409](B9780080571157500121.xhtml#p409)\nRussell, Bertrand [20](B9780080571157500017.xhtml#p20)\nRussell, Steve [777](B9780080571157500224.xhtml#p777)\nRussell, Stuart [504](B9780080571157500145.xhtml#p504),[650](B9780080571157500182.xhtml#p650)\nS\n!!!(p) {:.idxletter}\n\nS [660](B9780080571157500194.xhtml#p660)\n`S` [686-688](B9780080571157500200.xhtml#p686),[692](B9780080571157500200.xhtml#p692),[699](B9780080571157500200.xhtml#p699),[701](B9780080571157500200.xhtml#p701),[703](B9780080571157500200.xhtml#p703),[716](B9780080571157500212.xhtml#p716),[725](B9780080571157500212.xhtml#p725),[726](B9780080571157500212.xhtml#p726)\nSacerdoti, Earl [147](B9780080571157500042.xhtml#p147)\nSager, Naomi [749](B9780080571157500212.xhtml#p749)\nSAINT\n!!!(span) {:.smallcaps}\n [239](B978008057115750008X.xhtml#p239),[259](B978008057115750008X.xhtml#p259)\n`same-shape-tree` [76](B9780080571157500030.xhtml#p76)\nSamuel, A. L. [651](B9780080571157500182.xhtml#p651)\nSangal, Rajeev [xiv](B9780080571157500261.xhtml#pxiv)\nsatisficing [146](B9780080571157500042.xhtml#p146)\n`satisfy-premises` [533](B9780080571157500169.xhtml#p533),[546](B9780080571157500169.xhtml#p546)\n`SAVE` [814](B9780080571157500236.xhtml#p814)\n`sbit` [73](B9780080571157500030.xhtml#p73)\nWord Count: 0\n"
  },
  {
    "path": "PAIP.txt",
    "content": "## Frontmatter\nParadigms of \nArtificial Intelligence \nProgramming: \n\nCASE STUDIES IN COMMON LISP \n\nPeter Norvig \n\nMORGAN KAUFMANN PUBLISHERS ^ SAN FRANCISCO, CALIFORNIA \n\n\f\nSponsoring Editor Michael B. Morgan \nProduction Manager Yonie Overton \nCover Designer Sandra Popovich \nText Design/Composition SuperScnpt Typography \nCopyeditor Barbara Beidler Kendnck \nProofreaders Lynn Meinhardt, Shanlyn Hovind, Gary Morus \nPrinter Malloy Lithographing \n\nMorgan Kaufmann Publishers, Inc. \n\nEditorial and Sales Office: \n\n340 Pine Street, Sbcth Floor \nSan Francisco, CA 94104-3205 \nUSA \nTelephone 415/392-2665 \nFacsimile 415/982-2665 \nInternet mkp@mkp.com \nWeb site http://mkp.com \n\n© 1992 Morgan Kaufmann Publishers, Inc. \nAll rights reserved \n\nPrinted in the United States of America \n\n03 02 Ol 8 7 6 \nNo part of this publication may be reproduced, stored in a retrieval system, or \ntransmitted in any form or by any means-electronic, photocopying, recording, or \notherwise—without the prior written permission of the publisher. \n\nLibrary of Congress Cataloging-in-Publication Data \n\nNorvig, Peter. \nParadigms of artificial inteUigence programming: case studies in \ncommon Lisp / Peter Norvig. \n\np. cm. \nIncludes bibliographical references and index. \nISBN 1-55860-191-0: \n1. Electronic digital computers-Programming. 2. COMMON LISP \n(Computer program language) 3. Artificial intelligence. I. Title. \nQA76.6.N6871991 \n006.3-dc20 91-39187 \nCIP \n\n\f\nTo my family,.. \n\n\f\n## Preface\n<a id='page-vii'></a>\n\n> **paradigm** *n* **1** an example or pattern; *esp* an outstandingly clear or typical example. \n>\n> -*Longman's Dictionary of the English Language*, 1984 \n\nThis book is concerned with three related topics: the field of artificial intelligence, or AI; the skill \nof computer programming; and the programming language Common Lisp. Careful readers of \nthis book can expect to come away with an appreciation of the major questions and techniques \nof AI, an understanding of some important AI programs, and an ability to read, modify, and \ncreate programs using Common Lisp. The examples in this book are designed to be clear \nexamples of good programming style—paradigms of programming. They are also paradigms \nof AI research—historically significant programs that use widely applicable techniques to solve \nimportant problems. \n\nJust as a liberal arts education includes a course in \"the great books\" of a culture, so this book \nis, at one level, a course in \"the great programs\" that define the AI culture.[TK fn1] \n\nAt another level, this book is a highly technical compendium of the knowledge you will need \nto progress from being an intermediate Lisp programmer to being an expert. Parts I and II are \ndesigned to help the novice get up to speed, but the complete beginner may have a hard time \neven with this material. Fortunately, there are at least five good texts available for the beginner; \nsee [page xiii](preface#page-xiii) for my recommendations. \n\n[TK fn1] This does not imply that the programs chosen are the best of all AI programs—just that \nthey are representative. \n\n\f\n<a id='page-viii'></a>\n\nAll too often, the teaching of computer programming consists of explaining the \nsyntax of the chosen language, showing the student a 10-line program, and then \nasking the student to write programs. In this book, we take the approach that the \nbest way to learn to write is to read (and conversely, a good way to improve reading \nskills is to write). After the briefest of introductions to Lisp, we start right off with \ncomplex programs and ask the reader to understand and make small modifications \nto these programs. \n\nThe premise of this book is that you can only write something useful and interesting \nwhen you both understand what makes good writing and have something \ninteresting to say. This holds for writing programs as well as for writing prose. As \nKernighan and Plauger put it on the cover of *Software Tools in Pascal*: \n\n> Good programming is not learned from generalities, but by seeing how significant \nprograms can be made clean, easy to read, easy to maintain and modify, \nhuman-engineered, efficient, and reliable, by the application of common sense \nand good programming practices. Careful study and imitation of good programs \nleads to better writing. \n\nThe proud craftsman is often tempted to display only the finished work, without \nany indication of the false starts and mistakes that are an unfortunate but unavoidable \npart of the creative process. Unfortunately, this reluctance to unveil the process is \na barrier to learning; a student of mathematics who sees a beautiful 10-line proof in \na textbook can marvel at its conciseness but does not learn how to construct such a \nproof. This book attempts to show the complete programming process, \"warts and \nall.\" Each chapter starts with a simple version of a program, one that works on some \nexamples but fails on others. Each chapter shows how these failures can be analyzed \nto build increasingly sophisticated versions of the basic program. Thus, the reader \ncan not only appreciate the final result but also see how to learn from mistakes and \nrefine an initially incomplete design. Furthermore, the reader who finds a particular \nchapter is becoming too difficult can skip to the next chapter, having gained some \nappreciation of the problem area, and without being overwhelmed by the details. \n\nThis book presents a body of knowledge loosely known as \"AI programming \ntechniques,\" but it must be recognized that there are no clear-cut boundaries on this \nbody of knowledge. To be sure, no one can be a good AI programmer without first \nbeing a good programmer. Thus, this book presents topics (especially in parts III \nand V) that are not AI per se, but are essential background for any AI practitioner. \n\n### Why Lisp? Why Common Lisp? \n\nLisp is one of the oldest programming languages still in widespread use today. There \nhave been many versions of Lisp, each sharing basic features but differing in detail. \nIn this book we use the version called Common Lisp, which is the most widely \naccepted standard. Lisp has been chosen for three reasons. \n\n\f\n<a id='page-ix'></a>\n\nFirst, Lisp is the most popular language for AI programming, particularly in the \nUnited States. If you're going to learn a language, it might as well be one with a \ngrowing literature, rather than a dead tongue. \n\nSecond, Lisp makes it easy to capture relevant generalizations in defining new \nobjects. In particular. Lisp makes it easy to define new languages especially targeted \nto the problem at hand. This is especially handy in AI applications, which often \nmanipulate complex information that is most easily represented in some novel form. \nLisp is one of the few languages that allows full flexibility in defining and manipulating \nprograms as well as data. All programming languages, by definition, provide \na means of defining programs, but many other languages limit the ways in which a \nprogram can be used, or limit the range of programs that can be defined, or require \nthe programmer to explicitly state irrelevant details. \n\nThird, Lisp makes it very easy to develop a working program fast. Lisp programs \nare concise and are uncluttered by low-level detail. Common Lisp offers an unusually \nlarge number of useful predefined objects, including over 700 functions. The programming \nenvironment (such as debugging tools, incremental compilers, integrated \neditors, and interfaces to window systems) that surround Lisp systems are usually \nvery good. And the dynamic, interactive nature of Lisp makes it easy to experiment \nand change a program while it is being developed. \n\nIt must be mentioned that in Europe and Japan, Prolog has been as popular as \nLisp for AI work. Prolog shares most of Lisp's advantages in terms of flexibility and \nconciseness. Recently, Lisp has gained popularity worldwide, and Prolog is becoming \nmore well known in the United States. As a result, the average AI worker today is \nlikely to be bilingual. This book presents the key ideas behind Prolog in chapters 11 \nand 12, and uses these ideas in subsequent chapters, particularly 20 and 21. \n\nThe dialect of Lisp known as Scheme is also gaining in popularity, but primarily \nfor teaching and experimenting with programming language design and techniques, \nand not so much for writing large AI programs. Scheme is presented in chapters 22 \nand 23. Other dialects of Lisp such as Franz Lisp, MacLisp, InterLisp, ZetaLisp, \nand Standard Lisp are now considered obsolete. The only new dialect of Lisp to be \nproposed recently is EuLisp, the European Lisp. A few dialects of Lisp live on as \nembedded extension languages. For example, the Gnu Emacs text editor uses elisp, \nand the AutoCad computer-aided design package uses AutoLisp, a derivative of Xlisp. \nIn the future, it is likely that Scheme will become a popular extension language, since \nit is small but powerful and has an officially sanctioned standard definition. \n\nThere is a myth that Lisp (and Prolog) are \"special-purpose\" languages, while \nlanguages like Pascal and C are \"general purpose.\" Actually, just the reverse is \ntrue. Pascal and C are special-purpose languages for manipulating the registers and \nmemory of a von Neumann-style computer. The majority of their syntax is devoted \nto arithmetic and Boolean expressions, and while they provide some facilities for \nforming data structures, they have poor mechanisms for procedural abstraction \nor control abstraction. In addition, they are designed for the state-oriented style \n\f\n<a id='page-x'></a>\nof programming: computing a result by changing the value of variables through \nassignment statements. \n\nLisp, on the other hand, has no special syntax for arithmetic. Addition and \nmultiplication are no more or less basic than list operations like appending, or string \noperations like converting to upper case. But Lisp provides all you will need for \nprogramming in general: defining data structures, functions, and the means for \ncombining them. \n\nThe assignment-dominated, state-oriented style of programming is possible in \nLisp, but in addition object-oriented, rule-based, and functional styles are all supported \nwithin Lisp. This flexibility derives from two key features of Lisp: First, Lisp \nhas a powerful *macro* facility, which can be used to extend the basic language. When \nnew styles of programming were invented, other languages died out; Lisp simply \nincorporated the new styles by defining some new macros. The macro facility is \npossible because Lisp programs are composed of a simple data structure: the list. \nIn the early days, when Lisp was interpreted, most manipulation of programs was \ndone through this data structure. Nowadays, Lisp is more often compiled than interpreted, \nand programmers rely more on Lisp's second great flexible feature: the \n*function*. Of course, other languages have functions, but Lisp is rare in allowing the \ncreation of new functions while a program is running. \n\nLisp's flexibility allows it to adapt as programming styles change, but more importantly. \nLisp can adapt to your particular programming problem. In other languages \nyou fit your problem to the language; with Lisp you extend the language to fit your \nproblem. \n\nBecause of its flexibility. Lisp has been succesful as a high-level language for rapid \nprototyping in areas such as AI, graphics, and user interfaces. Lisp has also been \nthe dominant language for exploratory programming, where the problems are so \ncomplex that no clear solution is available at the start of the project. Much of AI falls \nunder this heading. \n\nThe size of Common Lisp can be either an advantage or a disadvantage, depending \non your outlook. In David Touretzky's (1989) fine book for beginning programmers, \nthe emphasis is on simplicity. He chooses to write some programs slightly less \nconcisely, rather than introduce an esoteric new feature (he cites `pushnew` as an \nexample). That approach is entirely appropriate for beginners, but this book goes \nwell past the level of beginner. This means exposing the reader to new features of \nthe language whenever they are appropriate. Most of the time, new features are \ndescribed as they are introduced, but sometimes explaining the details of a low-\nlevel function would detract from the explanation of the workings of a program. \nIn accepting the privilege of being treated as an \"adult,\" the reader also accepts a \nresponsibility—to look up unfamiliar terms in an appropriate reference source. \n\n\f\n<a id='page-xi'></a>\n\n### Outline of the Book \n\nThis book is organized into five parts. \n\n**Part I** introduces the Common Lisp programming language. \n\nChapter 1 gives a quick introduction by way of small examples that demonstrate \nthe novel features of Lisp. It can be safely skipped or skimmed by the experienced \nprogrammer. \n\nChapter 2 is a more extended example showing how the Lisp primitives can be \nput together to form a program. It should be studied carefully by the novice, and \neven the experienced programmer will want to look through it to get a feel for my \nprogramming style. \n\nChapter 3 provides an overview of the Lisp primitives. It can be skimmed on first \nreading and used as a reference whenever an unfamiliar function is mentioned in \nthe text. \n\nPart I has been kept intentionally brief, so that there is more room for presenting \nactual AI programs. Unfortunately, that means that another text or reference book \n(or online help) may be needed to clarify some of the more esoteric features of the \nlanguage. My recommendations for texts are on [page xiii](preface#page-xiii). \n\nThe reader may also want to refer to chapter 25, which offers some debugging \nand troubleshooting hints. \n\n**Part II** covers four early AI programs that all use rule-based pattern-matching \ntechniques. By starting with relatively simple versions of the programs and then \nimproving them and moving on to more complex programs, the reader is able to \ngradually acquire increasingly advanced programming skills. \n\nChapter 4 presents a reconstruction of GPS, the General Problem Solver. The \nimplementation follows the STRIPS approach. \n\nChapter 5 describes ELIZA, a program that mimics human dialogue. This is \nfollowed by a chapter that generalizes some of the techniques used in GPS and ELIZA \nand makes them available as tools for use in subsequent programs. \n\nChapter 7 covers STUDENT, a program that solves high-school-level algebra word \nproblems. \n\nChapter 8 develops a small subset of the MACSYMA program for doing symbolic \nalgebra, including differential and integral calculus. It may be skipped by those who \nshy away from heavy mathematics. \n\n**Part III** detours from AI for a moment to present some general tools for more \nefficient programming. The reader who masters the material in this part can be \nconsidered an advanced Lisp programmer. \n\nChapter 9 is a detailed study of efficiency techniques, concentrating on caching, \nindexing, compilation, and delaying computation. Chapter 10 covers lower-level efficiency \nissues such as using declarations, avoiding garbage generation, and choosing \nthe right data structure. \n\n\f\n<a id='page-xii'></a>\n\nChapter 11 presents the Prolog language. The aim is two-fold: to show how to \nwrite an interpreter for another language, and to introduce the important features \nof Prolog, so that they can be used where appropriate. Chapter 12 shows how a \ncompiler for Prolog can be 20 to 200 times faster than the interpreter. \n\nChapter 13 introduces object-oriented programming in general, then explores the \nCommon Lisp Object System (CLOS). \n\nChapter 14 discusses the advantages and limitations of both logic-oriented and \nobject-oriented programming, and develops a knowledge representation formalism \nusing all the techniques of part III. \n\n**Part IV** covers some advanced AI programs. \n\nChapter 15 uses the techniques of part III to come up with a much more efficient \nimplementation of MACSYMA. It uses the idea of a canonical form, and replaces the \nvery general rewrite rule approach with a series of more specific functions. \n\nChapter 16 covers the EMYCIN expert system shell, a backward chaining rule-based \nsystem based on certainty factors. The MYCIN medical expert system is also \ncovered briefly. \n\nChapter 17 covers the Waltz line-labeling algorithm for polyhedra (using Huffman-Clowes \nlabels). Different approaches to constraint propagation and backtracking \nare discussed. \n\nChapter 18 presents a program that plays an excellent game of Othello. The \ntechnique used, alpha-beta searching, is appropriate to a wide variety of two-person \ngames. \n\nChapter 19 is an introduction to natural language processing. It covers context-free \ngrammar, top-down and bottom-up parsing, chart parsing, and some semantic \ninterpretation and preferences. \n\nChapter 20 extends the linguistic coverage of the previous chapter and introduces \nlogic grammars, using the Prolog compiler developed in chapter 11. \n\nChapter 21 is a fairly comprehensive grammar of English using the logic grammar \nformalism. The problems of going from a simple idea to a realistic, comprehensive \nprogram are discussed. \n\n**Part V** includes material that is peripheral to AI but important for any serious \nLisp programmer. \n\nChapter 22 presents the Scheme dialect of Lisp. A simple Scheme interpreter is \ndeveloped, then a properly tail-recursive interpreter, then an interpreter that explicitly \nmanipulates continuations and supports `call/cc`. Chapter 23 presents a Scheme \ncompiler. \n\nChapter 24 presents the features that are unique to American National Standards \nInstitute (ANSI) Common Lisp. This includes the `loop` macro, as well as error \nhandling, pretty printing, series and sequences, and the package facility. \n\nChapter 25 is a guide to troubleshooting and debugging Lisp programs. \n\n\f\n<a id='page-xiii'></a>\n\nThe bibliography lists over 200 sources, and there is a comprehensive index. In \naddition, the appendix provides a directory of publicly available Lisp programs. \n\n### How to Use This Book \n\nThe intended audience for this book is broad: anyone who wants to become an advanced \nLisp programmer, and anyone who wants to be an advanced AI practitioner. \nThere are several recommended paths through the book: \n\n* *In an Introductory AI Course:* Concentrate on parts I and II, and at least one \nexample from part IV. \n* *In an Advanced AI Programming Course:* Concentrate on parts I, II and IV, skipping \nchapters that are of less interest and adding as much of part III as time permits. \n* *In an Advanced Programming Languages Course:* Concentrate on parts I and V, \nwith selections from part III. Cover chapters 11 and 13 if similar material is not \npresented with another text. \n* *For the Professional Lisp Programmer:* Read as much of the book as possible, and \nrefer back to it often. Part III and chapter 25 are particularly important. \n\n### Supplementary Texts and Reference Books \n\nThe definitive reference source is Steele's *Common Lisp the Language.* From 1984 \nto 1990, this unambiguously defined the language Common Lisp. However, in \n1990 the picture became more complicated by the publication of *Common Lisp the \nLanguage,* 2d edition. This book, also by Steele, contains the recommendations of \nANSI subcommittee X3J13, whose charter is to define a standard for Lisp. These \nrecommendations include many minor changes and clarifications, as well as brand \nnew material on object-oriented programming, error condition handling, and the \nloop macro. The new material doubles the size of the book from 465 to 1029 pages. \n\nUntil the ANSI recommendations are formally accepted, Common Lisp users \nare in the unfortunate situation of having two distinct and incompatible standards: \n\"original\" Common Lisp and ANSI Common Lisp. Most of the code in this book is \ncompliant with both standards. The most significant use of an ANSI function is the \n`loop` macro. The ANSI `map-into`, `complement`, and `reduce` functions are also used, \nalthough rarely. Definitions for all these functions are included, so even those using \nan \"original\" Common Lisp system can still run all the code in the book. \n\nWhile *Common Lisp the Language* is the definitive standard, it is sometimes terse \nand can be difficult for a beginner. *Common Lisp: the Reference,* published by Franz \nInc., offers complete coverage of the language with many helpful examples. *Common \nLISPcraft,* by Robert Wilensky, and *Artificial Intelligence Programming,* by Charniak \n\f\n<a id='page-xiv'></a>\net al., also include brief summaries of the Common Lisp functions. They are not \nas comprehensive, but that can be a blessing, because it can lead the reader more \ndirectly to the functions that are important (at least in the eyes of the author). \n\nIt is a good idea to read this book with a computer at hand, to try out the examples \nand experiment with examples of your own. A computer is also handy because Lisp \nis self-documenting, through the functions `apropos`, `describe`, and `documentation`. \nMany implementations also provide more extensive documentation through some \nkind of 'help' command or menu. \n\nThe five introductory Lisp textbooks I recommend are listed below. The first is \nmore elementary than the others. \n\n* *Common Lisp: A Gentle Introduction to Symbolic Computation* by David Touretzky. \nMost appropriate for beginners, including those who are not computer \nscientists. \n\n* *A Programmer's Guide to Common Lisp* by Deborah G. Tatar. Appropriate for \nthose with experience in another programming language, but none in Lisp. \n\n* *Common LISPcraft* by Robert Wilensky. More comprehensive and faster paced, \nbut still useful as an introduction as well as a reference. \n\n* *Common Lisp* by Wade L. Hennessey. Somewhat hit-and-miss in terms of the \ntopics it covers, but with an enlightened discussion of implementation and \nefficiency issues that do not appear in the other texts. \n\n* *LISP* (3d edition) by Patrick H. Winston and Bertold Horn. Covers the most \nground in terms of programming advice, but not as comprehensive as a reference. \nMay be difficult for beginners. Includes some AI examples. \n\nWhile it may be distracting for the beginner to be continually looking at some \nreference source, the alternative—to have this book explain every new function in \ncomplete detail as it is introduced—would be even more distracting. It would interrupt \nthe description of the AI programs, which is what this book is all about. \n\nThere are a few texts that show how to write AI programs and tools, but none \nthat go into the depth of this book. Nevertheless, the expert AI programmer will \nwant to be familiar with all the following texts, listed in rough order of increasing \nsophistication: \n\n* *LISP* (3d edition). (See above.) \n\n* *Programming Paradigms in Lisp* by Rajeev Sangal. Presents the different styles \nof programming that Lisp accommodates, illustrating them with some useful \nAI tools. \n\n\f\n<a id='page-xv'></a>\n\n* *Programming for Artificial Intelligence* by Wolfgang Kreutzer and Bruce McKenzie. \nCovers some of the basics of rule-based and pattern-matching systems well, \nbut covers Lisp, Prolog, and Smalltalk, and thus has no time left for details in \nany of the languages. \n\n* *Artificial Intelligence Programming* (2d edition) by Eugene Charniak, Christopher \nRiesbeck, Drew McDermott, and James Meehan. Contains 150 pages of \nLisp overview, followed by an advanced discussion of AI tools, but no actual \nAI programs. \n\n* *AI in Practice: Examples in Pop-11* by Allan Ramsey and Rosalind Barrett. Advanced, \nhigh-quality implementations of five AI programs, unfortunately using \na language that has not gained popularity. \n\nThe current text combines the virtues of the last two entries: it presents both actual \nAI programs and the tools necessary to build them. Furthermore, the presentation is \nin an incremental fashion, with simple versions presented first for clarity, followed \nby more sophisticated versions for completeness. \n\n### A Note on Exercises \n\nSample exercises are provided throughout. Readers can test their level of understanding \nby faithfully doing the exercises. The exercises are graded on the scale [s], \n[m], [h], [d], which can be interpreted either as a level of difficulty or as an expected \ntime it will take to do the exercise: \n\n| Code | Difficulty | Time to Do  |\n|------|------------|-------------|\n| [s]  | Simple     | Seconds     |\n| [m]  | Medium     | Minutes     |\n| [h]  | Hard       | Hours       |\n| [d]  | Difficult  | Days        |\n\nThe time to do the exercise is measured from the point that the concepts have \nbeen well understood. If the reader is unclear on the underlying concepts, it might \ntake hours of review to understand a [m] problem. Answers to the exercises can be \nfound in a separate section at the end of each chapter. \n\n### Acknowledgments \n\nA great many people contributed to this book. First of all I would like to thank my \nstudents at USC and Berkeley, as well as James Martin's students at Colorado and \nMichael Pazzani's students at Irvine, who course-tested earlier versions of this book. \nUseful suggestions, corrections, and additions were made by: \n\n\f\n<a id='page-xvi'></a>\n\nNina Amenta (Berkeley), Ray S. Babcock and John Paxton (Montana State), \nBryan A. Bentz (BBN), Mary P. Boelk (Johnson Controls), Michael Braverman (Berkeley), \nR. Chandrasekar and M. Sasikumar (National Centre for Software Technology, \nBombay), Mike Clancy (Berkeley), Michael Covington (Georgia), Bruce D'Ambrosio \n(Oregon State), Piew Datta (Irvine), Shawn Dettrey (USC), J. A. Durieux (AI Engineering \nBV, Amsterdam), Joseph Faletti (ETS), Paul Fuqua (Texas Instruments), \nRobert Goldman (Tulane), Marty Hall (Johns Hopkins), Marti Hearst (Berkeley), Jim \nHendler (Maryland), Phil Laird (NASA), Raymond Lang (Tulane), David D. Loeffler \n(MCC), George Luger (New Mexico), Rob MacLachlan (CMU), Barry Margolin \n(Thinking Machines), James Mayfield (UMBC), Sanjay Manchandi (Arizona), Robert \nMcCartney (Connecticut), James Meehan (DEC), Andrew L. Ressler, Robert S. Rist \n(University of Technology, Sydney), Paul Snively (Apple), Peter Van Roy (Berkeley), \nDavid Gumby Wallace (Cygnus), and Jeff Wu (Colorado). \n\nSam Dooley and Eric Wefald both wrote Othello-playing programs without which \nI would not have written chapter 18. Eric also showed me Aristotle's quotes on means-ends \nanalysis. Tragically, Eric died in August 1989. He is sorely missed by his friends \nand colleagues. Richard Fateman made suggestions for chapter 8, convinced me to \nwrite chapter 15, and, with help from Peter Klier, wrote a substantial program from \nwhich I adapted some code for that chapter. Charley Cox (Franz Inc.), Jamie Zawinski \n(Lucid Inc.), and Paul Fuqua (Texas Instruments) explained the inner workings of \ntheir respective companies' compilers. Mike Harrison, Paul Hilfinger, Marc Luria, \nEthan Munson, and Stephan Slade helped with LATEX. Narciso Jarimillo tested all the \ncode and separated it into the files that are available to the reader (see [page 897](appendix.md#page-897)). \n\nDuring the writing of this book I was supported by a grant from the Defense \nAdvanced Research Projects Agency (DoD), Arpa Order No. 4871, monitored by \nSpace and Naval Warfare Systems Command under Contract N00039-84-C-0089. \nSpecial thanks to DARPA and to Robert Wilensky and the rest of my colleagues and \nstudents at Berkeley for providing a stimulating environment for research, programming, \nand writing. \n\nFinally, thanks to Mike Morgan and Yonie Overton for overseeing the production \nof the book and encouraging me to finish on time. \n\n\f\n## Chapter 1\n<a id='page-3'></a>\n\nIntroduction to Lisp \n\nYou think you know when you learn, are more sure \nwhen you can write, even more when you can teach, \nhut certain when you can program. \n\n—Alan Perils \nYale University computer scientist \n\n.1 his chapter is for people with little or no experience in Lisp. Readers who feel confident \nin their Lisp programming ability can quickly skim the chapter or skip it entirely. This \nchapter necessarily moves quickly, so those with little programming experience, or any \nreader who finds this chapter tough going, should seek out a supplementary introductory text. \nMy recommendations are in the preface. \nComputers allow one to carry out computations. A word processing program deals with \nwords while a calculator deals with numbers, but the principles are the same. In both cases, \nyou provide the input (words or numbers) and specify the operations (such as deleting a word \nor adding two numbers) to yield a result (a completed document or calculation). \nWe will refer to anything that can be represented in the memory of a computer as a computational \nobject, or just an object. So, words, paragraphs, and numbers can be objects. And because \nthe operations (deleting and adding) must be represented somewhere in the computer's memory, \nthey are objects, too. \n\n\f\n<a id='page-4'></a>\n\nNormally, the distinction between a computer \"user\" and a computer \"programmer\" \nis that the user provides new input, or data (words or numbers), while the \nprogrammer defines new operations, or programs, as well as new types of data. Every \nnew object, be it datum or operation, must be defined in terms of previously defined \nobjects. The bad news is that it can be quite tedious to get these definitions right. \nThe good news is that each new object can in turn be used in the definition of future \nobjects. Thus, even complex programs can be built out of smaller, simpler objects. \nThis book covers a number of typical AI problems, showing how each problem can \nbe broken down into manageable pieces, and also how each piece can be described in \nthe programming language Common Lisp. Ideally, readers will learn enough through \nstudying these examples to attack new AI problems with style, grace, and success. \n\nLet's consider a simple example of a computation: finding the sum of two numbers, \nlet's say 2 and 2. If we had a calculator handy, we would type \"2 -f 2 =\" and see \nthe answer displayed. On a calculator using reverse Polish notation, we would have \nto type\" 22+ \" to see the same answer. In Lisp, as with the calculator, the user carries \nout an interactive dialog with the computer by typing in an expression and seeing the \ncomputer print the value of that expression. This interactive mode is different from \nmany other programming languages that only offer a batch mode, wherein an entire \nprogram is compiled and run before any output can be seen. \n\nWe start up a pocket calculator by flipping the on/off switch. The Lisp program \nmust also be started, but the details vary from one computer to another, so I can't \nexplain how your Lisp will work. Assuming we have managed to start up Lisp, we \nare likely to see a prompt of some kind. On my computer. Lisp types \" > \" to indicate \nit is ready to accept the next computation. So we are faced with a screen that looks \nlike this: \n\nWe may now type in our computation and see the result displayed. It turns out that \nthe Lisp convention for arithemtic expressions is slightly different: a computation \nconsists of a parenthesized list with the operation name first, followed by any number \nof operands, or arguments. This is called prefix notation. \n\n> (+ 2 2) \n\n> \n\nWe see that Lisp has printed the answer, 4, and then another prompt, >, to indicate \nit is ready for the next computation. Throughout this book, all Lisp expressions will \nbe displayed in typewriter font. Text on the same line as the \">\" prompt is input \ntyped by the user, and text following it is output printed by the computer. Usually, \ninput that is typed by the programmer will be in 1 owercase letters, while output that \n\n\f\n<a id='page-5'></a>\n\nis printed back by the computer will be in UPPERCASE letters. Of course, with symbols \nlike + and 4 there is no difference. \n\nTo save space on the page, the output will sometimes be shown on the same line \nas the input, separated by an arrow which can be read as \"evaluates to,\" and \ncan also be thought of as standing for the return or enter key that the user presses to \ncomplete the input: \n\n> (+ 2 2) ^ 4 \n\nOne advantage of parenthesized prefix notation is that the parentheses clearly mark \nthe beginning and end of an expression. If we want, we can give + more than two \narguments, and it will still add them all: \n\n> (+ 1 2 3 4 5 6 7 8 9 10) 55 \n\nThis time we try (9000 + 900 + 90 -f 9) - (5000 + 500 + 50 + 5): \n\n> (- (+ 9000 900 90 9) (+ 5000 500 50 5)) => 4444 \n\nThis example shows that expressions can be nested. The arguments to the function \nare parenthesized lists, while the arguments to each + are atoms. The \nLisp notation may look unusual compared to standard mathematical notation, but \nthere are advantages to this notation; since Lisp expressions can consist of a function \nfollowed by any number of arguments, we don't have to keep repeating the More \nimportant than the notation is the rule for evaluation. In Lisp, lists are evaluated \nby first evaluating all the arguments, then applying the function to the arguments, \nthereby computing the result. This rule is much simpler than the rule for evaluating \nnormal mathematical expressions, where there are many conventions to remember, \nsuch as doing multiplications and divisions before sums and differences. We will see \nbelow that the actual Lisp evaluation rule is a little more complicated, but not much. \n\nSometimes programmers who are familiar with other languages have preconceptions \nthat make it difficult for them to learn Lisp. For them, three points are worth \nstressing here. First, many other languages make a distinction between statements \nand expressions. An expression, like 2 + 2, has a value, but a statement, like . = \n2 + 2, does not. Statements have effects, but they do not return values. In Lisp, \nthere is no such distinction: every expression returns a value. It is true that some \nexpressions have effects, but even those expressions also return values. \n\nSecond, the lexical rules for Lisp are much simpler than the rules for other \nlanguages. In particular, there are fewer punctuation characters: only parentheses, \nquote marks (single, double, and backward), spaces, and the comma serve to separate \nsymbols from each other. Thus, while the statement y=a*x+3 is analyzed as seven \nseparate tokens in other languages, in Lisp it would be treated as a single symbol. To \n\n\f\n<a id='page-6'></a>\n\nget a list of tokens, we would have to insert spaces: (y = a * . + 3).^ \n\nThird, while many languages use semicolons to delimit statements. Lisp has no \nneed of semicolons, since expressions are delimited by parentheses. Lisp chooses \nto use semicolons for another purpose—to mark the beginning of a comment, which \nlasts until the end of the line: \n\n> (+ 2 2) ; this is a comment \n\n1.1 Symbolic Computation \nAll we've done so far is manipulate numbers in the same way a simple pocket \ncalculator would. Lisp is more useful than a calculator for two main reasons. First, \nit allows us to manipulate objects other than numbers, and second, it allows us \nto define new objects that might be useful in subsequent computations. We will \nexamine these two important properties in turn. \n\nBesides numbers. Lisp can represent characters (letters), strings of characters, \nand arbitrary symbols, where we are free to interpret these symbols as referring to \nthings outside the world of mathematics. Lisp can also build nonatomic objects \nby combining several objects into a list. This capability is fundamental and well \nsupported in the language; in fact, the name Lisp is short for LISt Processing. \n\nHere's an example of a computation on lists: \n\n> (append '(Pat Kim) '(Robin Sandy)) (PAT KIM ROBIN SANDY) \n\nThis expression appends together two lists of names. The rule for evaluating this \nexpression is the same as the rule for numeric calculations: apply the function (in \nthis case append) to the value of the arguments. \n\nThe unusual part is the quote mark ('), which serves to block the evaluation of the \nfollowing expression, returning it literally. If we just had the expression (Pat Kim), \nit would be evaluated by considering Pat as a function and applying it to the value of \nthe expression Ki m. This is not what we had in mind. The quote mark instructs Lisp \nto treat the list as a piece of data rather than as a function call: \n\n> '(Pat Kim) (PAT KIM) \n\nIn other computer languages (and in English), quotes usually come in pairs: one to \nmark the beginning, and one to mark the end. In Lisp, a single quote is used to mark \n\n^This list of symbols is not a legal Lisp assignment statement, but it is a Lisp data object. \n\n\f\n<a id='page-7'></a>\n\nthe beginning of an expression. Since we always know how long a single expression \nis—either to the end of an atom or to the matching parenthesis of a list—we don't need \nan explicit punctuation mark to tell us where the expression ends. Quotes can be \nused on hsts, as in * (Pat Ki m), on symbols as in ' Robi n, and in fact on anything else. \nHere are some examples: \n\n> 'John => JOHN \n\n> '(John Q Public) => (JOHN Q PUBLIC) \n\n> '2 2 \n\n> . => . \n\n> '(+ 2 2) =.> (+ 2 2) \n\n> (+ 2 2) => 4 \n\n> John ^ Error: ]OHN is not a bound variable \n\n> (John Q Public) ^ Error: JOHN is not a function \n\nNote that ' 2 evaluates to 2 because it is a quoted expression, and 2 evaluates to 2 \nbecause numbers evaluate to themselves. Same result, different reason. In contrast, \n'John evaluates to John because it is a quoted expression, but evaluating John leads \nto an error, because evaluating a symbol means getting the value of the symbol, and \nno value has been assigned to John. \n\nSymbolic computations can be nested and even mixed with numeric computations. \nThe following expression builds a list of names in a slightly different way than \nwe saw before, using the built-in function list. We then see how to find the number \nof elements in the list, using the built-in function length: \n\n> (append '(Pat Kim) (list '(John Q Public) 'Sandy)) \n(PAT KIM (JOHN Q PUBLIC) SANDY) \n\n> (length (append '(Pat Kim) (list '(John Q Public) 'Sandy))) \n4 \n\nThere are four important points to make about symbols: \n\n* First, it is important to remember that Lisp does not attach any external significance \nto the objects it manipulates. For example, we naturally think of (Robi. \nSandy) asalistof two first names, and (John Q Publ ic) as a list of one person's \nfirst name, middle initial, and last name. Lisp has no such preconceptions. To \nLisp, both Robi. and xyzzy are perfectly good symbols. \n* Second, to do the computations above, we had to know that append, length, \nand + are defined functions in Common Lisp. Learning a language involves \n\f\n<a id='page-8'></a>\n\nremembering vocabulary items (or knowing where to look them up) as well \nas learning the basic rules for forming expressions and determining what they \nmean. Common Lisp provides over 700 built-in functions. At some point the \nreader should flip through a reference text to see what's there, but most of the \nimportant functions are presented in part I of this book. \n\n* Third, note that symbols in Common Lisp are not case sensitive. By that I \nmean that the inputs John, John, and jOhN all refer to the same symbol, which \nis normally printed as JOHN.^ \n* Fourth, note that a wide variety of characters are allowed in symbols: numbers, \nletters, and other punctuation marks like'+' or'!'. The exact rules for what constitutes \na symbol are a little complicated, but the normal convention is to use \nsymbols consisting mostly of letters, with words separated by a dash (-), and \nperhaps with a number at the end. Some programmers are more liberal in naming \nvariables, and include characters like'? 1 $/<=>'. For example, a function to \nconvert dollars to yen might be named with the symbol $- to -yen or $ ->yen in \nLisp, while one would use something like Dol 1 arsToYen, dol 1 ars_to_yen or \ndo! 2yen in Pascal or C. There are a few exceptions to these naming conventions, \nwhich will be dealt with as they come up. \n1.2 Variables \nWe have seen some of the basics of symbolic computation. Now we move on to \nperhaps the most important characteristic of a programming language: the ability to \ndefine new objects in terms of others, and to name these objects for future use. Here \nsymbols again play an important role—they are used to name variables. A variable \ncan take on a value, which can be any Lisp object. One way to give a value to a \nvariable is with setf: \n\n> (setf . '(John 0 Public)) => (JOHN Q PUBLIC) \n\n> . (JOHN Q PUBLIC) \n\n> (setf X 10) 10 \n\n> (+ X x) 20 \n\n> (+ X (length p)) => 13 \n\nAfter assigning the value (John Q Rubi i c) to the variable named p, we can refer to \nthe value with the name p. Similarly, after assigning a value to the variable named x, \nwe can refer to both . and p. \n\n^The variable *pri nt - case* controls how symbols will be printed. By default, the value of \nthis variable is -.upcase, but it can be changed to rdowncaseor : capitalize. \n\n\f\n<a id='page-9'></a>\n\nSymbols are also used to name functions in Common Lisp. Every symbol can \nbe used as the name of a variable or a function, or both, although it is rare (and \npotentially confusing) to have symbols name both. For example, append and length \nare symbols that name functions but have no values as variables, and pi does not \nname a function but is a variable whose value is 3.1415926535897936 (or thereabout). \n\n1.3 Special Forms \nThe careful reader will note that setf violates the evaluation rule. We said earlier \nthat functions like +, - and append work by first evaluating all their arguments and \nthen applying the function to the result. But setf doesn't follow that rule, because \nsetf is not a function at all. Rather, it is part of the basic syntax of Lisp. Besides the \nsyntax of atoms and function calls. Lisp has a small number of syntactic expressions. \nThey are known as special forms. They serve the same purpose as statements in other \nprogramming languages, and indeed have some of the same syntactic markers, such \nas i f and 1 oop. There are two main differences between Lisp's syntax and other \nlanguages. First, Lisp's syntactic forms are always lists in which the first element is \none of a small number of privileged symbols, setf is one of these symbols, so (setf \n. 10) is a special form. Second, special forms are expressions that return a value. \nThis is in contrast to statements in most languages, which have an effect but do not \nreturn a value. \n\nIn evaluating an to expression like (setf . (+ 1 2)), we set the variable named \nby the symbol . to the value of (+12), which is 3. If setf were a normal function, \nwe would evaluate both the symbol x and the expression (+1 2) and do something \nwith these two values, which is not what we want at all. setf is called a special form \nbecause it does something special: if it did not exist, it would be impossible to write \na function that assigns a value to a variable. The philosophy of Lisp is to provide a \nsmall number of special forms to do the things that could not otherwise be done, and \nthen to expect the user to write everthing else as functions. \n\nThe term special form is used confusingly to refer both to symbols like setf and \nexpressions that start with them, like (setf . 3). In the book Common LISPcraft \nWilensky resolves the ambiguity by calling setf a special function, and reserving the \nterm special form for (setf . 3). This terminology implies that setf is just another \nfunction, but a special one in that its first argument is not evaluated. Such a view \nmade sense in the days when Lisp was primarily an interpreted language. The \nmodern view is that setf should not be considered some kind of abnormal function \nbut rather a marker of special syntax that will be handled specially by the compiler. \nThus, the special form (setf x (+ 2 1)) should be considered the equivalent of . = \n2 + 1 in C. When there is risk of confusion, we will call setf a special form operator \nand (setf . 3) a special form expression. \n\n\f\n<a id='page-10'></a>\n\nIt turns out that the quote mark is just an abbreviation for another special form. \nThe expression 'x is equivalent to (quote ;c), a special form expression that evaluates \ntoX. The special form operators used in this chapter are: \n\ndefun define function \ndefparameter define special variable \nset f set variable or field to new value \nlet bind local variable(s) \ncase choose one of several alternatives \nif do one thing or another, depending on a test \nfunction (#') refer to a function \nquote (') introduce constant data \n\n1.4 Lists \nSo far we have seen two functions that operate on hsts: append and length. Since \nlists are important, let's look at some more list processing functions: \n\n> . => (JOHN 0 PUBLIC) \n\n> (first p) JOHN \n\n> (rest p) (Q PUBLIC) \n\n> (second p) ^ Q \n\n> (third p) => PUBLIC \n\n> (fourth p) ^ NIL \n\n> (length p) 3 \n\nThe functions first, second, third, and fourth are aptly named: first returns \nthe first element of a list, second gives you the second element, and so on. The \nfunction rest is not as obvious; its name stands for \"the rest of the list after the first \nelement.\" The symbol nil and the form () are completely synonymous; they are \nboth representations of the empty list, ni 1 is also used to denote the \"false\" value in \nLisp. Thus, (fourth .) is ni 1 because there is no fourth element of p. Note that Hsts \nneed not be composed only of atoms, but can contain sublists as elements: \n\n> (setf . '((1st element) 2 (element 3) ((4)) 5)) \n((1ST ELEMENT) 2 (ELEMENT 3) ((4)) 5) \n\n> (length x) \n\n> (first x) = (1ST ELEMENT) \n\n\f\n<a id='page-11'></a>\n\n> (second x) => 2 \n\n> (third X) => (ELEMENT 3) \n\n> (fourth X) ((4)) \n\n> (first (fourth x)) ^ (4) \n\n> (first (first (fourth x))) ^ 4 \n\n> (fifth X) ^ 5 \n\n> (first X) (1ST ELEMENT) \n\n> (second (first x)) => ELEMENT \n\nSo far we have seen how to access parts of lists. It is also possible to build up new \nlists, as these examples show: \n\n> . (JOHN Q PUBLIC) \n\n> (cons 'Mr p) ^ (MR JOHN Q PUBLIC) \n\n> (cons (first p) (rest p)) => (JOHN Q PUBLIC) \n\n> (setf town (list 'Anytown 'USA)) => (ANYTOWN USA) \n\n> (list . Of town 'may 'have 'already 'won!) ^ \n((JOHN Q PUBLIC) OF (ANYTOWN USA) MAY HAVE ALREADY WON!) \n\n> (append . '(of) town '(may have already won!)) \n(JOHN Q PUBLIC OF ANYTOWN USA MAY HAVE ALREADY WON!) \n\n> . (JOHN Q PUBLIC) \n\nThe function cons stands for \"construct.\" It takes as arguments an element and \na list,^ and constructs a new list whose first is the element and whose rest is the \noriginal list. 1 i st takes any number of elements as arguments and returns a new \nhst containing those elements in order. We've already seen append, which is similar \nto 1 ist; it takes as arguments any number of lists and appends them all together, \nforming one big list. Thus, the arguments to append must be lists, while the arguments \nto 11 St may be lists or atoms. It is important to note that these functions create new \nlists; they don't modify old ones. When we say (append . q), the effect is to create \na brand new list that starts with the same elements that were in p. . itself remains \nunchanged. \n\nNow let's move away from abstract functions on lists, and consider a simple \nproblem: given a person's name in the form of a list, how might we extract the family \nname? For (JOHN Q PUBLIC) we could Justuse the function thi rd, but that wouldn't \n\n^ Later we will see what happens when the second argument is not a list. \n\n\f\n<a id='page-12'></a>\n\nwork for someone with no middle name. There is a function called last in Common \nLisp; perhaps that would work. We can experiment: \n\n> (last p) => (PUBLIC) \n\n> (first (last p)) PUBLIC \n\nIt turns out that last perversely returns a list of the last element, rather than the \nlast element itself.^ Thus we need to combine first and last to pick out the actual \nlast element. We would like to be able to save the work we've done, and give it a \nproper description, like 1 a st - name. We could use setf to save the last name of p, but \nthat wouldn't help determine any other last name. Instead we want to define a new \nfunction that computes the last name of any name that is represented as a list. The \nnext section does just that. \n\n1.5 Defining New Functions \nThe special form defun stands for \"define function.\" It is used here to define a new \nfunction called last-name: \n\n(defun last-name (name) \n\"Select the last name from a name represented as a list. \" \n(first (last name))) \n\nWe give our new function the name last-name. It has a parameter list consisting of a \nsingle parameter: (name). This means that the function takes one argument, which \nwe will refer to as name. It also has a documentation string that states what the function \ndoes. This is not used in any computation, but documentation strings are crucial \ntools for debugging and understanding large systems. The body of the definition is \n(first (last name)), which is what we used before to pick out the last name of p. \nThe difference is that here we want to pick out the last name of any name, not just of \nthe particular name p. \n\nIn general, a function definition takes the following form (where the documentation \nstring is optional, and all other parts are required): \n\n^In ANSI Common Lisp, last is defined to return a list of the last . elements, where . \ndefaults to 1. Thus (last p) = (last . 1) = (PUBLIC), and (last . 2) = (Q PUBLIC). This \nmay make the definition of last seem less perverse. \n\n\f\n<a id='page-13'></a>\n\n(defun function-name {parameter...) \n''documentation string'' \nfunction-body...) \n\nThe function name must be a symbol, the parameters are usually symbols (with some \ncomplications to be explained later), and the function body consists of one or more \nexpressions that are evaluated when the function is called. The last expression is \nreturned as the value of the function call. \n\nOnce we have defined last-name, we can use it just like any other Lisp function: \n\n> (last-name p)=i> PUBLIC \n\n> (last-name '(Rear Admiral Grace Murray Hopper))^ HOPPER \n\n> (last-name '(Rex Morgan MD)) ^ MD \n\n> (last-name '(Spot)) ^ SPOT \n\n> (last-name '(Aristotle)) ARISTOTLE \n\nThe last three examples point out an inherent limitation of the programming enterprise. \nWhen we say (defun last-name...) we are not really defining what it means \nfor a person to have a last name; we are just defining an operation on a representation \nof names in terms of lists. Our intuitions—that MD is a title. Spot is the first name \nof a dog, and Aristotle lived before the concept of last name was invented—are not \nrepresented in this operation. However, we could always change the definition of \nlast-name to incorporate these problematic cases. \n\nWe can also define the function first-name. Even though the definition is trivial \n(it is the same as the function first), it is still good practice to define first-name \nexplicitly. Then we can use the function fi rst - name when we are dealing with names, \nand first when we are dealing with arbitrary lists. The computer will perform the \nsame operation in each case, but we as programmers (and readers of programs) will \nbe less confused. Another advanatge of defining specific functions like first-name \nis that if we decide to change the representation of names we will only have to change \nthe definition of first-name. This is a much easier task than hunting through a large \nprogram and changing the uses of first that refer to names, while leaving other \nuses alone. \n\n(defun first-name (name) \n\"Select the first name from a name represented as a list. \" \n(first name)) \n\n> . (JOHN Q PUBLIC) \n\n> (first-name p) JOHN \n\n> (first-name '(Wilma Flintstone)) WILMA \n\n\f\n<a id='page-14'></a>\n\n> (setf names '((John Q Public) (Malcolm X) \n(Admiral Grace Murray Hopper) (Spot) \n(Aristotle) (A A Milne) (Z . Top) \n(Sir Larry Olivier) (Miss Scarlet))) => \n\n((JOHN Q PUBLIC) (MALCOLM X) (ADMIRAL GRACE MURRAY HOPPER) \n(SPOT) (ARISTOTLE) (A A MILNE) (Z . TOP) (SIR LARRY OLIVIER) \n(MISS SCARLET)) \n\n> (first-name (first names)) JOHN \n\nIn the last expression we used the function first to pick out the first element in \na list of names, and then the function first-name to pick out the first name of \nthat element. We could also have said (first (first names)) or even (first \n(first-name names)) and still have gotten JOHN, but we would not be accurately \nrepresenting what is being considered a name and what is being considered a list \nof names. \n\n1.6 Using Functions \nOne good thing about defining a list of names, as we did above, is that it makes it \neasier to test our functions. Consider the following expression, which can be used to \ntest the last-name function: \n\n> (mapcar #'last-name names) \n(PUBLIC X HOPPER SPOT ARISTOTLE MILNE TOP OLIVIER SCARLET) \n\nThe funny # ' notation maps from the name of a function to the function itself. This \nis analogous to ' . notation. The built-in function mapca r is passed two arguments, a \nfunction and a list. It returns a list built by calling the function on every element of \nthe input list. In other words, the mapcar call above is equivalent to: \n\n(list (last-name (first names)) \n(last-name (second names)) \n(last-name (third names)) \n...) \n\nmapcar's name comes from the fact that it \"maps\" the function across each of the \narguments. The car part of the name refers to the Lisp function car, an old name for \nfirst. cdr is the old name for rest. The names stand for \"contents of the address \nregister\" and \"contents of the decrement register,\" the instructions that were used in \nthe first implementation of Lisp on the IBM 704. I'm sure you'll agree that first and \n\n\f\n<a id='page-15'></a>\nrest are much better names, and they will be used instead of ca r and cdr whenever \nwe are talking about lists. However, we will continue to use car and cdr on occasion \nwhen we are considering a pair of values that are not considered as a list. Beware \nthat some programmers still use ca r and cdr for Usts as well. \n\nHere are some more examples of mapcar: \n\n> (mapcar '(1 2 3 4))=>(-l -2 -3 -4) \n\n> (mapcar #'+ '(1 2 3 4) '(10 20 30 40)) ^(11 22 33 44) \n\nThis last example shows that mapcar can be passed three arguments, in which case the \nfirst argument should be a binary function, which will be applied to corresponding \nelements of the other two Usts. In general, mapcar expects an n-ary function as its \nfirst argument, followed by . lists. It first applies the function to the argument list \nobtained by collecting the first element of each list. Then it applies the function to the \nsecond element of each list, and so on, until one of the lists is exhausted. It returns a \nlist of all the function values it has computed. \n\nNow that we understand mapcar, let's use it to test the first-name function: \n\n> (mapcar #'first-name names) \n\n(JOHN MALCOLM ADMIRAL SPOT ARISTOTLE A . SIR MISS) \n\nWe might be disappointed with these results. Suppose we wanted a version of \n\nfirst-name which ignored titles like Admiral and Miss, and got to the \"real\" first \n\nname. We could proceed as follows: \n\n(defparameter nitles * \n'(Mr Mrs Miss Ms Sir Madam Dr Admiral Major General) \n\"A list of titles that can appear at the start of a name.\") \n\nWe've introduced another new special form, defparameter, which defines a parameter—\na variable that does not change over the course of a computation, but that \nmight change when we think of new things to add (like the French Mme or the military \nLt.). The def parameter form both gives a value to the variable and makes it possible \nto use the variable in subsequent function definitions. In this example we have \nexercised the option of providing a documentation string that describes the variable. \nIt is a widely used convention among Lisp programmers to mark special variables by \nspelling their names with asterisks on either end. This is just a convention; in Lisp, \nthe asterisk is just another character that has no particular meaning. \n\nWe next give a new definition for first-name, which supersedes the previous \ndefinition.^ This definition says that if the first word of the name is a member of the \n\n^Just as we can change the value of a variable, we can also change the value of a function \n\n\f\n<a id='page-16'></a>\n\nlist of titles, then we want to ignore that word and return the first-name of the rest \nof the words in the name. Otherwise, we use the first word, just as before. Another \nbuilt-in function, member, tests to see if its first argument is an element of the list \npassed as the second argument. \n\nThe special form i f has the form ( i f test then-part else-part). There are many \nspecial forms for performing conditional tests in Lisp; i f is the most appropriate for \nthis example. An i f form is evaluated by first evaluating the test expression. If it is \ntrue, the then-part is evaluated and returned as the value of the i f form; otherwise \nthe else-part is evaluated and returned. While some languages insist that the value of \na conditional test must be either true or f al se. Lisp is much more forgiving. The test \nmay legally evaluate to any value at all. Only the value nil is considered false; all \nother values are considered true. In the definition of first - name below, the function \nmember will return a non-nil (hence true) value if the first element of the name is in the \nlist of titles, and will return .i 1 (hence false) if it is not. Although all non-nil values \nare considered true, by convention the constant t is usually used to represent truth. \n\n(defun first-name (name) \n\n\"Select the first name from a name represented as a list. \" \n\n(if (member (first name) *titles*) \n\n(first-name (rest name)) \n\n(first name))) \n\nWhen we map the new fi rst-name over the list of names, the results are more \nencouraging. In addition, the function gets the \"right\" result for '(Madam Major \nGeneral Paul a Jones) by dropping off titles one at a time. \n\n> (mapcar #'first-name names) \n(JOHN MALCOLM GRACE SPOT ARISTOTLE A . LARRY SCARLET) \n\n> (first-name '(Madam Major General Paula Jones)) \nPAULA \n\nWe can see how this works by tracing the execution of first-name, and seeing the \nvalues passed to and returned from the function. The special forms trace and \nuntrace are used for this purpose. \n\n> (trace first-name) \n(FIRST-NAME) \n\nin Lisp. It is not necessary to recompile everything when a change is made, as it would be in \nother languages. \n\n\f\n<a id='page-17'></a>\n> (first-name '(John Q Public)) \n(1 ENTER FIRST-NAME: (JOHN Q PUBLIC)) \n(1 EXIT FIRST-NAME: JOHN) \nJOHN \n\nWhen first - name is called, the definition is entered with the single argument, name, \ntaking on the value (JOHN Q PUBLIC). The value returned is JOHN. Trace prints two \nlines indicating entry and exit from the function, and then Lisp, as usual, prints the \nfinal result, JOHN. \n\nThe next example is more complicated. The function first-name is used four \ntimes. First, it is entered with name bound to (Madam Major General Paula Jones). \nThe first element of this list is Madam, and since this is a member of the list of titles, \nthe result is computed by calling first-name again on the rest of the name—(Major \nGeneral Paula Jones). This process repeats two more times, and we finally enter \nfirst - name with name bound to (Paul a Jones). Since Pa ul a is not a title, it becomes \nthe result of this call to first - name, and thus the result of all four calls, as trace shows. \nOnce we are happy with the workings of first - name, the special form unt race turns \noff tracing. \n\n> (first-name '(Madam Major General Paula Jones)) => \n(1 ENTER FIRST-NAME: (MADAM MAJOR GENERAL PAULA JONES)) \n(2 ENTER FIRST-NAME: (MAJOR GENERAL PAULA JONES)) \n\n(3 ENTER FIRST-NAME: (GENERAL PAULA JONES)) \n(4 ENTER FIRST-NAME: (PAULA JONES)) \n(4 EXIT FIRST-NAME: PAULA) \n\n(3 EXIT FIRST-NAME: PAULA) \n\n(2 EXIT FIRST-NAME: PAULA) \n(1 EXIT FIRST-NAME: PAULA) \nPAULA \n\n> (untrace first-name) (FIRST-NAME) \n\n> (first-name '(Mr Blue Jeans)) BLUE \n\nThe function first-name is said to be recursive because its definition includes a call \nto itself. Programmers who are new to the concept of recursion sometimes find it \nmysterious. But recursive functions are really no different from nonrecursive ones. \nAny function is required to return the correct value for the given input(s). Another \nway to look at this requirement is to break it into two parts: a function must return \na value, and it must not return any incorrect values. This two-part requirement is \nequivalent to the first one, but it makes it easier to think about and design function \ndefinitions. \n\nNext I show an abstract description of the first-name problem, to emphasize \nthe design of the function and the fact that recursive solutions are not tied to Lisp in \nanyway: \n\n\f\n<a id='page-18'></a>\n\nfunction first-name(name): \n\ni f the first element of name is a title \n\nthen do something complicated to get the first-name \n\nelse return the first element of the name \n\nThis breaks up the problem into two cases. In the second case, we return an answer, \nand it is in fact the correct answer. We have not yet specified what to do in the first \ncase. But we do know that it has something to do with the rest of the name after the \nfirst element, and that what we want is to extract the first name out of those elements. \nThe leap of faith is to go ahead and use first-name, even though it has not been fully \ndefined yet: \n\nfunction first-name(name): \n\ni f thefirstelement of name is a title \nthen return the fi rst-name of the rest of the name \nel se return the first element of the name \n\nNow the first case in fi rst-name is recursive, and the second case remains unchanged. \nWe already agreed that the second case returns the correct answer, and the \nfirst case only returns what first-name returns. So first-name as a whole can only \nreturn correct answers. Thus, we're halfway to showing that the function is correct; \nthe other half is to show that it eventually returns some answer. But every recursive \ncall chops off the first element and looks at the rest, so for an n-element list there \ncan be at most . recursive calls. This completes the demonstration that the function \nis correct. Programmers who learn to think this way find recursion to be a valuable \ntool rather than a confusing mystery. \n\n1.7 Higher-Order Functions \nFunctions in Lisp can not only be \"called,\" or applied to arguments, they can also be \nmanipulated just like any other kind of object. A function that takes another function \nas an argument is called a higher-orderfunction, ma pea r is an example. To demonstrate \nthe higher-order-function style of programming, we will define a new function called \nmappend. It takes two arguments, a function and a list, mappend maps the function \nover each element of the list and appends together all the results. The first definition \nfollows immediately from the description and the fact that the function appl y can be \nused to apply a function to a list of arguments. \n\n\f\n<a id='page-19'></a>\n\n(defun mappend (fn the-list) \n\"Apply fn to each element of list and append the results. \" \n(apply #'append (mapcar fn the-list))) \n\nNow we experiment a little to see how apply and mappend work. The first example \napplies the addition function to a list of four numbers. \n\n> (apply #'+ '(1 2 3 4))^10 \n\nThe next example applies append to a list of two arguments, where each argument is \na list. If the arguments were not lists, it would be an error. \n\n> (apply #'append '((1 2 3) (a b c)))=^(l 2 3 A . C) \n\nNow we define a new function, sel f-and-doubl e, and apply it to a variety of arguments. \n\n\n> (defun self-and-double (x) (list . (+ . .))) \n\n> (self-and-double 3) {3 6) \n\n> (apply #'self-and-double '(3))=^(3 6) \n\nIf we had tried to apply sel f-and-doubl e to a list of more than one argument, or to a \nlist that did not contain a number, it would be an error, just as it would be an error to \nevaluate (self-and-double 3 4) or (self-and-double 'Kim). Now let's return to \nthe mapping functions: \n\n> (mapcar #'self-and-double '(1 10 300))=>((1 2) (10 20) (300 600)) \n\n> (mappend #'self-and-double '(1 10 300))=. (1 2 10 20 300 600) \n\nWhen mapcar is passed a function and a list of three arguments, it always returns a \nlist of three values. Each value is the result of calling the function on the respective \nargument. In contrast, when mappend is called, it returns one big list, which is equal \nto all the values that mapca r would generate appended together. It would be an error \nto call mappend with a function that didn't return lists, because append expects to see \nlists as its arguments. \n\nNow consider the following problem: given a list of elements, return a list consisting \nof all the numbers in the original list and the negation of those numbers. For \nexample, given the list (testing 12 3 test), return (1 -12-2 3 -3). This \nproblem can be solved very easily using mappend as a component: \n\n\f\n<a id='page-20'></a>\n\n(defun numbers-and-negations (input) \n\"Given a list, return only the numbers and their negations.\" \n(mappend #'number-and-negation input)) \n\n(defun number-and-negation (x) \n\"If . is a number, return a list of . and -x.\" \n(if (numberp x) \n\n(list . (- .)) \nnil)) \n\n> (numbers-and-negations '(testing 12 3 test)) =^(1-12-2 3 -3) \n\nThe alternate definition of mappend shown in the following doesn't make use of \nma pea r; instead it builds up the list one element at a time: \n\n(defun mappend (fn the-list) \n\"Apply fn to each element of list and append the results.\" \n(if (null the-list) \n\nnil \n(append (funcall fn (first the-list)) \n(mappend fn (rest the-list))))) \n\nfuncall is similar to apply; it too takes a function as its first argument and applies the \nfunction to a list of arguments, but in the case of funcall, the arguments are listed \nseparately: \n\n> (funcall #'+ 2 3) =i> 5 \n\n> (apply #'+ '(2 3)) 5 \n\n> (funcall #'+ '(2 3) )=> Error: (2 3) is not a number. \n\nThese are equivalent to (+ 2 3), (+ 2 3),and(+ '(2 3)), respectively. \n\nSo far, every function we have used has been either predefined in Common Lisp \nor introduced with a defun, which pairs a function with a name. It is also possible to \nintroduce a function without giving it a name, using the special syntax 1 ambda. \n\nThe name lambda comes from the mathematician Alonzo Church's notation for \nfunctions (Church 1941). Lisp usually prefers expressive names over terse Greek \nletters, but lambda is an exception. A better name would be make -function. Lambda \nderives from the notation in Russell and Whitehead's Principia Mathematica, which \nused a caret over bound variables: x{x -hx). Church wanted a one-dimensional \nstring, so he moved the caret in front: ^x{x-\\-x). The caret looked funny with nothing \nbelow it, so Church switched to the closest thing, an uppercase lambda, \\x{x -f x). \nThe . was easily confused with other symbols, so eventually the lowercase lambda \nwas substituted: \\x{x -hx). John McCarthy was a student of Church's at Princeton, \nso when McCarthy invented Lisp in 1958, he adopted the lambda notation. There \n\n\f\n<a id='page-21'></a>\nwere no Greek letters on the keypunches of that era, so McCarthy used (1 ambda (x) \n(+ . .)), and it has survived to this day. In general, the form of a lambda expression is \n\n(lambda (parameters...) body...) \n\nA lambda expression is just a nonatomic name for a function, just as append is an \natomic name for a built-in function. As such, it is appropriate for use in the first \nposition of a function call, but if we want to get at the actual function, rather than its \nname, we still have to use the # ' notation. For example: \n\n> ((lambda (x) (+ . 2)) 4) => 6 \n\n> (funcall #'(lambda (x) (+ . 2)) 4) => 6 \n\nTo understand the distinction we have to be clear on how expressions are evaluated \nin Lisp. The normal rule for evaluation states that symbols are evaluated by looking \nup the value of the variable that the symbol refers to. So the x in (+ . 2) is evaluated \nby looking up the value of the variable named x. A list is evaluated in one of two \nways. If the first element of the list is a special form operator, then the list is evaluated \naccording to the syntax rule for that special form. Otherwise, the Hst represents a \nfunction call. The first element is evaluated in a unique way, as a function. This \nmeans it can either be a symbol or a lambda expression. In either case, the function \nnamed by the first element is applied to the values of the remaining elements in the \nlist. These values are determined by the normal evaluation rules. If we want to refer \nto a function in a position other than the first element of a function call, we have \nto use the #' notation. Otherwise, the expressions will be evaluated by the normal \nevaluation rule, and will not be treated as functions. For example: \n\n> append ^ Error: APPEND is not a bound variable \n\n> (lambda (x) i+ . Z)) Error: LAMBDA is not a function \n\nHere are some more examples of the correct use of functions: \n\n> (mapcar #*(lambda (x) (+ . .)) \n'(12 3 4 5)) ^ \n(2468 10) \n\n> (mappend #'(lambda (1) (list 1 (reverse 1))) \n'((1 2 3) (a b c))) => \n((1 2 3) (3 2 1) (A . C) (C . A)) \n\nProgrammers who are used to other languages sometimes fail to see the point of \nlambda expressions. There are two reasons why lambda expressions are very useful. \n\n\f\n<a id='page-22'></a>\n\nFirst, it can be messy to clutter up a program with superfluous names. Just as it \nis clearer to write (a+b)*(c+cl) rather than to invent variable names like tempi and \ntemp2 to hold a+b and c+d, so it can be clearer to define a function as a lambda \nexpression rather than inventing a name for it. \n\nSecond, and more importantly, lambda expressions make it possible to create \nnew functions at run time. This is a powerful technique that is not possible in \nmost programming languages. These run-time functions, known as closures, will be \ncovered in section 3.16. \n\n1.8 Other Data Types \nSo far we have seen just four kinds of Lisp objects: numbers, symbols, lists, and \nfunctions. Lisp actually defines about 25 different types of objects: vectors, arrays, \nstructures, characters, streams, hash tables, and others. At this point we will introduce \none more, the string. As you can see in the following, strings, like numbers, \nevaluate to themselves. Strings are used mainly for printing out messages, while \nsymbols are used for their relationships to other objects, and to name variables. The \nprinted representation of a string has a double quote mark (\") at each end. \n\n> \"a string\" =4> \"a string\" \n\n> (length \"a string\") =i>8 \n\n> (length \"\")=^0 \n\n1.9 Summary: The Lisp Evaluation Rule \nWe can now summarize the evaluation rule for Lisp. \n\n* Every expression is either a list or an atom. \n* Every list to be evaluated is either a special form expression or a function application. \n* A specialform expression is defined to be a lis t whose first element is a special form \noperator. The expression is evaluated according to the operator's idiosyncratic \nevaluation rule. For example, the evaluation rule for setf is to evaluate the \nsecond argument according to the normal evaluation rule, set the first argument \nto that value, and return the value as the result. The rule for defun is to define \na new function, and return the name of the function. The rule for quote \nis to return the first argument unevaluated. The notation 'x is actually an \n\f\n<a id='page-23'></a>\nabbreviation for the special form expression (quote x). Similarly, the notation \n# '/is an abbreviation for the special form expression (function f). \n\n'John = (quote John) JOHN \n(setf . 'John) => JOHN \n\n(defun twice (x) (+ . x)) => TWICE \n\n(if (= 2 3) (error) (+ 5 6)) => 11 \n\nAfunction application is evaluated by first evaluating the arguments (the rest of \nthe list) and then finding the function named by the first element of the list and \napplying it to the list of evaluated arguments. \n\n(+2 3) =^5 \n\n(- (+ 90 9) (+ 50 5 (length '(Pat Kim)))) => 42 \n\nNote that if ' (Pat Kim) did not have the quote, it would be treated as a function \napplication of the function pat to the value of the variable ki m. \n\nEvery atom is either a symbol or a nonsymbol \n\nA symbol evaluates to the most recent value that has been assigned to the \nvariable named by that symbol. Symbols are composed of letters, and possibly \ndigits and, rarely, punctuation characters. To avoid confusion, we will use \nsymbols composed mostly of the letters a-z and the character, with a few \nexceptions.^ \n\nnames \n\n. \n*print-pretty* \n\n* A nonsymbol atom evaluates to itself. For now, numbers and strings are the \nonly such non-symbol atoms we know of. Numbers are composed of digits, \nand possibly a decimal point and sign. There are also provisions for scientific \nnotation, rational and complex numbers, and numbers with different bases, \nbut we won't describe the details here. Strings are delimited by double quote \nmarks on both sides. \n^For example, symbols that denote so-called special variables usually begin and end in \nasterisks. Also, note that I did not hesitate to use the symbol won! on [page 11](chapter1.md#page-11). \n\n\f\n<a id='page-24'></a>\n\n42 42 \n\n-273.15 -273.15 \n\n\"a string\" \"a string\" \n\nThere are some minor details of Common Lisp that complicate the evaluation \nrules, but this definition will suffice for now. \n\nOne complication that causes confusion for beginning Lispers is the difference \nbetween reading and evaluating an expression. Beginners often imagine that when \nthey type an expression, such as \n\n> (+ (* 3 4) (* 5 6)) \n\nthe Lisp system first reads the (+, then fetches the addition function, then reads (* \n\n34) and computes 12, then reads (* 5 6) and computes 30, and finally computes \n42. In fact, what actually happens is that the system first reads the entire expression, \nthe list (+ (* 3 4) (* 5 6)). Only after it has been read does the system begin \nto evaluate it. This evaluation can be done by an interpreter that looks at the list \ndirectly, or it can be done by a compiler that translates the list into machine language \ninstructions and then executes those instructions. \nWe can see now that it was a little imprecise to say, \"Numbers are composed \nof digits, and possibly a decimal point and sign.\" It would be more precise to say \nthat the printed representation of a number, as expected by the function read and \nas produced by the function print, is composed of digits, and possibly a decimal \npoint and sign. The internal representation of a number varies from one computer \nto another, but you can be sure that it will be a bit pattern in a particular memory \nlocation, and it will no longer contain the original characters used to represent the \nnumber in decimal notation. Similarly, it is the printed representation of a string \nthat is surrounded by double quote marks; the internal representation is a memory \nlocation marking the beginning of a vector of characters. \n\nBeginners who fail to grasp the distinction between reading and evaluating may \nhave a good model of what expressions evaluate to, but they usually have a terrible \nmodel of the efficiency of evaluating expressions. One student used only one-letter \nvariable names, because he felt that it would be faster for the computer to look up \na one-letter name than a multiletter name. While it may be true that shorter names \ncan save a microsecond at read time, this makes no difference at all at evaluation \ntime. Every variable, regardless of its name, is just a memory location, and the time \nto access the location does not depend on the name of the variable. \n\n\f\n<a id='page-25'></a>\n1.10 What Makes Lisp Different? \nWhat is it that sets Lisp apart from other languages? Why is it a good language for \nAI applications? There are at least eight important factors: \n\n* Built-in Support for Lists \n* Automatic Storage Management \n* Dynamic Typing \n* First-Class Functions \n* Uniform Syntax \n* Interactive Environment \n* Extensibility \n* History \nIn sum, these factors allow a programmer to delay making decisions. In the example \ndealing with names, we were able to use the built-in list functions to construct and \nmanipulate names without making a lot of explicit decisions about their representation. \nIf we decided to change the representation, it would be easy to go back and \nalter parts of the program, leaving other parts unchanged. \n\nThis ability to delay decisions—or more accurately, to make temporary, nonbinding \ndecisions—is usually a good thing, because it means that irrelevant details can be \nignored. There are also some negative points of delaying decisions. First, the less we \ntell the compiler, the greater the chance that it may have to produce inefficient code. \nSecond, the less we tell the compiler, the less chance it has of noticing inconsistencies \nand warning us. Errors may not be detected until the program is run. Let's consider \neach factor in more depth, weighing the advantages and disadvantages: \n\n* Built-in Support for Lists. The list is a very versatile data structure, and while lists \ncan be implemented in any language. Lisp makes it easy to use them. Many \nAI applications involve lists of constantly changing size, making fixed-length \ndata structures like vectors harder to use. \nEarly versions of Lisp used lists as their only aggregate data structure. Common \nLisp provides other types as well, because lists are not always the most efficient \nchoice. \n\nAutomatic Storage Management. The Lisp programmer needn't keep track of \nmemory allocation; it is all done automatically. This frees the programmer of a \nlot of effort, and makes it easy to use the functional style of programming. Other \n\n\f\n<a id='page-26'></a>\n\nlanguages present programmers with a choice. Variables can be allocated on \nthe stack, meaning that they are created when a procedure is entered, and \ndisappear when the procedure is done. This is an efficient use of storage, but \nit rules out functions that return complex values. The other choice is for the \nprogrammer to explicitly allocate and free storage. This makes the functional \nstyle possible but can lead to errors. \n\nFor example, consider the trivial problem of computing the expression . . (b + \nc), where a, 6, and c are numbers. The code is trivial in any language; here it is \nin Pascal and in Lisp: \n\n/* Pascal */ Lisp \n\na * (b + c) (* a (+ b c)) \n\nThe only difference is that Pascal uses infix notation and Lisp uses prefix. Now \nconsider computing . . (b -f c) when a, 6, and c are matrices. Assume we have \nprocedures for matrix multiplication and addition. In Lisp the form is exactly \nthe same; only the names of the functions are changed. In Pascal we have the \nchoice of approaches mentioned before. We could declare temporary variables \nto hold intermediate results on the stack, and replace the functional expression \nwith a series of procedure calls: \n\n/* Pascal */ ;;; Lisp \n\nvar temp, result: matrix; \n\nadd(b,c,temp); (mult a (add b c)) \n\nmult(a,temp,result); \n\nreturn(result); \n\nThe other choice is to write Pascal functions that allocate new matrices on the \nheap. Then one can write nice functional expressions like mul t (a, add (b, c)) \neven in Pascal. However, in practice it rarely works this nicely, because of the \nneed to manage storage explicitly: \n\n/* Pascal */ ;;; Lisp \n\nvar a,b,c,x,y: matrix; \n\n\f\n<a id='page-27'></a>\n\nX := adcl(b,c); (mult a (add b c)) \n\ny := mult(a,x); \n\nfree(x); \n\nreturn(y); \n\nIn general, deciding which structures to free is a difficult task for the Pascal \nprogrammer. If the programmer misses some, then the program may run out \nof memory. Worse, if the programmer frees a structure that is still being used, \nthen strange errors can occur when that piece of memory is reallocated. Lisp \nautomatically allocates and frees structures, so these two types of errors can \n\nnever occur. \n\nDynamic Typing. Lisp programmers don't have to provide type declarations, \nbecause the language keeps track of the type of each object at run time, rather \nthan figuring out all types at compile time. This makes Lisp programs shorter \nand hence faster to develop, and it also means that functions can often be \nextended to work for objects to which they were not originally intended to \napply. In Pascal, we can write a procedure to sort an array of 100 integers, but \nwe can't use that same procedure to sort 200 integers, or 100 strings. In Lisp, \none sort fits all. \n\nOne way to appreciate this kind of flexibility is to see how hard it is to achieve \nin other languages. It is impossible in Pascal; in fact, the language Modula was \ninvented primarily to fix this problem in Pascal. The language Ada was designed \nto allow flexible generic functions, and a book by Musser and Stepanov \n(1989) describes an Ada package that gives some of the functionality of Common \nLisp's sequence functions. But the Ada solution is less than ideal: it \ntakes a 264-page book to duplicate only part of the functionality of the 20-page \nchapter 14 from Steele (1990), and Musser and Stepanov went through five Ada \ncompilers before they found one that would correctly compile their package. \nAlso, their package is considerably less powerful, since it does not handle vectors \nor optional keyword parameters. In Common Lisp, all this functionality \ncomes for free, and it is easy to add more. \n\nOn the other hand, dynamic typing means that some errors will go undetected \nuntil run time. The great advantage of strongly typed languages is that they are \nable to give error messages at compile time. The great frustration with strongly \ntyped languages is that they are only able to warn about a small class of errors. \nThey can tell you that you are mistakenly passing a string to a function that \nexpects an integer, but they can't tell you that you are passing an odd number \nto a function that expects an even number. \n\nFirst-Class Functions. A first-class object is one that can be used anywhere and \ncan be manipulated in the same ways as any other kind of object. In Pascal or C, \n\n\f\n<a id='page-28'></a>\n\nfor example, functions can be passed as arguments to other functions, but they \nare not first-class, because it is not possible to create new functions while the \nprogram is running, nor is it possible to create an anonymous function without \ngiving it a name. In Lisp we can do both those things using 1 ambda. This is \nexplained in section 3.16, [page 92](chapter3.md#page-92). \n\n* Uniform Syntax. The syntax of Lisp programs is simple. This makes the language \neasy to learn, and very little time is wasted correcting typos. In addition, \nit is easy to write programs that manipulate other programs or define whole \nnew languages—a very powerful technique. The simple syntax also makes it \neasy for text editing programs to parse Lisp. Your editor program should be \nable to indent expressions automatically and to show matching parentheses. \nThis is harder to do for languages with complex syntax. \nOn the other hand, some people object to all the parentheses. There are two \n\nanswers to this objection. First, consider the alternative: in a language with \n\n\"conventional\" syntax. Lisp's parentheses pairs would be replaced either by an \n\nimplicit operator precedence rule (in the case of arithmetic and logical expres\n\n\nsions) or by a begin/end pair (in the case of control structures). But neither \n\nof these is necessarily an advantage. Implicit precedence is notoriously error-\n\nprone, and begin/end pairs clutter up the page without adding any content. \n\nMany languages are moving away from begi n/end: C uses { and }, which are \n\nequivalent to parentheses, and several modern functional languages (such as \n\nHaskell) use horizontal blank space, with no explicit grouping at all. \n\nSecond, many Lisp programmers have considered the alternative. There have \nbeen a number of preprocessors that translate from \"conventional\" syntax into \nLisp. None of these has caught on. It is not that Lisp programmers find it \ntolerable to use all those parentheses, rather, they find it advantageous. With a \nlittle experience, you may too. \n\nIt is also important that the syntax of Lisp data is the same as the syntax of \nprograms. Obviously, this makes it easy to convert data to program. Less \nobvious is the time saved by having universal functions to handle input and \noutput. The Lisp functions read and pri nt will automatically handle any list, \nstructure, string, or number. This makes it trivial to test individual functions \nwhile developing your program. In a traditional language like C or Pascal, you \nwould have to write special-purpose functions to read and print each data type \nyou wanted to debug, as well as a special-purpose driver to call the routines. \nBecause this is time-consuming and error-prone, the temptation is to avoid \ntesting altogether. Thus, Lisp encourages better-tested programs, and makes \nit easier to develop them faster. \n\n* Interactive Environment. Traditionally, a programmer would write a complete \nprogram, compile it, correct any errors detected by the compiler, and then \n\f\n<a id='page-29'></a>\nrun and debug it. This is known as the batch mode of interaction. For long \nprograms, waiting for the compiler occupied a large portion of the debugging \ntime. In Lisp one normally writes a few small functions at a time, getting \nfeedback from the Lisp system after evaluating each one. This is knovm as \nan interactive environment. When it comes time to make a change, only the \nchanged functions need to be recompiled, so the wait is much shorter. In \naddition, the Lisp programmer can debug by typing in arbitrary expressions \nat any time. This is a big improvement over editing the program to introduce \nprint statements and recompiling. \n\nNotice that the distinction between interactive and a batch languages is separate \nfrom the distinction between interpreted and compiled languages. It has often \nbeen stated, incorrectly, that Lisp has an advantage by virtue of being an \ninterpreted language. Actually, experienced Common Lisp programmers tend \nto use the compiler almost exclusively. The important point is interaction, not \ninterpretation. \n\nThe idea of an interactive environment is such a good one that even traditional \nlanguages like C and Pascal are starting to offer interactive versions, so this is \nnot an exclusive advantage of Lisp. However, Lisp still provides much better \naccess to the interactive features. A C interpreter may allow the progranuner \nto type in an expression and have it evaluated immediately, but it will not allow \nthe programmer to write a program that, say, goes through the symbol table \nand finds all the user-defined functions and prints information on them. In \nC-even interpreted C-the symbol table is just a Cheshire-cat-like invention \nof the interpreter's imagination that disappears when the program is run. In \nLisp, the symbol table is a first-class object^ that can be accessed and modified \nwith functions like read, intern and do-symbols. \n\nCommon Lisp offers an unusually rich set of useful tools, including over 700 \nbuilt-in functions (ANSI Conunon Lisp has over 900). Thus, writing a new \nprogram involves more gathering of existing pieces of code and less writing of \nnew code from scratch. In addition to the standard functions. Common Lisp \nimplementations usually provide extensions for interacting with the editor, \ndebugger, and window system. \n\nExtensibility. When Lisp was invented in 1958, nobody could have foreseen the \nadvances in programming theory and language design that have taken place in \nthe last thirty years. Other early languages have been discairded, replaced by \nones based on newer ideas. However, Lisp has been able to survive, because \nit has been able to adapt. Because Lisp is extensible, it has been changed to \nincorporate the newest features as they become popular. \n\n^Actually, there can be several symbol tables. They are known as packages in Common \nLisp. \n\n\f\n<a id='page-30'></a>\n\nThe easiest way to extend the language is with macros. When so-called structured \nprogramming constructs such as case and if-then-else arose, they were \nincorporated into Lisp as macros. But the flexibility of Lisp goes beyond \nadding individual constructs. Brand new styles of programming can easily be \nimplemented. Many AI applications are based on the idea of rule-based programming. \nAnother new style is object-oriented programming, which has been \nincorporated with the Common Lisp Object System (CLOS),^ a set of macros, \nfunctions, and data types that have been integrated into ANSI Common Lisp. \n\nTo show how far Lisp has come, here's the only sample program given in the \nLisp/MTS Programmer's Guide (Hafner and Wilcox 1974): \n\n(PROG (LIST DEPTH TEMP RESTLIST) \n(SETQ RESTLIST (LIST (CONS (READ) 0)) ) \nA (COND \n((NOT RESTLIST) (RETURN 'DONE)) \n(T (SETQ LIST (UNCONS (UNCONS RESTLIST \n\nRESTLIST ) DEPTH)) \n(COND ((ATOM LIST) \n(MAPC 'PRINl (LIST '\"ATOM:\" LIST '\".\" 'DEPTH DEPTH)) \n(TERPRD) \n(T (SETQ TEMP (UNCONS LIST LIST)) \n(COND (LIST \n(SETQ RESTLIST (CONS(CONS LIST DEPTH) RESTLIST)))) \n(SETQ RESTLIST (CONS (CONS TEMP \n\n(ADDl DEPTH)) RESTLIST)) \n)))) \n(GO A)) \n\nNote the use of the now-deprecated goto (GO) statement, and the lack of consistent \nindentation conventions. The manual also gives a recursive version of the same \nprogram: \n\n(PROG NIL ( \n(LABEL ATOMPRINT (LAMBDA (RESTLIST) \n(COND ((NOT RESTLIST) (RETURN 'DONE)) \n((ATOM (CAAR RESTLIST)) (MAPC 'PRINl \n\n(LIST '\"ATOM:\" (CAAR RESTLIST) \n\n'\",\" 'DEPTH (CDAR RESTLIST))) \n(TERPRD \n(ATOMPRINT (CDR RESTLIST))) \n( . (ATOMPRINT (GRAFT \n(LIST (CONS (CAAAR RESTLIST) (ADDl (CDAR RESTLIST)))) \n(AND (CDAAR RESTLIST) (LIST (CONS (CDAAR RESTLIST) \n\n^Pronounced \"see-loss.\" An alternate pronunciation, \"klaus,\" seems to be losing favor. \n\n\f\n<a id='page-31'></a>\n(CDAR RESTLIST)))) \n(COR RESTLIST))))))) \n(LIST (CONS (READ) 0)))) \n\nBoth versions are very difficult to read. With our modern insight (and text editors \n\nthat automatically indent), a much simpler program is possible: \n\n(defun atomprint (exp &optional (depth 0)) \n\"Print each atom in exp. along with its depth of nesting.\" \n(if (atom exp) \n\n(format t \"\"SATOM: ~a, DEPTH \"d\" exp depth) \n\n(dolist (element exp) \n(atomprint element (+ depth 1))))) \n\n1.11 Exercises \n&#9635; Exercise 1.1 [m] Define a version of last-name that handles \"Rex Morgan MD,\" \n\"Morton Downey, Jr.,\" and whatever other cases you can think of. \n\n&#9635; Exercise 1.2 [m] Write a function to exponentiate, or raise a number to an integer \npower. For example: (power 3 2) = 3^ = 9. \n\n&#9635; Exercise 1.3 [m] Write a function that counts the number of atoms in an expression. \nFor example: (count-atoms '(a (b) c)) = 3. Notice that there is something of an \nambiguity in this: should (a nil c) count as three atoms, or as two, because it is \nequivalent to (a () c)? \n\n&#9635; Exercise 1.4 [m] Write a function that counts the number of times an expression \noccurs anywhere within another expression. Example: (count-anywhere 'a *(a \n((a) b) a)) 3. \n\n&#9635; Exercise 1.5 [m] Write a function to compute the dot product of two sequences \nof numbers, represented as lists. The dot product is computed by multiplying \ncorresponding elements and then adding up the resulting products. Example: \n\n(dot-product ' (10 20) ' (3 4)) = 10 . 3 + 20 . 4 = 110 \n\n\f\n<a id='page-32'></a>\n\n1.12 Answers \nAnswer 1.2 \n\n(defun power (x n) \n\"Power raises . to the nth power. . must be an integer >= 0. \nThis executes in log . time, because of the check for even n. \n\n(cond ((= . 0) 1) \n((evenp n) (expt (power . (/ . 2)) 2)) \n(t (* . (power . (-. 1)))))) \n\nAnswer 1.3 \n\n(defun count-atoms (exp) \n\"Return the total number of non-nil atoms in the expression.\" \n(cond ((null exp) 0) \n\n((atom exp) 1) \n\n(t (+ (count-atoms (first exp)) \n(count-atoms (rest exp)))))) \n\n(defun count-all-atoms (exp &optional (if-null 1)) \n\"Return the total number of atoms in the expression, \ncounting nil as an atom only in non-tail position.\" \n(cond ((null exp) if-null) \n\n((atom exp) 1) \n\n(t (+ (count-all-atoms (first exp) 1) \n(count-all-atoms (rest exp) 0))))) \n\nAnswer 1.4 \n\n(defun count-anywhere (item tree) \n\"Count the times item appears anywhere within tree.\" \n(cond ((eql item tree) 1) \n\n((atom tree) 0) \n(t (+ (count-anywhere item (first tree)) \n(count-anywhere item (rest tree)))))) \n\n\f\n<a id='page-33'></a>\nAnswer 1.5 Here are three versions: \n\n(defun dot-product (a b) \n\"Compute the mathematical dot product of two vectors.\" \n(if (or (null a) (null b)) \n\n0 \n(+ (* (first a) (first b)) \n(dot-product (rest a) (rest b))))) \n\n(defun dot-product (a b) \n\"Compute the mathematical dot product of two vectors.\" \n(let ((sum 0)) \n\n(dotimes (i (length a)) \n(incf sum (* (elt a i) (elt b i)))) \nsum)) \n\n(defun dot-product (a b) \n\"Compute the mathematical dot product of two vectors.\" \n(apply #'+ (mapcar #'* a b))) \n\n\f\n## Chapter 2\n<a id='page-34'></a>\n\n### A Simple Lisp Program \n\n> *Cerium quod factum.*  \n> (One is certain of only what one builds.) \n> \n> -Giovanni Battista Vico (1668-1744)  \n> Italian royal historiographer \n\nYou will never become proficient in a foreign language by studying vocabulary lists. \nRather, you must hear and speak (or read and write) the language to gain proficiency. \nThe same is true for learning computer languages. \n\nThis chapter shows how to combine the basic functions and special forms of Lisp into a \ncomplete program. If you can learn how to do that, then acquiring the remaining vocabulary of \nLisp (as outlined in chapter 3) will be easy. \n\n\f\n<a id='page-35'></a>\n### 2.1 A Grammar for a Subset of English \nThe program we will develop in this chapter generates random English sentences. \nHere is a simple grammar for a tiny portion of English: \n\n> *Sentence &rArr; Noun-Phrase + Verb-Phrase  \nNoun-Phrase &rArr; Article + Noun  \nVerb-Phrase &rArr; Verb + Noun-Phrase  \nArticle &rArr; the, a, ...  \nNoun &rArr; man, ball, woman, table...  \nVerb &rArr; hit, took, saw, liked...*\n\nTo be technical, this description is called a *context-free phrase-structure grammar,* and \nthe underlying paradigm is called *generative syntax.* The idea is that anywhere we \nwant a sentence, we can generate a noun phrase followed by a verb phrase. Anywhere \na noun phrase has been specified, we generate instead an article followed by a noun. \nAnywhere an article has been specified, we generate either \"the,\" \"a,\" or some other \narticle. The formalism is \"context-free\" because the rules apply anywhere regardless \nof the surrounding words, and the approach is \"generative\" because the rules as a \nwhole define the complete set of sentences in a language (and by contrast the set of \nnonsentences as well). In the following we show the derivation of a single sentence \nusing the rules: \n\n\n* To get a *Sentence,* append a *Noun-Phrase* and a *Verb-Phrase* \n  * To get a *Noun-Phrase*, append an *Article* and a *Noun* \n    * Choose *\"the\"* for the *Article* \n    * Choose *\"man\"* for the *Noun* \n  * The resulting *Noun-Phrase* is \"the man\" \n  * To get a *Verb-Phrase,* append a *Verb* and a *Noun-Phrase* \n    * Choose *\"hit\"* for the *Verb* \n    * To get a *Noun-Phrase*, append an *Article* and a *Noun* \n      * Choose *\"the\"* for the *Article* \n      * Choose *\"ball\"* for the *Noun* \n    * The resulting *Noun-Phrase* is \"the ball\" \n  * The resulting *Verb-Phrase* is \"hit the ball\" \n* The resulting Sentence is \"The man hit the ball\" \n\n### 2.2 A Straightforward Solution \nWe will develop a program that generates random sentences from a phrase-structure \ngrammar. The most straightforward approach is to represent each grammar rule by \na separate Lisp function: \n\n\f\n<a id='page-36'></a>\n\n```lisp\n(defun sentence ()    (append (noun-phrase) (verb-phrase))) \n(defun noun-phrase () (append (Article) (Noun))) \n(defun verb-phrase () (append (Verb) (noun-phrase))) \n(defun Article ()     (one-of '(the a))) \n(defun Noun ()        (one-of '(man ball woman table)) ) \n(defun Verb ()        (one-of '(hit took saw liked)) ) \n```\n\nEach of these function definitions has an empty parameter list, `()`. That means the \nfunctions take no arguments. This is unusual because, strictly speaking, a function \nwith no arguments would always return the same thing, so we would use a constant \ninstead. However, these functions make use of the `random` function (as we will see \nshortly), and thus can return different results even with no arguments. Thus, they \nare not functions in the mathematical sense, but they are still called functions in Lisp, \nbecause they return a value. \n\nAll that remains now is to define the function `one-of`. It takes a list of possible \nchoices as an argument, chooses one of these at random, and returns a one-element \nlist of the element chosen. This last part is so that all functions in the grammar will \nreturn a list of words. That way, we can freely apply append to any category. \n\n```lisp\n(defun one-of (set) \n  \"Pick one element of set, and make a list of it.\" \n  (list (random-elt set))) \n\n(defun random-elt (choices) \n  \"Choose an element from a list at random.\" \n  (elt choices (random (length choices)))) \n```\n\nThere are two new functions here, `elt` and `random`, `elt` picks an element out of a list. \nThe first argument is the list, and the second is the position in the list. The confusing \npart is that the positions start at 0, so `(elt choices 0)` is the first element of the list, \nand `(elt choices 1)` is the second. Think of the position numbers as telling you \nhow far away you are from the front. The expression `(random n)` returns an integer \nfrom 0 to n-1, so that `(random 4)` would return either 0, 1, 2, or 3. \n\nNow we can test the program by generating a few random sentences, along with \na noun phrase and a verb phrase: \n\n\f\n<a id='page-37'></a>\n\n```lisp\n> (sentence) => (THE WOMAN HIT THE BALL) \n\n> (sentence) => (THE WOMAN HIT THE MAN) \n\n> (sentence) =>(THE BALL SAW THE WOMAN) \n\n> (sentence) => (THE BALL SAW THE TABLE) \n\n> (noun-phrase) => (THE MAN) \n\n> (verb-phrase) => (LIKED THE WOMAN) \n\n> (trace sentence noun-phrase verb-phrase article noun verb) => \n(SENTENCE NOUN-PHRASE VERB-PHRASE ARTICLE NOUN VERB) \n\n> (sentence) => \n(1 ENTER SENTENCE) \n  (1 ENTER NOUN-PHRASE) \n    (1 ENTER ARTICLE) \n    (1 EXIT ARTICLE: (THE)) \n    (1 ENTER NOUN) \n    (1 EXIT NOUN: (MAN)) \n  (1 EXIT NOUN-PHRASE: (THE MAN)) \n  (1 ENTER VERB-PHRASE) \n    (1 ENTER VERB) \n    (1 EXIT VERB: (HIT)) \n    (1 ENTER NOUN-PHRASE) \n      (1 ENTER ARTICLE) \n      (1 EXIT ARTICLE: (THE)) \n      (1 ENTER NOUN) \n      (1 EXIT NOUN: (BALL) \n    (1 EXIT NOUN-PHRASE: (THE BALL) \n  (1 EXIT VERB-PHRASE: (HIT THE BALL) \n(1 EXIT SENTENCE: (THE MAN HIT THE BALL) \n(THE MAN HIT THE BALL) \n```\n\nThe program works fine, and the trace looks just like the sample derivation above, \nbut the Lisp definitions are a bit harder to read than the original grammar rules. \nThis problem will be compounded as we consider more complex rules. Suppose we \nwanted to allow noun phrases to be modified by an indefinite number of adjectives \nand an indefinite number of prepositional phrases. In grammatical notation, we \nmight have the following rules: \n\n> *Noun-Phrase &rArr; Article + Adj\\* + Noun + PP\\*  \n> Adj\\* &rArr; 0&#x0338;, Adj + Adj\\*  \n> PP\\* &rArr; 0&#x0338;, PP + PP\\*  \n> PP &rArr; Prep + Noun-Phrase  \n> Adj &rArr; big, little, blue, green, ...  \n> Prep &rArr; to, in, by, with, ...*\n\n\nIn this notation, 0&#x0338; indicates a choice of nothing at all, a comma indicates a choice of \nseveral alternatives, and the asterisk is nothing special—as in Lisp, it's just part of the \nname of a symbol. However, the convention used here is that names ending in an \nasterisk denote zero or more repetitions of the underlying name. That is, *PP*\\* denotes \nzero or more repetitions of *PP.* This is known as \"Kleene star\" notation (pronounced \n\f\n<a id='page-38'></a>\n\"clean-E\") after the mathematician Stephen Cole Kleene.[TK - fn1] \nThe problem is that the rules for Adj * and PP * contain choices that we would have \nto represent as some kind of conditional in Lisp. For example: \n\n```lisp\n(defun Adj* () \n  (if (= (random 2) 0) \n      nil \n      (append (Adj) (Adj*)))) \n\n(defun PP* () \n  (if (random-elt '(t nil)) \n      (append (PP) (PP*)) \n      nil)) \n\n(defun noun-phrase () (append (Article) (Adj*) (Noun) (PP*))) \n(defun PP () (append (Prep) (noun-phrase))) \n(defun Adj () (one-of '(big little blue green adiabatic))) \n(defun Prep () (one-of '(to in by with on))) \n```\n\nI've chosen two different implementations for `Adj*` and `PP*`; either approach would \nwork in either function. We have to be careful, though; here are two approaches that \nwould not work: \n\n```lisp\n(defun Adj* () \n  \"Warning - incorrect definition of Adjectives.\" \n  (one-of '(nil (append (Adj) (Adj*))))) \n\n(defun Adj* () \n  \"Warning - incorrect definition of Adjectives.\" \n  (one-of (list nil (append (Adj) (Adj*))))) \n```\n\nThe first definition is wrong because it could return the literal expression `((append (Adj) (Adj *)))` \nrather than a list of words as expected. The second definition would \ncause infinite recursion, because computing the value of `(Adj*)` always involves a \nrecursive call to `(Adj*)`. The point is that what started out as simple functions are \nnow becoming quite complex. To understand them, we need to know many Lisp \nconventions—`defun`, `()`, `case`, `if`, `quote`, and the rules for order of evaluation—when \nideally the implementation of a grammar rule should use only *linguistic* conventions. \nIf we wanted to develop a larger grammar, the problem could get worse, because the \nrule-writer might have to depend more and more on Lisp. \n\n[TK, fn1] We will soon see \"Kleene plus\" notation, wherein *PP+* denotes one or more repetitions \nof *PP.* \n\n\f\n<a id='page-39'></a>\n### 2.3 A Rule-Based Solution \nAn alternative implementation of this program v^ould concentrate on making it easy \nto write grammar rules and would worry later about how they will be processed. \nLet's look again at the original grammar rules: \n\n> *Sentence &rArr; Noun-Phrase + Verb-Phrase  \nNoun-Phrase &rArr; Article + Noun  \nVerb-Phrase &rArr; Verb + Noun-Phrase  \nArticle &rArr; the, a, ...  \nNoun &rArr; man, ball, woman, table...  \nVerb &rArr; hit, took, saw, liked...*\n\nEach rule consists of an arrow with a symbol on the left-hand side and something on \nthe right-hand side. The complication is that there can be two kinds of right-hand \nsides: a concatenated list of symbols, as in *\"Noun-Phrase &rArr; Article+Noun,\"* or a list of \nalternate words, as in *\"Noun => man, ball, ...\"* We can account for these possibilities \nby deciding that every rule will have a list of possibilities on the right-hand side, and \nthat a concatenated list, *for example \"Article+Noun,\"* will be represented as a Lisp list, \n*for example* \"`(Article Noun)`\". The list of rules can then be represented as follows: \n\n```lisp\n(defparameter *simple-grammar* \n  '((sentence -> (noun-phrase verb-phrase)) \n    (noun-phrase -> (Article Noun)) \n    (verb-phrase -> (Verb noun-phrase)) \n    (Article -> the a) \n    (Noun -> man ball woman table) \n    (Verb -> hit took saw liked)) \n  \"A grammar for a trivial subset of English.\") \n\n(defvar *grammar* *simple-grammar* \n  \"The grammar used by generate. Initially, this is \n  *simple-grammar*, but we can switch to other grammars.\") \n```\n\nNote that the Lisp version of the rules closely mimics the original version. In particular, \nI include the symbol \"`->`\", even though it serves no real purpose; it is purely \ndecorative. \n\nThe special forms `defvar` and `defparameter` both introduce special variables \nand assign a value to them; the difference is that a *variable,* like `*grammar*`, is \nroutinely changed during the course of running the program. A *parameter,* like \n`*simple-grammar*`, on the other hand, will normally stay constant. A change to a \nparameter is considered a change to the program, not a change *by* the program. \n\nOnce the list of rules has been defined, it can be used to find the possible rewrites \nof a given category symbol. The function `assoc` is designed for just this sort of task. \n\n\f\n<a id='page-40'></a>\n\nIt takes two arguments, a \"key\" and a list of lists, and returns the first element of the \nlist of lists that starts with the key. If there is none, it returns `nil`. Here is an example: \n\n```lisp\n> (assoc 'noun *grammar*) (NOUN -> MAN BALL WOMAN TABLE) \n```\n\nAlthough rules are quite simply implemented as lists, it is a good idea to impose a \nlayer of abstraction by defining functions to operate on the rules. We will need three \nfunctions: one to get the right-hand side of a rule, one for the left-hand side, and one \nto look up all the possible rewrites (right-hand sides) for a category. \n\n```lisp\n(defun rule-lhs (rule) \n  \"The left-hand side of a rule.\" \n  (first rule)) \n\n(defun rule-rhs (rule) \n  \"The right-hand side of a rule.\" \n  (rest (rest rule))) \n\n(defun rewrites (category) \n  \"Return a list of the possible rewrites for this category.\" \n  (rule-rhs (assoc category *grammar*))) \n```\n\nDefining these functions will make it easier to read the programs that use them, \nand it also makes changing the representation of rules easier, should we ever decide \nto do so. \n\nWe are now ready to address the main problem: defining a function that will \ngenerate sentences (or noun phrases, or any other category). We will call this function \n`generate`. It will have to contend with three cases: (1) In the simplest case, `generate` \nis passed a symbol that has a set of rewrite rules associated with it. We choose one of \nthose at random, and then generate from that. (2) If the symbol has no possible rewrite \nrules, it must be a terminal symbol—a word, rather than a grammatical category—and \nwe want to leave it alone. Actually, we return the list of the input word, because, as \nin the previous program, we want all results to be lists of words. (3) In some cases, \nwhen the symbol has rewrites, we will pick one that is a list of symbols, and try to \ngenerate from that. Thus, `generate` must also accept a list as input, in which case \nit should generate each element of the list, and then append them all together. In \nthe following, the first clause in `generate` handles this case, while the second clause \nhandles (1) and the third handles (2). Note that we used the `mappend` function from \nsection 1.7 ([page 18](chapter1.md#page-18)). \n\n\f\n<a id='page-41'></a>\n\n```lisp\n(defun generate (phrase) \n  \"Generate a random sentence or phrase\" \n  (cond ((listp phrase) \n        (mappend #'generate phrase)) \n        ((rewrites phrase) \n         (generate (random-elt (rewrites phrase)))) \n        (t (list phrase)))) \n```\n\nLike many of the programs in this book, this function is short, but dense with \ninformation: the craft of programming includes knowing what *not* to write, as well \nas what to write. \n\nThis style of programming is called *data-driven* programming, because the data \n(the list of rewrites associated with a category) drives what the program does next. It \nis a natural and easy-to-use style in Lisp, leading to concise and extensible programs, \nbecause it is always possible to add a new piece of data with a new association without \nhaving to modify the original program. \n\nHere are some examples of `generate` in use: \n\n```lisp\n> (generate 'sentence) => (THE TABLE SAW THE BALL) \n\n> (generate 'sentence) => (THE WOMAN HIT A TABLE) \n\n> (generate 'noun-phrase) => (THE MAN) \n\n> (generate 'verb-phrase) (TOOK A TABLE) \n```\n\nThere are many possible ways to write `generate`. The following version uses `if` \ninstead of `cond`: \n\n```lisp\n(defun generate (phrase) \n  \"Generate a random sentence or phrase\" \n  (if (listp phrase) \n      (mappend #'generate phrase) \n      (let ((choices (rewrites phrase))) \n        (if (null choices) \n            (list phrase) \n            (generate (random-elt choices)))))) \n```\n\nThis version uses the special form `let`, which introduces a new variable (in this case, \n`choices`) and also binds the variable to a value. In this case, introducing the variable \nsaves us from calling the function `rewrites` twice, as was done in the `cond` version \nof `generate`. The general form of a `let` form is: \n\n> `(let` ((var value)...)  \n> &nbsp;&nbsp; body-containing-vars)*\n\n`let` is the most common way of introducing variables that are not parameters of \nfunctions. One must resist the temptation to use a variable without introducing it: \n\n\f\n<a id='page-42'></a>\n\n```lisp\n(defun generate (phrase) \n  (setf choices ...)         ;; wrong! \n  ... choices ...) \n```\n\nThis is wrong because the symbol `choices` now refers to a special or global variable, \none that may be shared or changed by other functions. Thus, the function `generate` \nis not reliable, because there is no guarantee that `choices` will retain the same value \nfrom the time it is set to the time it is referenced again. With `let` we introduce a brand \nnew variable that nobody else can access; therefore it is guaranteed to maintain the \nproper value. \n\n&#9635; Exercise 2.1 [m] Write a version of `generate` that uses `cond` but avoids calling \n`rewrites` twice. \n\n&#9635; Exercise 2.2 [m] Write a version of `generate` that explicitly differentiates between \nterminal symbols (those with no rewrite rules) and nonterminal symbols. \n\n### 2.4 Two Paths to Follow \nThe two versions of the preceding program represent two alternate approaches that \ncome up time and time again in developing programs: (1) Use the most straightforward \nmapping of the problem description directly into Lisp code. (2) Use the most \nnatural notation available to solve the problem, and then worry about writing an \ninterpreter for that notation. \n\nApproach (2) involves an extra step, and thus is more work for small problems. \nHowever, programs that use this approach are often easier to modify and expand. \nThis is especially true in a domain where there is a lot of data to account for. The \ngrammar of natural language is one such domain—in fact, most AI problems fit this \ndescription. The idea behind approach (2) is to work with the problem as much as \npossible in its own terms, and to minimize the part of the solution that is written \ndirectly in Lisp. \n\nFortunately, it is very easy in Lisp to design new notations—in effect, new programming \nlanguages. Thus, Lisp encourages the construction of more robust programs. \nThroughout this book, we will be aware of the two approaches. The reader may \nnotice that in most cases, we choose the second. \n\n\f\n<a id='page-43'></a>\n### 2.5 Changing the Grammar without Changing the Program \nWe show the utility of approach (2) by defining a new grammar that includes adjectives, \nprepositional phrases, proper names, and pronouns. We can then apply the \n`generate` function without modification to this new grammar. \n\n```lisp\n(defparameter *bigger-grammar* \n  '((sentence -> (noun-phrase verb-phrase)) \n    (noun-phrase -> (Article Adj* Noun PP*) (Name) (Pronoun)) \n    (verb-phrase -> (Verb noun-phrase PP*)) \n    (PP* -> () (PP PP*)) \n    (Adj* -> () (Adj Adj*)) \n    (PP -> (Prep noun-phrase)) \n    (Prep -> to in by with on) \n    (Adj -> big little blue green adiabatic) \n    (Article -> the a) \n    (Name -> Pat Kim Lee Terry Robin) \n    (Noun -> man ball woman table) \n    (Verb -> hit took saw liked) \n    (Pronoun -> he she it these those that))) \n\n(setf *grammar* *bigger-grammar*) \n\n> (generate 'sentence) \n(A TABLE ON A TABLE IN THE BLUE ADIABATIC MAN SAW ROBIN \n WITH A LITTLE WOMAN) \n\n> (generate 'sentence) \n(TERRY SAW A ADIABATIC TABLE ON THE GREEN BALL BY THAT WITH KIM \n IN THESE BY A GREEN WOMAN BY A LITTLE ADIABATIC TABLE IN ROBIN \n ON LEE) \n\n> (generate 'sentence) \n(THE GREEN TABLE HIT IT WITH HE) \n```\n\nNotice the problem with case agreement for pronouns: the program generated \"with \nhe,\" although \"with him\" is the proper grammatical form. Also, it is clear that the \nprogram does not distinguish sensible from silly output. \n\n### 2.6 Using the Same Data for Several Programs \nAnother advantage of representing information in a declarative form-as rules or \nfacts rather than as Lisp functions-is that it can be easier to use the information for \nmultiple purposes. Suppose we wanted a function that would generate not just the \n\f\n<a id='page-44'></a>\nlist of words in a sentence but a representation of the complete syntax of a sentence. \nFor example, instead of the list `(a woman took a ball)`, we want to get the nested list: \n\n```lisp\n(SENTENCE (NOUN-PHRASE (ARTICLE A) (NOUN WOMAN)) \n          (VERB-PHRASE (VERB TOOK) \n                       (NOUN-PHRASE (ARTICLE A) (NOUN BALL)))) \n```\n\nThis corresponds to the tree that linguists draw as in figure 2.1. \n\n```\nTK: diagram\nsentence \n\nart noun verb art noun \nI I I I I \na woman took a ball \n```\n\nFigure 2.1: Sentence Parse Tree \n\nUsing the \"straightforward functions\" approach we would be stuck; we'd have to \nrewrite every function to generate the additional structure. With the \"new notation\" \napproach we could keep the grammar as it is and just write one new function: a \nversion of `generate` that produces nested lists. The two changes are to `cons` the \ncategory onto the front of each rewrite, and then not to append together the results \nbut rather just list them with `mapcar`: \n\n```lisp\n(defun generate-tree (phrase) \n  \"Generate a random sentence or phrase, \n  with a complete parse tree.\" \n  (cond ((listp phrase) \n         (mapcar #'generate-tree phrase)) \n        ((rewrites phrase) \n         (cons phrase \n               (generate-tree (random-elt (rewrites phrase))))) \n        (t (list phrase)))) \n```\n\nHere are some examples: \n\n\f\n<a id='page-45'></a>\n\n```lisp\n> (generate-tree 'Sentence) \n(SENTENCE (NOUN-PHRASE (ARTICLE A) \n                       (ADJ*) \n                       (NOUN WOMAN) \n                       (PP*)) \n      (VERB-PHRASE (VERB HIT) \n                       (NOUN-PHRASE (PRONOUN HE)) \n                       (PP*))) \n\n> (generate-tree 'Sentence) \n(SENTENCE (NOUN-PHRASE (ARTICLE A) \n                       (NOUN WOMAN)) \n          (VERB-PHRASE (VERB TOOK) \n                       (NOUN-PHRASE (ARTICLE A) (NOUN BALL)))) \n```\n\nAs another example of the one-data/multiple-program approach, we can develop a \nfunction to generate all possible rewrites of a phrase. The function `generate-all`  \nreturns a list of phrases rather than just one, and we define an auxiliary function, \n`combine-all`, to manage the combination of results. Also, there are four cases instead \nof three, because we have to check for nil explicitly. Still, the complete program is \nquite simple: \n\n```lisp\n(defun generate-all (phrase) \n  \"Generate a list of all possible expansions of this phrase.\" \n  (cond ((null phrase) (list nil)) \n        ((listp phrase) \n         (combine-all (generate-all (first phrase)) \n                      (generate-all (rest phrase)))) \n        ((rewrites phrase) \n         (mappend #'generate-all (rewrites phrase))) \n        (t (list (list phrase))))) \n\n(defun combine-all (xlist ylist) \n  \"Return a list of lists formed by appending a y to an x. \n  E.g., (combine-all '((a) (b)) '((1) (2))) \n  -> ((A 1) (B 1) (A 2) (B 2)).\" \n  (mappend #'(lambda (y) \n               (mapcar #'(lambda (x) (append . y)) xlist)) \n           ylist)) \n```\n\nWe can now use `generate-all` to test our original little grammar. Note that a serious \ndrawback of `generate-all` is that it can't deal with recursive grammar rules like \n`Adj* => Adj + Adj*` that appear in `*bigger-grammar*`, since these lead to an infinite \nnumber of outputs. But it works fine for finite languages, like the language generated \nby `*simple-grammar*`: \n\n\f\n<a id='page-46'></a>\n\n```lisp\n> (generate-all 'Article) \n\n((THE) (A)) \n\n> (generate-all 'Noun) \n\n((MAN) (BALL) (WOMAN) (TABLE)) \n\n> (generate-all 'noun-phrase) \n((A MAN) (A BALL) (A WOMAN) (A TABLE) \n (THE MAN) (THE BALL) (THE WOMAN) (THE TABLE)) \n\n> (length (generate-all 'sentence)) \n256 \n```\n\nThere are 256 sentences because every sentence in this language has the form Article-\nNoun-Verb-Article-Noun, and there are two articles, four nouns and four verbs \n(2 &times; 4 &times; 4 &times; 2 &times; 4 = 256). \n\n### 2.7 Exercises \n&#9635; Exercise 2.3 [h] Write a trivial grammar for some other language. This can be a \nnatural language other than English, or perhaps a subset of a computer language. \n\n&#9635; Exercise 2.4 [m] One way of describing `combine-all` is that it calculates the cross-product \nof the function a ppend on the argument lists. Write the higher-order function \n`cross-product`, and define `combine-all` in terms of it. \\\nThe moral is to make your code as general as possible, because you never know what \nyou may want to do with it next. \n\n### 2.8 Answers \n#### Answer 2.1 \n```lisp\n  (defun generate (phrase) \n  \"Generate a random sentence or phrase\" \n  (let ((choices nil)) \n    (cond ((listp phrase) \n        (mappend #'generate phrase)) \n       ((setf choices (rewrites phrase)) \n        (generate (random-elt choices))) \n       (t (list phrase))))) \n```\n\n\f\n<a id='page-47'></a>\n#### Answer 2.2 \n\n```lisp\n(defun generate (phrase) \n  \"Generate a random sentence or phrase\" \n  (cond ((listp phrase) \n         (mappend #'generate phrase)) \n        ((non-terminal-p phrase) \n         (generate (random-elt (rewrites phrase)))) \n        (t (list phrase)))) \n\n(defun non-terminal-p (category) \n  \"True if this is a category in the grammar.\" \n  (not (null (rewrites category)))) \n```\n\n#### Answer 2.4 \n```lisp\n(defun cross-product (fn xlist ylist) \n  \"Return a list of all (fn . y) values.\" \n  (mappend #'(lambda (y) \n               (mapcar #'(lambda (x) (funcall fn x y)) \n                       xlist)) \n           ylist)) \n\n(defun combine-all (xlist ylist) \n  \"Return a list of lists formed by appending a y to an x\" \n  (cross-product #'append xlist ylist)) \n```\n\nNow we can use the `cross-product` in other ways as well: \n\n```\n> (cross-product #'+ '(1 2 3) '(10 20 30)) \n(11 12 13 \n 21 22 23 \n 31 32 33) \n\n> (cross-product #'list '(a b c d e f g h) \n                        '(1 2 3 4 5 6 7 8)) \n((A 1) (B 1) (C 1) (D 1) (E 1) (F 1) (G 1) (H 1) \n (A 2) (B 2) (C 2) (D 2) (E 2) (F 2) (G 2) (H 2) \n (A 3) (B 3) (C 3) (D 3) (E 3) (F 3) (G 3) (H 3) \n (A 4) (B 4) (C 4) (D 4) (E 4) (F 4) (G 4) (H 4) \n (A 5) (B 5) (C 5) (D 5) (E 5) (F 5) (G 5) (H 5) \n (A 6) (B 6) (C 6) (D 6) (E 6) (F 6) (G 6) (H 6) \n (A 7) (B 7) (C 7) (D 7) (E 7) (F 7) (G 7) (H 7) \n (A 8) (B 8) (C 8) (D 8) (E 8) (F 8) (G 8) (H 8)) \n```\n\n\f\n## Chapter 3\n<a id='page-48'></a>\n\nOverview of Lisp \n\nNo doubt about it. Common Lisp is a big language. \n\n—Guy L. Steele, Jr. \nForeword to Koschman 1990 \n\nI 1 his chapter briefly covers the most important special forms and functions in Lisp. It \ncan be safely skipped or skimmed by the experienced Common Lisp programmer \n\nbut is required reading for the novice Lisp progranuner, or one who is new to the \nCommon Lisp dialect. \n\nr. \n\nThis chapter can be used as a reference source, but the definitive reference is Steele's Common \nLisp the Language, 2d edition, which should be consulted whenever there is any confusion. Since \nthat book is 25 times longer than this chapter, it is clear that we can only touch on the important \nhighlights here. More detailed coverage is given later in this book as each feature is used in a \nreal program. \n\n\f\n<a id='page-49'></a>\n3.1 A Guide to Lisp Style \nThe beginning Common Lisp programmer is often overwhelmed by the number of \noptions that the language provides. In this chapter we show fourteen different ways \nto find the length of a list. How is the programmer to choose between them? One \nanswer is by reading examples of good programs—as illustrated in this book—and \ncopying that style. In general, there are six maxims that every programmer should \nfollow: \n\n* Be specific. \n* Use abstractions. \n* Be concise. \n* Use the provided tools. \n* Don't be obscure. \n* Be consistent. \nThese require some explanation. \n\nUsing the most specific form possible makes it easier for your reader to understand \nyour intent. For example, the conditional special form when is more specific than i f. \nThe reader who sees a when knows to look for only one thing: the clause to consider \nwhen the test is true. The reader who sees an i f can rightfully expect two clauses: \none for when the test is true, and one for when it is false. Even though it is possible \nto use i f when there is only one clause, it is preferable to use when, because when is \nmore specific. \n\nOne important way of being specific is using abstractions. Lisp provides very \ngeneral data structures, such as lists and arrays. These can be used to implement \nspecific data structures that your program will use, but you should not make the \nmistake of invoking primitive functions directly. If you define a list of names: \n\n(defvar *names* '((Robert E. Lee) ...)) \n\nthen you should also define functions to get at the components of each name. To get \nat Lee,use (last-name (first *names*)),not (caddar *names*). \n\nOften the maxims are in concord. For example, if your code is trying to find an \nelement in a list, you should use f 1 nd (or maybe f 1 nd-1 f), not 1 oop or do. f i nd is \nmore specific than the general constructs 1 oop or do, it is an abstraction, it is more \nconcise, it is a built-in tool, and it is simple to understand. \n\n\f\n<a id='page-50'></a>\n\nSometimes, however, the maxims are in confUct, and experience will tell you \nwhich one to prefer. Consider the following two ways of placing a new key/value \npair on an association list:^ \n\n(push (cons key val) a-list) \n(setf a-list (aeons key val a-list)) \n\nThe first is more concise. But the second is more specific, as it uses the aeons \nfunction, which is designed specifically for association lists. The decision between \nthem probably hinges on obscurity: those who find aeons to be a familiar function \nwould prefer the second, and those who find it obscure would prefer the first. \n\nA similar choice arises in the question of setting a variable to a value. Some prefer \n(setq X val) because it is most specific; others use (setf . val), feeling that it is \nmore consistent to use a single form, setf, for all updating. Whichever choice you \nmake on such issues, remember the sixth maxim: be consistent. \n\n3.2 Special Forms \nAs noted in chapter 1, \"special form\" is the term used to refer both to Common Lisp's \nsyntactic constructs and the reserved words that mark these constructs. The most \ncommonly used special forms are: \n\ndefinitions conditional variables iteration other \ndefun and let do declare \ndefstruct case let* do* function \ndefvar cond pop dolist progn \ndefparameter if push dotimes quote \ndefconstant or setf loop return \ndefmacro unless incf trace \nlabels when decf untrace \n\nTo be precise, only declare, function. If, labels, let, let*, progn and quote \nare true special forms. The others are actually defined as macros that expand into \ncalls to more primitive special forms and functions. There is no real difference to the \nprogrammer, and Common Lisp implementations are free to implement macros as \nspecial forms and vice versa, so for simplicity we will continue to use \"special form\" \nas a blanket term for both true special forms and built-in macros. \n\n^Association lists are covered in section 3.6. \n\n\f\n<a id='page-51'></a>\nSpecial Forms for Definitions \n\nIn this section we survey the special forms that can be used to introduce new global \nfunctions, macros, variables, and structures. We have already seen the defun form \nfor defining functions; the def macro form is similar and is covered on [page 66](chapter3.md#page-66). \n\n(defun function-name (parameter...) \" optional documentation\" body...) \n\n(defmacro macro-name (parameter...) \"optional documentation\" body...) \n\nThere are three forms for introducing special variables, defvar defines a special \nvariable and can optionally be used to supply an initial value and a documentation \nstring. The initial value is evaluated and assigned only if the variable does not yet \nhave any value, def pa rameter is similar, except that the value is required, and it will \nbe used to change any existing value, def constant is used to declare that a symbol \nwill always stand for a particular value. \n\n(defvar vanable-name initial-value \"optional documentation\") \n(defparameter vanable-name value \"optional documentation\") \n(def constant variable-name value \"optional documentation\") \n\nAll the def - forms define global objects. It is also possible to define local variables \nwith let, and to define local functions with label s, as we shall see. \n\nMost programming languages provide a way to group related data together into \na structure. Common Lisp is no exception. The def struct special form defines a \nstructure type (known as a record type in Pascal) and automatically defines functions \nto get at components of the structure. The general syntax is: \n\n(def struct structure-name \"optional documentation\" slot...) \n\nAs an example, we could define a structure for names: \n\n(defstruct name \nfirst \n(middle nil) \nlast) \n\nThis automatically defines the constructor function make-name, the recognizer predicate \nname-p, and the accessor functions name-first, name-middle and name-last. \nThe (middle nil) means that each new name built by make-name will have a middle \nname of ni 1 by default. Here we create, access, and modify a structure: \n\n\f\n<a id='page-52'></a>\n\n> (setf b (make-name :first 'Barney :last 'Rubble)) => \n#S(NAME :FIRST BARNEY :LAST RUBBLE) \n\n> (name-first b) ^ BARNEY \n\n> (name-middle b) NIL \n\n> (name-last b) ^ RUBBLE \n\n> (name-p b) =. . \n\n> (name-p 'Barney) =. NIL ; only the results of make-name are names \n\n> (setf (name-middle b) 'Q) => Q \n\n> b #S(NAME :FIRST BARNEY .-MIDDLE Q :LAST RUBBLE) \n\nThe printed representation of a structure starts with a #S and is followed by a list \nconsisting of the type of the structure and alternating pairs of slot names and values. \nDo not let this representation fool you: it is a convenient way of printing the structure, \nbut it is not an accurate picture of the way structures are represented internally. \nStructures are actually implemented much like vectors. For the name structure, the \ntype would be in the zero element of the vector, the first name in the first element, \nmiddle in the second, and last in the third. This means structures are more efficient \nthan lists: they take up less space, and any element can be accessed in a single step. \nIn a list, it takes . steps to access the nth element. \n\nThere are options that give more control over the structure itself and the individual \nslots. They will be covered later as they come up. \n\nSpecial Forms for Conditionals \n\nWe have seen the special form i f, which has the form (i f test then-part else-part), \nwhere either the then-part or the else-part is the value, depending on the success of the \ntest. Remember that only . i 1 counts as false; all other values are considered true for \nthe purpose of conditionals. However, the constant t is the conventional value used \nto denote truth (unless there is a good reason for using some other value). \n\nThere are actually quite a few special forms for doing conditional evaluation. \nTechnically, i f is defined as a special form, while the other conditionals are macros, \nso in some sense 1 f is supposed to be the most basic. Some programmers prefer to \nuse i f for most of their conditionals; others prefer cond because it has been around \nthe longest and is versatile (if not particularly pretty). Finally, some programmers opt \nfor a style more like English prose, and freely use when, unl ess, 1 f, and all the others. \n\nThe following table shows how each conditional can be expressed in terms of \n1 f and cond. Actually, these translations are not quite right, because or, case, and \ncond take care not to evaluate any expression more than once, while the translations \nwith i f can lead to multiple evaluation of some expressions. The table also has \n\n\f\n<a id='page-53'></a>\ntranslations to cond. The syntax of cond is a series of cond-clauses, each consisting of \na test expression followed by any number of result expressions: \n\n(cond {testresult...) \n{test result...) \n\n...) \n\ncond goes through the cond-clauses one at a time, evaluating each test expression. \nAs soon as a test expression evaluates non-nil, the result expressions for that clause \nare each evaluated, and the last expression in the clause is the value of the whole \ncond. In particular, if a cond-clause consists of just a test and no result expressions, \nthen the value of the cond is the test expression itself, if it is non-nil. If all of the test \nexpressions evaluate to nil, then nil is returned as the value of the cond. A common \nidiom is to make the last cond-clause be (t result...). \n\nThe forms when and unl ess operate like a single cond clause. Both forms consist \nof a test followed by any number of consequents, which are evaluated if the test is \nsatisfied-that is, if the test is true for when or false for unl ess. \n\nThe and form tests whether every one of a list of conditions is true, and or tests \nwhether any one is true. Both evaluate the arguments left to right, and stop as soon \nas the final result can be determined. Here is a table of equivalences: \n\nconditional if form cond form \n(when test ah c) (if test (progn a be)) (cond {testaba)) \n(unless testxy) (if {nottest) (progn xy)) (cond {{not test) xy)) \n(and abc) (if a (if b c)) (cond(fl (cond {be)))) \n(or ahc) (if a a (if b b c)) (cond (a) {b) (c)) \n(case a {b c) (t x)) (if (eql a 'b) c x) (cond ((eql a 'b)c) {tx)) \n\nIt is considered poor style to use and and or for anything other than testing a \nlogical condition, when, unl ess, and 1 f can all be used for taking conditional action. \nFor example: \n\n(and (> . 100) \n(princ \"N is large.\")) ; Bad style! \n\n(or (<= . 100) \n(princ \"N is large.\")) ; Even worse style! \n\n(cond ((> . 100) ; OK. but not MY preference \n(princ \"N is large.\")) \n\n(when (> . 100) \n(princ \"N is large.\")) ; Good style. \n\nWhen the main purpose is to return a value rather than take action, cond and i f \n(with explicit . i 1 in theelsecase)are preferred overwhenandunl ess, which implicitly \n\n\f\n<a id='page-54'></a>\n\nreturn nil in the else case, when and unl ess are preferred when there is only one \npossibility, i f (or, for some people, cond) when there are two, and cond when there \nare more than two: \n\n(defun tax-bracket (income) \n\n\"Determine what percent tax should be paid for this income.\" \n\n(cond ((< income 10000.00) 0.00) \n\n((< income 30000.00) 0.20) \n((< income 50000.00) 0.25) \n((< income 70000.00) 0.30) \n(t 0.35))) \n\nIf there are several tests comparing an expression to constants, then case is appropriate. \nA case form looks like: \n\n(case expression \n(matchresult..)...) \n\nThe expression is evaluated and compared to each successive match. As soon as one \nis eql, the result expressions are evaluated and the last one is returned. Note that the \nmatch expressions are not evaluated. If a match expression is a list, then case tests if \nthe expression is eql to any member of the list. If a match expression is the symbol \notherwi se (or the symbol t), then it matches anything. (It only makes sense for this \notherwl se clause to be the last one.) \n\nThere is also another special form, typecase, which compares the type of an \nexpression against several possibilities and, like case, chooses the first clause that \nmatches. In addition, the special forms ecase and etypecase are just like case and \ntypecase except that they signal an error if there is no match. You can think of the e \nas standing for either \"exhaustive\" or \"error.\" The forms cease and etypecase also \nsignal errors, but they can be continuable errors (as opposed to fatal errors): the user \nis offered the chance to change the expression to something that satisfies one of the \nmatches. Here are some examples of case forms and their cond equivalents: \n\n(case . (cond \n(1 10) ((eql . 1) 10) \n(2 20)) ((eql . 2) 20)) \n(typecase . (cond \n(number (abs x)) ((typep . 'number) (abs x)) \n(list (length x))) ((typep . 'list ) (length x))) \n(ecase . (cond \n(1 10) ((eql . 1) 10) \n(2 20)) ((eql . 2) 20) \n(t (error \"no valid case\"))) \n\n\f\n<a id='page-55'></a>\n(etypecase . (cond \n(number (abs .)) ((typep . 'number) (abs x)) \n(list (length x))) ((typep . 'list ) (length x)) \n(t (error \"no valid typecase\"))) \n\nSpecial Forms for Dealing with Variables and Places \n\nThe special form setf is used to assign a new value to a variable or place, much as an \nassignment statement with = or := is used in other languages. A place, or generalized \nvariable is a name for a location that can have a value stored in it. Here is a table of \ncorresponding assignment forms in Lisp and Pascal: \n\nLisp /* Pascal */ \n(setf . 0) . := 0; \n(setf (aref A i j) 0) A[i,j] := 0; \n(setf (rest list ) nil) list\\res t := nil ; \n(setf (name-middle b) 'Q) b\\middle := \"Q\"; \n\nsetf can be used to set a component of a structure as well as to set a variable. In \nlanguages like Pascal, the expressions that can appear on the left-hand side of an \nassignment statement are limited by the syntax of the language. In Lisp, the user can \nextend the expressions that are allowed in a s etf form using the special forms defs et f \nor define-setf-method. These are introduced on pages [514](chapter15.md#page-514) and [884](chapter25.md#page-884) respectively. \n\nThere are also some built-in functions that modify places. For example, (rpl a cd \nlist nil) has the same effect as (setf (rest list) nil), except that it returns \nlist instead of ni 1. Most Common Lisp programmers prefer to use the setf forms \nrather than the specialized functions. \n\nIf you only want to set a variable, the special form setq can be used instead. In \nthis book I choose to use setf throughout, opting for consistency over specificity. \n\nThe discussion in this section makes it seem that variables (and slots of structures) \nare assigned new values all the time. Actually, many Lisp programs do no \nassignments whatsoever. It is very common to use Lisp in a functional style where \nnew variables may be introduced, but once a new variable is established, it never \nchanges. One way to introduce a new variable is as a parameter of a function. It \nis also possible to introduce local variables using the special form let. Following \nare the general let form, along with an example. Each variable is bound to the \ncorresponding value, and then the body is evaluated: \n\n\f\n<a id='page-56'></a>\n\n(let((variablevalue)..,) (let ((x 40) \nbody...) (y (+ 1 1))) \n(+ X y)) 42 \n\nDefining a local variable with a let form is really no different from defining parameters \nto an anonymous function. The former is equivalent to: \n\n((lambdei(variable..,) ((lambda (x y) \nbody...) (+ X y)) \nvalue..,) 40 \n\n(+ 1 D) \n\nFirst, all the values are evaluated. Then they are bound to the variables (the parameters \nof the lambda expression), and finally the body is evaluated, using those \nbindings. \n\nThe special form let* is appropriate when you want to use one of the newly \nintroduced variables in a subsequent value computation. For example: \n\n(let* ((x 6) \n(y (* . .))) \n(+ . y)) 42 \n\nWe could not have used let here, because then the variable . would be unbound \n\nduring the computation of y's value. \n\n&#9635; Exercise 3.1 [m] Show a lambda expression that is equivalent to the above let* \nexpression. You may need more than one lambda. \n\nBecause lists are so important to Lisp, there are special forms for adding and \ndeleting elements from the front of a list—in other words, for treating a list as a stack. \nIf 1 i st is the name of a location that holds a list, then (push A: 1 i st) will change 1 i st \nto have . as its first element, and (pop 1 i st) will return the first element and, as \na side-effect, change 1 i st to no longer contain the first element, push and pop are \nequivalent to the following expressions: \n\n(push . list) = (setf list (cons . list)) \n\n(pop list) = (let ((result (first list))) \n(setf list (rest list)) \nresult) \n\nJust as a Hst can be used to accumulate elements, a running sum can be used to \naccumulate numbers. Lisp provides two more special forms, 1 ncf and decf, that can \nbe used to increment or decrement a sum. For both forms the first argument must \n\n\f\n<a id='page-57'></a>\nbe a location (a variable or other setf-able form) and the second argument, which \nis optional, is the number to increment or decrement by. For those who know C, \n(incf x) is equivalent to -H-X, and (incf . 2) is equivalent to x+=2. In Lisp the \nequivalence is: \n\n(incf x) = (incf . 1) = (setf . (+ . D) \n(decf x) = (decf . 1) = (setf . (- . D) \n\nWhen the location is a complex form rather than a variable. Lisp is careful to expand \ninto code that does not evaluate any subform more than once. This holds for push, \npop, 1 ncf, and decf. In the following example, we have a list of players and want \nto decide which player has the highest score, and thus has won the game. The \nstructure pi ayer has slots for the player's score and number of wins, and the function \ndetermi ne -wi nner increments the winning player's w1 ns field. The expansion of the \ni ncf form binds a temporary variable so that the sort is not done twice. \n\n(defstruct player (score 0) (wins 0)) \n\n(defun determine-winner (players) \n\n\"Increment the WINS for the player with highest score.\" \n\n(incf (player-wins (first (sort players #*> \n\n:key #'player-score))))) \n\n(defun determine-winner (players) \n\n\"Increment the WINS for the player with highest score.\" \n\n(let ((temp (first (sort players #'> :key #'player-score)))) \n\n(setf (player-wins temp) (+ (player-wins temp) 1)))) \n\nFunctions and Special Forms for Repetition \n\nMany languages have a small number of reserved words for forming iterative loops. \nFor example, Pascal has whi 1 e, repeat, and for statements. In contrast, Conunon \nLisp has an almost bewildering range of possibilities, as summarized below: \n\ndolist loop over elements of a list \ndot1mes loop over successive integers \ndo, do* general loop, sparse syntax \nloop general loop, verbose syntax \nmapc. mapcar loop over elements of lists(s) \nsome, every loop over list until condition \nfind, reduce, efc. more specific looping functions \nrecursion general repetition \n\n\f\n<a id='page-58'></a>\n\nTo explain each possibiUty, we will present versions of the function length, which \nreturns the number of elements in a list. First, the special form dol i st can be used \nto iterate over the elements of a list. The syntax is: \n\n(dol i st (variable list optional-result) body...) \n\nThis means that the body is executed once for each element of the list, with variable \nbound to the first element, then the second element, and so on. At the end, \ndol i st evaluates and returns the optional-result expression, or nil if there is no result \nexpression. \n\nBelow is a version of length usingdol i st. The let form introduces anew variable, \n1 en, which is initially bound to zero. The dol i st form then executes the body once \nfor each element of the list, with the body incrementing 1 en by one each time. This \nuse is unusual in that the loop iteration variable, el ement, is not used in the body. \n\n(defun length1 (list ) \n(let (den 0)) start with LEN=0 \n(dolist (element list ) and on each iteration \n(incf len)) increment LEN by 1 \nlen)) and return LEN \n\nIt is also possible to use the optional result of dol i st, as shown below. While many \nprogrammers use this style, I find that it is too easy to lose track of the result, and so \nI prefer to place the result last explictly. \n\n(defun length1.1 (list) ; alternate version: \n(let (den 0)) ; (not my preference) \n(dolist (element list len) ; uses len as result here \n(incf len)))) \n\nThe function mapc performs much the same operation as the special form dol i st. In \nthe simplest case, mapc takes two arguments, the first a function, the second a list. It \napplies the function to each element of the list. Here is length using mapc: \n\n(defun lengthZ (list) \n(let (den 0)) ; start with LEN=0 \n(mapc #'dambda (element) ; and on each iteration \n(incf len)) ; increment LEN by 1 \nlist) \nlen)) ; and return LEN \n\nThere are seven different mapping functions, of which the most useful are mapc and \nmapca r. mapca r executes the same function calls as mapc, but then returns the results \n\n\f\n<a id='page-59'></a>\nin a list. \n\nThere is also a dot i mes form, which has the syntax: \n\n(dot i mes (variable number optional-result) body,..) \nand executes the body with variable bound first to zero, then one, all the way up to \nnumber-1 (for a total of number times). Of course, dot i mes is not appropriate for \nimplementing length, since we don't know the number of iterations ahead of time. \nThere are two very general looping forms, do and 1 oop. The syntax of do is as \nfollows: \n\n(do ((variable initial next)...) \n(exit-test result) \nbody...) \n\nEach variable is initially bound to the initial value. If exit-test is true, then result is returned. \nOtherwise, the body is executed and each variable is set to the corresponding \nnext value and exit-test is tried again. The loop repeats until exit-test is true. If a next \nvalue is omitted, then the corresponding variable is not updated each time through \nthe loop. Rather, it is treated as if it had been bound with a let form. \n\nHere is length implemented withdo,usingtwo variables, 1 en to count the number \nof elements, and 1 to go down the list. This is often referred to as cdr-ing down a list, \nbecause on each operation we apply the function cdr to the list. (Actually, here we \nhave used the more mnemonic name rest instead of cdr.) Note that the do loop has \nno body! All the computation is done in the variable initialization and stepping, and \nin the end test. \n\n(defun lengths (list) \n(do (den 0 (+ len D) ; start with LEN=0. increment \n(1 list (rest 1))) ; ... on each iteration \n((null 1) len))) ; (until the end of the list) \n\nI find the do form a little confusing, because it does not clearly say that we are looping \nthrough a list. To see that it is indeed iterating over the list requires looking at both \nthe variable 1 and the end test. Worse, there is no variable that stands for the current \nelement of the Ust; we would need to say (first 1 ) to get at it. Both dol i st and \nmapc take care of stepping, end testing, and variable naming automatically. They are \nexamples of the \"be specific\" principle. Because it is so unspecific, do will not be \nused much in this book. However, many good programmers use it, so it is important \nto know how to read do loops, even if you decide never to write one. \n\nThe syntax of 1 oop is an entire language by itself, and a decidedly non-Lisp-like \nlanguage it is. Rather than list all the possibilities for 1 oop, we will just give examples \n\n\f\n<a id='page-60'></a>\n\nhere, and refer the reader to Common Lisp the Language, 2d edition, or chapter 24.5 for \nmore details. Here are three versions of length using 1 oop: \n\n(defun length4 (list) \n(loop for element in list ; go through each element \ncount t)) ; counting each one \n\n(defun lengths (11st) \n(loop for element in list ; go through each element \nsumming 1)) ; adding 1 each time \n\n(defun lengthe (list) \n\n(loop with len = 0 ; start with LEN=0 \nuntil (null list) ; and (until end of list) \nfor element = (pop list) ; on each iteration \ndo (incf len) ; increment LEN by 1 \nfinally (return len))) ; and return LEN \n\nEvery programmer learns that there are certain kinds of loops that are used again \nand again. These are often called programming idioms or cliches. An example is going \nthrough the elements of a list or array and doing some operation to each element. \nIn most languages, these idioms do not have an explicit syntactic marker. Instead, \nthey are implemented with a general loop construct, and it is up to the reader of the \nprogram to recognize what the programmer is doing. \n\nLisp is unusual in that it provides ways to explicitly encapsulate such idioms, and \nrefer to them with explicit syntactic and functional forms, dol 1 st and dotimes are \ntwo examples of this-they both follow the \"be specific\" principle. Most programmers \nprefer to use a dol i st rather than an equivalent do, because it cries out \"this loop \niterates over the elements of a list.\" Of course, the corresponding do form also says \nthe same thing—but it takes more work for the reader to discover this. \n\nIn addition to special forms like dol 1 st and dotimes, there are quite a few functions \nthat are designed to handle common idioms. Two examples are count-If, \nwhich counts the number of elements of a sequence that satisfy a predicate, and \nposition-If, which returns the index of an element satisfying a predicate. Both \ncan be used to implement length. In length7 below, count -1f gives the number of \nelements in 11 st that satisfy the predicate true. Since true is defined to be always \ntrue, this gives the length of the list. \n\n(defun length? (list) \n(count-if #*true list)) \n\n(defun true (x) t) \n\nIn lengthS, the function position -1 f finds the position of an element that satisfies \nthe predicate true, starting from the end of the list. This will be the very last element \n\n\f\n<a id='page-61'></a>\nof the list, and since indexing is zero-based, we add one to get the length. Admittedly, \nthis is not the most straightforward implementation of length. \n\n(defun lengths (list) \n\n(if (null list) \n0 \n(+ 1 (position-if #*true list :from-end t)))) \n\nA partial table of functions that implement looping idioms is given below. These \nfunctions are designed to be flexible enough to handle almost all operations on \nsequences. The flexibility comes in three forms. First, functions like mapcar can \napply to an arbitrary number of lists, not just one: \n\n> (mapcar '(1 2 3)) => (-1 -2 -3) \n> (mapcar #'+ '(1 2) '(10 20)) (11 22) \n> (mapcar #'+ '(1 2) '(10 20) '(100 200)) => (111 222) \n\nSecond, many of the functions accept keywords that allow the user to vary the test \nfor comparing elements, or to only consider part of the sequence. \n\n> (remove 1 '(1 2 3 2 1 0 -1)) =4^ (2 3 2 0 -1) \n\n> (remove 1 '(1 2 3 2 1 0 -1) :key #'abs) ^(2320) \n\n> (remove 1 '(1 2 3 2 1 0 -1) :test #'<) =>(110 -1) \n\n> (remove 1 '(1 2 3 2 1 0 -1) rstart 4) (1 2 3 2 0 -1) \n\nThird, some have corresponding functions ending in -if or -if-not that take a \npredicate rather than an element to match against: \n\n> (remove-if #Oddp '(1 2 3 2 1 0 -1)) =^(2 2 0) \n\n> (remove-if-not #'oddp '(123210 -1)) =^(131 -1) \n\n> (find-if #'evenp '(123210 -1)) 2 \n\nThe following two tables assume these two values: \n\n(setf . '(a b c)) \n\n(setf y '(1 2 3)) \n\nThe first table lists functions that work on any number of lists but do not accept \nkeywords: \n\n\f\n<a id='page-62'></a>\n\n(every #Oddp y) =..i 1 test if every element satisfies a predicate \n(some #Oddp y) => t test if some element satisfies predicate \n(mapcar y) =^(-1 -2 -3) apply function to each element and return result \n(mapc #'print y) prints 12 3 perform operation on each element \n\nThe second table lists functions that have -if and -if-not versions and also \naccept keyword arguments: \n\n(member 2 y) =^(2 3) see if element is in list \n(count 'b x) =>1 count the number of matching elements \n(delete 1 y) =>(2 3) omit matching elements \n(find 2 y) ^2 find first element that matches \n(position 'a x) =^0 find index of element in sequence \n(reduce #'+ y) apply function to succesive elements \n(remove 2 y) =>(1 3) like del ete, but makes a new copy \n(substitute 4 2 y) =^(14 3) replace elements with new ones \n\nRepetition through Recursion \n\nLisp has gained a reputation as a \"recursive\" language, meaning that Lisp encourages \nprogrammers to write functions that call themselves. As we have seen above, there is \na dizzying number of functions and special forms for writing loops in Common Lisp, \nbut it is also true that many programs handle repetition through recursion rather \nthan with a syntactic loop. \n\nOne simple definition of length is \"the empty list has length 0, and any other list \nhas a length which is one more than the length of the rest of the list (after the first \nelement).\" This translates directly into a recursive function: \n\n(defun length9 (list) \n\n(if (null list) \n0 \n(+ 1 (length9 (rest list))))) \n\nThis version of length arises naturally from the recursive definition of a list: \"a list \nis either the empty list or an element consed onto another list.\" In general, most \nrecursive functions derive from the recursive nature of the data they are operating \non. Some kinds of data, like binary trees, are hard to deal with in anything but a \nrecursive fashion. Others, like Hsts and integers, can be defined either recursively \n(leading to recursive functions) or as a sequence (leading to iterative functions). In \nthis book, I tend to use the \"list-as-sequence\" view rather than the \"list-as-first-and-\nrest\" view. The reason is that defining a hst as a first and a rest is an arbitrary and \nartificial distinction that is based on the implementation of lists that Lisp happens to \nuse. But there are many other ways to decompose a list. We could break it into the last \n\n\f\n<a id='page-63'></a>\nelement and all-but-the-last elements, for example, or the first half and the second \n\nhalf. The \"list-as-sequence\" view makes no such artificial distinction. It treats all \n\nelements identically. \n\nOne objection to the use of recursive functions is that they are inefficient, because \nthe compiler has to allocate memory for each recursive call. This may be true for the \nfunction length9, but it is not necessarily true for all recursive calls. Consider the \nfollowing definition: \n\n(defun length1O (list) \n(length1O-aux list 0)) \n\n(defun length1O-aux (sublist len-so-far) \n\n(if (null sublist) \nlen-so-far \n(length1O-aux (rest sublist) (+ 1 len-so-far)))) \n\nlength1O uses length1O - aux as an auxiliary function, passing it 0 as the length of the \nlist so far. 1 engt hlO - a ux then goes down the list to the end, adding 1 for each element. \nThe invariant relation is that the length of the sublist plus 1 en- so - fa r always equals \nthe length of the original list. Thus, when the sublist is nil, then 1 en-so-f ar is the \nlength of the original list. Variables like 1 en- so - fa r that keep track of partial results \nare called accumulators. Other examples of functions that use accumulators include \nf 1 a tten - a 11 on [page 329](chapter10.md#page-329); one- un known on page [page 237](chapter7.md#page-237); the Prolog predicates discussed\non [page 686](chapter20.md#page-686); and anonymous-variables-in on pages [page 400](chapter12.md#page-400) and [page 433](chapter12.md#page-433), which uses two \naccumulators. \n\nThe important difference between length9 and length1O is when the addition \nis done. In length9, the function calls itself, then returns, and then adds 1. In \nlength1O-aux, the function adds 1, then calls itself, then returns. There are no \npending operations to do after the recursive call returns, so the compiler is free to \nrelease any memory allocated for the original call before making the recursive call. \nlength1O-aux is called a tail-recursive function, because the recursive call appears as \nthe last thing the function does (the tail). Many compilers will optimize tail-recursive \ncalls, although not all do. (Chapter 22 treats tail-recursion in more detail, and points \nout that Scheme compilers guarantee that tail-recursive calls will be optimized.) \n\nSome find it ugly to introduce length 10 - a ux. For them, there are two alternatives. \n\nFirst, we could combine length1O and length1O-aux into a single function with an \n\noptional parameter: \n\n(defun length11 (list &optional (len-so-far 0)) \n\n(if (null list) \nlen-so-far \n(length11 (rest list) (+ 1 len-so-far)))) \n\n\f\n<a id='page-64'></a>\n\nSecond, we could introduce a local function inside the definition of the main function. \nThis is done with the special form 1 abel s: \n\n(defun length12 (the-list) \n(labels \n((length13 (list len-so-far) \n\n(if (null list) \nlen-so-far \n(length1S (rest list) (+ 1 len-so-far))))) \n\n(length1S the-list 0))) \n\nIn general, a 1 abel s form (or the similar flet form) can be used to introduce one or \nmore local functions. It has the following syntax: \n\n(labels \n\n((function-name {parameter...)function-body)...) \nbody-of-labels) \n\nOther Special Forms \n\nA few more special forms do not fit neatly into any category. We have already seen \nthe two special forms for creating constants and functions, quote and function. \nThese are so common that they have abbreviations: 'x for (quote x) and #'f for \n(function f). \n\nThe special form progn can be used to evaluate a sequence of forms and return \nthe value of the last one: \n\n(progn (setf . 0) (setf . (+ . D) .) 1 \n\nprogn is the equivalent of a begin.. .end block in other languages, but it is used \nvery infrequently in Lisp. There are two reasons for this. First, programs written \nin a functional style never need a sequence of actions, because they don't have side \neffects. Second, even when side effects are used, many special forms allow for a \nbody which is a sequence—an implicit progn. I can only think of three places where \na progn is justified. First, to implement side effects in a branch of a two-branched \nconditional, one could use either an i f with a progn, or a cond: \n\n(if (> X 100) (cond ((> . 100) \n(progn (print \"too big\") (print \"too big\") \n(setf X 100)) (setf . 100)) \n\nX) (t X)) \n\f\n<a id='page-65'></a>\nIf the conditional had only one branch, then when or unl ess should be used, since \nthey allow an implicit progn. If there are more than two branches, then cond should \nbe used. \n\nSecond, progn is sometimes needed in macros that expand into more than one \ntop-level form, as in the defun* macro on [page 326](chapter10.md#page-326), section 10.3. Third, a progn is \nsometimes needed in an unwi nd- protect, an advanced macro. An example of this is \nthe wi th- resource macro on [page 338](chapter10.md#page-338), section 10.4. \n\nThe forms trace and untrace are used to control debugging information about \nentry and exit to a function: \n\n> (trace length9) (LENGTH9) \n\n> (length9 '(a b c)) \n(1 ENTER LENGTH9: (ABO ) \n(2 ENTER LENGTH9: (BO ) \n\n(3 ENTER LENGTH9: (O) \n(4 ENTER LENGTH9: NIL) \n(4 EXIT LENGTH9: 0) \n\n(3 EXIT LENGTH9: 1) \n\n(2 EXIT LENGTH9: 2) \n(1 EXIT LENGTH9: 3) \n3 \n\n> (untrace length9) => (LENGTH9) \n\n> (length9 '(a b c)) => 3 \n\nFinally, the special form return can be used to break out of a block of code. Blocks are \nset up by the special form bl ock, or by the looping forms (do, do*, dol i st, dot i mes, or \nloop). For example, the following function computes the product of a list of numbers, \nbut if any number is zero, then the whole product must be zero, so we immediately \nreturn zero from the dol i st loop. Note that this returns from the dol i st only, not \nfrom the function itself (although in this case, the value returned by dol i st becomes \nthe value returned by the function, because it is the last expression in the function). I \nhave used uppercase letters in RETURN to emphasize the fact that it is an unusual step \nto exit from a loop. \n\n(defun product (numbers) \n\"Multiply all the numbers together to compute their product.\" \n(let ((prod D) \n\n(dolist (n numbers prod) \n\n(if (= . 0) \n(RETURN 0) \n(setf prod (* . prod)))))) \n\n\f\n<a id='page-66'></a>\n\nMacros \n\nThe preceding discussion has been somewhat cavalier with the term \"special form.\" \nActually, some of these special forms are really macros, forms that the compiler \nexpands into some other code. Common Lisp provides a number of built-in macros \nand allows the user to extend the language by defining new macros. (There is no way \nfor the user to define new special forms, however.) \n\nMacros are defined with the special form def ma c ro. Suppose we wanted to define \na macro, whi 1 e, that would act like the whi 1 e loop statement of Pascal. Writing a \nmacro is a four-step process: \n\n* Decide if the macro is really necessary. \n* Write down the syntax of the macro. \n* Figure out what the macro should expand into. \n* Use def macro to implement the syntax/expansion correspondence. \nThe first step in writing a macro is to recognize that every time you write one, \nyou are defining a new language that is just like Lisp except for your new macro. \nThe programmer who thinks that way will rightfully be extremely frugal in defining \nmacros. (Besides, when someone asks, \"What did you get done today?\" it sounds \nmore impressive to say \"I defined a new language and wrote a compiler for it\" than \nto say \"I just hacked up a couple of macros.\") Introducing a macro puts much more \nmemory strain on the reader of your program than does introducing a function, \nvariable or data type, so it should not be taken lightly. Introduce macros only when \nthere is a clear need, and when the macro fits in well with your existing system. As \n\nC.A.R. Hoare put it, \"One thing the language designer should not do is to include \nuntried ideas of his own.\" \nThe next step is to decide what code the macro should expand into. It is a good \nidea to follow established Lisp conventions for macro syntax whenever possible. \nLook at the looping macros (dolist, dot i mes, do-symbols), the defining macros \n(defun, defvar, defparameter, defstruct), or the the I/O macros (with-open-file, \nwith-open-stream, with-input-from-string), for example. If you follow the naming \nand syntax conventions for one of these instead of inventing your own conventions, \nyou'll be doing the reader of your program a favor. For whi 1 e, a good syntax is: \n\n(while test body...) \n\nThe third step is to write the code that you want a macro call to expand into: \n\n\f\n<a id='page-67'></a>\n(loop \n(unless test (return nil)) \nbody) \n\nThe final step is to write the definition of the macro, using defmacro. A defmacro \nform is similar to a defun in that it has a parameter list, optional documentation \nstring, and body. There are a few differences in what is allowed in the parameter list, \nwhich will be covered later. Here is a definition of the macro whi 1 e, which takes a \ntest and a body, and builds up the 1 oop code shown previously: \n\n(defmacro while (test &rest body) \n\"Repeat body while test is true.\" \n(list* .... \n\n(list 'unless test '(return nil)) \nbody)) \n\n(The function 1 i st* is like 11 st, except that the last argument is appended onto the \nend of the list of the other arguments.) We can see what this macro expands into by \nusing macroexpand, and see how it runs by typing in an example: \n\n> (macroexpand-1 '(while (< i 10) \n(print (* i i)) \n(setf i (+ i 1)))) ^ \n\n(LOOP (UNLESS (<I 10) (RETURN NIL)) \n(PRINT (* I I)) \n(SETF I (+ I 1))) \n\n> (setf i 7) => 7 \n\n> (while (< i 10) \n(print (* i i)) \n(setf i (+ i 1))) => \n\n49 \n64 \n81 \nNIL \n\nSection 24.6 ([page 853](chapter24.md#page-853)) describes a more complicated macro and some details on the \npitfalls of writing complicated macros ([page 855](chapter24.md#page-855)). \n\nBackquote Notation \n\nThe hardest part about defining whi 1 e is building the code that is the expansion of \nthe macro. It would be nice if there was a more immediate way of building code. \nThe following version of while following attempts to do just that. It defines the local \n\n\f\n<a id='page-68'></a>\n\nvariable code to be a template for the code we want, and then substitutes the real \nvalues of the variables test and body for the placeholders in the code. This is done \nwith the function subst; (subst new old tree) substitutes new for each occurrence of \nold anywhere within tree. \n\n(defmacro while (test &rest body) \n\n\"Repeat body while test is true.\" \n\n(let ((code '(loop (unless test (return nil)) . body))) \n\n(subst test 'test (subst body 'body code)))) \n\nThe need to build up code (and noncode data) from components is so frequent that \nthere is a special notation for it, the backquote notation. The backquote character \n\"'\" is similar to the quote character \" . A backquote indicates that what follows is \nmostly a literal expression but may contain some components that are to be evaluated. \nAnything marked by a leading comma\",\" is evaluated and inserted into the structure, \nand anything marked with a leading \" ,@\" must evaluate to a Hst that is spliced into \nthe structure: each element of the list is inserted, without the top-level parentheses. \nThe notation is covered in more detail in section 23.5. Here we use the combination \nof backquote and comma to rewrite whi 1 e: \n\n(defmacro while (test &rest body) \n\n\"Repeat body while test is true.\" \n\n'(loop (unless .test (return nil)) \n\n.body)) \n\nHere are some more examples of backquote. Note that at the end of a list,\", @\" has the \nsame effect as \".\" followed by \",\". In the middle of a list, only \", @\" is a possibility. \n\n> (setf testl '(a test)) => (A TEST) \n\n> '(this is .testl) => (THIS IS (A TEST)) \n\n> '(this is .testl) =i> (THIS IS A TEST) \n\n> '(this is . .testl) (THIS IS A TEST) \n\n> '(this is .testl -- this is only .testl) \n(THIS IS A TEST THIS IS ONLY A TEST) \n\nThis completes the section on special forms and macros. The remaining sections of \nthis chapter give an overview of the important built-in functions in Common Lisp. \n\n\f\n<a id='page-69'></a>\n3.3 Functions on Lists \n\nFor the sake of example, assume we have the following assignments: \n\n(setf . '(a b c)) \n(setf y '(1 2 3)) \n\nThe most important functions on lists are summarized here. The more complicated \nones are explained more thoroughly when they are used. \n\n(first x) a first element of a list \n\n(second x) =>b second element of a list \n\n(third x) third element of a list \n\n(nth 0 x) => a nth element of a list, 0-based \n\n(rest x) => (b c) all but the first element \n\n(car x) => a another name for the first element of a list \n\n(cdr x) =>(b c) another name for all but the first element \n\n(last x) =i>(c) last cons cell in a list \n\n(length x) =^3 number of elements in a list \n\n(reverse x) =>(c b a) puts list in reverse order \n\n(cons 0 y) =>(0 1 2 3) add to front of list \n\n(append . y) =i>(a b c 1 2 3) append together elements \n\n(list . y) =>i{d b c) (1 2 3)) make a new list \n\n(list* 1 2 .) =>(1 2 a b c) append last argument to others \n\n(null nil) =>J predicate is true of the empty list \n\n(null x) =>nil ... and false for everything else \n\ndistp x) =>T predicate is true of any list, including . i1 \n\ndistp 3) => nil ... and is false for nonlists \n\n(consp x) =>t predicate is true of non-nil lists \n\n(consp nil) =>nil ... and false for atoms, including . i1 \n\n(equal . .) =^t true for lists that look the same \n\n(equal . y) nil ... and false for lists that look different \n\n(sort y #'>) =^(3 2 1) sort a list according to a comparison function \n\n(subseq . 1 2) => (B) subsequence with given start and end points \n\nWe said that (cons a b) builds a longer list by adding element a to the front of list \nb, but what if b is not a list? This is not an error; the result is an object . such that \n(firstjc) =^a, (restjc) b, and where ;c prints as ia . b). This is known as dotted \npair notation. If i? is a list, then the usual list notation is used for output rather than \nthe dotted pair notation. But either notation can be used for input. \n\nSo far we have been thinking of lists as sequences, using phrases like \"a list of \nthree elements.\" The list is a convenient abstraction, but the actual implementation \nof lists relies on lower-level building blocks called cons cells. A cons cell is a data \nstructure with two fields: a first and a rest. What we have been calling \"a list of \nthree elements\" can also be seen as a single cons cell, whose first field points to \n\n\f\n<a id='page-70'></a>\n\nthe first element and whose rest field points to another cons cell that is a cons cell \nrepresenting a Ust of two elements. This second cons cell has a rest field that is a \nthird cons cell, one whose rest field is nil. All proper lists have a last cons cell whose \nrest field is nil. Figure 3.1 shows the cons cell notation for the three-element list (one \ntwo three), as well as for the result of (cons One 'two). \n\n(ONE TWO THREE) (ONE . TWO) \n\nONE TWO THREE ONE TWO \n\nFigure 3.1: Cons Cell Diagrams \n\n&#9635; Exercise 3.2 [s] The function cons can be seen as a special case of one of the other \nfunctions listed previously. Which one? \n\n&#9635; Exercise 3.3 [m] Write a function that will print an expression in dotted pair notation. \nUse the built-in function princ to print each component of the expression. \n\n&#9635; Exercise 3.4 [m] Write a function that, like the regular print function, will print an \nexpression in dotted pair notation when necessary but will use normal list notation \nwhen possible. \n\n3.4 Equality and Internal Representation \nIn Lisp there are five major equality predicates, because not all objects are created \nequally equal. The numeric equality predicate, =, tests if two numbers are the same. \nIt is an error to apply = to non-numbers. The other equality predicates operate \non any kind of object, but to understand the difference between them, we need to \nunderstand some of the internals of Lisp. \n\nWhen Lisp reads a symbol in two different places, the result is guaranteed to be \nthe exact same symbol. The Lisp system maintains a symbol table that the function \nread uses to map between characters and symbols. But when a list is read (or built) \n\n\f\n<a id='page-71'></a>\nin two different places, the results are not identically the same, even though the \ncorresponding elements may be. This is because read calls cons to build up the list, \nand each call to cons returns a new cons cell. Figure 3.2 shows two lists, x and y, \nwhich are both equal to (one two), but which are composed of different cons cells, \nand hence are not identical. Figure 3.3 shows that the expression (rest x) does not \ngenerate new cons cells, but rather shares structure with x, and that the expression \n(cons ' zero x) generates exactly one new cons cell, whose rest is x. \n\n(setf X '(one two)) \n\nONE TWO \n\n(setf y '(one two)) \n\nFigure 3.2: Equal But Nonidentical Lists \n\n(cons 'zero x) . (restx) \n\n1 \n1 \n\nZERO ONE TWO \n\nFigure 3.3: Parts of Lists \n\n\f\n<a id='page-72'></a>\n\nWhen two mathematically equal numbers are read (or computed) in two places, \nthey may or may not be the same, depending on what the designers of your implementation \nfelt was more efficient. In most systems, two equal fixnums will be identical, \nbut equal numbers of other types will not (except possibly short floats). Common \nLisp provides four equality predicates of increasing generality. All four begin with \nthe letters eq, with more letters meaning the predicate considers more objects to be \nequal. The simplest predicate is eq, which tests for the exact same object. Next, \neql tests for objects that are either eq or are equivalent numbers, equal tests for \nobjects that are either eql or are lists or strings with eql elements. Finally, equal . \nis like equal except it also matches upper- and lowercase characters and numbers \nof different types. The following table summarizes the results of applying each of \nthe four predicates to various values of . and y. The ? value means that the result \ndepends on your implementation: two integers that are eql may or may not be eq. \n\nX eq eql equal equal .\n\ny \n'x 'X . . . . \n. . . . .\n\n? \n\n'(.) '(.) nil nil . . \n\n'\"xy\" '\"xy\" nil nil . . \n\n\"'Xy\" '\"..\" nil nil nil . \n\n'0 ... nil nil nil . \n. . nil nil nil nil \nIn addition, there are specialized equaUty predicates such as =, tree -equal, \nchar-equal, and string-equal, which compare numbers, trees, characters, and \nstrings, respectively. \n\n3.5 Functions on Sequences \nCommon Lisp is in a transitional position halfway between the Lisps of the past \nand the Lisps of the future. Nowhere is that more apparent than in the sequence \nfunctions. The earliest Lisps dealt only with symbols, numbers, and lists, and \nprovided Hst functions like append and length. More modern Lisps added support \nfor vectors, strings, and other data types, and introduced the term sequence to refer \nto both vectors and lists. (A vector is a one-dimensional array. It can be represented \nmore compactly than a list, because there is no need to store the rest pointers. It \nis also more efficient to get at the nth element of a vector, because there is no need \nto follow a chain of pointers.) Modern Lisps also support strings that are vectors of \ncharacters, and hence also a subtype of sequence. \n\nWith the new data types came the problem of naming functions that operated \non them. In some cases. Common Lisp chose to extend an old function: length can \n\n\f\n<a id='page-73'></a>\napply to vectors as well as lists. In other cases, the old names were reserved for the \nlist functions, and new names were invented for generic sequence functions. For \nexample, append and mapcar only work on lists, but concatenate and map work on \nany kind of sequence. In still other cases, new functions were invented for specific \ndata types. For example, there are seven functions to pick the nth element out of a \nsequence. The most general is e 11, which works on any kind of sequence, but there are \nspecific functions for lists, arrays, strings, bit vectors, simple bit vectors, and simple \nvectors. Confusingly, nth is the only one that takes the index as the first argument: \n\n(nth . list) \nieM sequence n) \n{aref array n) \n{char string n) \n(bit bit vector n) \n(sb i t simple-hit vector .) \n(sV ref simple-vector .) \n\nThe most important sequence functions are listed elsewhere in this chapter, depending \non their particular purpose. \n\n3.6 Functions for Maintaining Tables \nLisp lists can be used to represent a one-dimensional sequence of objects. Because \nthey are so versatile, they have been put to other purposes, such as representing \ntables of information. The association list is a type of list used to implement tables. \nAn association list is a list of dotted pairs, where each pair consists of a key and a value. \nTogether, the list of pairs form a table: given a key, we can retrieve the corresponding \nvalue from the table, or verify that there is no such key stored in the table. Here's \nan example for looking up the names of states by their two-letter abbreviation. The \nfunction a s s oc is used. It returns the key/value pair (if there is one). To get the value, \nwe just take the cdr of the result returned by assoc. \n\n(setf state-table \n'((AL . Alabama) (AK . Alaska) (AZ . Arizona) (AR . Arkansas))) \n\n> (assoc 'AK state-table) => (AK . ALASKA) \n\n> (cdr (assoc 'AK state-table)) => ALASKA \n\n> (assoc 'TX state-table) => NIL \n\nIf we want to search the table by value rather than by key, we can use rassoc: \n\n> (rassoc 'Arizona table) (AZ . ARIZONA) \n\n\f\n<a id='page-74'></a>\n\n> (car (rassoc 'Arizona table)) => AZ \n\nManaging a table with assoc is simple, but there is one drawback: we have to search \nthrough the whole list one element at a time. If the list is very long, this may take \na while. \n\nAnother way to manage tables is with hash tables. These are designed to handle \nlarge amounts of data efficiently but have a degree of overhead that can make \nthem inappropriate for small tables. The function gethash works much like get—it \ntakes two arguments, a key and a table. The table itself is initialized with a call to \nmake-hash-tab! e and modified with a setf of gethash: \n\n(setf table (make-hash-table)) \n\n(setf (gethash 'AL table) 'Alabama) \n(setf (gethash 'AK table) 'Alaska) \n(setf (gethash 'AZ table) 'Arizona) \n(setf (gethash 'AR table) 'Arkansas) \n\nHere we retrieve values from the table: \n\n> (gethash 'AK table) => ALASKA \n> (gethash 'TX table) => NIL \n\nThe function remhash removes a key/value pair from a hash table, cl rhash removes \nall pairs, and maphash can be used to map over the key/value pairs. The keys to hash \ntables are not restricted; they can be any Lisp object. There are many more details \non the implementation of hash tables in Common Lisp, and an extensive Uterature \non their theory. \n\nA third way to represent table is with property lists. A property list is a Hst of \nalternating key/value pairs. Property lists (sometimes called p-lists or plists) and \nassociation lists (sometimes called a-lists or alists) are similar: \n\na-list; iikeyi . vah) {keyi . vali) ... {keyn . vain)) \n\np-list: {key I val\\ key 2 vah ... key . vain) \n\nGiven this representation, there is little to choose between a-Hsts and p-lists. They \nare slightly different permutations of the same information. The difference is in how \nthey are normally used. Every symbol has a property list associated with it. That \nmeans we can associate a property/value pair directly with a symbol. Most programs \nuse only a few different properties but have many instances of property/value pairs \nfor each property. Thus, each symbol's p-list wiH likely be short. In our example, \nwe are only interested in one property: the state associated with each abbreviation. \n\n\f\n<a id='page-75'></a>\nThat means that the property lists will be very short indeed: one property for each \nabbreviation, instead of a list of 50 pairs in the association list implementation. \n\nProperty values are retrieved with the function get, which takes two arguments: \nthe first is a symbol for which we are seeking information, and the second is the \nproperty of that symbol that we are interested in. get returns the value of that \nproperty, if one has been stored. Property/value pairs can be stored under a symbol \nwith a setf form. A table would be built as follows: \n\n(setf (get 'AL 'state) 'Alabama) \n\n(setf (get 'AK 'state) 'Alaska) \n(setf (get 'AZ 'state) 'Arizona) \n(setf (get 'AR 'state) 'Arkansas) \n\nNow we can retrieve values with get: \n\n> (get 'AK 'state) => ALASKA \n> (get 'TX 'state) => NIL \n\nThis will be faster because we can go immediately from a symbol to its lone property \nvalue, regardless of the number of symbols that have properties. However, if a given \nsymbol has more than one property, then we still have to search linearly through the \nproperty list. As Abraham Lincoln might have said, you can make some of the table \nlookups faster some of the time, but you can't make all the table lookups faster all \nof the time. Notice that there is no equivalent of rassoc using property lists; if you \nwant to get from a state to its abbreviation, you could store the abbreviation under a \nproperty of the state, but that would be a separate setf form, as in: \n\n(setf (get 'Arizona 'abbrev) *AZ) \n\nIn fact, when source, property, and value are all symbols, there are quite a few \npossibilities for how to use properties. We could have mimicked the a-list approach, \nand Usted all the properties under a single symbol, using setf on the function \nsymbol - pi i st (which gives a symbol's complete property list): \n\n(setf (symbol-piist 'state-table) \n'(AL Alabama AK Alaska AZ Arizona AR Arkansas)) \n\n> (get 'state-table 'AK) => ALASKA \n\n> (get 'state-table 'Alaska) => NIL \n\nProperty lists have a long history in Lisp, but they are falling out of favor as new \nalternatives such as hash tables are introduced. There are two main reasons why \nproperty lists are avoided. First, because symbols and their property lists are global. \n\n\f\n<a id='page-76'></a>\n\nit is easy to get conflicts when trying to put together two programs that use property \nlists. If two programs use the same property for different purposes, they cannot be \nused together. Even if two programs use different properties on the same symbols, \nthey will slow each other down. Second, property lists are messy. There is no way to \nremove quickly every element of a table implemented with property Hsts. In contrast, \nthis can be done trivially with cl rhash on hash tables, or by setting an association \nHst to nil. \n\n3.7 Functions on Trees \nMany Common Lisp functions treat the expression ((a b) ((c)) (d e))as a \nsequence of three elements, but there are a few functions that treat it as a tree with \nfive non-null leaves. The function copy - tree creates a copy of a tree, and tree - equa 1 \ntests if two trees are equal by traversing cons cells, but not other complex data like \nvectors or strings. In that respect, tree-equal is similar to equal, but tree-equal is \nmore powerful because it allows a : test keyword: \n\n> (setf tree '((a b) ((c)) (d e))) \n\n> (tree-equal tree (copy-tree tree)) . \n\n(defun same-shape-tree (a b) \n\"Are two trees the same except for the leaves?\" \n(tree-equal a b :test #*true)) \n\n(defun true (&rest ignore) t) \n\n> (same-shape-tree tree '((1 2) ((3)) (4 5))) ^ . \n\n> (same-shape-tree tree '((1 2) (3) (4 5))) => NIL \n\nFigure3.4shows thetree ((a b) ((c)) (d e)) as a cons ceU diagram. \n\nThere are also two functions for substituting a new expression for an old one \nanywhere within a tree, subst substitutes a single value for another, while sub! i s \ntakes a list of substitutions in the form of an association Hst of (old . new) pairs. \nNote that the order of old and new in the a-Hst for subl i s is reversed from the order \nof arguments to subst. The name subl i s is uncharacteristically short and confusing; \na better name would be subst -1 i St. \n\n> (subst 'new 'old '(old ((very old))) ^ (NEW ((VERY NEW))) \n\n> (sublis '((old . new)) '(old ((very old))))=^ (NEW ((VERY NEW))) \n\n> (subst 'new 'old Old) => 'NEW \n\n\f\n<a id='page-77'></a>\n(defun english->french (words) \n\n(sublis '((are . va) (book . libre) (friend . ami) \n(hello . bonjour) (how . comment) (my . mon) \n(red . rouge) (you . tu)) \n\nwords)) \n\n> (english->french '(hello my friend - how are you today?)) \n(BONJOUR MON AMI - COMMENT VA TU TODAY?) \n\n((ab) ((c)) (de)) \n\nFigure 3.4: Cons Cell Diagram of a Tree \n\n\f\n<a id='page-78'></a>\n\n3.8 Functions on Numbers \nThe most commonly used functions on numbers are listed here. There are quite a \nfew other numeric functions that have been omitted. \n\n(+ 4 2) =>6 add \n(- 4 2) =^Z subtract \n(* 4 2) ^8 multiply \n(/ 4 2) =>2 divide \n(> 100 99) greater than (also >=, greater than or equal to) \n(= 100 100) equal (also /=, not equal) \n(< 99 100) less than (also <=, less than or equal to) \n(random 100) =^42 random integer from 0 to 99 \n(expt 4 2) =i>16 exponentiation (also exp, and 1 eg) \n(sin pi) ^0.0 sine function (also cos, tan, etc.) \n(asin 0) =>0.0 arcsine or sin~^ function (also acos, atan, etc.) \n(min 2 3 4) =>2 minimum (also max) \n(abs -3) =>3 absolute value \n(sqrt 4) square root \n(round 4.1) round off (also truncate, f 1 cor, cei 1 i ng) \n(rem 11 5) remainder (also mod) \n\n3.9 Functions on Sets \nOne of the important uses of lists is to represent sets. Common Lisp provides \nfunctions that treat lists in just that way. For example, to see what elements the sets \nr = {a, 6, c,d} and s = {c, d, e} have in common, we could use: \n\n> (setf . '(a b c d)) (A . C D) \n> (setf s '(c d e))=. (C D E) \n> (intersection r s) = > (C D) \n\nThis implementation returned (C D) as the answer, but another might return (DC). \n\nThey are equivalent sets, so either is valid, and your program should not depend on \n\nthe order of elements in the result. Here are the main functions on sets: \n\n(intersection r s) => (c d) find common elements of two sets \n(union r s) (a b c d e) find all elements in either of two sets \n(set-difference r s) =>(a b) find elements in one but not other set \n(member *d r) ^(d) check if an element is a member of a set \n(subsetp s r) =>nil see if all elements of one set are in another \n(adjoin 'b s) =^(b c d e) add an element to a set \n(adjoin 'c s) =>{c d e) ... but don't add duplicates \n\n\f\n<a id='page-79'></a>\nIt is also possible to represent a set with a sequence of bits, given a particular \nuniverse of discourse. For example, if every set we are interested in must be a subset \nof(a b c d e), then we can use the bit sequence 111 10 to represent (a b cd), 00000 \nto represent the empty set, and 11001 to represent (a b e). The bit sequence can be \nrepresented in Common Lisp as a bit vector, or as an integer in binary notation. For \nexample, (a be) would be the bit vector #* 11001 or the integer 25, which can also \nbe written as #bllOOL \n\nThe advantage of using bit sequences is that it takes less space to encode a set, \nassuming a small universe. Computation will be faster, because the computer's \nunderlying instruction set will typically process 32 elements at a time. \n\nCommon Lisp provides a full complement of functions on both bit vectors and \nintegers. The following table lists some, their correspondence to the list functions. \n\nlists integers bit vectors \nintersection logand bit-and \nunion logior bit-ior \nset-difference logandc2 bit-andc2 \nmember logbitp bit \nlength logcount \nFor example, \n\n(intersection '(a bed) '(a b e)) (A B) \n(bit-and #*11110 #*11001) #*11000 \n(logand #bllllO #bll001) 24 = #bll000 \n\n3.10 Destructive Functions \nIn mathematics, a function is something that computes an output value given some \ninput arguments. Functions do not \"do\" anything, they just compute results. For \nexample, if I tell you that . = 4 and y = 5 and ask you to apply the function \"plus\" to \nX and y, I expect you to tell me 9. IfI then ask, \"Now what is the value of x?\" it would \nbe surprising if . had changed. In mathematics, applying an operator to . can have \nno effect on the value of x. \n\nIn Lisp, some functions are able to take effect beyond just computing the result. \nThese \"functions\" are not functions in the mathematical sense,^ and in other languages \nthey are known as \"procedures.\" Of course, most of the Lisp functions are true \nmathematical functions, but the few that are not can cause great problems. They can \n\n^In mathematics, a function must associate a unique output value with each input value. \n\n\f\n<a id='page-80'></a>\n\nalso be quite useful in certain situations. For both reasons, they are worth knowing \nabout. \nConsider the following: \n\n> (setf X '(a b c)) (A . C) \n> (setf y '(1 2 3)) => (1 2 3) \n> (append . y) => (A .C 1 2 3) \n\nappend is a pure function, so after evaluating the call to append, we can rightfully \nexpect that . and y retain their values. Now consider this: \n\n> (nconc X y) (A .C 1 2 3) \n> . => (A .C 1 2 3) \n> y (1 2 3) \n\nThe function nconc computes the same result as append, but it has the side effect \nof altering its first argument. It is called a destructive function, because it destroys \nexisting structures, replacing them with new ones. This means that there is quite \na conceptual load on the programmer who dares to use nconc. He or she must be \naware that the first argument may be altered, and plan accordingly. This is far more \ncomplicated than the case with nondestructive functions, where the programmer \nneed worry only about the results of a function call. \n\nThe advantage of nconc is that it doesn't use any storage. While append must \nmake a complete copy of x and then have that copy end with y, nconc does not need \nto copy anything. Instead, it just changes the rest field of the last element of x to \npoint to y. So use destructive functions when you need to conserve storage, but be \naware of the consequences. \n\nBesides nconc, many of the destructive functions have names that start with \nn, including nreverse, nintersection, nunion, nset-difference, and nsubst. An \nimportant exception is del ete, which is the name used for the destructive version of \nremove. Of course, the setf special form can also be used to alter structures, but it \nis the destructive functions that are most dangerous, because it is easier to overlook \ntheir effects. \n\n&#9635; Exercise 3.5 [h] (Exercise in altering structure.) Write a program that will play the \nrole of the guesser in the game Twenty Questions. The user of the program will have \nin mind any type of thing. The program will ask questions of the user, which must \nbe answered yes or no, or \"it\" when the program has guessed it. If the program runs \nout of guesses, it gives up and asks the user what \"it\" was. At first the program will \nnot play well, but each time it plays, it will remember the user's replies and use them \nfor subsequent guesses. \n\n\f\n<a id='page-81'></a>\n3.11 Overview of Data Types \nThis chapter has been organized around functions, with similar functions grouped \ntogether. But there is another way of organizing the Common Lisp world: by considering \nthe different data types. This is useful for two reasons. First, it gives an \nalternative way of seeing the variety of available functionality. Second, the data types \nthemselves are objects in the Common Lisp language, and as we shall see, there are \nfunctions that manipulate data types. These are useful mainly for testing objects (as \nwith the typecase macro) and for making declarations. \n\nHere is a table of the most commonly used data types: \n\nType Example Explanation \ncharacter #\\c A single letter, number, or punctuation mark. \nnumber 42 The most common numbers are floats and integers. \nfloat 3.14159 A number with a decimal point. \ninteger 42 A whole number, of either fixed or indefinite size: \nfixnum 123 An integer that fits in a single word of storage. \nbignum 123456789 An integer of unbounded size. \nfunction #'sin A function can be applied to an argument list. \nsymbol sin Symbols can name fns and vars, and are themselves objects. \nnull nil The object ni 1 is the only object of type null. \nkeyword :key Keywords are a subtype of symbol. \nsequence (a b c) Sequences include lists and vectors. \nlist (a b c) A list is either a cons or nul 1. \nvector #(a b c) A vector is a subtype of sequence. \ncons (a b c) A cons is a non-nil list. \natom t An atom is anything that is not a cons. \nstring \"abc\" A string is a type of vector of characters. \narray #lA(a b c) Arrays include vectors and higher-dimensional arrays. \nstructure #S(type ... ) Structures are defined by defstruct. \nhash-table Hash tables are created by make-hash-tabl e. \n\nAlmost every data type has a recognizer predicate—a function that returns true \nfor only elements of that type. In general, a predicate is a function that always \nreturns one of two values: true or false. In Lisp, the false value is ni 1 , and every \nother value is considered true, although the most common true value is t. In most \ncases, the recognizer predicate's name is composed of the type name followed by \n\np:characterp recognizes characters, numberp recognizes numbers, and so on. For \nexample, (numberp 3) returns t because 3 is a number, but (numberp \"x\") returns \n.i 1 because \".\" is a string, not a number. \nUnfortunately, Common Lisp is not completely regular. There are no recognizers \nfor fixnums, bignums, sequences, and structures. Two recognizers, nul 1 and atom, \ndo not end in p. Also note that there is a hyphen before the . in hash-table-p, \nbecause the type has a hyphen in it. In addition, all the recognizers generated by \ndefstruct have a hyphen before the p. \n\n\f\n<a id='page-82'></a>\n\nThe function type - of returns the type of its argument, and typep tests if an object \nis of a specified type. The function subtypep tests if one type can be determined to \nbe a subtype of another. For example: \n\n> (type-of 123) ^ FIXNUM \n\n> (typep 123 'fixnum) . \n\n> (typep 123 'number) . \n\n> (typep 123 'integer) => . \n\n> (typep 123.0 'integer) ^ NIL \n\n> (subtypep 'fixnum 'number) => . \n\nThe hierarchy of types is rather complicated in Common Lisp. As the prior example \nshows, there are many different numeric types, and a number like 123 is considered \nto be of type fixnum, integer, and number. We will see later that it is also of type \nrational andt. \n\nThe type hierarchy forms a graph, not just a tree. For example, a vector is both \na sequence and an array, although neither array nor sequence are subtypes of each \nother. Similarly, nul 1 is a subtype of both symbol and 1 i st. \n\nThe following table shows a number of more specialized data types that are not \nused as often: \n\nType Example Explanation \n\nt 42 Every object is of type t. \n\nnil No object is of type nil. \n\ncomplex #C(0 1) Imaginary numbers. \n\nbit 0 Zero or one. \n\nrational 2/3 Rationals include integers and ratios. \n\nratio 2/3 Exact fractional numbers. \n\nsimple-array #lA(x y) An array that is not displaced or adjustable. \nreadtable A mapping from characters to their meanings to read. \n\npackage A collection of symbols that form a module. \n\npathname #P'7usr/spool/mail\" A file or directory name. \n\nstream A pointer to an open file; used for reading or printing. \nrandom-state A state used as a seed by random. \n\nIn addition, there are even more specialized types, such as s ho r t -f 1 oa t, comp i 1 ed f \nuncti on, and bi t-vector. It is also possible to construct more exact types, such as \n(vector (integer 0 3) 100), which represents a vector of 100 elements, each of \nwhich is an integer from 0 to 3, inclusive. Section 10.1 gives more information on \ntypes and their use. \n\nWhile almost every type has a predicate, it is also true that there are predicates \nthat are not type recognizers but rather recognize some more general condition. For \n\n\f\n<a id='page-83'></a>\nexample, oddp is true only of odd integers, and stri ng-greaterp is true if one string \nis alphabetically greater than another. \n\n3.12 Input/Output \nInput in Lisp is incredibly easy because a complete lexical and syntactic parser is \navailable to the user. The parser is called read. It is used to read and return a single \nLisp expression. If you can design your application so that it reads Lisp expressions, \nthen your input worries are over. Note that the expression parsed by read need not \nbe a legal evaluable Lisp expression. That is, you can read (\"hello\" cons zzz) just \nas well as (+ 2 2). In cases where Lisp expressions are not adequate, the function \nread-char reads a single character, and read-1 i ne reads everything up to the next \nnewline and returns it as a string. \n\nTo read from the terminal, the functions read, read-char, or read-line (with \nno arguments) return an expression, a character, and a string up to the end of line, \nrespectively. It is also possible to read from a file. The function open or the macro \nwith-open-stream can be used to open a file and associate it with a stream, Lisp's \nname for a descriptor of an input/output source. All three read functions take three \noptional arguments. The first is the stream to read from. The second, if true, causes \nan error to be signaled at end of file. If the second argument is nil, then the third \nargument indicates the value to return at end of file. \n\nOutput in Lisp is similar to output in other languages, such as C. There are a \nfew low-level functions to do specific kinds of output, and there is a very general \nfunction to do formatted output. The function print prints any object on a new line, \nwith a space following it. pri nl will print any object without the new line and space. \nFor both functions, the object is printed in a form that could be processed by read. \nForexample, the string \"hello there\" would print as \"hello there\". Thefunction \n.r i.c is used to print in a human-readable format. The string in question would print \nas hel1 o there with pri nc—the quote marks are not printed. This means that read \ncannot recover the original form; read would interpret it as two symbols, not one \nstring. The function wri te accepts eleven different keyword arguments that control \nwhether it acts like pri nl or pri .c, among other things. \n\nThe output functions also take a stream as an optional argument. In the following, \nwe create the file \"test.text\" and print two expressions to it. Then we open the \nfile for reading, and try to read back the first expression, a single character, and then \ntwo more expressions. Note that the read-char returns the character #\\G, so the \nfollowing read reads the characters OODBYE and turns them into a symbol. The final \nread hits the end of file, and so returns the specified value, eof. \n\n\f\n<a id='page-84'></a>\n\n> (with-open-file (stream \"test.text\" idirectlon :output) \n(print '(hello there) stream) \n(princ 'goodbye stream)) \n\nGOODBYE ; and creates the file test.text \n\n> (with-open-file (stream \"test.text\" idirection .-input) \n(list (read stream) (read-char stream) (read stream) \n(read stream nil 'eof))) ^ \n((HELLO THERE) #\\G OODBYE EOF) \n\nThe function terpri stands for \"terminate print line,\" and it skips to the next line. \nThe function fresh -1 i ne also skips to the next line, unless it can be determined that \nthe output is already at the start of a line. \n\nCommon Lisp also provides a very general function for doing formatted output, \ncalled format. The first argument to format is always the stream to print to; use \nt to print to the terminal. The second argument is the format string. It is printed \nout verbatim, except for format directives, which begin with the character \" ~\". These \ndirectives tell how to print out the remaining arguments. Users of C's pri ntf function \nor FORTRAN'S format statement should be familiar with this idea. Here's \nan example: \n\n> (format t \"hello, world\") \nhello, world \nNIL \n\nThings get interesting when we put in additional arguments and include format \ndirectives: \n\n> (format t \"~ra plus -^s is ~f\" \"two\" \"two\" 4) \ntwo plus \"two\" is 4.0 \nNIL \n\nThedirective \"~&\" moves to a fresh line, \"~a\" printsthenextargumentas pri no would, \n\" ~ s\" prints the next argument as . r i .1 would, and \" ~ f\" prints a number in floatingpoint \nformat. If the argument is not a number, then princ is used, format always \nreturns nil. There are 26 different format directives. Here's a more complex example: \n\n> (let ((numbers '(12 3 4 5))) \n(format t \"~&~{~r~\" plus \"} is ~@r\" \n\nnumbers (apply #'+ numbers))) \none plus two plus three plus four plus five is XV \nNIL \n\nThe directive \"~r\" prints the next argument, which should be a number, in English, \n\n\f\n<a id='page-85'></a>\nand \" ~@.\" prints a number as a roman numeral. The compound directive \" ~{...\"}\" \ntakes the next argument, which must be a list, and formats each element of the list \naccording to the format string inside the braces. Finally, the directive exits \nfrom the enclosing \"''i...\"}\" loop if there are no more arguments. You can see that \nformat, like 1 oop, comprises almost an entire programming language, which, also \nlike 1 oop, is not a very Lisplike language. \n\n3.13 Debugging Tools \nIn many languages, there are two strategies for debugging: (1) edit the program to \ninsert print statements, recompile, and try again, or (2) use a debugging program to \ninvestigate (and perhaps alter) the internal state of the running program. \n\nCommon Lisp admits both these strategies, but it also offers a third: (3) add \nannotations that are not part of the program but have the effect of automatically \naltering the running program. The advantage of the third strategy is that once \nyou are done you don't have to go back and undo the changes you would have \nintroduced in the first strategy. In addition, Common Lisp provides functions that \ndisplay information about the program. You need not rely solely on looking at the \nsource code. \n\nWe have already seen how trace and untrace can be used to provide debugging \ninformation ([page 65](chapter3.md#page-65)). Another useful tool is st e p, which can be used to halt execution \nbefore each subform is evaluated. The form (step expression) will evaluate and return \nexpression, but pauses at certain points to allow the user to inspect the computation, \nand possibly change things before proceeding to the next step. The commands \navailable to the user are implementation-dependent, but typing a ? should give you \na list of commands. As an example, here we step through an expression twice, the \nfirst time giving commands to stop at each subevaluation, and the second time giving \ncommands to skip to the next function call. In this implementation, the commands \nare control characters, so they do not show up in the output. All output, including \nthe symbols <= and => are printed by the stepper itself; I have added no annotation. \n\n> (step (+ 3 4 (* 5 6 (/ 7 8)))) \n\n<i= (+ 3 4 (* 5 6 (/ 7 8))) \n\n<i= 4 =i> 4 \n<^ (* 5 6 (/ 7 8)) \n<^ 5 ^ 5 \n\n<^ (/ 7 8) \n7 7 \n8 => 8 \n\n^ (/ 7 8) 7/8 \n\n\f\n<a id='page-86'></a>\n\n^ (* 5 6 (/ 7 8)) 105/4 \n<^ (+ 3 4 (* 5 6 (/ 7 8))) ^ 133/4 \n133/4 \n\n> (step (+ 3 4 (* 5 6 (/ 7 8)))) \n\n^ (+ 3 4 (* 5 6 (/ 7 8))) \n/: 7 8 => 7/8 \n*: 5 6 7/8 105/4 \n+: 3 4 105/4 133/4 \n\n(+ 3 4 (* 5 6 (/ 7 8))) => 133/4 \n133/4 \n\nThe functions descri be, i nspect, documentati on, and apropos provide information \nabout the state of the current program, apropos prints information about all symbols \nwhose name matches the argument: \n\n> (apropos 'string ) \nMAKE-STRING function (LENGTH &KEY INITIAL-ELEMENT) \nPRINl-TO-STRING function (OBJECT) \nPRINC-TO-STRING function (OBJECT) \nSTRING function (X) \n\nOnce you know what obj ect you are interested in, des c r i be can give more information \non it: \n\n> (describe 'make-string) \nSymbol MAKE-STRING is in LISP package. \nThe function definition is #<FUNCTION MAKE-STRING -42524322>: \n\nNAME: MAKE-STRING \nARGLIST: (LENGTH &KEY INITIAL-ELEMENT) \nDOCUMENTATION: \"Creates and returns a string of LENGTH elements, \n\nall set to INITIAL-ELEMENT.\" \nDEFINITION: (LAMBDA (LENGTH &KEY INITIAL-ELEMENT) \n(MAKE-ARRAY LENGTH :ELEMENT-TYPE 'CHARACTER \n:INITIAL-ELEMENT (OR INITIAL-ELEMENT \n\n#\\SPACE))) \nMAKE-STRING has property INLINE: INLINE \nMAKE-STRING has property :SOURCE-FILE: #P\"SYS:KERNEL; STRINGS\" \n\n> (describe 1234.56) \n1234.56 is a single-precision floating-point number. \nSign 0, exponent #o211. 23-bit fraction #06450754 \n\nIf all you want is a symbol's documentation string, the function documentati on will \ndo the trick: \n\n\f\n<a id='page-87'></a>\n\n> (documentation 'first 'function) => \"Return the first element of LIST.' \n> (documentation 'pi 'variable) => \"pi\" \n\nIf you want to look at and possibly alter components of a complex structure, \nthen i nspect is the tool. In some implementations it invokes a fancy, window-based \nbrowser. \n\nCommon Lisp also provides a debugger that is entered automatically when an \nerror is signalled, either by an inadvertant error or by deliberate action on the part \nof the program. The details of the debugger vary between implementations, but \nthere are standard ways of entering it. The function break enters the debugger \nafter printing an optional message. It is intended as the primary method for setting \ndebugging break points, break is intended only for debugging purposes; when a \nprogram is deemed to be working, all calls to break should be removed. However, \nit is still a good idea to check for unusual conditions with error, cerror, assert, or \ncheck -type, which will be described in the following section. \n\n3.14 Antibugging Tools \nIt is a good idea to include antibugging checks in your code, in addition to doing normal \ndebugging. Antibugging code checks for errors and possibly takes corrective action. \n\nThe functions error and cerror are used to signal an error condition. These are \nintended to remain in the program even after it has been debugged. The function \nerror takes a format string and optional arguments. It signals a fatal error; that is, it \nstops the program and does not offer the user any way of restarting it. For example: \n\n(defun average (numbers) \n\n(if (null numbers) \n(error \"Average of the empty list is undefined.\") \n(/ (reduce #'+ numbers) \n\n(length numbers)))) \n\nIn many cases, a fatal error is a little drastic. The function cerror stands for continuable \nerror, cerror takes two format strings; the first prints a message indicating \nwhat happens if we continue, and the second prints the error message itself, cerror \ndoes not actually take any action to repair the error, it just allows the user to signal \nthat continuing is alright. In the following implementation, the user continues by \ntyping : conti nue. In ANSI Common Lisp, there are additional ways of specifying \noptions for continuing. \n\n\f\n<a id='page-88'></a>\n\n(defun average (numbers) \n(if (null numbers) \n(progn \n(cerror \"Use 0 as the average.\" \n\"Average of the empty list is undefined.\") \n0) \n(/ (reduce #'+ numbers) \n(length numbers)))) \n\n> (average '()) \nError: Average of the empty list is undefined. \nError signaled by function AVERAGE. \nIf continued: Use 0 as the average. \n> :continue \n0 \n\nIn this example, adding error checking nearly doubled the length of the code. This \nis not unusual; there is a big difference between code that works on the expected \ninput and code that covers all possible errors. Common Lisp tries to make it easier \nto do error checking by providing a few special forms. The form ecase stands for \n\"exhaustive case\" or \"error case.\" It is like a normal case form, except that if none \nof the cases are satisfied, an error message is generated. The form cease stands for \n\"continuable case.\" It is like ecase, except that the error is continuable. The system \nwill ask for a new value for the test object until the user supplies one that matches \none of the programmed cases. \n\nTo make it easier to include error checks without inflating the length of the code \ntoo much. Common Lisp provides the special forms check-type and assert. As \nthe name implies, check-type is used to check the type of an argument. It signals a \ncontinuable error if the argument has the wrong type. For example: \n\n(defun sqr (x) \n\"Multiply . by itself.\" \n(check-type . number) \n\n(* X X)) \n\nIf s qr is called with a non-number argument, an appropriate error message is printed: \n\n> (sqr \"hello\") \nError: the argument X was \"hello\", which is not a NUMBER. \nIf continued: replace X with new value \n> :continue 4 \n16 \n\nassert is more general than check-type. In the simplest form, assert tests an \n\n\f\n<a id='page-89'></a>\nexpression and signals an error if it is false. For example: \n\n(defun sqr (x) \n\"Multiply X by itself.\" \n(assert (numberp x)) \n\n(* X X)) \n\nThere is no possibility of continuing from this kind of assertion. It is also possible to \ngive assert a list of places that can be modified in an attempt to make the assertion \ntrue. In this example, the variable . is the only thing that can be changed: \n\n(defun sqr (x) \n\"Multiply X by itself.\" \n(assert (numberp x) (x)) \n\n(* X X)) \n\nIf the assertion is violated, an error message will be printed and the user will be given \nthe option of continuing by altering x. If . is given a value that satisfies the assertion, \nthen the program continues, assert always returns nil. \n\nFinally, the user who wants more control over the error message can provide \na format control string and optional arguments. So the most complex syntax for \nassert is: \n\n(assert test-form (place...) format-ctl-string format-arg...) \n\nHere is another example. The assertion tests that the temperature of the bear's \nporridge is neither too hot nor too cold. \n\n(defun eat-porridge (bear) \n\n(assert (< too-cold (temperature (bear-porridge bear)) too-hot) \n(bear (bear-porridge bear)) \n\"~a's porridge is not just right: ~a\" \nbear (hotness (bear-porridge bear))) \n\n(eat (bear-porridge bear))) \n\nIn the interaction below, the assertion failed, and the programmer's error message \nwas printed, along with two possibilities for continuing. The user selected one, typed \nin a call to make - por r i dge for the new value, and the function succesfully continued. \n\n\f\n<a id='page-90'></a>\n\n> (eat-porridge momma-bear) \nError: #<MOMMA BEAR>*s porridge is not just right: 39 \nRestart actions (select using :continue): \n\n0: Supply a new value for BEAR \n1: Supply a new value for (BEAR-PORRIDGE BEAR) \n> :continue 1 \nForm to evaluate and use to replace (BEAR-PORRIDGE BEAR): \n(make-porridge :temperature just-right) \nnil \nIt may seem like wasted effort to spend time writing assertions that (if all goes well) \nwill never be used. However, for all but the perfect programmer, bugs do occur, and \nthe time spent antibugging will more than pay for itself in saving debugging time. \n\nWhenever you develop a complex data structure, such as some kind of data base, \nit is a good idea to develop a corresponding consistency checker. A consistency \nchecker is a function that will look over a data structure and test for all possible \nerrors. When a new error is discovered, a check for it should be incorporated into \nthe consistency checker. Calling the consistency checker is the fastest way to help \nisolate bugs in the data structiu-e. \n\nIn addition, it is a good idea to keep a list of difficult test cases on hand. That \nway, when the program is changed, it will be easy to see if the change reintroduces \na bug that had been previously removed. This is called regression testing, and Waters \n(1991) presents an interesting tool for maintaining a suite of regression tests. But it \nis simple enough to maintain an informal test suite with a function that calls assert \non a series of examples: \n\n(defun test-ex () \n\"Test the program EX on a series of examples.\" \n(i nit-ex) ; Initialize the EX program first, \n(assert (equal (ex 3 4) 5)) \n(assert (equal (ex 5 0) 0)) \n(assert (equal (ex *x 0) 0))) \n\nTiming Tools \n\nA program is not complete just because it gives the right output. It must also deliver \nthe output in a timely fashion. The form (t i me expression) can be used to see how \nlong it takes to execute expression. Some implementations also print statistics on the \namount of storage required. For example: \n\n> (defun f (n) (dotimes (i n) nil)) => F \n\n\f\n<a id='page-91'></a>\n> (time (f 10000)) => NIL \nEvaluation of (F 10000) took 4.347272 Seconds of elapsed time, \nincluding 0.0 seconds of paging time for 0 faults, Consed 27 words. \n\n> (compile 'f) => F \n\n> (time (f 10000)) NIL \nEvaluation of (F 10000) took 0.011518 Seconds of elapsed time, \nincluding 0.0 seconds of paging time for 0 faults, Consed 0 words. \n\nThis shows that the compiled version is over 300 times faster and uses less storage \nto boot. Most serious Common Lisp programmers work exclusively with compiled \nfunctions. However, it is usually a bad idea to worry too much about efficiency details \nwhile starting to develop a program. It is better to design a flexible program, get it to \nwork, and then modify the most frequently used parts to be more efficient. In other \nwords, separate the development stage from the fine-tuning stage. Chapters 9 and \n10 give more details on efficiency consideration, and chapter 25 gives more advice \non debugging and antibugging techniques. \n\n3.15 Evaluation \nThere are three functions for doing evaluation in Lisp: funcall, apply, and eval. \nfuncall is used to apply a function to individual arguments, while apply is used \nto apply a function to a list of arguments. Actually, apply can be given one or \nmore individual arguments before the final argument, which is always a Ust. eval \nis passed a single argument, which should be an entire form-a function or special \nform followed by its arguments, or perhaps an atom. The following five forms are \nequivalent: \n\n> (+ 1 2 3 4) 10 \n> (funcall #'+12 3 4) ^ 10 \n> (apply #'+ '(1 2 3 4))=^ 10 \n> (apply #.+ 1 2 '(3 4)) => 10 \n> (eval '(+12 3 4)) => 10 \n\nIn the past, eval was seen as the key to Lisp's flexibility. In modern Lisps with lexical \nscoping, such as Common Lisp, eval is used less often (in fact, in Scheme there is \nno eval at all). Instead, programmers are expected to use 1 ambda to create a new \nfunction, and then apply or funcall the function. In general, if you find yourself \nusing eval, you are probably doing the wrong thing. \n\n\f\n<a id='page-92'></a>\n\n3.16 Closures \nWhat does it mean to create a new function? Certainly every time a function (or #') \nspecial form is evaluated, a function is returned. But in the examples we have seen \nand in the following one, it is always the same function that is returned. \n\n> (mapcar #'(1ambda (x) (+ . .)) '(1 3 10)) =4>(2 6 20) \n\nEvery time we evaluate the # * (1 ambda ...) form, it returns the function that doubles \nits argument. However, in the general case, a function consists of the body of the \nfunction coupled with any free lexical vanables that the function references. Such a \npairing is called a lexical closure, or just a closure, because the lexical variables are \nenclosed within the function. Consider this example: \n\n(defun adder (c) \n\"Return a function that adds c to its argument.\" \n#'(lambda (x) (+ . c))) \n\n> (mapcar (adder 3) '(1 3 10)) =^(4 6 13) \n\n> (mapcar (adder 10) '(1 3 10)) ^ (11 13 20) \n\nEach time we call adder with a different value for c, it creates a different function, \nthe function that adds c to its argument. Since each call to adder creates a new local \nvariable named c, each function returned by adder is a unique function. \n\nHere is another example. The function bank-account returns a closure that can \nbe used as a representation of a bank account. The closure captures the local variable \nbalance. The body of the closure provides code to access and modify the local \nvariable. \n\n(defun bank-account (balance) \n\"Open a bank account starting with the given balance.\" \n#'(lambda (action amount) \n\n(case action \n(deposit (setf balance (->' balance amount))) \n(withdraw (setf balance (- balance amount)))))) \n\nIn the following, two calls to bank-account create two different closures, each with \na separate value for the lexical variable bal a nee. The subsequent calls to the two \nclosures change their respective balances, but there is no confusion between the two \naccounts. \n\n> (setf my-account (bank-account 500.00)) => #<CLOSURE 52330407> \n\n\f\n<a id='page-93'></a>\n> (setf your-account (bank-account 250.00)) ^ #<CLOSURE 52331203> \n\n> (funcall my-account 'withdraw 75.00) 425.0 \n\n> (funcall your-account 'deposit 250.00) ^ 500.0 \n\n> (funcall your-account 'withdraw 100.00) 400.0 \n\n> (funcall my-account 'withdraw 25.00) => 400.0 \n\nThis style of programming will be considered in more detail in chapter 13. \n\n3.17 Special Variables \nCommon Lisp provides for two kinds of variables: lexical and special variables. For \nthe beginner, it is tempting to equate the special variables in Common Lisp with \nglobal variables in other languages. Unfortunately, this is not quite correct and can \nlead to problems. It is best to understand Common Lisp variables on their own terms. \n\nBy default. Common Lisp variables are lexical variables. Lexical variables are \nintroduced by some syntactic construct like let or defun and get their name from the \nfact that they may only be referred to by code that appears lexically within the body \nof the syntactic construct. The body is called the scope of the variable. \n\nSo far, there is no difference between Common Lisp and other languages. The \ninteresting part is when we consider the extent, or lifetime, of a variable. In other \nlanguages, the extent is the same as the scope: a new local variable is created when a \nblock is entered, and the variable goes away when the block is exited. But because it \nis possible to create new functions—closures—in Lisp, it is therefore possible for code \nthat references a variable to live on after the scope of the variable has been exited. \nConsider again the bank-account function, which creates a closure representing a \nbank account: \n\n(defun bank-account (balance) \n\n\"Open a bank account starting with the given balance.\" \n\n#'(lambda (action amount) \n\n(case action \n\n(deposit (setf balance (+ balance amount))) \n\n(withdraw (setf balance (- balance amount)))))) \n\nThe function introduces the lexical variable bal anee. The scope of bal anee is the \nbody of the function, and therefore references to bal anee can occur only within this \nscope. What happens when ba. k -a ccount is called and exited? Once the body of the \nfunction has been left, no other code can refer to that instance of bal anee. The scope \nhas been exited, but the extent of bal anee lives on. We can call the closure, and it \n\n\f\n<a id='page-94'></a>\n\ncan reference bal anee, because the code that created the closure appeared lexically \nwithin the scope of bal anee. \n\nIn summary. Common Lisp lexical variables are different because they can be \ncaptured inside closures and referred to even after the flow of control has left their \nscope. \n\nNow we will consider special variables. A variable is made special by a def va r or \ndefparameter form. For example, if we say \n\n(defvar *counter* 0) \n\nthen we can refer to the special variable ^counter* anywhere in our program. This \nis just like a familiar global variable. The tricky part is that the global binding of \n*counter* can be shadowed by a local binding for that variable. In most languages, \nthe local binding would introduce a local lexical variable, but in Common Lisp, special \nvariables can be bound both locally and globally. Here is an example: \n\n(defun report () \n(format t \"Counter = '^d \" *counter*)) \n\n> (report) \nCounter = 0 \nNIL \n\n> (let ((*counter* 100)) \n\n(report)) \nCounter = 100 \nNIL \n\n> (report) \nCounter = 0 \nNIL \n\nThere are three calls to report here. In the first and third, report prints the global \nvalue of the special variable ^counter*. In the second call, the let form introduces \na new binding for the special variable ^counter*, which is again printed by report. \nOnce the scope of the let is exited, the new binding is disestablished, so the final \ncall to report uses the global value again. \n\nIn summary. Common Lisp special variables are different because they have \nglobal scope but admit the possibility of local (dynamic) shadowing. Remember: \nA lexical variable has lexical scope and indefinite extent. A special variable has \nindefinite scope and dynamic extent. \n\nThe function call (symbol - value var), where var evaluates to a symbol, can be \nused to get at the current value of a special variable. To set a special variable, the \nfollowing two forms are completely equivalent: \n\n\f\n<a id='page-95'></a>\n(setf (symbol-valuePflr) t7fl/Me) \n\n(set var value) \n\nwhere both var and value are evaluated. There are no corresponding forms for \naccessing and setting lexical variables. Special variables set up a mapping between \nsymbols and values that is accessible to the running program. This is unlike lexical \nvariables (and all variables in traditional languages) where symbols (identifiers) \nhave significance only while the program is being compiled. Once the program is \nrunning, the identifiers have been compiled away and cannot be used to access the \nvariables; only code that appears within the scope of a lexical variable can reference \nthat variable. \n\n&#9635; Exercise 3.6 [s] Given the following initialization for the lexical variable a and the \nspecial variable *b*, what will be the value of the let form? \n\n(setf a 'global-a) \n(defvar *b* 'global-b) \n\n(defun fn () *b*) \n\n(let ((a 'local-a) \n(*b* 'local-b)) \n(list a *b* (fn) (symbol-value 'a) (symbol-value'*b*))) \n\n3.18 Multiple Values \nThroughout this book we have spoken of \"the value returned by a function.\" Historically, \nLisp was designed so that every function returns a value, even those functions \nthat are more like procedures than like functions. But sometimes we want a single \nfunction to return more than one piece of information. Of course, we can do that by \nmaking up a list or structure to hold the information, but then we have to go to the \ntrouble of defining the structure, building an instance each time, and then taking that \ninstance apart to look at the pieces. Consider the function round. One way it can be \nused is to round off a floating-point number to the nearest integer. So (round 5.1) is \n\n5. Sometimes, though not always, the programmer is also interested in the fractional \npart. The function round serves both interested and disinterested programmers by \nreturning two values: the rounded integer and the remaining fraction: \n> (round 5.1) 5 .1 \n\nThere are two values after the => because round returns two values. Most of the time. \n\n\f\n<a id='page-96'></a>\n\nmultiple values are ignored, and only the first value is used. So (* 2 (round 5.1)) \nis 10, just as if round had only returned a single value. If you want to get at multiple \nvalues, you have to use a special form, such as mul ti pi e-val ue-bi nd: \n\n(defun show-both (x) \n(multiple-value-bind (int rem) \n(round x) \n(format t \"~f = ~d + ~f\" . int rem))) \n\n> (show-both 5.1) \n5.1 = 5 + 0.1 \n\nYou can write functions of your own that return multiple values using the function \nval ues, which returns its arguments as multiple values: \n\n> (values 1 2 3) =i> 1 2 3 \n\nMultiple values are a good solution because they are unobtrusive until they are \nneeded. Most of the time when we are using round, we are only interested in the \ninteger value. If round did not use multiple values, if it packaged the two values up \ninto a list or structure, then it would be harder to use in the normal cases. \n\nIt is also possible to return no values from a function with (values). This is \nsometimes used by procedures that are called for effect, such as printing. For \nexample, descri be is defined to print information and then return no values: \n\n> (describe '.) \nSymbol X is in the USER package. \nIt has no value, definition or properties. \n\nHowever, when (val ues) or any other expression returning no values is nested in \na context where a value is expected, it still obeys the Lisp rule of one-value-per-\nexpression and returns nil. In the following example, descri be returns no values, \nbut then 1 i st in effect asks for the first value and gets nil. \n\n> (list (describe 'x)) \nSymbol X is in AI LP package. \nIt has no value, definition or properties. \n(NIL) \n\n\f\n<a id='page-97'></a>\n3.19 More about Parameters \nCommon Lisp provides the user with a lot of flexibility in specifying the parameters \nto a function, and hence the arguments that the function accepts. Following is a \nprogram that gives practice in arithmetic. It asks the user a series of . problems, \nwhere each problem tests the arithmetic operator op (which can be +, -, *, or /, or \nperhaps another binary operator). The arguments to the operator will be random \nintegers from 0 to range. Here is the program: \n\n(defun math-quiz (op range n) \n\"Ask the user a series of math problems.\" \n(dotimes (i .) \n\n(problem (random range) op (random range)))) \n\n(defun problem (x op y) \n\"Ask a math problem, read a reply, and say if it is correct.\" \n(format t \"~&How much is ~d ~a ~d?\" . op y) \n(if (eql (read) (funcall op . y)) \n\n(princ \"Correct!\") \n\n(princ \"Sorry, that's not right.\"))) \n\nand here is an example of its use: \n\n> (math-quiz '+ 100 2) \n\nHow much is 32 + 60? 92 \n\nCorrect! \n\nHow much is 91 + 19? 100 \n\nSorry, that's not right. \n\nOne problem with the function math-qui . is that it requires the user to type three \narguments: the operator, a range, and the number of iterations. The user must \nremember the order of the arguments, and remember to quote the operator. This is \nquite a lot to expect from a user who presumably is just learning to add! \n\nCommon Lisp provides two ways of dealing with this problem. First, a programmer \ncan specify that certain arguments are optional, and provide default values for \nthose arguments. For example, in math- qui . we can arrange to make be the default \noperator, 100 be the default number range, and 10 be the default number of examples \nwith the following definition: \n\n\f\n<a id='page-98'></a>\n\n(defun math-quiz (&optional (op ''.-) (range 100) (n 10)) \n\n\"Ask the user a series of math problems.\" \n\n(dotimes (i n) \n\n(problem (random range) op (random range)))) \n\nNow (math-quiz) means the same as (math-quiz '+ 100 10). If an optional \nparameter appears alone without a default value, then the default is ni 1. Optional \nparameters are handy; however, what if the user is happy with the operator and \nrange but wants to change the number of iterations? Optional parameters are still \nposition-dependent, so the only solution is to type in all three arguments: (ma th - qui. \n\n100 5). \n\nCommon Lisp also allows for parameters that are position-independent. These \nkeyword parameters are explicitly named in the function call. They are useful when \nthere are a number of parameters that normally take default values but occasionally \nneed specific values. For example, we could have defined math- qui . as: \n\n(defun math-quiz (&key (op '+) (range 100) (n 10)) \n\n\"Ask the user a series of math problems.\" \n\n(dotimes (i n) \n\n(problem (random range) op (random range)))) \n\nNow (math-quiz :n 5) and (math-quiz :op '+ :n 5 -.range 100) mean the same. \nKeyword arguments are specified by the parameter name preceded by a colon, and \nfollowed by the value. The keyword/value pairs can come in any order. \n\nA symbol starting with a colon is called a keyword, and can be used anywhere, \nnot just in argument lists. The term keyword is used differently in Lisp than in many \nother languages. For example, in Pascal, keywords (or reserved words) are syntactic \nsymbols, like if, el se, begin, and end. In Lisp we call such symbols special form \noperators or just special forms. Lisp keywords are symbols that happen to reside in \nthe keyword package.\"^ They have no special syntactic meaning, although they do \nhave the unusual property of being self-evaluating: they are constants that evaluate \nto themselves, unlike other symbols, which evaluate to whatever value was stored in \nthe variable named by the symbol. Keywords also happen to be used in specifying \n&key argument lists, but that is by virtue of their value, not by virtue of some syntax \nrule. It is important to remember that keywords are used in the function call, but \nnormal nonkeyword symbols are used as parameters in the function definition. \n\nJust to make things a little more confusing, the symbols &opti onal, &rest, and \n&key are called lambda-list keywords, for historical reasons. Unlike the colon in real \nkeywords, the & in lambda-list keywords has no special significance. Consider these \nannotated examples: \n\nApackage is a symbol table: a mapping between strings and the symbols they name. \n\n\f\n<a id='page-99'></a>\n> :xyz => :XYZ ;keywords are self-evaluating \n\n> &optional => ; lambda-list keywords are normal symbols \n\nError: the symbol &optional has no value \n\n> '&optional &OPTIONAL \n\n> (defun f (&xyz) (+ &xyz &xyz)) F ;& has no significance \n\n> (f 3) =. 6 \n\n> (defun f (:xyz) (+ :xyz :xyz)) ^ \n\nError: the keyword :xyz appears in a variable list. \n\nKeywords are constants, and so cannot be used as names of variables. \n\n> (defun g (&key . y) (list . y)) G \n\n> (let ((keys *(:x :y :z))) ;keyword args can be computed \nig (second keys) 1 (first keys) 2)) => (2 1) \n\nMany of the functions presented in this chapter take keyword arguments that make \nthem more versatile. For example, remember the function f i nd, which can be used \nto look for a particular element in a sequence: \n\n> (find 3 *(1 2 3 4 -5 6.0)) => 3 \n\nIt turns out that find takes several optional keyword arguments. For example, \nsuppose we tried to find 6 in this sequence: \n\n> (find 6 '(1 2 3 4 -5 6.0)) nil \n\nThis fails because f i nd tests for equality with eql, and 6 is not eql to 6.0. However, \n6 is equal . to 6.0, so we could use the : test keyword: \n\n> (find 6 '(1 2 3 4 -5 6.0) :test #'equalp) ^ 6.0 \n\nIn fact, we can specify any binary predicate for the : test keyword; it doesn't have to \nbe an equality predicate. For example, we could find the first number that 4 is less \nthan: \n\n> (find 4 '(1 2 3 4 -5 6.0) :test #*<) 6.0 \n\nNow suppose we don't care about the sign of the numbers; if we look for 5, we want \nto find the - 5. We can handle this with the key keyword to take the absolute value of \neach element of the list with the abs function: \n\n\f\n<a id='page-100'></a>\n\n> (find 5 '(1 2 3 4 -5 6.0) ikey #'abs) -5 \n\nKeyword parameters significantly extend the usefulness of built-in functions, and \nthey can do the same for functions you define. Among the built-in functions, the most \ncommon keywords fall into two main groups: :tes t,:tes t - not and : key, which are \nused for matching functions, and : start, :end, and :from-end, which are used on \nsequence functions. Some functions accept both sets of keywords. {Common Lisp the \nLanguage, 2d edition, discourages the use of :test -not ke3words, although they are \nstill a part of the language.) \n\nThe matching functions include sub! i s, posi ti on, subst, uni on, i ntersecti on, \nset -difference, remove, remove-if, subsetp, assoc, find, and member. By default, \neach tests if some item is eql to one or more of a series of other objects. This test can \nbe changed by supplying some other predicate as the argument to : test, or it can be \nreversed by specifying :tes t - not. In addition, the comparison can be made against \nsome part of the object rather than the whole object by specifying a selector function \nas the : key argument. \n\nThe sequence functions include remove, remove-if, position, and find. The \nmost common type of sequence is the list, but strings and vectors can also be used as \nsequences. A sequence function performs some action repeatedly for some elements \nof a sequence. The default is to go through the sequence from beginning to end, but \nthe reverse order can be specified with : from-end t, and a subsequence can be \nspecifed by supplying a number for the : sta rt or : end keyword. The first element \nof a sequence is numbered 0, not 1, so be careful. \n\nAs an example of keyword parameters, suppose we wanted to write sequence \nfunctions that are similar to find and find-if, except that they return a list of all \nmatching elements rather than just the first matching element. We will call the \nnew functions f i nd-a 11 and f i nd-a. - i f. Another way to look at these functions \nis as variations of remove. Instead of removing items that match, they keep all the \nitems that match, and remove the ones that don't. Viewed this way, we can see \nthat the function f i nd-a 11 - i f is actually the same function as remove- i f -not. It is \nsometimes useful to have two names for the same function viewed in different ways \n(like not and nul 1). The new name could be defined with a defun, but it is easier to \njust copy over the definition: \n\n(setf (symbol-function 'find-all-if) #'remove-if-not) \n\nUnfortunately, there is no built-in function that corresponds exactly to f i nd-a 11, so \nwe will have to define it. Fortunately, remove can do most of the work. All we have \nto do is arrange to pass remove the complement of the : test predicate. For example, \nfinding all elements that are equal to 1 in a list is equivalent to removing elements \nthat are not equal to 1: \n\n\f\n<a id='page-101'></a>\n> (setf nums '(1 2 3 2 D) (1 2 3 2 1) \n\n> (find-all 1 nums :test #'=) = (remove 1 nums rtest #V=) (1 1) \n\nNow what we need is a higher-order function that returns the complement of a \nfunction. In other words, given =, we want to return /=. This function is called \ncompl ement in ANSI Common Lisp, but it was not defined in earlier versions, so it is \ngiven here: \n\n(defun complement (fn) \n\n\"If FN returns y, then (complement FN) returns (not y). \" \nThis function is built-in in ANSI Common Lisp, \nbut is defined here for those with non-ANSI compilers. \n\n#*(lambda (&rest args) (not (apply fn args)))) \n\nWhen find-all is called with a given :test predicate, all we have to do is call \nremove with the complement as the :test predicate. This is true even when the \n: test function is not specified, and therefore defaults to eql. We should also test \nfor when the user specifies the : test-not predicate, which is used to specify that \nthe match succeeds when the predicate is false. It is an error to specify both a : test \nand : test-not argument to the same call, so we need not test for that case. The \ndefinition is: \n\n(defun find-all (item sequence &rest keyword-args \n\n&key (test #*eql) test-not &aHow-other-keys) \n\"Find all those elements of sequence that match item, \naccording to the keywords. Doesn't alter sequence.\" \n(if test-not \n\n(apply #*remove item sequence \n:test-not (complement test-not) keyword-args) \n(apply #.remove item sequence \n:test (complement test) keyword-args))) \n\nThe only hard part about this definition is understanding the parameter list. The \n&rest accumulates all the keyword/value pairs in the variable keyword-args. In \naddition to the &rest parameter, two specific keyword parameters, rtest and \n: test-not, are specified. Any time you put a &key in a parameter Ust, you need \nan &al 1 ow-other- keys if, in fact, other keywords are allowed. In this case we want \n\nto accept keywords like : sta rt and : key and pass them on to remove. \n\nAll the keyword/value pairs will be accumulated in the Ust keyword - a rgs, including \nthe rtest or rtest-not values. SowewiUhave: \n\n\f\n<a id='page-102'></a>\n(find-all 1 nums ;test #'= :key #*abs) \n= (remove 1 nums :test (complement #*=) :test #'= :key #*abs) \n^ (1 1) \nNote that the call to remove will contain two : tes t keywords. This is not an error; \nCommon Lisp declares that the leftmost value is the one that counts. \n\n&#9635; Exercise 3.7 [s] Why do you think the leftmost of two keys is the one that counts, \nrather than the rightmost? \n\n&#9635; Exercise 3.8 [m] Some versions of Kyoto Common Lisp (KCL) have a bug wherein \nthey use the rightmost value when more than one keyword/value pair is specified \nfor the same keyword. Change the definition of f i nd -a 11 so that it works in KCL. \nThere are two more lambda-list keywords that are sometimes used by advanced \nprogrammers. First, within a macro definition (but not a function definition), the \nsymbol &body can be used as a synonym for &rest. The difference is that &body \ninstructs certain formatting programs to indent the rest as a body. Thus, if we \ndefined the macro: \n(defmacro while2 (test &body body) \n\"Repeat body while test is true.\" \n'(loop (if (not .test) (return nil)) \n. .body)) \nThen the automatic indentation of wh 11 e2 (on certain systems) is prettier than wh 11 e: \n(while (< i 10)\n(print (* i D )\n(setf i (+ i 1))) \n(while2 (< i 10) \n(print (* i i)) \n(setf i (+ i 1))) \nFinally, an &aux can be used to bind a new local variable or variables, as if bound \nwith let*. Personally, I consider this an abomination, because &aux variables are \nnot parameters at all and thus have no place in a parameter list. I think they should \nbe clearly distinguished as local variables with a let. But some good programmers \ndo use &aux, presumably to save space on the page or screen. Against my better \njudgement, I show an example: \n(defun length14 (list &aux (len 0)) \n(dolist (element lis t len) \n(incf len))) \n\n\f\n<a id='page-103'></a>\n3.20 The Rest of Lisp \nThere is a lot more to Common Lisp than what we have seen here, but this overview \nshould be enough for the reader to comprehend the programs in the chapters to \ncome. The serious Lisp programmer will further his or her education by continuing \nto consult reference books and online documentation. You may also find part V \nof this book to be helpful, particularly chapter 24, which covers advanced features \nof Common Lisp (such as packages and error handling) and chapter 25, which is a \ncollection of troubleshooting hints for the perplexed Lisper. \n\nWhile it may be distracting for the beginner to be continually looking at some \nreference source, the alternative—to explain every new function in complete detail as \nit is introduced—would be even more distracting. It would interrupt the description \nof the AI programs, which is what this book is all about. \n\n3.21 Exercises \n&#9635; Exercise 3.9 [m] Write a version of length using the function reduce. \n\n&#9635; Exercise 3.10 [m] Use a reference manual or descri be to figure out what the functions \n1 cm and . reconc do. \n\n&#9635; Exercise 3.11 [m] There is a built-in Common Lisp function that, given a key, a \nvalue, and an association Hst, returns a new association list that is extended to \ninclude the key/value pair. What is the name of this function? \n\n&#9635; Exercise 3.12 [m] Write a single expression using format that will take a list of \nwords and print them as a sentence, with the first word capitalized and a period after \nthe last word. You will have to consult a reference to learn new format directives. \n\n3.22 Answers \nAnswer 3.2 (consab) = (Mst*ab) \n\n\f\n<a id='page-104'></a>\n\nAnswer 3.3 \n\n(defun dprint (x) \n\"Print an expression in dotted pair notation.' \n(cond ((atom x) (princ x)) \n\n(t (princ \"(\") \n(dprint (first x)) \n(pr-rest (rest x)) \n(princ \")\") \n\nX))) \n\n(defun pr-rest (x) \n(princ \" . \") \n(dprint x)) \n\nAnswer 3.4 Use the same dpri nt function defined in the last exercise, but change \npr-rest. \n\n(defun pr-rest (x) \n\n(cond ((null x)) \n((atom x) (princ \" . \") (princ x)) \n(t (princ \" \") (dprint (first x)) (pr-rest (rest x))))) \n\nAnswer 3.5 We will keep a data base called *db*. The data base is organized into \na tree structure of nodes. Each node has three fields: the name of the object it \nrepresents, a node to go to if the answer is yes, and a node for when the answer is no. \nWe traverse the nodes until we either get an \"it\" reply or have to give up. In the latter \ncase, we destructively modify the data base to contain the new information. \n\n(defstruct node \nname \n(yes nil) \n(no nil)) \n\n(defvar *db* \n\n(make-node :name 'animal \n:yes (make-node :name 'mammal) \n:no (make-node \n\n:name 'vegetable \n:no (make-node :name 'mineral)))) \n\n\f\n<a id='page-105'></a>\n(defun questions (&optional (node *db*)) \n(format t \"~&Is it a ~a? \" (node-name node)) \n(case (read) \n\n((y yes) (if (not (null (node-yes node))) \n(questions (node-yes node)) \n(setf (node-yes node) (give-up)))) \n\n((n no) (if (not (null (node-no node))) \n(questions (node-no node)) \n(setf (node-no node) (give-up)))) \n\n(it 'aha!) \n(t (format t \"Reply with YES, NO, or IT if I have guessed it.\") \n(questions node)))) \n\n(defun give-up () \n(format t \"~&I give up - what is it? \") \n(make-node :name (read))) \n\nHere it is used: \n\n> (questions) \n\nIs it a ANIMAL? yes \n\nIs it a MAMMAL? yes \n\nI give up - what is it? bear \n\n#S(NODE :NAME BEAR) \n\n> (questions) \n\nIs it a ANIMAL? yes \nIs it a MAMMAL? no \n\nI give up - what is it? penguin \n\n#S(NODE :NAME PENGUIN) \n\n> (questions) \n\nIs it a ANIMAL? yes \nIs it a MAMMAL? yes \nIs it a BEAR? it \n\nAHA! \n\nAnswer 3.6 The value is (LOCAL-A LOCAL-B LOCAL-B GLOBAL-A LOCAL-B). \n\nThe let form binds a lexically and *b* dynamically, so the references to a and \n*b* (including the reference to *b* within f n) all get the local values. The function \nsymbol - value always treats its argument as a special variable, so it ignores the lexical \nbinding for a and returns the global binding instead. However, the symbol - va1 ue of \n*b* is the local dynamic value. \n\n\f\n<a id='page-106'></a>\n\nAnswer 3.7 There are two good reasons: First, it makes it faster to search through \nthe argument list: just search until you find the key, not all the way to the end. \nSecond, in the case where you want to override an existing keyword and pass the \nargument list on to another function, it is cheaper to cons the new keyword/value \npair on the front of a list than to append it to the end of a list. \n\nAnswer 3.9 \n\n(defun length-r (list) \n(reduce #*+ (mapcar #*(lambda (x) 1) list))) \n\nor more efficiently: \n\n(defun length-r (list) \n(reduce #'(lambda (x y) (+ . D) list \nrinitial-value 0)) \n\nor, with an ANSI-compliant Common Lisp, you can specify a : key \n\n(defun length-r (list) \n(reduce #'+ list :key #'(lambda (x) 1))) \n\nAnswer 3.12 (format t '^@r{'^a'^^ '(this is a test)) \n\n\f\n## Chapter 4\n<a id='page-109'></a>\n\nGPS: The Genera \nProblem Solver \n\nThere are now in the world machines that think. \n\n—Herbert Simon \nNobel Prize-winning Al researcher \n\nI I 1 he General Problem Solver, developed in 1957 by Alan Newell and Herbert Simon, em-\nI bodied a grandiose vision: a single computer program that could solve any problem, \n\nJL given a suitable description of the problem. GPS caused quite a stir when it was introduced, \nand some people in AI felt it would sweep in a grand new era of intelligent machines. \nSimon went so far as to make this statement about his creation: \n\nIt is not my aim to surprise or shock you. ... But the simplest way I can summarize is to say \nthat there are now in the world machines that think, that learn and create. Moreover, their \nability to do these things is going to increase rapidly until-in a visible future-the range of \nproblems they can handle will be coextensive with the range to which the human mind has \nbeen applied. \n\n\f\n<a id='page-110'></a>\n\nAlthough GPS never lived up to these exaggerated claims, it was still an important \nprogram for historical reasons. It was the first program to separate its problem-\nsolving strategy from its knowledge of particular problems, and it spurred much \nfurther research in problem solving. For all these reasons, it is a fitting object \nof study. \n\nThe original GPS program had a number of minor features that made it quite \ncomplex. In addition, it was written in an obsolete low-level language, IPL, that added \ngratuitous complexity. In fact, the confusing nature of IPL was probably an important \nreason for the grand claims about GPS. If the program was that complicated, it must \ndo something important. We will be ignoring some of the subtleties of the original \nprogram, and we will use Common Lisp, a much more perspicuous language than \nIPL. The result will be a version of GPS that is quite simple, yet illustrates some \nimportant points about AI. \n\nOn one level, this chapter is about GPS. But on another level, it is about the process \nof developing an AI computer program. We distinguish five stages in the development \nof a program. First is the problem description, which is a rough idea—usually \nwritten in English prose~of what we want to do. Second is the program specification, \nwhere we redescribe the problem in terms that are closer to a computable procedure. \nThe third stage is the implementation of the program in a programming language \nsuch as Common Lisp, the fourth is testing, and the fifth is debugging and analysis. \nThe boundaries between these stages are fluid, and the stages need not be completed \nin the order stated. Problems at any stage can lead to a change in the previous stage, \nor even to complete redesign or abandonment of the project. A programmer may \nprefer to complete only a partial description or specification, proceed directly to \nimplementation and testing, and then return to complete the specification based on \na better understanding. \n\nWe follow all five stages in the development of our versions of GPS, with the hope \nthat the reader will understand GPS better and will also come to understand better \nhow to write a program of his or her own. To summarize, the five stages of an AI \nprogramming project are: \n\n1. Describe the problem in vague terms \n2. Specify the problem in algorithmic terms \n3. Implement the problem in a programming language \n4. Test the program on representative examples \n5. Debug and analyze the resulting program, and repeat the process \n\f\n<a id='page-111'></a>\n\n4.1 Stage 1: Description \nAs our problem description, we will start with a quote from Newell and Simon's 1972 \nbook. Human Problem Solving: \n\nThe main methods of GPS jointly embody the heunstic ofmeans-ends analysis. \nMeans-ends analysis is typified by the following kind of common-sense \nargument: \n\nI want to take my son to nursery school. What's the difference \nbetween what I have and what I want? One of distance. What \nchanges distance? My automobile. My automobile won't work. \nWhat is needed to make it work? A new battery. What has new \nbattenes? An auto repair shop. I want the repair shop to put in a \nnew battery; but the shop doesn't know I need one. What is the \ndifficulty? One of communication. What allows communication? \nAtelephone... and so on. \n\nThe kind of analysis-classifying things in terms of the functions they serve and \noscillating among ends, functions required, andmeans thatperform them-forms \nthe basic system of heuristic of GPS. \n\nOf course, this kind of analysis is not exactly new. The theory of means-ends \nanalysis was laid down quite elegantly by Aristotle 2300 years earlier in the chapter \nentitled \"The nature of deliberation and its objects\" of the Nicomachean Ethics (Book \nIII. 3,1112b): \n\nWe deliberate not about ends, but about means. For a doctor does not deliberate \nwhether he shall heal, nor an orator whether he shall persuade, nor a statesman \nwhether he shall produce law and order, nor does any one else deliberate about \nhis end. They assume the end and consider how and by what means it is attained; \nand if it seems to be produced by several means they consider by which it is \nmost easily and best produced, while if it is achieved by one only they consider \nhow it will be achieved by this and by what means this will be achieved, till \nthey come to the first cause, which in the order of discovery is last... and what \nis last in the order of analysis seems to be first in the order of becoming. And if \nwe come on an impossibility, we give up the search, e.g., if we need money and \nthis cannot be got; but if a thing appears possible we try to do it. \n\nGiven this description of a theory of problem solving, how should we go about \nwriting a program? First, we try to understand more fully the procedure outlined in \nthe quotes. The main idea is to solve a problem using a process called means-ends \nanalysis, where the problem is stated in terms of what we want to happen. In Newell \nand Simon's example, the problem is to get the kid to school, but in general we would \n\n\f\n<a id='page-112'></a>\n\nlike the program to be able to solve a broad class of problems. We can solve a problem \nif we can find some way to eliminate \"the difference between what I have and what \nI want.\" For example, if what I have is a child at home, and what I want is a child \nat school, then driving may be a solution, because we know that driving leads to a \nchange in location. We should be aware that using means-ends analysis is a choice: \nit is also possible to start from the current situation and search forward to the goal, \nor to employ a mixture of different search strategies. \n\nSome actions require the solving of preconditions as subproblems. Before we can \ndrive the car, we need to solve the subproblem of getting the car in working condition. \nIt may be that the car is already working, in which case we need do nothing to solve \nthe subproblem. So a problem is solved either by taking appropriate action directly, \nor by first solving for the preconditions of an appropriate action and then taking \nthe action. It is clear we will need some description of allowable actions, along \nwith their preconditions and effects. We will also need to develop a definition of \nappropriateness. However, if we can define these notions better, it seems we won't \nneed any new notions. Thus, we will arbitrarily decide that the problem description \nis complete, and move on to the problem specification. \n\n4.2 Stage 2: Specification \nAt this point we have an idea—admittedly vague—of what it means to solve a problem \nin GPS. We can refine these notions into representations that are closer to Lisp as \nfollows: \n\n* We can represent the current state of the world—\"what I have\"—or the goal \nstate—\"what I want\"—as sets of conditions. Common Lisp doesn't have a data \ntype for sets, but it does have Usts, which can be used to implement sets. Each \ncondition can be represented by a symbol. Thus, a typical goal might be the list \nof two conditions (rich famous), and a typical current state might be (unknown \npoor). \n* We need a list of allowable operators. This list will be constant over the course \nof a problem, or even a series of problems, but we want to be able to change it \nand tackle a new problem domain. \n* An operator can be represented as a structure composed of an action, a list \nof preconditions, and a list of effects. We can place limits on the kinds of \npossible effects by saying that an effect either adds or deletes a condition from \nthe current state. Thus, the list of effects can be split into an add-list and \na delete-list. This was the approach taken by the STRIPS^ implementation of \n^STRIPS is the Stanford Research Institute Problem Solver, designed by Richard Pikes and \nNilsNilsson (1971). \n\n\f\n<a id='page-113'></a>\n\nGPS, which we will be in effect reconstructing in this chapter. The original GPS \nallowed more flexibility in the specification of effects, but flexibility leads to \ninefficiency. \n\n* A complete problem is described to GPS in terms of a starting state, a goal state, \nand a set of known operators. Thus, GPS will be a function of three arguments. \nFor example, a sample call might be: \n(GPS '(unknown poor) '(rich famous) list-of-ops) \n\nIn other words, starting from the state of being poor and unknown, achieve the \nstate of being rich and famous, using any combination of the known operators. \nGPS should return a true value only if it solves the problem, and it should print \na record of the actions taken. The simplest approach is to go through the \nconditions in the goal state one at a time and try to achieve each one. If they \ncan all be achieved, then the problem is solved. \n\n* A single goal condition can be achieved in two ways. If it is already in the \ncurrent state, the goal is trivially achieved with no effort. Otherwise, we have \nto find some appropriate operator and try to apply it. \n* An operator is appropriate if one of the effects of the operator is to add the goal \nin question to the current state; in other words, if the goal is in the operator's \nadd-list. \n* We can apply an operator if we can achieve all the preconditions. But this is \neasy, because we just defined the notion of achieving a goal in the previous \nparagraph. Once the preconditions have been achieved, applying an operator \nmeans executing the action and updating the current state in term of the operator's \nadd-list and delete-list. Since our program is just a simulation—it won't \nbe actually driving a car or dialing a telephone—we must be content simply to \nprint out the action, rather than taking any real action. \n4.3 Stage 3: Implementation \nThe specification is complete enough to lead directly to a complete Common Lisp \nprogram. Figure 4.1 summarizes the variables, data types, and functions that make \nup the GPS program, along with some of the Common Lisp functions used to implement \nit. \n\n\f\n<a id='page-114'></a>\n\nTop-Level Function \nGPS Solve a goal from a state using a list of operators. \nSpecial Variables \n*state* The current state: a list of conditions. \n*ops* A list of available operators. \nData Types \nop An operation with preconds, add-list and del-list. \nFunctions \nachieve Achieve an individual goal. \nappropriate-p Decide if an operator is appropriate for a goal. \napply-op Apply operator to current state. \nSelected Common Lisp Functions \nmember Test if an element is a member of a list. (p. 78) \nset-difference All elements in one set but not the other. \nunion All elements in either of two sets. \nevery Test if every element of a list passes a test. (p. 62) \nsome Test if any element of a list passes a test. \nPreviously Defined Functions \nfind-all A list of all matching elements, (p. 101) \nFigure 4.1: Glossary for the GPS Program \n\nHere is the complete GPS program itself: \n\n(defvar *state* nil \"The current state: a list of conditions.\") \n\n(defvar *ops* nil \"A list of available operators.\") \n\n(defstruct op \"An operation\" \n(action nil) (preconds nil) (add-list nil) (del-list nil)) \n\n(defun GPS (*state* goals *ops*) \n\"General Problem Solver: achieve all goals using *ops*.\" \n(if (every #'achieve goals) 'solved)) \n\n(defun achieve (goal) \n\"A goal is achieved if it already holds, \nor if there is an appropriate op for it that is applicable.\" \n(or (member goal *state*) \n\n(some #'apply-op \n(find-all goal *ops* :test #'appropriate-p)))) \n\n(defun appropriate-p (goal op) \n\"An op is appropriate to a goal if it is in its add list.\" \n(member goal (op-add-list op))) \n\n\f\n<a id='page-115'></a>\n\n(defun apply-op (op) \n\"Print a message and update *state* if op is applicable.\" \n(when (every #*achieve (op-preconds op)) \n\n(print (list 'executing (op-action op))) \n(setf *state* (set-difference *state* (op-del-list op))) \n(setf *state* (union *state* (op-add-list op))) \nt)) \n\nWe can see the program is made up of seven definitions. These correspond to the \nseven items in the specification above. In general, you shouldn't expect such a \nperfect fit between specification and implementation. There are two def var forms, \none def s t r uct, and four defun forms. These are the Common Lisp forms for defining \nvariables, structures, and functions, respectively. They are the most common top-\nlevel forms in Lisp, but there is nothing magic about them; they are just special forms \nthat have the side effect of adding new definitions to the Lisp environment. \n\nThe two def var forms, repeated below, declare special variables named *state* \nand *ops*, which can then be accessed from anywhere in the program. \n\n(defvar *state* nil \"The current state: a list of conditions.\") \n\n(defvar *ops* nil \"A list of available operators.\") \n\nThe defstruct form defines a structure called an op, which has slots called acti on, \npreconds, add -1 i st, and del -1 i st. Structures in Common Lisp are similar to structures \nin C, or records in Pascal. The defstruct automatically defines a constructor \nfunction, which is called make-op, and an access function for each slot of the structure. \nThe access functions are called op-action, op-preconds, op-add-list, and \nop-del -1 ist. The defstruct also defines a copier function, copy-op, a predicate, \nop-p, and setf definitions for changing each slot. None of those are used in the GPS \nprogram. Roughly speaking, it is as if the defstruct form \n\n(defstruct op \"An operation\" \n(action nil) (preconds nil) (add-list nil) (del-list nil)) \n\nexpanded into the following definitions: \n\n(defun make-op (&key action precondsadd-1ist del-1 ist) \n(vector 'op action preconds add-list del-list)) \n\n(defun op-action (op) (elt op 1)) \n(defun op-preconds (op) (elt op 2)) \n(defun op-add-list (op) (elt op 3)) \n(defun op-del-list (op) (elt op 4)) \n\n(defun copy-op (op) (copy-seq op)) \n\n\f\n<a id='page-116'></a>\n\n(defun op-p (op) \n(and (vectorp op) (eq (elt op 0) Op))) \n\n(setf (documentation 'op 'structure) \"An operation\") \n\nNext in tlie GPS program are four function definitions. The main function, GPS, is \npassed three arguments. The first is the current state of the world, the second the \ngoal state, and the third a list of allowable operators. The body of the function says \nsimply that if we can achieve every one of the goals we have been given, then the \nproblem is solved. The unstated alternative is that otherwise, the problem is not \nsolved. \n\nThe function a chi eve is given as an argument a single goal. The function succeeds \nif that goal is already true in the current state (in which case we don't have to do \nanything) or if we can apply an appropriate operator. This is accomplished by first \nbuilding the list of appropriate operators and then testing each in turn until one can \nbe applied, achieve calls find-al 1, which we defined on [page 101](chapter3.md#page-101). In this use, \nfind-al 1 returns a list of operators that match the current goal, according to the \npredicate appropriate-p. \n\nThe function appropriate-p tests if an operator is appropriate for achieving a \ngoal. (It follows the Lisp naming convention that predicates end in - p.) \n\nFinally, the function apply-op says that if we can achieve all the preconditions \nfor an appropriate operator, then we can apply the operator. This involves printing \na message to that effect and changing the state of the world by deleting what was in \nthe delete-list and adding what was in the add-Hst. apply-op is also a predicate; it \nreturns t only when the operator can be applied. \n\n4.4 Stage 4: Test \nThis section will define a list of operators applicable to the \"driving to nursery school\" \ndomain and will show how to pose and solve some problems in that domain. First, \nwe need to construct the list of operators for the domain. The defstruct form for the \ntype op automatically defines the function make - op, which can be used as follows: \n\n(make-op :action 'drive-son-to-school \nipreconds *(son-at-home car-works) \n:add-list '(son-at-school) \n:del-list '(son-at-home)) \n\nThis expression returns an operator whose action is the symbol drive-son-to-school \nand whose preconditions, add-list and delete-list are the specified lists. The intent \n\n\f\n<a id='page-117'></a>\n\nof this operator is that whenever the son is at home and the car works, dri ve-sonto-\nschool can be appHed, changing the state by deleting the fact that the son is at \nhome, and adding the fact that he is at school. \n\nIt should be noted that using long hyphenated atoms like son - at - home is a useful \napproach only for very simple examples like this one. A better representation would \nbreak the atom into its components: perhaps (at son home). The problem with \nthe atom-based approach is one of combinatorics. If there are 10 predicates (such \nas at) and 10 people or objects, then there will be 10 . 10 . 10 = 1000 possible \nhyphenated atoms, but only 20 components. Clearly, it would be easier to describe \nthe components. In this chapter we stick with the hyphenated atoms because it is \nsimpler, and we do not need to describe the whole world. Subsequent chapters take \nknowledge representation more seriously. \n\nWith this operator as a model, we can define other operators corresponding to \nNewell and Simon's quote on [page 109](chapter4.md#page-109). There will be an operator for installing a \nbattery, telling the repair shop the problem, and telephoning the shop. We can fill in \nthe \"and so on\" by adding operators for looking up the shop's phone number and for \ngiving the shop money: \n\n(defparameter *school-ops* \n(list \n\n(make-op taction 'drive-son-to-school \n:preconds '(son-at-home car-works) \n:add-list '(son-at-school) \n:del-list '(son-at-home)) \n\n(make-op taction 'shop-installs-battery \nipreconds '(car-needs-battery shop-knows-problem shop-has-money) \n:add-list '(car-works)) \n\n(make-op taction 'tell-shop-problem \n:preconds '(in-communication-with-shop) \n:add-list '(shop-knows-problem)) \n\n(make-op raction 'telephone-shop \nrpreconds '(know-phone-number) \n:add-list '(in-communication-with-shop)) \n\n(make-op .-action 'look-up-number \nipreconds '(have-phone-book) \n:add-list '(know-phone-number)) \n\n(make-op taction 'give-shop-money \nipreconds '(have-money) \n:add-list '(shop-has-money) \n:del-list '(have-money)))) \n\nThe next step is to pose some problems to GPS and examine the solutions. Following \nare three sample problems. In each case, the goal is the same: to achieve the single \ncondition son-at-school. The Hst of available operators is also the same in each \n\n\f\n<a id='page-118'></a>\n\nproblem; the difference is in the initial state. Each of the three examples consists of \nthe prompt, \">\", which is printed by the Lisp system, followed by a call to GPS, \" (gps \n...which is typed by the user, then the output from the program, \"(EXECUTING \n...)\", and finally the result of the function call, which can be either SOLVED or NI L. \n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book) \n'(son-at-school) \n*school-ops*) \n\n(EXECUTING LOOK-UP-NUMBER) \n(EXECUTING TELEPHONE-SHOP) \n(EXECUTING TELL-SHOP-PROBLEM) \n(EXECUTING GIVE-SHOP-MONEY) \n(EXECUTING SHOP-INSTALLS-BATTERY) \n(EXECUTING DRIVE-SON-TO-SCHOOL) \nSOLVED \n\n> (gps '(son-at-home car-needs-battery have-money) \n'(son-at-schoo1) \n*school-ops*) \n\nNIL \n\n> (gps '(son-at-home car-works) \n'(son-at-school) \n*school-ops*) \n\n(EXECUTING DRIVE-SON-TO-SCHOOL) \nSOLVED \n\nIn all three examples the goal is to have the son at school. The only operator that \nhas son-at-school in its add-list is drive-son-to-school, so GPS selects that operator \ninitially. Before it can execute the operator, GPS has to solve for the preconditions. \nIn the first example, the program ends up working backward through \nthe operators shop-instal 1 s-battery, give-shop-money, tel 1 -shop-problem, and \ntelephone-shop to look-up-number, whichhasnooutstandingpreconditions. Thus, \nthe 1 ook-up-number action can be executed, and the program moves on to the other \nactions. As Aristotle said, \"What is the last in the order of analysis seems to be first \nin the order of becoming.\" \n\nThe second example starts out exactly the same, but the 1 ook - up-.umber operator \nfails because its precondition, have-phone-book, cannot be achieved. Knowing the \nphone number is a precondition, directly or indirectly, of all the operators, so no \naction is taken and GPS returns NIL. \n\nFinally, the third example is much more direct; the initial state specifies that the \ncar works, so the driving operator can be applied immediately. \n\n\f\n<a id='page-119'></a>\n4.5 Stage 5: Analysis, or ''We Lied about the C \nIn the sections that follow, we examine the question of just how general this General \nProblem Solver is. The next four sections point out limitations of our version of GPS, \nand we will show how to correct these limitations in a second version of the program. \n\nOne might ask if \"limitations\" is just a euphemism for \"bugs.\" Are we \"enhancing\" \nthe program, or are we \"correcting\" it? There are no clear answers on this point, \nbecause we never insisted on an unambiguous problem description or specification. \nAI programming is largely exploratory programming; the aim is often to discover \nmore about the problem area rather than to meet a clearly defined specification. This \nis in contrast to a more traditional notion of programming, where the problem is \ncompletely specified before the first line of code is written. \n\n4.6 The Running Around the Block Problem \nRepresenting the operator \"driving from home to school\" is easy: the precondition \nand delete-list includes being at home, and the add-list includes being at school. But \nsuppose we wanted to represent \"running around the block.\" There would be no \nnet change of location, so does that mean there would be no add- or delete-list? If \nso, there would be no reason ever to apply the operator. Perhaps the add-list should \ncontain something like \"got some exercise\" or \"feel tired,\" or something more general \nlike \"experience running around the block.\" We will return to this question later. \n\n4.7 The Clobbered Sibling Goal Problem \nConsider the problem of not only getting the child to school but also having some \nmoney left over to use for the rest of the day. GPS can easily solve this problem from \nthe following initial condition: \n\n> (gps *(son-at-home have-money car-works) \n'(have-money son-at-school) \n*school-ops*) \n\n(EXECUTING DRIVE-SON-TO-SCHOOL) \nSOLVED \n\nHowever, in the next example GPS incorrectly reports success, when in fact it has \nspent the money on the battery. \n\n\f\n<a id='page-120'></a>\n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book) \n'(have-money son-at-school) \n^school-ops*) \n\n(EXECUTING LOOK-UP-NUMBER) \n(EXECUTING TELEPHONE-SHOP) \n(EXECUTING TELL-SHOP-PROBLEM) \n(EXECUTING GIVE-SHOP-MONEY) \n(EXECUTING SHOP-INSTALLS-BATTERY) \n(EXECUTING DRIVE-SON-TO-SCHOOL) \nSOLVED \n\nThe \"bug\" is that GPS uses the expression (every #'achieve goals) to achieve \na set of goals. If this expression returns true, it means that every one of the \ngoals has been achieved in sequence, but it doesn't mean they are all still true \nat the end. In other words, the goal (have-money son-at-school), which we intended \nto mean \"end up in a state where both have-money and son-at-school are \ntrue,\" was interpreted by GPS to mean \"first achieve have-money, and then achieve \nson-at-school.\" Sometimes achieving one goal can undo another, previously \nachieved goal. We will call this the \"prerequisite clobbers sibling goal\" problem.^ \nThat is, have-money and son-at-school are sibling goals, one of the prerequisites \nfor the plan for son-at-school is car-works, and achieving that goal clobbers the \nhave-money goal. \n\nModifying the program to recognize the \"prerequisite clobbers sibling goal\" problem \nis straightforward. First note that we call (every #'achieve something) twice \nwithin the program, so let's replace those two forms with (achi eve - al 1 something). \nWe can then define achi eve-al 1 as follows: \n\n(defun achieve-all (goals) \n\"Try to achieve each goal, then make sure they still hold.\" \n(and (every #'achieve goals) (subsetp goals *state*))) \n\nThe Common Lisp function subsetp returns true if its first argument is a subset of its \nsecond. In achi eve-al 1, it returns true if every one of the goals is still in the current \nstate after achieving all the goals. This is just what we wanted to test. \n\nThe introduction of achi eve-al 1 prevents GPS from returning true when one of \nthe goals gets clobbered, but it doesn't force GPS to replan and try to recover from a \nclobbered goal. We won't consider that possibility now, but we will take it up again \nin the section on the blocks world domain, which was Sussman's primary example. \n\n^Gerald Sussman, in his book A Computer Model of Skill Acquisition, uses the term \"prerequisite \nclobbers brother goal\" or PCBG. I prefer to be gender neutral, even at the risk of being \nlabeled a historical revisionist. \n\n\f\n<a id='page-121'></a>\n4 . 8 The Leaping before You Look Problem \n\nAnother way to address the \"prerequisite clobbers sibling goal\" problem is just to be \nmore careful about the order of goals in a goal list. If we want to get the kid to school \nand still have some money left, why not just specify the goal as (son-at-school \nhave-money) rather than (have-money son-at-school)? Let's see what happens \nwhen we try that: \n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book) \n'(son-at-school have-money) \n*school-ops*) \n\n(EXECUTING LOOK-UP-NUMBER) \n(EXECUTING TELEPHONE-SHOP) \n(EXECUTING TELL-SHOP-PROBLEM) \n(EXECUTING GIVE-SHOP-MONEY) \n(EXECUTING SHOP-INSTALLS-BATTERY) \n(EXECUTING DRIVE-SON-TO-SCHOOL) \nNIL \n\nGPS returns nil, reflecting the fact that the goal cannot be achieved, but only after \nexecuting all actions up to and including driving to school. I call this the \"leaping \nbefore you look\" problem, because if you asked the program to solve for the two goals \n(j ump - of f -c 1 i f f 1 a nd -sa f e1 y) it would happily jump first, only to discover that it \nhad no operator to land safely. This is less than prudent behavior. \n\nThe problem arises because planning and execution are interleaved. Once the \npreconditions for an operator are achieved, the action is taken—and *sta te* is irrevocably \nchanged—even if this action may eventually lead to a dead end. An alternative \nwould be to replace the single global *state* with distinct local state variables, such \nthat a new variable is created for each new state. This alternative is a good one for \nanother, independent reason, as we shall see in the next section. \n\n4.9 The Recursive Subgoal Problem \nIn our simulated nursery school world there is only one way to find out a phone \nnumber: to look it up in the phone book. Suppose we want to add an operator for \nfinding out a phone number by asking someone. Of course, in order to ask someone \nsomething, you need to be in communication with him or her. The asking-for-a-\nphone-number operator could be implemented as follows: \n\n\f\n<a id='page-122'></a>\n\n(push (make-op :action 'ask-phone-number \n:preconds '(in-communication-with-shop) \n;add-list '(know-phone-number)) \n\n*school-ops*) \n\n(The special form (push item list) puts the item on the front of the list; it is equivalent \nto (setf list (cons item /fsO) in the simple case.) Unfortunately, something \nunexpected happens when we attempt to solve seemingly simple problems with this \nnew set of operators. Consider the following: \n\n> (gps *(son-at-home car-needs-battery have-money) \n'(son-at-school) \n*school-ops*) \n\n>TRAP 14877 (SYSTEM:PDL-OVERFLOW EH::REGULAR) \nThe regular push-down list has overflown. \nWhile in the function ACHIEVE <- EVERY <- REMOVE \n\nThe error message (which will vary from one implementation of Common Lisp to \nanother) means that too many recursively nested function calls were made. This \nindicates either a very complex problem or, more commonly, a bug in the program \nleading to infinite recursion. One way to try to see the cause of the bug is to trace a \nrelevant function, such as achi eve: \n\n> (trace achieve) => (ACHIEVE) \n\n> (gps '(son-at-home car-needs-battery have-money) \n'(son-at-school) \n*school-ops*) \n\n(1 ENTER ACHIEVE: SON-AT-SCHOOL) \n(2 ENTER ACHIEVE: SON-AT-HOME) \n(2 EXIT ACHIEVE: (SON-AT-HOME CAR-NEEDS-BATTERY HAVE-MONEY)) \n(2 ENTER ACHIEVE: CAR-WORKS) \n\n(3 ENTER ACHIEVE: CAR-NEEDS-BATTERY) \n(3 EXIT ACHIEVE: (CAR-NEEDS-BATTERY HAVE-MONEY)) \n(3 ENTER ACHIEVE: SHOP-KNOWS-PROBLEM) \n\n(4 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP) \n(5 ENTER ACHIEVE: KNOW-PHONE-NUMBER) \n(6 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP) \n(7 ENTER ACHIEVE: KNOW-PHONE-NUMBER) \n(8 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP) \n(9 ENTER ACHIEVE: KNOW-PHONE-NUMBER) \n\n\f\n<a id='page-123'></a>\nThe output from trace gives us the necessary clues. Newell and Simon talk of \n\"oscillating among ends, functions required, and means that perform them.\" Here \nit seems we have an infinite oscillation between being in communication with the \nshop (levels 4, 6, 8,...) and knowing the shop's phone number (levels 5, 7, 9,...). \nThe reasoning is as follows: we want the shop to know about the problem with the \nbattery, and this requires being in communication with him or her. One way to get in \ncommunication is to phone, but we don't have a phone book to look up the number. \nWe could ask them their phone number, but this requires being in communication \nwith them. As Aristotle put it, \"If we are to be always deliberating, we shall have to \ngo on to infinity.\" We will call this the \"recursive subgoal\" problem: trying to solve \na problem in terms of itself. One way to avoid the problem is to have achi eve keep \ntrack of all the goals that are being worked on and give up if it sees a loop in the \ngoal stack. \n\n4.10 The Lack of Intermediate Information \nProblem \nWhen GPS fails to find a solution, it just returns nil. This is annoying in cases where \nthe user expected a solution to be found, because it gives no information about the \ncause of failure. The user could always trace some function, as we traced achi eve \nabove, but the output from trace is rarely exactly the information desired. It would \nbe nice to have a general debugging output tool where the programmer could insert \nprint statements into his code and have them selectively printed, depending on the \ninformation desired. \n\nThe function dbg provides this capability, dbg prints output in the same way as \nformat, but it will only print when debugging output is desired. Each call to dbg is \naccompanied by an identifer that is used to specify a class of debugging messages. \nThe functions debug and undebug are used to add or remove message classes to the \nlist of classes that should be printed. In this chapter, all the debugging output will \nuse the identifier :gps. Other programs will use other identifiers, and a complex \nprogram will use many identifiers. \n\nA call to dbg will result in output if the first argument to dbg, the identifier, is one \nthat was specified in a call to debug. The other arguments to dbg are a format string \nfollowed by a list of arguments to be printed according to the format string. In other \nwords, we will write functions that include calls to dbg like: \n\n(dbg :gps \"The current goal is: ~a\" goal) \n\nIf we have turned on debugging with (debug :gps), then calls to dbg with the \nidentifier :gps will print output. The output is turned off with (undebug :gps). \n\n\f\n<a id='page-124'></a>\n\ndebug and undebug are designed to be similar to trace and untrace, in that they turn \ndiagnostic output on and off. They also follow the convention that debug with no \narguments returns the current list of identifiers, and that undebug with no arguments \nturns all debugging off. However, they differ from trace and untrace in that they \nare functions, not macros. If you use only keywords and integers for identifiers, then \nyou won't notice the difference. \n\nTwo new built-in features are introduced here. First, *debug-io* is the stream \nnormally used for debugging input/output. In all previous calls to format we have \nused t as the stream argument, which causes output to go to the *standa rd - output* \nstream. Sending different types of output to different streams allows the user some \nflexibility. For example, debugging output could be directed to a separate window, \nor it could be copied to a file. Second, the function fresh -1i ne advances to the next \nline of output, unless the output stream is already at the start of the line. \n\n(defvar *dbg-ids* nil \"Identifiers used by dbg\") \n\n(defun dbg (id format-string &rest args) \n\"Print debugging info if (DEBUG ID) has been specified.\" \n(when (member id *dbg-ids*) \n\n(fresh-line *debug-io*) \n(apply #'format *debug-io* format-string args))) \n\n(defun debug (&rest ids) \n\"Start dbg output on the given ids. \" \n(setf *dbg-ids* (union ids *dbg-ids*))) \n\n(defun undebug (&rest ids) \n\"Stop dbg on the ids. With no ids. stop dbg altogether.\" \n(setf *dbg-ids* (if (null ids) nil \n\n(set-difference *dbg-ids* ids)))) \n\nSometimes it is easier to view debugging output if it is indented according to some \npattern, such as the depth of nested calls to a function. To generate indented output, \nthe function dbg -1 ndent is defined: \n\n(defun dbg-indent (id indent format-string &rest args) \n\"Print indented debugging info if (DEBUG ID) has been specified.\" \n(when (member id *dbg-ids*) \n\n(fresh-line *debug-io*) \n(dotimes (i indent) (princ \" \" *debug-io*)) \n(apply #*format *debug-io* format-string args))) \n\n\f\n<a id='page-125'></a>\n4.11 GPS Version 2: A More General \nProblem Solver \nAt this point we are ready to put together a new version of GPS with solutions for \nthe \"running around the block,\" \"prerequisite clobbers sibling goal,\" \"leaping before \nyou look,\" and \"recursive subgoal\" problems. The glossary for the new version is in \nfigure 4.2. \n\nTop-Level Function \nGPS Solve a goal from a state using a list of operators. \nSpecial Variables \n*ops* A list of available operators. \nData Types \nop An operation with preconds, add-list and del-Hst. \nMajor Functions \nachieve-all Achieve a list of goals. \nachieve Achieve an individual goal. \nappropriate-p Decide if an operator is appropriate for a goal. \napply-op Apply operator to current state. \nAuxiliary Functions \nexecuting-p Is a condition an executi ng form? \nstarts-with Is the argument a list that starts with a given atom? \nconvert-op Convert an operator to use the executi ng convention. \nop Create an operator. \nuse Use a list of operators. \nmember-equal Test if an element is equal to a member of a list. \nSelected Common Lisp Functions \nmember Test if an element is a member of a list. (p. 78) \nset -difference All elements in one set but not the other. \nsubsetp Is one set wholly contained in another? \nunion All elements in either of two sets. \nevery Test if every element of a list passes a test. (p. 62) \nsome Test if any element of a list passes a test. \nremove-if Remove all items satisfying a test. \nPreviously Defined Functions \nfind-all A list of all matching elements, (p. 101) \nfind-all-if A list of all elements satisfying a predicate. \nFigure 4.2: Glossary for Version 2 of GPS \n\nThe most important change is that, instead of printing a message when each \noperator is applied, we will instead have GPS return the resulting state. A list of \n\n\f\n<a id='page-126'></a>\n\n\"messages\" in each state indicates what actions have been taken. Each message is \nactuallyacondition,aHstof the form (executing operator). This solves the \"running \naround the block\" problem: we could call GPS with an initial goal of ((executing \nrun -a round - bl ock)), and it would execute the run -a round - bl ock operator, thereby \nsatisfying the goal. The following code defines a new function, op, which builds \noperators that include the message in their add-list. \n\n(defun executing-p (x) \n\"Is X of the form: (executing ...) ? \" \n(starts-with . 'executing)) \n\n(defun starts-with (list x) \n\"Is this a list whose first element is x?\" \n(and (consp list) (eql (first list) x))) \n\n(defun convert-op (op) \n\"Make op conform to the (EXECUTING op) convention.\" \n(unless (some #'executing-p (op-add-list op)) \n\n(push (list 'executing (op-action op)) (op-add-list op))) \nop) \n\n(defun op (action &key preconds add-list del-list) \n\"Make a new operator that obeys the (EXECUTING op) convention.\" \n(convert-op \n\n(make-op :action action :preconds preconds \n:add-list add-list :del-list del-list))) \n\nOperators built by op will be correct, but we can convert existing operators using \nconvert-op directly: \n\n(mapc #'convert-op ^school-ops*) \n\nThis is an example of exploratory programming: instead of starting all over when \nwe discover a limitation of the first version, we can use Lisp to alter existing data \nstructures for the new version of the program. \n\nThe definition of the variable *ops* and the structure op are exactly the same as \nbefore, and the rest of the program consists of five functions we have already seen: \nGPS, achieve -all, achieve, appropriate-p, and apply-op. At the top level, the \nfunction GPS calls achieve-al 1, which returns either nil or a valid state. From this \nwe remove all the atoms, which leaves only the elements of the final state that are \nlists—in other words, the actions of the form (executi ng operator). Thus, the value \nof GPS itself is the Hst of actions taken to arrive at the final state. GPS no longer returns \nSOLVED when it finds a solution, but it still obeys the convention of returning nil for \nfailure, and non-nil for success. In general, it is a good idea to have a program return \n\n\f\n<a id='page-127'></a>\na meaningful value rather than print that value, if there is the possibility that some \nother program might ever want to use the value. \n\n(defvar *ops* nil \"A list of available operators.\") \n\n(defstruct op \"An operation\" \n(action nil) (preconds nil) (add-list nil) (del-list nil)) \n\n(defun GPS (state goals &optional (*ops* *ops*)) \n\"General Problem Solver: from state, achieve goals using *ops*.\" \n(remove-if #'atom (achieve-all (cons '(start) state) goals nil))) \n\nThe first major change in version 2 is evident from the first line of the program: there \nis no *state* variable. Instead, the program keeps track of local state variables. \nThis is to solve the \"leaping before you look\" problem, as outlined before. The \nfunctions achieve, achieve-al 1, and apply-op all take an extra argument which is \nthe current state, and all return a new state as their value. They also must still obey \nthe convention of returning nil when they fail. \n\nThus we have a potential ambiguity: does nil represent failure, or does it represent \na valid state that happens to have no conditions? We resolve the ambiguity \nby adopting the convention that all states must have at least one condition. This \nconvention is enforced by the function GPS. Instead of calling (achieve-al 1 state \ngoals nil), GPS calls (achieve-all (cons '(start) state) goals nil). Soeven \nif the user passes GPS a null initial state, it will pass on a state containing (start ) \nto achieve-al 1. From then on, we are guaranteed that no state will ever become \nnil, because the only function that builds a new state is apply - op, and we can see by \nlooking at the last line of appl y - op that it always appends something onto the state it \nis returning. (An add-list can never be nil, because if it were, the operator would not \nbe appropriate. Besides, every operator includes the (executi ng ... ) condition.) \n\nNote that the final value we return from GPS has all the atoms removed, so we end \nup reporting only the actions performed, since they are represented by conditions \nof the form (executi ng action). Adding the (start ) condition at the beginning also \nserves to differentiate between a problem that cannot be solved and one that is solved \nwithout executing any actions. Failure returns nil, while a solution with no steps will \nat least include the (sta rt) condition, if nothing else. \n\nFunctions that return nil as an indication of failure and return some useful value \notherwise are known as semipredicates. They are error prone in just these cases \nwhere nil might be construed as a useful value. Be careful when defining and using \nsemipredicates: (1) Decide if nil could ever be a meaningful value. (2) Insure that \nthe user can't corrupt the program by supplying nil as a value. In this program, GPS \nis the only function the user should call, so once we have accounted for it, we're \ncovered. (3) Insure that the program can't supply nil as a value. We did this by seeing \nthat there was only one place in the program where new states were constructed, \nand that this new state was formed by appending a one-element list onto another \n\n\f\n<a id='page-128'></a>\n\nstate. By following this three-step procedure, we have an informal proof that the \nsemipredicates involving states will function properly. This kind of informal proof \nprocedure is a common element of good program design. \n\nThe other big change in version 2 is the introduction of a goal stack to solve the \nrecursive subgoal problem. The program keeps track of the goals it is working on \nand immediately fails if a goal appears as a subgoal of itself. This test is made in the \nsecond clause of achi eve. \n\nThe function a chi eve -a 11 tries to achieve each one of the goals in turn, setting the \nvariable state2 to be the value returned from each successive call to achi eve. If all \ngoals are achieved in turn, and if all the goals still hold at the end (as subsetp checks \nfor), then the final state is returned; otherwise the function fails, returning nil. \n\nMost of the work is done by achieve, which gets passed a state, a single goal \ncondition, and the stack of goals worked on so far. If the condition is already in the \nstate, then achieve succeeds and returns the state. On the other hand, if the goal \ncondition is already in the goal stack, then there is no sense continuing—we will be \nstuck in an endless loop—so achi eve returns nil. Otherwise, achi eve looks through \nthe list of operators, trying to find one appropriate to apply. \n\n(defun achieve-all (state goals goal-stack) \n\"Achieve each goal, and make sure they still hold at the end.\" \n(let ((current-state state)) \n\n(if (and (every #'(lambda (g) \n(setf current-state \n(achieve current-state g goal-stack))) \ngoals) \n(subsetp goals current-state rtest #'equal)) \ncurrent-state))) \n\n(defun achieve (state goal goal-stack) \n\"A goal is achieved if it already holds, \nor if there is an appropriate op for it that is applicable.\" \n(dbg-indent :gps (length goal-stack) \"Goal: \"a\" goal) \n(cond ((member-equal goal state) state) \n\n((member-equal goal goal-stack) nil) \n(t (some #'(lambda (op) (apply-op state goal op goal-stack)) \n(find-all goal *ops* :test #*appropriate-p))))) \n\nThe goal ((executing run-around-block)) is a list of one condition, where the \ncondition happens to be a two-element list. Allowing lists as conditions gives us \nmore flexibility, but we also have to be careful. The problem is that not all Usts that \nlook alike actually are the same. The predicate equal essentially tests to see if its two \narguments look alike, while the predicate eql tests to see if its two arguments actually \nare identical. Since functions like member use eql by default, we have to specify with \na :test keyword that we want equal instead. Since this is done several times, we \n\n\f\n<a id='page-129'></a>\nintroduce the function member-equal. In fact, we could have carried the abstraction \none step further and defined member-situation, a function to test if a condition is \ntrue in a situation. This would allow the user to change the matching function from \neql to equal, and to anything else that might be useful. \n\n(defun member-equal (item list) \n(member item list :test #*equal)) \n\nThe function apply-op, which used to change the state irrevocably and print a message \nreflecting this, now returns the new state instead of printing anything. It first \ncomputes the state that would result from achieving all the preconditions of the \noperator. If it is possible to arrive at such a state, then apply-op returns a new state \nderived from this state by adding what's in the add-list and removing everything in \nthe delete-list. \n\n(defun apply-op (state goal op goal-stack) \n\"Return a new, transformed state if op is applicable.\" \n(dbg-indent :gps (length goal-stack) \"Consider: ~a\" (op-action op)) \n(let ((state2 (achieve-all state (op-preconds op) \n\n(cons goal goal-stack)))) \n\n(unless (null state2) \n;; Return an updated state \n(dbg-indent :gps (length goal-stack) \"Action: ~a\" (op-action op)) \n(append (remove-if #*(lambda (x) \n\n(member-equal . (op-del-list op))) \nstateZ) \n(op-add-list op))))) \n\n(defun appropriate-p (goal op) \n\"An op is appropriate to a goal if it is in its add-list.\" \n(member-equal goal (op-add-list op))) \n\nThere is one last complication in the way we compute the new state. In version \n1 of GPS, states were (conceptually) unordered sets of conditions, so we could use \nuni on and set -di f f erence to operate on them. In version 2, states become ordered \nlists, because we need to preserve the ordering of actions. Thus, we have to use the \nfunctions append and remove-if, since these are defined to preserve order, while \nunion and set -difference are not. \n\nFinally, the last difference in version 2 is that it introduces a new function: use. \nThis function is intended to be used as a sort of declaration that a given list of operators \nis to be used for a series of problems. \n\n\f\n<a id='page-130'></a>\n\n(defun use (oplist) \n\n\"Use oplist as the default list of operators.\" \nReturn something useful, but not too verbose: \nthe number of operators, \n\n(length (setf *ops* oplist))) \n\nCalling use sets the parameter *ops*, so that it need not be specified on each call \nto GPS. Accordingly, in the definition of GPS itself the third argument, *ops*, is now \noptional; if it is not supplied, a default will be used. The default value for *ops* is \ngiven as *ops*. This may seem redundant or superfluous—how could a variable be \nits own default? The answer is that the two occurrences of *ops* look alike, but they \nactually refer to two completely separate bindings of the special variable *ops*. Most \nof the time, variables in parameter lists are local variables, but there is no rule against \nbinding a special variable as a parameter. Remember that the effect of binding a \nspecial Vciriable is that all references to the special variable that occur anywhere in \nthe program—even outside the lexical scope of the function—refer to the new binding \nof the special variable. So after a sequence of calls we eventually reach achieve, \nwhich references *ops*, and it will see the newly bound value of *ops*. \n\nThe definition of GPS is repeated here, along with an alternate version that binds \na local variable and explicitly sets and resets the special variable *ops*. Clearly, \nthe idiom of binding a special variable is more concise, and while it can be initially \nconfusing, it is useful once understood. \n\n(defun GPS (state goals &optional (*ops* *ops*)) \n\"General Problem Solver: from state, achieve goals using *ops*.\" \n(remove-if #'atom (achieve-all (cons '(start) state) goals nil))) \n\n(defun GPS (state goals &optional (ops *ops*)) \n\"General Problem Solver: from state, achieve goals using *ops*.\" \n(let ((old-ops *ops*)) \n\n(setf *ops* ops) \n\n(let ((result (remove-if #'atom (achieve-all \n(cons '(start) state) \ngoalsnil)))) \n\n(setf *ops* old-ops) \nresult))) \n\nNow let's see how version 2 performs. We use the list of operators that includes the \n\"asking the shop their phone number\" operator. First we make sure it will still do the \nexamples version 1 did: \n\n> (use *school-ops*) 7 \n\n\f\n<a id='page-131'></a>\n> (gps '(son-at-home car-needs-battery have-money have-phone-book) \n'(son-at-school)) \n\n((START) \n(EXECUTING LOOK-UP-NUMBER) \n(EXECUTING TELEPHONE-SHOP) \n(EXECUTING TELL-SHOP-PROBLEM) \n(EXECUTING GIVE-SHOP-MONEY) \n(EXECUTING SHOP-INSTALLS-BATTERY) \n(EXECUTING DRIVE-SON-TO-SCHOOL)) \n\n> (debug :gps) => (:GPS) \n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book) \n\n'(son-at-school)) \nGoal: SON-AT-SCHOOL \nConsider: DRIVE-SON-TO-SCHOOL \n\nGoal: SON-AT-HOME \nGoal: CAR-WORKS \nConsider: SHOP-INSTALLS-BATTERY \n\nGoal: CAR-NEEDS-BATTERY \nGoal: SHOP-KNOWS-PROBLEM \nConsider: TELL-SHOP-PROBLEM \n\nGoal: IN-COMMUNICATION-WITH-SHOP \n\nConsider: TELEPHONE-SHOP \nGoal: KNOW-PHONE-NUMBER \nConsider: ASK-PHONE-NUMBER \n\nGoal: IN-COMMUNICATION-WITH-SHOP \nConsider: LOOK-UP-NUMBER \nGoal: HAVE-PHONE-BOOK \nAction: LOOK-UP-NUMBER \n\nAction: TELEPHONE-SHOP \nAction: TELL-SHOP-PROBLEM \nGoal: SHOP-HAS-MONEY \nConsider: GIVE-SHOP-MONEY \n\nGoal: HAVE-MONEY \nAction: GIVE-SHOP-MONEY \n\nAction: SHOP-INSTALLS-BATTERY \nAction: DRIVE-SON-TO-SCHOOL \n((START) \n\n(EXECUTING LOOK-UP-NUMBER) \n(EXECUTING TELEPHONE-SHOP) \n(EXECUTING TELL-SHOP-PROBLEM) \n(EXECUTING GIVE-SHOP-MONEY) \n(EXECUTING SHOP-INSTALLS-BATTERY) \n(EXECUTING DRIVE-SON-TO-SCHOOL)) \n\n> (undebug) NIL \n\n\f\n<a id='page-132'></a>\n\n> (gps *(son-at-home car-works) \n'(son-at-school)) \n((START) \n(EXECUTING DRIVE-SON-TO-SCHOOL)) \n\nNow we see that version 2 can also handle the three cases that version 1 got wrong. \nIn each case, the program avoids an infinite loop, and also avoids leaping before \nit looks. \n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book) \n'(have-money son-at-school)) \nNIL \n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book) \n'(son-at-school have-money)) \nNIL \n\n> (gps '(son-at-home car-needs-battery have-money) \n'(son-at-school)) \nNIL \n\nFinally, we see that this version of GPS also works on trivial problems requiring no \naction: \n\n> (gps '(son-at-home) '(son-at-home)) => ((START)) \n\n4.12 The New Domain Problem: Monkey \nand Bananas \nTo show that GPS is at all general, we have to make it work in different domains. We \nwill start with a \"classic\" AI problem.^ Imagine the following scenario: a hungry \nmonkey is standing at the doorway to a room. In the middle of the room is a bunch \nof bananas suspended from the ceiling by a rope, well out of the monkey's reach. \nThere is a chair near the door, which is light enough for the monkey to push and tall \nenough to reach almost to the bananas. Just to make things complicated, assume the \nmonkey is holding a toy ball and can only hold one thing at a time. \n\nIn trying to represent this scenario, we have some flexibility in choosing what to \nput in the current state and what to put in with the operators. For now, assume we \ndefine the operators as follows: \n\n^Originally posed by Saul Amarel (1968). \n\n\f\n<a id='page-133'></a>\n(defparameter *banana-ops* \n(list \n\n(op 'climb-on-chair \nipreconds '(chair-at-middle-room at-middle-room on-floor) \n:add-list '(at-bananas on-chair) \n:del-list '(at-middle-room on-floor)) \n\n(op 'push-chair-from-door-to-middle-room \n:preconds '(chair-at-door at-door) \n:add-list '(chair-at-middle-room at-middle-room) \n:del-list '(chair-at-door at-door)) \n\n(op 'walk-from-door-to-middle-room \nipreconds '(at-door on-floor) \n;add-list '(at-middle-room) \n:del-list '(at-door)) \n\n(op 'grasp-bananas \nrpreconds '(at-bananas empty-handed) \n:add-list '(has-bananas) \n:del-list '(empty-handed)) \n\n(op 'drop-ball \nipreconds '(has-ball) \nladd-list '(empty-handed) \nidel-list '(has-balD) \n\n(op 'eat-bananas \nipreconds '(has-bananas) \nladd-list '(empty-handed not-hungry) \nidel-list '(has-bananas hungry)))) \n\nUsing these operators, we could pose the problem of becoming not-hungry, given \nthe initial state of being at the door, standing on the floor, holding the ball, hungry, \nand with the chair at the door. GPS can find a solution to this problem: \n\n> (use *banana-ops*) => 6 \n\n> (GPS '(at-door on-floor has-ball hungry chair-at-door) \n'(not-hungry)) \n\n((START) \n(EXECUTING PUSH-CHAIR-FROM-DOOR-TO-MIDDLE-ROOM) \n(EXECUTING CLIMB-ON-CHAIR) \n(EXECUTING DROP-BALL) \n(EXECUTING GRASP-BANANAS) \n(EXECUTING EAT-BANANAS)) \n\nNotice we did not need to make any changes at all to the GPS program. We just used \na different set of operators. \n\n\f\n<a id='page-134'></a>\n\n4.13 The Maze Searching Domain \nNow we will consider another \"classic\" problem, maze searching. We will assume a \nparticular maze, diagrammed here. \n\n1 2 3 4 5 \n6 7 8 9 10 \n11 12 13 14 15 \n16 17 18 19 20 \n21 22 23 24 25 \n\nIt is much easier to define some functions to help build the operators for this \ndomain than it would be to type in all the operators directly. The following code \ndefines a set of operators for mazes in general, and for this maze in particular: \n\n(defun make-maze-ops (pair) \n\"Make maze ops in both directions\" \n(list (make-maze-op (first pair) (second pair)) \n\n(make-maze-op (second pair) (first pair)))) \n\n(defun make-maze-op (here there) \n\"Make an operator to move between two places\" \n(op '(move from ,here to .there) \n\nipreconds '((at .here)) \n:add-list '((at .there)) \n:del-list '((at .here)))) \n\n(defparameter *maze-ops* \n(mappend #'make-maze-ops \n\n'((1 2) (2 3) (3 4) (4 9) (9 14) (9 8) (8 7) (7 12) (12 13) \n(12 11) (11 6) (11 16) (16 17) (17 22) (21 22) (22 23) \n(23 18) (23 24) (24 19) (19 20) (20 15) (15 10) (10 5) (20 25)))) \n\nNote the backquote notation, (It is covered in section 3.2, [page 67](chapter3.md#page-67). \nWe can now use this list of operators to solve several problems with this maze. \nAnd we could easily create another maze by giving another list of connections. Note \nthat there is nothing that says the places in the maze are arranged in a five-by-five \nlayout—that is just one way of visualizing the connectivity. \n\n> (use *maze-ops*) 48 \n\n\f\n<a id='page-135'></a>\n> (gps '((at D) '((at 25))) \n\n((START) \n(EXECUTING (MOVE FROM 1 TO 2)) \n(EXECUTING (MOVE FROM 2 TO 3)) \n(EXECUTING (MOVE FROM 3 TO 4)) \n(EXECUTING (MOVE FROM 4 TO 9)) \n(EXECUTING (MOVE FROM 9 TO 8)) \n(EXECUTING (MOVE FROM 8 TO 7)) \n(EXECUTING (MOVE FROM 7 TO 12)) \n(EXECUTING (MOVE FROM 12 TO ID ) \n(EXECUTING (MOVE FROM 11 TO 16)) \n(EXECUTING (MOVE FROM 16 TO 17)) \n(EXECUTING (MOVE FROM 17 TO 22)) \n(EXECUTING (MOVE FROM 22 TO 23)) \n(EXECUTING (MOVE FROM 23 TO 24)) \n(EXECUTING (MOVE FROM 24 TO 19)) \n(EXECUTING (MOVE FROM 19 TO 20)) \n(EXECUTING (MOVE FROM 20 TO 25)) \n(AT 25)) \n\nThere is one subtle bug that the maze domain points out. We wanted GPS to return \na list of the actions executed. However, in order to account for the case where the \ngoal can be achieved with no action, I included (START) in the value returned by \nGPS. These examples include the START and EXECUTING forms but also a list of the \nform (AT n), for some n. This is the bug. If we go back and look at the function \nGPS, we find that it reports the result by removing all atoms from the state returned \nby achieve-al 1 . This is a \"pun\"—we said remove atoms, when we really meant \nto remove all conditions except the (START) and (EXECUTING action) forms. Up to \nnow, all these conditions were atoms, so this approach worked. The maze domain \nintroduced conditions of the form (AT n), so for the first time there was a problem. \nThe moral is that when a programmer uses puns—saying what's convenient instead \nof what's really happening—there's bound to be trouble. What we really want to do \nis not to remove atoms but to find all elements that denote actions. The code below \nsays what we mean: \n\n(defun GPS (state goals &optional (*ops* *ops*)) \n\"General Problem Solver: from state, achieve goals using *ops*.\" \n(find-all-if #*action-p \n\n(achieve-all (cons '(start) state) goals nil))) \n\n\f\n<a id='page-136'></a>\n\n(defun action-p (x) \n\"Is . something that is (start) or (executing ...)? \" \n(or (equal . '(start)) (executing-p x))) \n\nThe domain of maze solving also points out an advantage of version 2: that it returns \na representation of the actions taken rather than just printing them out. The reason \nthis is an advantage is that we may want to use the results for something, rather than \njust look at them. Suppose we wanted a function that gives us a path through a maze \nas a list of locations to visit in turn. We could do this by calling GPS as a subfunction \nand then manipulating the results: \n\n(defun find-path (start end) \n\"Search a maze for a path from start to end.\" \n(let ((results (GPS '((at .start)) '((at .end))))) \n\n(unless (null results) \n(cons start (mapcar #'destination \n(remove '(start) results \n:test #'equal)))))) \n\n(defun destination (action) \n\"Find the Y in (executing (move from X to Y))\" \n(fifth (second action))) \n\nThe function f i nd - path calls GPS to get the resul ts. If this is ni 1, there is no answer, \nbut if it is not, then take the rest of results (in other words, ignore the (START) part). \nPick out the destination,!/, from each (EXECUTING (MOVE FROM . TO y)) form, and \nremember to include the starting point. \n\n> (use *maze-ops*) => 48 \n\n> (find-path 1 25) ^ \n(1 2 3 4 9 8 7 12 11 16 17 22 23 24 19 20 25) \n\n> (find-path 1 1) (1) \n\n> (equal (find-path 1 25) (reverse (find-path 25 1))) => . \n\n4.14 The Blocks World Domain \n\nAnother domain that has attracted more than its share of attention in AI circles is \nthe blocks world domain. Imagine a child's set of building blocks on a table top. \nThe problem is to move the blocks from their starting configuration into some goal \nconfiguration. We will assume that each block can have only one other block directly \n\n\f\n<a id='page-137'></a>\non top of it, although they can be stacked to arbitrary height. The only action that \ncan be taken in this world is to move a single block that has nothing on top of it either \nto the top of another block or onto the table that represents the block world. We will \ncreate an operator for each possible block move. \n\n(defun make-block-ops (blocks) \n(let ((ops nil)) \n(dolist (a blocks) \n(dolist (b blocks) \n(unless (equal a b) \n(dolist (c blocks) \n(unless (or (equal c a) (equal c b)) \n\n(push (move-op abc) ops))) \n(push (move-op a 'table b) ops) \n(push (move-op a b 'table) ops)))) \n\nops)) \n\n(defun move-op (a b c) \n\"Make an operator to move A from . to C. \" \n(op '(move .a from .b to ,c) \n\nipreconds '((space on ,a) (space on ,c) (,a on .b)) \nladd-list (move-ons abc) \nidel-list (move-ons a c b))) \n\n(defun move-ons (a b c) \n\n(if (eq b 'table) \n*((,a on ,c)) \n*((.a on ,c) (space on ,b)))) \n\nNow we try these operators out on some problems. The simplest possible problem \nis stacking one block on another: \n\n. \nstart goal \n\n> (use (make-block-ops '(a b))) => 4 \n\n> (gps '((a on table) (b on table) (space on a) (space on b) \n(space on table)) \n'((a on b) (b on table))) \n((START) \n(EXECUTING (MOVE A FROM TABLE TO B))) \n\n\f\n<a id='page-138'></a>\n\nHere is a slightly more complex problem: inverting a stack of two blocks. This time \nwe show the debugging output. \n\nstart goa \n\n> (debug :gps) (:GPS) \n\n> (gps *((a on b) (b on table) (space on a) (space on table)) \n\n'((b on a))) \nGoal: (B ON A) \nConsider: (MOVE . FROM TABLE TO A) \n\nGoal: (SPACE ON B) \n\nConsider: (MOVE A FROM . TO TABLE) \nGoal: (SPACE ON A) \nGoal: (SPACE ON TABLE) \nGoal: (A ON B) \n\nAction: (MOVE A FROM . TO TABLE) \nGoal: (SPACE ON A) \nGoal: (B ON TABLE) \n\nAction: (MOVE . FROM TABLE TO A) \n\n((START) \n(EXECUTING (MOVE A FROM . TO TABLE)) \n(EXECUTING (MOVE . FROM TABLE TO A))) \n\n> (undebug) NIL \n\nSometimes it matters what order you try the conjuncts in. For example, you can't \nhave your cake and eat it too, but you can take a picture of your cake and eat it too, as \nlong as you take the picture before eating it. In the blocks world, we have: \n\nA \n_B_ \nC \n\nstart\n\n> (use (make-block-ops '(a b c))) 18 \n\n> (gps '((a on b) (b on c) (c on table)\n'((b on a) (c on b))) \n\n((START) \n(EXECUTING (MOVE A FROM . TO TABLE)) \n(EXECUTING (MOVE . FROM C TO A)) \n(EXECUTING (MOVE C FROM TABLE TO B))) \n\nC \n\n_B_ \n\nA \n\n goal \n\n (space on a) (space on table)) \n\n\f\n<a id='page-139'></a>\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table)) \n'((c on b) (b on a))) \nNIL \n\nIn the first case, the tower was built by putting . on A first, and then C on B. In \nthe second case, the program gets C on . first, but clobbers that goal while getting . \non A. The \"prerequisite clobbers sibling goal\" situation is recognized, but the program \ndoesn't do anything about it. One thing we could do is try to vary the order of the \nconjunct goals. That is, we could change achieve-al 1 as follows: \n\n(defun achieve-all (state goals goal-stack) \n\"Achieve each goal, trying several orderings.\" \n(some #'(lambda (goals) (achieve-each state goals goal-stack)) \n\n(orderings goals))) \n\n(defun achieve-each (state goals goal-stack) \n\"Achieve each goal, and make sure they still hold at the end.\" \n(let ((current-state state)) \n\n(if (and (every #'(lambda (g) \n(setf current-state \n(achieve current-state g goal-stack))) \ngoals) \n(subsetp goals current-state :test #*equal)) \ncurrent-state))) \n\n(defun orderings (1) \n\n(if (> (length 1) 1) \n(1 ist 1 (reverse 1)) \n(list 1))) \n\nNow we can represent the goal either way, and we'll still get an answer. Notice that \nwe only consider two orderings: the order given and the reversed order. Obviously, \nfor goal sets of one or two conjuncts this is all the orderings. In general, if there \nis only one interaction per goal set, then one of these two orders will work. Thus, \nwe are assuming that \"prerequisite clobbers sibling goal\" interactions are rare, and \nthat there will seldom be more than one interaction per goal set. Another possibility \nwould be to consider all possible permutations of the goals, but that could take a long \ntime with large goal sets. \n\nAnother consideration is the efficiency of solutions. Consider the simple task of \ngetting block C on the table in the following diagram: \n\nA] \\B] [A] [B] \nstart goal \n\f\n<a id='page-140'></a>\n\n> (gps '((c on a) (a on table) (b on table) \n(space on c) (space on b) (space on table)) \n'((c on table))) \n\n((START) \n(EXECUTING (MOVE C FROM A TO B)) \n(EXECUTING (MOVE C FROM . TO TABLE))) \n\nThe solution is correct, but there is an easier solution that moves C directly to the \ntable. The simpler solution was not found because of an accident: it happens that \nmake-bl ock-ops defines the operators so that moving C from . to the table comes \nbefore moving C from A to the table. So the first operator is tried, and it succeeds \nprovided C is on B. Thus, the two-step solution is found before the one-step solution is \never considered. The following example takes four steps when it could be done in two: \n\n. \nstart goal \n\n> (gps '((c on a) (a on table) (b on table) \n(space on c) (space on b) (space on table)) \n'((c on table) (a on b))) \n\n((START) \n(EXECUTING (MOVE C FROM A TO B)) \n(EXECUTING (MOVE C FROM . TO TABLE)) \n(EXECUTING (MOVE A FROM TABLE TO O ) \n(EXECUTING (MOVE A FROM C TO B))) \n\nHow could we find shorter solutions? One way would be to do a full-fledged search: \nshorter solutions are tried first, temporarily abandoned when something else looks \nmore promising, and then reconsidered later on. This approach is taken up in \nchapter 6, using a general searching function. A less drastic solution is to do a limited \nrearrangement of the order in which operators are searched: the ones with fewer \nunfulfilled preconditions are tried first. In particular, this means that operators with \nall preconditions filled would always be tried before other operators. To implement \nthis approach, we change achi eve: \n\n(defun achieve (state goal goal-stack) \n\"A goal is achieved if it already holds, \nor if there is an appropriate op for it that is applicable.\" \n(dbg-indent :gps (length goal-stack) \"Goal:~a\" goal) \n(cond ((member-equal goal state) state) \n\n((member-equal goal goal-stack) nil) \n\n\f\n<a id='page-141'></a>\n\n(t (some #'(lambda (op) (apply-op state goal op goal-stack)) \n(appropriate-ops goal state))))) \n\n(defun appropriate-ops (goal state) \n\"Return a list of appropriate operators, \nsorted by the number of unfulfilled preconditions.\" \n(sort (copy-list (find-all goal *ops* :test #'appropriate-p)) #'< \n\n:key #*(lambda (op) \n(count-if #'(lambda (precond) \n(not (member-equal precond state))) \n(op-preconds op))))) \n\nNow we get the solutions we wanted: \n\nstart goal \n\n> (gps '((c on a) (a on table) (b on table) \n(space on c) (space on b) (space on table)) \n'((c on table) (a on b))) \n\n((START) \n(EXECUTING (MOVE C FROM A TO TABLE)) \n(EXECUTING (MOVE A FROM TABLE TO B))) \n\nstart goal \n\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table)) \n'((b on a) (c on b))) \n\n((START) \n(EXECUTING (MOVE A FROM . TO TABLE)) \n(EXECUTING (MOVE . FROM C TO A)) \n(EXECUTING (MOVE C FROM TABLE TO B))) \n\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table)) \n'((c on b) (b on a))) \n\n((START) \n(EXECUTING (MOVE A FROM . TO TABLE)) \n(EXECUTING (MOVE . FROM C TO A)) \n(EXECUTING (MOVE C FROM TABLE TO B))) \n\n\f\n<a id='page-142'></a>\n\nThe Sussman Anomaly \n\nSurprisingly, there are problems that can't be solved by any reordering of goals. \nConsider: \n\n. A \nStart goal \n\nThis doesn't look too hard, so let's see how our GPS handles it: \n\n> (setf start '((c on a) (a on table) (b on table) (space on c) \n(space on b) (space on table))) \n((C ON A) (A ON TABLE) (B ON TABLE) (SPACE ON C) \n(SPACE ON B) (SPACE ON TABLE)) \n\n> (gps start '((a on b) (b on c))) NIL \n\n> (gps start *((b on c) (a on b))) => NIL \n\nThere is a \"prerequisite clobbers sibling goal\" problem regardless of which way we \norder the conjuncts! In other words, no combination of plans for the two individual \ngoals can solve the conjunction of the two goals. This is a surprising fact, and the \nexample has come to be known as \"the Sussman anomaly.\"^ We will return to this \nproblem in chapter 6. \n\n4.15 Stage 5 Repeated: Analysis of Version 2 \nWe have shown that GPS is extensible to multiple domains. The main point is that \nwe didn't need to change the program itself to get the new domains to work; we \njust changed the list of operators passed to GPS. Experience in different domains \ndid suggest changes that could be made, and we showed how to incorporate a few \nchanges. Although version 2 is a big improvement over version 1, it still leaves much \nto be desired. Now we will discover a few of the most troubling problems. \n\n^ A footnote in Waldinger 1977 says, 'This problem was proposed by Allen Brown. Perhaps \nmany children thought of it earlier but did not recognize that it was hard.\" The problem is \nnamed after Gerald Sussman because he popularized it in Sussman 1973. \n\n\f\n<a id='page-143'></a>\n4.16 The Not Looking after You Don^t \nLeap Problem \nWe solved the \"leaping before you look\" problem by introducing variables to hold a \nrepresentation of possible future states, rather than just a single variable representing \nthe current state. This prevents GPS from taking an ill-advised action, but we shall \nsee that even with all the repair strategies introduced in the last section, it doesn't \nguarantee that a solution will be found whenever one is possible. \n\nTo see the problem, add another operator to the front of the ^school - ops* Hst \nand turn the debugging output back on: \n\n(use(push (op 'taxi-son-to-school \n:preconds *(son-at-home have-money) \n:add-list '(son-at-school) \n:del-list '(son-at-home have-money)) \n\n*school-ops*)) \n\n(debug :gps) \n\nNow, consider the problem of getting the child to school without using any money: \n\n> (gps '(son-at-home have-money car-works) \n\n'(son-at-school have-money)) \nGoal: SON-AT-SCHOOL \nConsider: TAXI-SON-TO-SCHOOL \n\nGoal: SON-AT-HOME \n\nGoal: HAVE-MONEY \nAction: TAXI-SON-TO-SCHOOL \nGoal: HAVE-MONEY \nGoal: HAVE-MONEY \nGoal: SON-AT-SCHOOL \nConsider: TAXI-SON-TO-SCHOOL \n\nGoal: SON-AT-HOME \n\nGoal: HAVE-MONEY \nAction: TAXI-SON-TO-SCHOOL \nNIL \n\nThe first five lines of output succesfully solve the son-at-school goal with the \nTAX I - SON - TO- SCHOO L action. The next line shows an unsuccesf ul attempt to solve the \nhave - money goal. The next step is to try the other ordering. This time, the have - money \ngoal is tried first, and succeeds. Then, the son-at-school goal is achieved again by \nthe TAX I - SON - TO- SCHOO L action. But the check for consistency in achi eve-each fails, \nand there are no repairs available. The goal fails, even though there is a valid solution: \ndriving to school. \n\n\f\n<a id='page-144'></a>\n\nThe problem is that achi eve uses some to look at the appropri ate-ops. Thus, if \nthere is some appropriate operator, achi eve succeeds. If there is only one goal, this \nwill yield a correct solution. However, if there are multiple goals, as in this case, \nachi eve will still only find one way to fulfill the first goal. If the first solution is a bad \none, the only recourse is to try to repair it. In domains like the block world and maze \nworld, repair often works, because all steps are reversible. But in the taxi example, no \namount of plan repair can get the money back once it is spent, so the whole plan fails. \n\nThere are two ways around this problem. The first approach is to examine all \npossible solutions, not just the first solution that achieves each subgoal. The language \nProlog, to be discussed in chapter 11, does just that. The second approach is to have \nachi eve and achi eve-al 1 keep track of a list of goals that must be protected. In the \ntaxi example, we would trivially achieve the have-money goal and then try to achieve \nson-at-school, while protecting the goal have-money. An operator would only \nbe appropriate if it didn't delete any protected goals. This approach still requires \nsome kind of repair or search through multiple solution paths. If we tried only \none ordering-achieving son - at - school and then trying to protect it while achieving \nhave - money—then we would not find the solution. David Warren's WARPLAN planner \nmakes good use of the idea of protected goals. \n\n4.17 The Lack of Descriptive Power Problem \nIt would be a lot more economical, in the maze domain, to have one operator that \nsays we can move from here to there if we are at \"here,\" and if there is a connection \nfrom \"here\" to \"there.\" Then the input to a particular problem could list the valid \nconnections, and we could solve any maze with this single operator. Similarly, we \nhave defined an operator where the monkey pushes the chair from the door to the \nmiddle of the room, but it would be better to have an operator where the monkey \ncan push the chair from wherever it is to any other nearby location, or better yet, an \noperator to push any \"pushable\" object from one location to a nearby one, as long \nas there is no intervening obstacle. The conclusion is that we would like to have \nvariables in the operators, so we could say something like: \n\n(op '(push X from A to B) \n\n:preconds '((monkey at A) (X at A) (pushable X) (path A B)) \n\n:add-list '((monkey at B) (X at B)) \n\n:del-list '((monkey at A) (X at A))) \n\nOften we want to characterize a state in terms of something more abstract than a \nlist of conditions. For example, in solving a chess problem, the goal is to have the \nopponent in checkmate, a situation that cannot be economically described in terms \nof primitives like (bl ack ki ng on A 4), so we need to be able to state some kind \n\n\f\n<a id='page-145'></a>\nof constraint on the goal state, rather than just listing its components. We might \nwant to be able to achieve a disjunction or negation of conditions, where the current \nformalism allows only a conjunction. \n\nIt also is important, in many domains, to be able to state problems dealing with \ntime: we want to achieve X before time To, and then achieve Y before time T2, but \nnot before Ti. Scheduling work on a factory floor or building a house are examples \nof planning where time plays an important role. \n\nOften there are costs associated with actions, and we want to find a solution \nwith minimal, or near-minimal costs. The cost might be as simple as the number of \noperators required for a solution—we saw in the blocks world domain that sometimes \nan operator that could be applied immediately was ignored, and an operator that \nneeded several preconditions satisfied was chosen instead. Or we may be satisfied \nwith a partial solution, if a complete solution is impossible or too expensive. We may \nalso want to take the cost (and time) of computation into account. \n\n4.18 The Perfect Information Problem \nAll the operators we have seen so far have unambiguous results; they add or delete \ncertain things from the current state, and GPS always knows exactly what they are \ngoing to do. In the real world, things are rarely so cut and dried. Going back to the \nproblem of becoming rich, one relevant operator would be playing the lottery. This \noperator has the effect of consuming a few dollars, and once in a while paying off a \nlarge sum. But we have no way to represent a payoff \"once in a while.\" Similarly, \nwe have no way to represent unexpected difficulties of any kind. In the nursery \nschool problem, we could represent the problem with the car battery by having GPS \nexplicitly check to see if the car was working, or if it needed a battery, every time \nthe program considered the driving operator. In the real world, we are seldom this \ncareful; we get in the car, and only when it doesn't start do we consider the possibility \nof a dead battery. \n\n4.19 The Interacting Goals Problem \nPeople tend to have multiple goals, rather than working on one at a time. Not only do \nI want to get the kid to nursery school, but I want to avoid getting hit by another car, \nget to my job on time, get my work done, meet my friends, have some fun, continue \nbreathing, and so on. I also have to discover goals on my own, rather than work on \na set of predefined goals passed to me by someone else. Some goals I can keep in \nthe background for years, and then work on them when the opportunity presents \nitself. There is never a notion of satisfying all possible goals. Rather, there is a \n\n\f\n<a id='page-146'></a>\n\ncontinual process of achieving some goals, partially achieving others, and deferring \nor abandoning still others. \n\nIn addition to having active goals, people also are aware of undesirable situations \nthat they are trying to avoid. For example, suppose I have a goal of visiting a friend \nin the hospital. This requires being at the hospital. One appHcable operator might \nbe to walk to the hospital, while another would be to severly injure myself and wait \nfor the ambulance to take me there. The second operator achieves the goal just as \nwell (perhaps faster), but it has an undesirable side effect. This could be addressed \neither with a notion of solution cost, as outlined in the last section, or with a list of \nbackground goals that every solution attempts to protect. \n\nHerb Simon coined the term \"satisficing\" to describe the strategy of satisfying a \nreasonable number of goals to a reasonable degree, while abandoning or postponing \nother goals. GPS only knows success and failure, and thus has no way of maximizing \npartial success. \n\n4.20 The End of GPS \nThese last four sections give a hint as to the scope of the limitations of GPS. In fact, it \nis not a very general problem solver at all. Itis general in the sense that the algorithm \nis not tied to a particular domain; we can change domain by changing the operators. \nBut GPS fails to be general in that it can't solve many interesting problems. It is \nconfined to small tricks and games. \n\nThere is an important yet subtle reason why GPS was destined to fail, a reason \nthat was not widely appreciated in 1957 but now is at the core of computer science. \nIt is now recognized that there are problems that computers can't solve—not because \na theoretically correct program can't be written, but because the execution of the \nprogram will take too long. A large number of problems can be shown to fall into \nthe class of \"NP-hard\" problems. Computing a solution to these problems takes \ntime that grows exponentially as the size of the problem grows. This is a property \nof the problems themselves, and holds no matter how clever the programmer is. \nExponential growth means that problems that can be solved in seconds for, say, a \nfive-input case may take trillions of years when there are 100 inputs. Buying a faster \ncomputer won't help much. After all, if a problem would take a trillion years to solve \non your computer, it won't help much to buy 1000 computers each 1000 times faster \nthan the one you have: you're still left with a million years wait. For a theoretical \ncomputer scientist, discovering that a problem is NP-hard is an end in itself. But for \nan AI worker, it means that the wrong question is being asked. Many problems are \nNP-hard when we insist on the optimal solution but are much easier when we accept \na solution that might not be the best. \n\nThe input to GPS is essentially a program, and the execution of GPS is the execution \nof that program. If GPS's input language is general enough to express any program. \n\n\f\n<a id='page-147'></a>\nthen there will be problems that can't be solved, either because they take too long \nto execute or because they have no solution. Modern problem-solving programs \nrecognize this fundamental limitation, and either limit the class of problems they try \nto solve or consider ways of finding approximate or partial solutions. Some problem \nsolvers also monitor their own execution time and know enough to give up when a \nproblem is too hard. \n\nThe following quote from Drew McDermott's article \"Artificial Intelligence Meets \nNatural Stupidity\" sums up the current feeling about GPS. Keep it in mind the next \ntime you have to name a program. \n\nRemember GPS? By now, \"GPS\" is a colorless term denoting a particularly stupid \nprogram to solve puzzles. But it originally meant ''General Problem Solver,\" \nwhich caused everybody a lot of needless excitement and distraction. It should \nhave been called LFGNS-\"Loca/ Feature-Guided Network Searcher.\" \n\nNonetheless, GPS has been a useful vehicle for exploring programming in general, \nand AI programming in particular. More importantly, it has been a useful vehicle \nfor exploring \"the nature of deliberation.\" Surely we'll admit that Aristotle was \na smarter person than you or me, yet with the aid of the computational model of \nmind as a guiding metaphor, and the further aid of a working computer program \nto help explore the metaphor, we have been led to a more thorough appreciation of \nmeans-ends analysis—at least within the computational model. We must resist the \ntemptation to believe that all thinking follows this model. \n\nThe appeal of AI can be seen as a split between means and ends. The end of a \nsuccessful AI project can be a program that accomplishes some useful task better, \nfaster, or cheaper than it could be before. By that measure, GPS is a mostly a failure, \nas it doesn't solve many problems particularly well. But the means toward that end \ninvolved an investigation and formalization of the problem-solving process. By that \nmeasure, our reconstruction of GPS is a success to the degree in which it leads the \nreader to a better understanding of the issues. \n\n4.21 History and References \nThe original GPS is documented in Newell and Simon's 1963 paper and in their 1972 \nbook. Human Problem Solving, as well as in Ernst and Newell 1969. The implementation \nin this chapter is based on the STRIPS program (Fikes and Nilsson 1971). \n\nThere are other important planning programs. Earl Sacerdoti's ABSTRIPS program \nwas a modification of STRIPS that allowed for hierarchical planning. The idea was to \nsketch out a skeletal plan that solved the entire program at an abstract level, and then \nfill in the details. David Warren's WARPLAN planner is covered in Warren 1974a,b \nand in a section of Coelho and Cotta 1988. Austin Tate's NONLIN system (Tate 1977) \n\n\f\n<a id='page-148'></a>\n\nachieved greater efficiency by considering a plan as a partially ordered sequence of \noperations rather than as a strictly ordered sequence of situations. David Chapman's \nTWEAK synthesizes and formalizes the state of the art in planning as of 1987. \nAll of these papers-an d quite a few other important planning papers-ar e \nreprinted in Allen, Hendler, and Tate 1990. \n4.22 Exercises \n&#9635; Exercise 4.1 [m] It is possible to implement dbg using a single call to format. Can \nyou figure out the format directives to do this? \n\n&#9635; Exercise 4.2 [m] Write a function that generates all permutations of its input. \n\n&#9635; Exercise 4.3 [h] GPS does not recognize the situation where a goal is accidentally \nsolved as part of achieving another goal. Consider the goal of eating dessert. Assume \nthat there are two operators available: eating ice cream (which requires having the \nice cream) and eating cake (which requires having the cake). Assume that we can \nbuy a cake, and that the bakery has a deal where it gives out free ice cream to each \ncustomer who purchases and eats a cake. (1) Design a list of operators to represent \nthis situation. (2) Give gps the goal of eating dessert. Show that, with the right list \nof operators, gps will decide to eat ice cream, then decide to buy and eat the cake in \norder to get the free ice cream, and then go ahead and eat the ice cream, even though \nthe goal of eating dessert has already been achieved by eating the cake. (3) Fix gps so \nthat it does not manifest this problem. \nThe following exercises address the problems in version 2 of the program. \n\n&#9635; Exercise 4.4 [h] The Not Looking after You Don't Leap Problem. Write a program that \nkeeps track of the remaining goals so that it does not get stuck considering only one \npossible operation when others will eventually lead to the goal. Hint: have achi eve \ntake an extra argument indicating the goals that remain to be achieved after the \ncurrent goal is achieved, achi eve should succeed only if it can achieve the current \ngoal and also achi eve-all the remaining goals. \n\n&#9635; Exercise 4.5 [d] Write a planning program that, like Warren's WARPLAN, keeps \ntrack of the list of goals that remain to be done as well as the list of goals that have \nbeen achieved and should not be undone. The program should never undo a goal \nthat has been achieved, but it should allow for the possibility of reordering steps that \n\n\f\n<a id='page-149'></a>\n\nhave already been taken. In this way, the program will solve the Sussman anomaly \nand similar problems. \n\n&#9635; Exercise 4.6 [d] The Lack of Descriptive Power Problem. Read chapters 5 and 6 to learn \nabout pattern matching. Write a version of GPS that uses the pattern matching tools, \nand thus allows variables in the operators. Apply it to the maze and blocks world \ndomains. Your program will be more efficient if, like Chapman's TWEAK program, \nyou allow for the possibility of variables that remain unbound as long as possible. \n\n&#9635; Exercise 4.7 [d] Speculate on the design of a planner that can address the Perfect \nInformation and Interacting Goals problems. \n\n4.23 Answers \nAnswer 4.1 In this version, the format string \" ~&~V@T~?\" breaks down as follows: \n\nmeans go to a fresh line; \"~V@T\" means insert spaces (@T) but use the next \nargument (V) to get the number of spaces. The \" ~?\" is the indirection operator: use \nthe next argument as a format string, and the argument following that as the list of \narguments for the format string. \n\n(defun dbg-indent (id indent format-string &rest args) \n\"Print indented debugging info if (DEBUG ID) has been specified.\" \n(when (member id *dbg-ids*) \n\n(format *debug-io* \"~&~v@T~?\" (* 2 indent) format-string args))) \n\n\f\n<a id='page-150'></a>\n\nAnswer 4.2 Here is one solution. The sophisticated Lisp programmer should also \nsee the exercise on [page 680](chapter19.md#page-680). \n\n(defun permutations (bag) \n\n\"Return a list of all the permutations of the input.\" \nIf the input is nil, there is only one permutation: \nnil itself \n\n(if (null bag) \n\n'(()) \nOtherwise, take an element, e, out of the bag. \nGenerate all permutations of the remaining elements. \nAnd add e to the front of each of these. \nDo this for all possible e to generate all permutations, \n\n(mapcan #'(lambda (e) \n(mapcar #*(lambda (p) (cons e p)) \n(permutations \n(remove e bag :count 1 :test #'eq)))) \nbag))) \n\n\f\n## Chapter 5\n<a id='page-151'></a>\n\nELIZA: Dialog with a Machine \n\nIt is said that to explain is to explain away. \n\n—Joseph Weizenbaum \nMIT computer scientist \n\nI I 1 his chapter and the rest of part I will examine three more well-known AI programs of \n\nI the 1960s. ELIZA held a conversation with the user in which it simulated a psychother\n\n\napist. STUDENT solved word problems of the kind found in high school algebra books, \nand MACSYMA solved a variety of symbolic mathematical problems, including differential and \nintegral calculus. We will develop versions of the first two programs that duplicate most of \nthe essential features, but for the third we will implement only a tiny fraction of the original \nprogram's capabilities. \n\nAll three programs make heavy use of a technique called pattern matching. Part I serves to \nshow the versatility—and also the limitations—of this technique. \n\nOf the three programs, the first two process input in plain English, and the last two solve nontrivial \nproblems in mathematics, so there is some basis for describing them as being \"intelligent.\" \nOn the other hand, we shall see that this intelligence is largely an illusion, and that ELIZA in \nparticular was actually designed to demonstrate this illusion, not to be a \"serious\" AI program. \n\n\f\n<a id='page-152'></a>\n\nELIZA was one of the first programs to feature English output as well as input. \nThe program was named after the heroine of Pygmalion, who was taught to speak \nproper English by a dedicated teacher. ELIZA'S principal developer, MIT professor \nJoseph Weizenbaum, published a paper on ELIZA in the January 1966 issue of the \nCommunications of the Association for Computing Machinery. The introduction to that \npaper is reproduced in its entirety here: \n\nIt is said that to explain is to explain away. This maxim is nowhere so well \nfulfilled as in the area of computer programming, especially in what is called \nheuristic programming and artificial intelligence. For in those realms machines \nare made to behave in wondrous ways, often sufficient to dazzle even the most \nexperienced observer. But once a particular program is unmasked, once its inner \nworkings are explained in language sufficiently plain to induce understanding \nits magic crumbles away; it stands revealed as a mere collection of procedures, \neach quite comprehensible. The observer says to himself, \"I could have written \nthat.\" With that thought he moves the program in question from the shelf \nmarked \"intelligent,\" to that reserved for curios, fit to be discussed only with \npeople less enlightened than he. \n\nThe object of this paper is to cause just such a re-evaluation of the program about \nto be \"explained.\" Few programs ever needed it more. \n\nLet me point out in passing that the main object of this book is to cause the reader \nto say to him or herself, \"I could have written that.\" It is hoped that in some cases \nthis will be because the reader has gained something, and not solely because the \nprograms in question have lost their ability to dazzle. \n\nLet's start our investigation of ELIZA by looking at a sample dialog from the \nWeizenbaum article. ELIZA was designed to be instructed by a variety of scripts, or \npatterns of interaction. In fact it had several scripts, including ones in German and \nWelsh. But the only script that was used to any extent was in English, and it made \nELIZA emulate a Rogerian psychoanalyst. Rogerians are \"nondirective\"—they try to \nlet the patient reveal himself. This is an easy script for ELIZA to follow, because it \ninvolves being passive and reacting, rather than volunteering new information. In \nthe listing that follows, the user's input is in mixed case, and ELIZA'S response is in \ncapitals: \n\nMen are all alike. \nIN WHAT WAY \nThey're always bugging us about something or another. \nCAN YOU BE MORE SPECIFIC \nWell, my boyfriend made me come here. \nYOUR BOYFRIEND MADE YOU COME HERE \nHe says I'm depressed much of the time. \nI AM SORRY TO HEAR YOU ARE DEPRESSED \n\n\f\n<a id='page-153'></a>\n\nIt's true. I am unhappy. \nDO YOU THINK COMING HERE WILL HELP YOU NOT TO BE UNHAPPY \nI need some help, that much seems certain. \nWHAT WOULD IT MEAN TO YOU IF YOU GOT SOME HELP \nPerhaps I could learn to get along with my mother. \nTELL ME MORE ABOUT YOUR FAMILY \n\nThis seems quite impressive; the program is responding reasonably to a variety of \ninputs and appears to be exhibiting true \"understanding.\" But, as Weizenbaum \nexplains, this appearance is an illusion, and the program has finessed the difficult \ntask of understanding by carefully recognizing, transforming, and echoing pieces \nof the input. The procedure is to look for specific patterns, based on a key word \nor words in the input. For example, whenever the program sees the words \"alike\" \nor \"same,\" it prints a message asking about similarity, in this case, \"IN WHAT WAY.\" \nOther patterns are more complicated. In the next to last exchange, ELIZA first throws \naway everything after the comma, and then uses a pattern that looks for input of \nthe form \"I need X\" and transforms it to the output \"What would it mean to you if \nyou got X,\" where X is the phrase \"some help\" in this case. The great advantage of \nthis approach is that the response will make sense for a variety of inputs: \"I need \na vacation\" will elicit \"What would it mean to you if you got a vacation.\" This will \nwork automatically, without having to tell the program the difference between \"some \nhelp\" and \"a vacation.\" The disadvantage is that the program will sometimes make \nsilly responses: \"I need this like a hole in the head\" will be answered with \"What \nwould it mean to you if you got this like a hole in the head.\" In fact, the program only \nmakes any sense at all if it is receiving input from someone who makes sense—and \nsomeone who interprets its answers charitably. When given \"I need gibble plix zzq,\" \nELIZA would reply \" What would it mean to you if you got gibble plix zzq,\" without any \ninkling that something is wrong. Another example of the original ELIZA program has \nit communicating with another program, PARRY, which was written by Dr. Kenneth \nColby to mimic paranoid behavior. Part of the conversation follows, with ELIZA again \nin capitals and PARRY in mixed case: \n\nI don't understand your motives. \nWHY DON'T YOU UNDERSTAND MY MOTIVES? \nShouldn't I be? \nWHY DO YOU SAY THAT JUST NOW? \nThat's just the way it is . \nSUPPOSE THAT'S JUST THE WAY IT WERE NOT. \nSo? \nI AM NOT SURE I UNDERSTAND YOU FULLY. \nYou harp on the same questions too much. \nWHAT DOES THAT SIMILARITY SUGGEST TO YOU? \nI don't get you. \nDO YOU WISH THAT YOU DID GET I ? \n\n\f\n<a id='page-154'></a>\n\nThis suggests that neither ELIZA nor PARRY had a deep understanding of the dialog. \nWhen there is a human to take on most of the burden of carrying forth the conversation, \nthese programs can be convincing, but when the human is taken out of the \nconversation, the weaknesses of the programs are revealed. \n\n5.1 Describing and Specifying ELIZA \nNow that we have an idea of what ELIZA is like, we can begin the description and specification \nof the program, and eventually move to the implementation and debugging. \n\nThe ELIZA algorithm can be described simply as: (1) read an input, (2) find a \npattern that matches the input, (3) transform the input into a response, and (4) print \nthe response. These four steps are repeated for each input. \n\nThe specification and implementation of steps (1) and (4) are trivial: for (1), use \nthe built-in read function to read a list of words, and for (4) use print to print the list \nof words in the response. \n\nOf course, there are some drawbacks to this specification. The user will have \nto type a real list—using parentheses—and the user can't use characters that are \nspecial to read, like quotation marks, commas, and periods. So our input won't \nbe as unconstrained as in the sample dialog, but that's a small price to pay for the \nconvenience of having half of the problem neatly solved. \n\n5.2 Pattern Matching \nThe hard part comes with steps (2) and (3)—this notion of pattern matching and \ntransformation. There are four things to be concerned with: a general pattern and \nresponse, and a specific input and transformation of that input. Since we have agreed \nto represent the input as a list, it makes sense for the other components to be lists \ntoo. For example, we might have: \n\nPattern: (i need a X) \n\nResponse: (what would it mean to you if you got a X ?) \n\nInput: (i need a vacation) \nTransformation: (what would it mean to you if you got a vacation ?) \n\nThe pattern matcher must match the literals i with i, need with need, and a with a, \nas well as match the variable X with va cat i on. This presupposes that there is some \nway of deciding that X is a variable and that need is not. We must then arrange to \nsubstitute vacation for X within the response, in order to get the final transformation. \n\n\f\n<a id='page-155'></a>\nIgnoring for a moment the problem of transforming the pattern into the response, \nwe can see that this notion of pattern matching is just a generalization of the Lisp \nfunction equa 1. Below we show the function s i mpl e - equa 1, which is like the built-in \nfunction equal,^ and the function pat-match, which is extended to handle pattern-\nmatching variables: \n\n(defun simple-equal (x y) \n\"Are . and y equal? (Don't check inside strings.)\" \n(if (or (atom x) (atom y)) \n\n(eql . y) \n(and (simple-equal (first x) (first y)) \n(simple-equal (rest x) (rest y))))) \n\n(defun pat-match (pattern input) \n\"Does pattern match input? Any variable can match anything.\" \n(if (variable-p pattern) \n\nt \n\n(if (or (atom pattern) (atom input)) \n(eql pattern input) \n(and (pat-match (first pattern) (first input)) \n\n(pat-match (rest pattern) (rest input)))))) \n\n&#9635; Exercise 5.1 [s] Would it be a good idea to replace the complex and form in \npat-match with the simpler (every #'pat-match pattern input)? \n\nBefore we can go on, we need to decide on an implementation for pattern-\nmatching variables. We could, for instance, say that only a certain set of symbols, \nsuch as {.,.,.}, are variables. Alternately, we could define a structure of type \nvari abl e, but then we'd have to type something verbose like (make-vari abl e : name \n\n* X) every time we wanted one. Another choice would be to use symbols, but to distinguish \nvariables from constants by the name of the symbol. For example, in Prolog, \nvariables start with capital letters and constants with lowercase. But Common Lisp \nis case-insensitive, so that won't work. Instead, there is a tradition in Lisp-based AI \nprograms to have variables be symbols that start with the question mark character. \nSo far we have dealt with symbols as atoms—objects with no internal structure. \nBut things are always more compHcated than they first appear and, as in Lisp as \nin physics, it turns out that even atoms have components. In particular, symbols \nhave names, which are strings and are accessible through the symbol - name function. \nStrings in turn have elements that are characters, accessible through the function \nchar. The character '?' is denoted by the self-evaluating escape sequence #\\?. So \nthe predicate variab1 e-p can be defined as follows, and we now have a complete \npattern matcher: \n\n^The difference is that simpl e-equal does not handle strings. \n\n\f\n<a id='page-156'></a>\n\n(defun variab1e-p (x) \n\"Is X a variable (a symbol beginning with *?*)?\" \n(and (symbolp x) (equal (char (symbol-name x) 0) #\\?))) \n\n> (pat-match '(I need a ?X) '(I need a vacation)) \n. \n\n> (pat-match *(I need a ?X) '(I really need a vacation)) \nNIL \n\nIn each case we get the right answer, but we don't get any indication of what ?X is, so \nwe couldn't substitute it into the response. We need to modify pat-match to return \nsome kind of table of variables and corresponding values. In making this choice, the \nexperienced Common Lisp programmer can save some time by being opportunistic: \nrecognizing when there is an existing function that will do a large part of the task at \nhand. What we want is to substitute values for variables throughout the response. \nThe alert programmer could refer to the index of this book or the Common Lisp \nreference manual and find the functions substi tute, subst, and subl i s. All of these \nsubstitute some new expression for an old one within an expression. It turns out that \nsubl i s is most appropriate because it is the only one that allows us to make several \nsubstitutions all at once, subl 1 s takes two arguments, the first a list of old-new pairs, \nand the second an expression in which to make the substitutions. For each one of \nthe pairs, the car is replaced by the cdr. In other words, we would form each pair \nwith something like (cons ol d new). (Such a list of pairs is known as an association \nUst, or a-list, because it associates keys with values. See section 3.6.) In terms of the \nexample above, we would use: \n\n> (sublis '((?X . vacation)) \n'(what would it mean to you if you got a ?X ?)) \n(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?) \n\nNow we need to arrange for pat-match to return an a-Iist, rather than just . for \nsuccess. Here's a first attempt: \n\n(defun pat-match (pattern input) \n\"Does pattern match input? WARNING: buggy version. \" \n(if (variable-p pattern) \n\n(list (cons pattern input)) \n\n(if (or (atom pattern) (atom input)) \n(eql pattern input) \n(append (pat-match (first pattern) (first input)) \n\n(pat-match (rest pattern) (rest input)))))) \n\nThis implementation looks reasonable: it returns an a-list of one element if the pattern \nis a variable, and it appends alists if the pattern and input are both lists. However, \n\n\f\n<a id='page-157'></a>\nthere are several problems. First, the test (eql pattern input) may return T, which \nis not a list, so append will complain. Second, the same test might return nil, which \nshould indicate failure, but it will just be treated as a list, and will be appended to \nthe rest of the answer. Third, we haven't distinguished between the case where the \nmatch fails—and returns nil—versus the case where everything matches, but there \nare no variables, so it returns the null a-list. (This is the semipredicate problem \ndiscussed on [page 127](chapter4.md#page-127).) Fourth, we want the bindings of variables to agree—if ?X is \nused twice in the pattern, we don't want it to match two different values in the input. \nFinally, it is inefficient for pat-match to check both the first and rest of Hsts, even \nwhen the corresponding first parts fail to match. (Isn't it amazing that there could \nbe five bugs in a seven-line function?) \n\nWe can resolve these problems by agreeing on two major conventions. First, it is \nvery convenient to make pat-match a true predicate, so we will agree that it returns \n.i 1 only to indicate failure. That means that we will need a non-nil value to represent \nthe empty binding list. Second, if we are going to be consistent about the values of \nvariables, then the firstwillhavetoknow what the restisdoing. We can accomplish \nthis by passing the binding list as a third argument to pat-match. We make it an \noptional argument, because we want to be able to say simply (pat-match ab). \n\nTo abstract away from these implementation decisions, we define the constants \nfai 1 and no-bi ndi ngs to represent the two problematic return values. The special \nform defconstant is used to indicate that these values will not change. (It is customary \nto give special variables names beginning and ending with asterisks, but this \nconvention usually is not followed for constants. The reasoning is that asterisks \nshout out, \"Careful! I may be changed by something outside of this lexical scope.\" \nConstants, of course, will not be changed.) \n\n(defconstant fail nil \"Indicates pat-match failure\") \n\n(defconstant no-bindings '((t . t)) \n\"Indicates pat-match success, with no variables.\") \n\nNext, we abstract away from assoc by introducing the following four functions: \n\n(defun get-binding (var bindings) \n\"Find a (variable . value) pair in a binding list. \" \n(assoc var bindings)) \n\n(defun binding-val (binding) \n\"Get the value part of a single binding.\" \n(cdr binding)) \n\n(defun lookup (var bindings) \n\"Get the value part (for var) from a binding list. \" \n(binding-val (get-binding var bindings))) \n\n\f\n<a id='page-158'></a>\n\n(defun extend-bindings (var val bindings) \n\"Add a (var . value) pair to a binding list.\" \n(cons (cons var val) bindings)) \n\nNow that variables and bindings are defined, pat-match is easy. It consists of five \ncases. First, if the binding list is f ai 1, then the match fails (because some previous \nmatch must have failed). If the pattern is a single variable, then the match returns \nwhatever match- va r i abl e returns; either the existing binding Ust, an extended one, \nor f ai 1. Next, if both pattern and input are lists, we first call pat-match recursively \non the first element of each list. This returns a binding list (or f ai 1), which we use \nto match the rest of the lists. This is the only case that invokes a nontrivial function, \nso it is a good idea to informally prove that the function will terminate: each of the \ntwo recursive calls reduces the size of both pattern and input, and pat -match checks \nthe case of atomic patterns and inputs, so the function as a whole must eventually \nreturn an answer (unless both pattern and input are of infinite size). If none of these \nfour cases succeeds, then the match fails. \n\n(defun pat-match (pattern input &optional (bindings no-bindings)) \n\"Match pattern against input in the context of the bindings\" \n(cond ((eq bindings fail) fail) \n\n((variable-p pattern) \n\n(match-variable pattern input bindings)) \n((eql pattern input) bindings) \n((and (consp pattern) (consp input)) \n\n(pat-match (rest pattern) (rest input) \n(pat-match (first pattern) (first input) \nbindings))) \n(t fail))) \n\n(defun match-variable (var input bindings) \n\"Does VAR match input? Uses (or updates) and returns bindings.\" \n(let ((binding (get-binding var bindings))) \n\n(cond ((not binding) (extend-bindings var input bindings)) \n((equal input (binding-val binding)) bindings) \n(t fail)))) \n\nWe can now test pat-match and see how it works: \n\n> (pat-match '(i need a ?X) '(i need a vacation)) \n((?X . VACATION) (T . T)) \n\nThe answer is a list of variable bindings in dotted pair notation; each element of \nthe list is a (vanable , value) pair. The (T . T) is a remnant from no-bindings. It \ndoes no real harm, but we can eliminate it by making extend - bi ndi ngs a little more \ncomplicated: \n\n\f\n<a id='page-159'></a>\n(defun extend-bindings (var val bindings) \n\"Add a (var . value) pair to a binding list.\" \n(cons (cons var val) \n\nOnce we add a \"real\" binding, \nwe can get rid of the dummy no-bindings \n\n(if (eq bindings no-bindings) \nnil \nbindings) \n\n> (sublis (pat-match '(i need a ?X) '(i need a vacation)) \n'(what would it mean to you if you got a ?X ?)) \n(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?) \n\n> (pat-match '(i need a ?X) '(i really need a vacation)) \nNIL \n\n> (pat-match '(this is easy) '(this is easy)) \n((T . T)) \n\n> (pat-match '(?X is ?X) '((2 + 2) is 4)) \nNIL \n\n> (pat-match '(?X is ?X) '((2 + 2) is (2 + 2))) \n((?X 2 + 2)) \n\n> (pat-match '(?P need . ?X) '(i need a long vacation)) \n((?X A LONG VACATION) (?P . I)) \n\nNotice the distinction between NIL and ((. . .)). The latter means that the match \nsucceeded, but there were no bindings to return. Also, remember that (?X 2 + 2) \nmeans the same as (?X . (2 + 2)). \n\nA more powerful implementation of pat -match is given in chapter 6. Yet another \nimplementation is given in section 10.4. It is more efficient but more cumbersome \nto use. \n\n5.3 Segment Pattern Matching \nIn the pattern (?P need . ?X), the variable ?X matches the rest of the input Ust, \nregardless of its length. This is in contrast to ?P, which can only match a single \nelement, namely, the first element of the input. For many applications of pattern \nmatching, this is fine; we only want to match corresponding elements. However, \nELIZA is somewhat different in that we need to account for variables in any position \nthat match a sequence of items in the input. We will call such variables segment \nvanables. We will need a notation to differentiate segment variables from normal \n\n\f\n<a id='page-160'></a>\n\nvariables. The possibilities fall into two classes: either we use atoms to represent \nsegment variables and distinguish them by some spelling convention (as we did to \ndistinguish variables from constants) or we use a nonatomic construct. We will \nchoose the latter, using a list of the form (?* variable) to denote segment variables. \nThe symbol ?* is chosen because it combines the notion of variable with the Kleene-\nstar notation. So, the behavior we want from pat-match is now: \n\n> (pat-match '((?* ?p) need (?* ?x)) \n'(Mr Hulot and I need a vacation)) \n((?P MR HULOT AND I) (?X A VACATION)) \n\nIn other words, when both pattern and input are lists and the first element of the \npattern is a segment variable, then the variable will match some initial part of the \ninput, and the rest of the pattern will attempt to match the rest. We can update \npat-match to account for this by adding a single cond-clause. Defining the predicate \nto test for segment variables is also easy: \n\n(defun pat-match (pattern input &optional (bindings no-bindings)) \n\"Match pattern against input in the context of the bindings\" \n\n(cond ((eq bindings fail ) fail ) \n((variable-p pattern) \n(match-variable pattern input bindings)) \n((eql pattern input) bindings) \n((segment-pattern-p pattern) ; ** * \n(segment-match pattern input bindings)) ; ** * \n((and (consp pattern) (consp input)) \n(pat-match (rest pattern) (rest input) \n\n(pat-match (first pattern) (first input) \nbindings))) \n(t fail))) \n\n(defun segment-pattern-p (pattern) \n\n\"Is this a segment matching pattern: ((?* var) . pat)\" \n\n(and (consp pattern) \n\n(starts-with (first pattern) '?*))) \n\nIn writing segment-match, the important question is how much of the input the \nsegment variable should match. One answer is to look at the next element of the \npattern (the one after the segment variable) and see at what position it occurs in the \ninput. If it doesn't occur, the total pattern can never match, and we should f ai 1. If \nit does occur, call its position pos. We will want to match the variable against the \ninitial part of the input, up to pos. But first we have to see if the rest of the pattern \nmatches the rest of the input. This is done by a recursive call to pat-match. Let the \nresult of this recursive call be named b2. If b2 succeeds, then we go ahead and match \nthe segment variable against the initial subsequence. \n\n\f\n<a id='page-161'></a>\nThe tricky part is when bZ fails. We don't want to give up completely, because \nit may be that if the segment variable matched a longer subsequence of the input, \nthen the rest of the pattern would match the rest of the input. So what we want is to \ntry segment-match again, but forcing it to consider a longer match for the variable. \nThis is done by introducing an optional parameter, start, which is initially 0 and is \nincreased with each failure. Notice that this policy rules out the possibility of any \nkind of variable following a segment variable. (Later we will remove this constraint.) \n\n(defun segment-match (pattern input bindings &optional (start 0)) \n\"Match the segment pattern ((?* var) . pat) against input.\" \n(let ((var (second (first pattern))) \n\n(pat (rest pattern))) \n(if (null pat) \n\n(match-variable var input bindings) \nWe assume that pat starts with a constant \nIn other words, a pattern can't have 2 consecutive vars \n\n(let ((pos (position (first pat) input \n:start start :test #'equal))) \n\n(if (null pos) \nfail \n(let ((b2 (pat-match pat (subseq input pos) bindings))) \n\nIf this match failed, try another longer one \n\nIf it worked, check that the variables match \n\n(if (eq b2 fail) \n(segment-match pattern input bindings (+ pos 1)) \n(match-variable var (subseq input 0 pos) b2)))))))) \n\nSome examples of segment matching follow: \n\n> (pat-match '((?* ?p) need (?* ?x)) \n'(Mr Hulot and I need a vacation)) \n((?P MR HULOT AND I) (?X A VACATION)) \n\n> (pat-match '((?* ?x) is a (?* ?y)) '(what he is is a fool)) \n\n((?X WHAT HE IS) (?Y FOOD) \n\nThe first of these examples shows a fairly simple case: ?p matches everything up \nto need, and ?x matches the rest. The next example involves the more complicated \nbackup case. First ?x matches everything up to the first i s (this is position 2, since \ncounting starts at 0 in Common Lisp). But then the pattern a fails to match the input \ni s, so segment - match tries again with starting position 3. This time everything works; \ni s matches i s, a matches a, and (?* ?y) matches fool. \n\n\f\n<a id='page-162'></a>\n\nUnfortunately, this version of s egment - mat ch does not match as much as it should. \nConsider the following example: \n\n> (pat-match *((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) NIL \n\nThis fails because ?x is matched against the subsequence (1 2), and then \nthe remaining pattern succesfuUy matches the remaining input, but the final \ncall to match-variabl e fails, because ?x has two different values. The fix is to call \nmatch-vari able before testing whether the b2 fails, so that we will be sure to try \nsegment-match again with a longer match no matter what the cause of the failure. \n\n(defun segment-match (pattern input bindings &optional (start 0)) \n\"Match the segment pattern ((?* var) . pat) against input.\" \n(let ((var (second (first pattern))) \n\n(pat (rest pattern))) \n(if (null pat) \n\n(match-variable var input bindings) \nWe assume that pat starts with a constant \nIn other words, a pattern can't have 2 consecutive vars \n\n(let ((pos (position (first pat) input \nistart start rtest #'equal))) \n\n(if (null pos) \nfail \n(let ((b2 (pat-match \n\npat (subseq input pos) \n(match-variable var (subseq input 0 pos) \nbindings)))) \nIf this match failed, try another longer one \n\n(if (eq b2 fail) \n(segment-match pattern input bindings (+ pos 1)) \nb2))))))) \n\nNow we see that the match goes through: \n\n> (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) \n((?X 1 2 A B)) \n\nNote that this version of segment-match tries the shortest possible match first. It \nwould also be possible to try the longest match first. \n\n\f\n<a id='page-163'></a>\n5.4 The ELIZA Program: A Rule-Based \nTranslator \nNow that we have a working pattern matcher, we need some patterns to match. \nWhat's more, we want the patterns to be associated with responses. We can do this \nby inventing a data structure called a rul e, which consists of a pattern and one or \nmore associated responses. These are rules in the sense that they assert, \"If you \nsee A, then respond with . or C, chosen at random.\" We will choose the simplest \npossible implementation for rules: as lists, where the first element is the pattern and \nthe rest is a list of responses: \n\n(defun rule-pattern (rule) (first rule)) \n(defun rule-responses (rule) (rest rule)) \n\nHere's an example of a rule: \n\n(((?* ?x) I want (?* ?y)) \n(What would it mean if you got ?y) \n(Why do you want ?y) \n(Suppose you got ?y soon)) \n\nWhen applied to the input (I want to test this program), this rule (when interpreted \nby the ELIZA program) would pick a response at random, substitute in the \nvalueof ?y, and respond with, say, (why do you want to test this program). \n\nNow that we know what an individual rule will do, we need to decide how to \nhandle a set of rules. If ELIZA is to be of any interest, it will have to have a variety of \nresponses. So several rules may all be applicable to the same input. One possibility \nwould be to choose a rule at random from among the rules having patterns that match \nthe input. \n\nAnother possibility is just to accept the first rule that matches. This implies that \nthe rules form an ordered list, rather than an unordered set. The clever ELIZA rule \nwriter can take advantage of this ordering and arrange for the most specific rules to \ncome first, while more vague rules are near the end of the list. \n\nThe original ELIZA had a system where each rule had a priority number associated \nwith it. The matching rule with the highest priority was chosen. Note that putting the \nrules in order achieves the same effect as having a priority number on each rule: the \nfirst rule implicitly has the highest priority, the second rule is next highest, and so on. \n\nHere is a short list of rules, selected from Weizenbaum's original article, but with \nthe form of the rules updated to the form we are using. The answer to exercise 5.19 \ncontains a longer list of rules. \n\n\f\n<a id='page-164'></a>\n\n(defparameter *eliza-rules* \n'((((?* ?x) hello (?* ?y)) \n(How do you do. Please state your problem.)) \n\n(((?* ?x) I want (?* ?y)) \n(What would it mean if you got ?y) \n(Why do you want ?y) (Suppose you got ?y soon)) \n\n(((?* ?x) if (?* ?y)) \n(Do you really think its likely that ?y) (Do you wish that ?y) \n(What do you think about ?y) (Really-- if ?y)) \n\n(((?* ?x) no (?* ?y)) \n(Why not?) (You are being a bit negative) \n(Are you saying \"NO\" just to be negative?)) \n\n(((?* ?x) I was (?* ?y)) \n(Were you really?) (Perhaps I already knew you were ?y) \n(Why do you tell me you were ?y now?)) \n\n(((?* ?x) I feel (?* ?y)) \n(Do you often feel ?y ?)) \n(((?* ?x) I felt (?* ?y)) \n(What other feelings do you have?)))) \n\nFinally we are ready to define ELIZA proper. As we said earlier, the main program \nshould be a loop that reads input, transforms it, and prints the result. Transformation \nis done primarily by finding some rule such that its pattern matches the input, and \nthen substituting the variables into the rule's response. The program is summarized \nin figure 5.1. \n\nThere are a few minor complications. We print a prompt to tell the user to \ninput something. We use the function f 1 atten to insure that the output won't have \nimbedded lists after variable substitution. An important trick is to alter the input \nby swapping \"you\" for \"me\" and so on, since these terms are relative to the speaker. \nHere is the complete program: \n\n(defun el iza () \n\"Respond to user input using pattern matching rules.\" \n(loop \n\n(print 'eliza>) \n(write (flatten (use-eliza-rules (read))) ipretty t))) \n\n(defun use-eliza-rules (input) \n\"Find some rule with which to transform the input.\" \n(some #*(lambda (rule) \n\n(let ((result (pat-match (rule-pattern rule) input))) \n(if (not (eq result fail)) \n(sublis (switch-viewpoint result) \n(random-elt (rule-responses rule)))))) \n*eliza-rules*)) \n\n\f\n<a id='page-165'></a>\nTop-Level Function \n\nel iza Respond to user input using pattern matching rules. \n\nSpecial Variables \n\n*eliza-rules* A list of transformation rules. \n\nData Types \n\nrule An association of a pattern with a list of responses. \n\nFimctions \n\nel iza Respond to user input using pattern matching rules. \nuse-eliza-rules Find some rule with which to transform the input. \nswitch-viewpoint Change I to you and vice versa, and so on. \nflatten Append together elements of a list. \n\nSelected Common Lisp Functions \n\nsublis Substitute elements into a tree. \n\nPreviously Defined Functions \n\nrandom-elt Pick a random element from a list. (p. 36) \npat-match Match a pattern against an input, (p. 160) \nmappend Append together the results of a mapcar. \n\nFigure 5.1: Glossary for the ELIZA Program \n\n(defun switch-viewpoint (words) \n\"Change I to you and vice versa, and so on.\" \n(sublis '((I . you) (you . I) (me . you) (am are)) \n\nwords)) \n\nNote the use of wri te with the : pretty keyword true. This will give better formatted \noutput in some cases. The program makes use of the previously defined random- el t, \nand f 1 atten, which is defined here using mappend and mkl i st, a function that is \ndefined in the InterLisp dialect but not in Common Lisp. \n\n(defun flatten (the-list) \n\"Append together elements (or lists) in the list. \" \n(mappend #'mklist the-list)) \n\n(defun mklist (.) \n\"Return . if it is a list, otherwise (x).\" \n(if distp X) \n\nX \n(list X))) \n\n(defun mappend (fn the-list) \n\"Apply fn to each element of list and append the results.' \n(apply #*append (mapcar fn the-list))) \n\n\f\n<a id='page-166'></a>\n\n(defun random-elt (choices) \n\"Choose an element from a list at random.\" \n(elt choices (random (length choices)))) \n\nThe actual ELIZA program had a few complications that don't show up in this version. \nFirst, there was an alias method for associating several words with the same pattern; \nboth \"mother\" and \"father\" could be associated with the \"family\" pattern. There was \nalso a synonym mechanism that would treat \"don't\" and \"do not\" or \"everybody\" and \n\"everyone\" the same. In the case of input with several comma-separated phrases, \neach phrase was processed separately, and the response with the highest priority \nwas selected. In addition, the original ELIZA had a \"memory\" mechanism. When \nno pattern matched the input, it said something like \"Tell me more about X,\" where \nX is some input given earlier. Finally, our version has fewer rules. Despite the \nshortcomings of our version, it can occasionally hold up its end of a conversation, as \nshown below: \n\n> (eliza) \nELIZA> (hello there) \n(HOW DO YOU DO. PLEASE STATE YOUR PROBLEM.) \nELIZA> (i want to test this program) \n(WHAT WOULD IT MEAN IF YOU GOT TO TEST THIS PROGRAM) \nELIZA> (i could see if it works) \n(DO YOU REALLY THINK ITS LIKELY THAT IT WORKS) \nELIZA> (no not really) \n(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?) \nELIZA> (no) \n(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?) \nELIZA> (forget it--i was wondering how general the program is) \n(WHY DO YOU TELL ME YOU WERE WONDERING HOW GENERAL THE PROGRAM IS NOW?) \nELIZA> (i felt like it) \n(WHAT OTHER FEELINGS DO YOU HAVE?) \nELIZA> (i feel this is enough) \n(DO YOU OFTEN FEEL THIS IS ENOUGH ?) \nELIZA> [Abort] \n\nIn the end, it is the technique that is important—not the program. ELIZA has been \n\"explained away\" and should rightfully be moved to the curio shelf. Pattern matching \nin general remains important technique, and we will see it again in subsequent \nchapters. The notion of a rule-based translator is also important. The problem \nof understanding English (and other languages) remains an important part of AI. \nClearly, the problem of understanding English is not solved by ELIZA. In part V, we \nwill address the problem again, using more sophisticated techniques. \n\n\f\n<a id='page-167'></a>\n5.5 History and References \nAs mentioned above, the original article describing ELIZA is Weizenbaum 1966. Another \ndialog system using similar pattern-matching techniques is Kenneth Colby's \n(1975) PARRY. This program simulated the conversation of a paranoid person well \nenough to fool several professional psychologists. Although the pattern matching \ntechniques were simple, the model of belief maintained by the system was much \nmore sophisticated than ELIZA. Colby has suggested that dialog programs like ELIZA, \naugmented with some sort of belief model like PARRY, could be useful tools in treating \nmentally disturbed people. According to Colby, it would be inexpensive and \neffective to have patients converse with a specially designed program, one that could \nhandle simple cases and alert doctors to patients that needed more help. Weizenbaum's \nbook Computer Power and Human Reason (1976) discusses ELIZA and PARRY \nand takes a very critical view toward Colby's suggestion. Other interesting early \nwork on dialog systems that model belief is reported by Allan Collins (1978) and \nJamie Carbonell (1981). \n\n5.6 Exercises \n&#9635; Exercise 5.2 [m] Experiment with this version of ELIZA. Show some exchanges \nwhere it performs well, and some where it fails. Try to characterize the difference. \nWhich failures could be fixed by changing the rule set, which by changing the \npa t - ma tch function (and the pattern language it defines), and which require a change \nto the el i za program itself? \n\n&#9635; Exercise 5.3 [h] Define a new set of rules that make ELIZA give stereotypical responses \nto some situation other than the doctor-patient relationship. Or, write a set \nof rules in a language other than English. Test and debug your new rule set. \n\n&#9635; Exercise 5.4 [s] We mentioned that our version of ELIZA cannot handle commas \nor double quote marks in the input. However, it seems to handle the apostrophe in \nboth input and patterns. Explain. \n\n&#9635; Exercise 5.5 [h] Alter the input mechanism to handle commas and other punctuation \ncharacters. Also arrange so that the user doesn't have to type parentheses \naround the whole input expression. (Hint: this can only be done using some Lisp \nfunctions we have not seen yet. Look at read-lineand read-from-string.) \n\n\f\n<a id='page-168'></a>\n\n&#9635; Exercise 5.6 [m] Modify ELIZA to have an explicit exit. Also arrange so that the \noutput is not printed in parentheses either. \n\n&#9635; Exercise 5.7 [m] Add the \"memory mechanism\" discussed previously to ELIZA. \nAlso add some way of definining synonyms like \"everyone\" and \"everybody.\" \n\n&#9635; Exercise 5.8 [h] It turns out that none of the rules in the given script uses a variable \nmore than once-ther e is no rule of the form (?x... ?x). Write a pattern matcher that \nonly adds bindings, never checks variables against previous bindings. Use the time \nspecial form to compare your function against the current version. \n\n&#9635; Exercise 5.9 [h] Winston and Horn's book Lisp presents a good pattern-matching \nprogram. Compare their implementation with this one. One difference is that they \nhandle the case where the first element of the pattern is a segment variable with the \nfollowing code (translated into our notation): \n(or (pat-match (rest pattern) (rest input) bindings) \n(pat-match pattern (rest input) bindings)) \nThis says that a segment variable matches either by matching the first element of \nthe input, or by matching more than the first element. It is much simpler than our \napproach using posi ti on, partly because they don't update the binding list. Can \nyou change their code to handle bindings, and incorporate it into our version of \npat-match? Is it still simpler? Is it more or less efficient? \n\n&#9635; Exercise 5.10 What is wrong with the following definition of s i mpl e equa1 \n? \n(defun simple-equal (x y) \n\"Test if two list s or atoms are equal.\" \nWarning incorrect \n(or (eql . y) \n(and (listp x) (listp y) \n(simple-equal (firs t x) (firs t y)) \n(simple-equal (rest x) (rest y)))) ) \n\n&#9635; Exercise 5.11 [m] Weigh the advantages of changing no-bi ndi ngs to ni 1, and f ai 1 \nto something else. \n\n\f\n<a id='page-169'></a>\n\n&#9635; Exercise 5.12 [m] Weigh the advantages of making pat-match return multiple values: \nthe first would be true for a match and false for failure, and the second would \nbe the binding list. \n\n&#9635; Exercise 5.13 [m] Suppose that there is a call to segment-match where the variable \nalready has a binding. The current definition will keep making recursive calls to \nsegment-match, one for each possible matching position. But this is silly—if the \nvariable is already bound, there is only one sequence that it can possibly match \nagainst. Change the definition so that it looks only for this one sequence. \n\n&#9635; Exercise 5.14 [m]\nof argument lists. \nDefine a version of ma ppend that, like ma pea r, accepts any number \n\n&#9635; Exercise 5.15 [m] Give an informal proof that segment-match always terminates. \n\n&#9635; Exercise 5.16 [s] Trick question: There is an object in Lisp which, when passed to \nvari abl e- p, results in an error. What is that object? \n\n&#9635; Exercise 5.17 [m] The current version of ELIZA takes an input, transforms it according \nto the first applicable rule, and outputs the result. One can also imagine a \nsystem where the input might be transformed several times before the final output \nis printed. Would such a system be more powerful? If so, in what way? \n\n&#9635; Exercise 5.18 [h] Read Weizenbaum's original article on ELIZA and transpose his \nlist of rules into the notation used in this chapter. \n\n\f\n<a id='page-170'></a>\n\n5.7 Answers \nAnswer 5.1 No. If either the pattern or the input were shorter, but matched every \nexisting element, the every expression would incorrectly return true. \n\n(every #'pat-match *(a b c) '(a)) . \n\nFurthermore, if either the pattern or the input were a dotted list, then the result of the \nevery would be undefined—some implementations might signal an error, and others \nmight just ignore the expression after the dot. \n\n(every #'pat-match '(a b . c) '(a b . d)) => T, NIL.orerror. \n\nAnswer 5.4 The expression don't may look like a single word, but to the Lisp reader \nit is composed of the two elements don and ' t, or (quote t). If these elements are \nused consistently, they will match correctly, but they won't print quite right—there \nwill be a space before the quote mark. In fact the :pretty t argument to write is \nspecified primarily to make (quote t) print as ' t (See [page 559](chapter16.md#page-559) of Steele's Common \nLisp the Language, 2d edition.) \n\nAnswer 5.5 One way to do this is to read a whole line of text with read -line rather \nthan read. Then, substitute spaces for any punctuation character in that string. \nFinally, wrap the string in parentheses, and read it back in as a list: \n\n(defun read-line-no-punct () \n\n\"Read an input line, ignoring punctuation.\" \n\n(read-from-string \n\n(concatenate 'string \"(\" (substitute-if #\\space#'punctuation-p \n\n(read-line)) \n\n\")\"))) \n\n(defun punctuation-p (char) (find char \".,;:*l?#-()\\\\\\\"\")) \n\nThis could also be done by altering the readtable, as in section 23.5, [page 821](chapter23.md#page-821). \n\n\f\n<a id='page-171'></a>\n\nAnswer 5.6 \n\n(defun eliza () \n\"Respond to user input using pattern matching rules.\" \n(loop \n\n(print *eliza>) \n\n(let* ((input (read-line-no-punct)) \n\n(response (flatten (use-eliza-rules input)))) \n(print-with-spaces response) \n(if (equal response '(good bye)) (RETURN))))) \n\n(defun print-with-spaces (list) \n(mapc #'(lambda (x) (prinl x) (princ \" \")) list)) \n\nor \n\n(defun print-with-spaces (list) \n(format t \"~{~a ~}\" list)) \n\nAnswer 5.10 Hint: consider (si mpl e-equal '() '(nil . nil)). \n\nAnswer 5.14 \n\n(defun mappend (fn &rest list) \n\"Apply fn to each element of lists and append the results.\" \n(apply #'append (apply #'mapcar fn lists))) \n\nAnswer 5.16 It must bea symbol, because for nonsymbols, variable-p just returns \nnil. Getting the symbol - name of a symbol is just accessing a slot, so that can't cause \nan error. The only thing left is el t; if the symbol name is the empty string, then \naccessing element zero of the empty string is an error. Indeed, there is a symbol \nwhose name is the empty string: the symbol. \n\nAnswer 5.17 Among other things, a recursive transformation system could be used \nto handle abbreviations. That is,a form like \"don't\" could be transformed into \"do \nnot\" and then processed again. That way, the other rules need only work on inputs \nmatching \"do not.\" \n\n\f\n<a id='page-172'></a>\n\nAnswer 5.19 The following includes most of Weizenbaum's rules: \n\n(defparameter *eliza-rules* \n'((((?* ?x) hello (?* ?y)) \n(How do you do. Please state your problem.)) \n\n(((?* ?x) computer (?* ?y)) \n(Do computers worry you?) (What do you think about machines?) \n(Why do you mention computers?) \n(What do you think machines have to do with your problem?)) \n\n(((?* ?x) name (?* ?y)) \n(I am not interested in names)) \n\n(((?* ?x) sorry (?* ?y)) \n(Please don't apologize) (Apologies are not necessary) \n(What feelings do you have when you apologize)) \n\n(((?* ?x) I remember (?* ?y)) \n(Do you often think of ?y) \n(Does thinking of ?y bring anything else to mind?) \n(What else do you remember) (Why do you recall ?y right now?) \n(What in the present situation reminds you of ?y) \n(What is the connection between me and ?y)) \n\n(((?* ?x) do you remember (?* ?y)) \n(Did you think I would forget ?y ?) \n(Why do you think I should recall ?y now) \n(What about ?y) (You mentioned ?y)) \n\n(((?* ?x) if (?* ?y)) \n(Do you really think its likely that ?y) (Do you wish that ?y) \n(What do you think about ?y) (Really-- if ?y)) \n\n(((?* ?x) I dreamt (?* ?y)) \n(Really-- ?y) (Have you ever fantasized ?y while you were awake?) \n(Have you dreamt ?y before?)) \n\n(((?* ?x) dream about (?* ?y)) \n(How do you feel about ?y in reality?)) \n\n(((?* ?x) dream (?* ?y)) \n(What does this dream suggest to you?) (Do you dream often?) \n(What persons appear in your dreams?) \n(Don't you believe that dream has to do with your problem?)) \n\n(((?* ?x) my mother (?* ?y)) \n(Who else in your family ?y) (Tell me more about your family)) \n\n(((?* ?x) my father (?* ?y)) \n(Your father) (Does he influence you strongly?) \n(What else comes to mind when you think of your father?)) \n\n\f\n<a id='page-173'></a>\n\n(((?* ?x) I want (?* ?y)) \n(What would it mean if you got ?y) \n(Why do you want ?y) (Suppose you got ?y soon)) \n\n(((?* ?x) I am glad (?* ?y)) \n(How have I helped you to be ?y) (What makes you happy just now) \n(Can you explain why you are suddenly ?y)) \n\n(((?* ?x) I am sad (?* ?y)) \n(I am sorry to hear you are depressed) \n(I'm sure it's not pleasant to be sad)) \n\n(((?* ?x) are like (?* ?y)) \n(What resemblance do you see between ?x and ?y)) \n\n(((?* ?x) is like (?* ?y)) \n(In what way is it that ?x is like ?y) \n(What resemblance do you see?) \n(Could there really be some connection?) (How?)) \n\n(((?* ?x) alike (?* ?y)) \n(In what way?) (What similarities are there?)) \n(((?* ?x) same (?* ?y)) \n(What other connections do you see?)) \n\n(((?* ?x) I was (?* ?y)) \n(Were you really?) (Perhaps I already knew you were ?y) \n(Why do you tell me you were ?y now?)) \n\n(((?* ?x) was I (?* ?y)) \n(What if you were ?y ?) (Do you think you were ?y) \n(What would it mean if you were ?y)) \n\n(((?* ?x) I am (?* ?y)) \n(In what way are you ?y) (Do you want to be ?y ?)) \n\n(((?* ?x) am I (?* ?y)) \n(Do you believe you are ?y) (Would you want to be ?y) \n(You wish I would tell you you are ?y) \n(What would it mean if you were ?y)) \n\n(((?* ?x) am (?* ?y)) \n(Why do you say \"AM?\") (I don't understand that)) \n\n(((?* ?x) are you (?* ?y)) \n(Why are you interested in whether I am ?y or not?) \n(Would you prefer if I weren't ?y) \n(Perhaps I am ?y in your fantasies)) \n\n(((?* ?x) you are (?* ?y)) \n(What makes you think I am ?y ?)) \n\n\f\n<a id='page-174'></a>\n\n(((?* ?x) because (?* ?y)) \n(Is that the real reason?) (What other reasons might there be?) \n(Does that reason seem to explain anything else?)) \n\n(((?* ?x) were you (?* ?y)) \n(Perhaps I was ?y) (What do you think?) (What if I had been ?y)) \n(((?* ?x) I can't (?* ?y)) \n(Maybe you could ?y now) (What if you could ?y ?)) \n(((?* ?x) I feel (?* ?y)) \n(Do you often feel ?y ?)) \n(((?* ?x) I felt (?* ?y)) \n(What other feelings do you have?)) \n(((?* ?x) I (?* ?y) you (?* ?z)) \n(Perhaps in your fantasy we ?y each other)) \n\n(((?* ?x) why don't you (?* ?y)) \n(Should you ?y yourself?) \n(Do you believe I don't ?y) (Perhaps I will ?y in good time)) \n\n(((?* ?x) yes (?* ?y)) \n(You seem quite positive) (You are sure) (I understand)) \n\n(((?* ?x) no (?* ?y)) \n(Why not?) (You are being a bit negative) \n(Are you saying \"NO\" just to be negative?)) \n\n(((?* ?x) someone (?* ?y)) \n(Can you be more specific?)) \n\n(((?* ?x) everyone (?* ?y)) \n(surely not everyone) (Can you think of anyone in particular?) \n(Who for example?) (You are thinking of a special person)) \n\n(((?* ?x) always (?* ?y)) \n(Can you think of a specific example) (When?) \n(What incident are you thinking of?) (Really-- always)) \n\n(((?* ?x) what (?* ?y)) \n(Why do you ask?) (Does that question interest you?) \n(What is it you really want to know?) (What do you think?) \n(What comes to your mind when you ask that?)) \n\n(((?* ?x) perhaps (?* ?y)) \n(You do not seem quite certain)) \n\n(((?* ?x) are (?* ?y)) \n(Did you think they might not be ?y) \n(Possibly they are ?y)) \n\n(((?* ?x)) \n(Very interesting) (I am not sure I understand you fully) \n(What does that suggest to you?) (Please continue) (Go on) \n(Do you feel strongly about discussing such things?)))) \n\n\f\n## Chapter 6\n<a id='page-175'></a>\n\nBuilding Software Tools \n\nMan is a tool-using animal \nWithout tools he is nothing \nwith tools he is all \n\n-Thomas Carlyle (1795-. 881) \n\nI\nI\nn chapters 4 and 5 we were concerned with building two particular programs, GPS and ELIZA. \nIn this chapter, we will reexamine those two programs to discover some common patterns. \nThose patterns will be abstracted out to form reusable software tools that will prove helpful \nin subsequent chapters. \n\n6.1 An Interactive Interpreter Tool \nThe structure of the function el i za is a common one. It is repeated below: \n\n(defun eliza () \n\"Respond to user input using pattern matching rules.\" \n(loop \n\n(print 'eliza>) \n\n(print (flatten (use-eliza-rules (read)))))) \n\n\f\n<a id='page-176'></a>\n\nMany other appHcations use this pattern, including Lisp itself. The top level of Lisp \ncould be defined as: \n\n(defun lisp () \n\n(loop \n\n(print '>) \n\n(print (eval (read))))) \n\nThe top level of a Lisp system has historically been called the \"read-eval-print loop.\" \nMost modern Lisps print a prompt before reading input, so it should really be called \nthe \"prompt-read-eval-print loop,\" but there was no prompt in some early systems \nlike MacLisp, so the shorter name stuck. If we left out the prompt, we could write a \ncomplete Lisp interpreter using just four symbols: \n\n(loop (print (eval (read)))) \n\nIt may seem facetious to say those four symbols and eight parentheses constitute a \nLisp interpreter. When we write that line, have we really accomplished anything? \nOne answer to that question is to consider what we would have to do to write a Lisp \n(or Pascal) interpreter in Pascal. We would need a lexical analyzer and a symbol table \nmanager. This is a considerable amount of work, but it is all handled by read. We \nwould need a syntactic parser to assemble the lexical tokens into statements, read \nalso handles this, but only because Lisp statements have trivial syntax: the syntax \nof lists and atoms. Thus read serves fine as a syntactic parser for Lisp, but would \nfail for Pascal. Next, we need the evaluation or interpretation part of the interpreter; \neval does this nicely, and could handle Pascal just as well if we parsed Pascal syntax \ninto Lisp expressions, print does much less work than read or eval, but is still \nquite handy. \n\nThe important point is not whether one line of code can be considered an implementation \nof Lisp; it is to recognize common patterns of computation. Both el iza \nand lisp can be seen as interactive interpreters that read some input, transform or \nevaluate the input in some way, print the result, and then go back for more input. We \ncan extract the following common pattern: \n\n(defun program () \n\n(loop \n(print prompt) \n(print (transform (read))))) \n\nThere are two ways to make use of recurring patterns like this: formally and informally. \nThe informal alternative is to treat the pattern as a cliche or idiom that will \noccur frequently in our writing of programs but will vary from use to use. When we \n\n\f\n<a id='page-177'></a>\nwant to write a new program, we remember writing or reading a similar one, go back \nand look at the first program, copy the relevant sections, and then modify them for \nthe new program. If the borrowing is extensive, it would be good practice to insert \na comment in the new program citing the original, but there would be no \"official\" \nconnection between the original and the derived program. \n\nThe formal alternative is to create an abstraction, in the form of functions and perhaps \ndata structures, and refer explicitly to that abstraction in each new application— \nin other words, to capture the abstraction in the form of a useable software tool. The \ninterpreter pattern could be abstracted into a function as follows: \n\n(defun interactive-interpreter (prompt transformer) \n\"Read an expression, transform it, and print the result.\" \n(loop \n\n(print prompt) \n\n(print (funcall transformer (read))))) \n\nThis function could then be used in writing each new interpreter: \n\n(defun lisp () \n(interactive-interpreter *> #'eval)) \n\n(defun eliza () \n(interactive-interpreter 'eliza> \n#'(lambda (x) (flatten (use-eliza-rules x))))) \n\nOr, with the help of the higher-order function compose: \n\n(defun compose (f g) \n\"Return the function that computes (f (g x)).\" \n#'(lambda (x) (funcall f (funcall g x)))) \n\n(defun eliza () \n(i nteracti ve-i nterpreter 'el iza> \n(compose #'flatten #'use-eliza-rules))) \n\nThere are two differences between the formal and informal approaches. First, they \nlook different. If the abstraction is a simple one, as this one is, then it is probably \neasier to read an expression that has the loop explicitly written out than to read one \nthat calls interact! ve-i nterpreter, since that requires finding the definition of \ni nteracti ve - i nterpreter and understanding it as well. \n\nThe other difference shows up in what's called maintenance. Suppose we find a \nmissing feature in the definition of the interactive interpreter. One such omission is \nthat the 1 oop has no exit. I have been assuming that the user can terminate the loop by \nhitting some interrupt (or break, or abort) key. A cleaner implementation would allow \n\n\f\n<a id='page-178'></a>\n\nthe user to give the interpreter an explicit termination command. Another useful \nfeature would be to handle errors within the interpreter. If we use the irrformal \napproach, then adding such a feature to one program would have no effect on the \nothers. Butif we use the formal approach, then improving i nteracti ve- i nterpreter \nwould automatically bring the new features to all the programs that use it. \n\nThe following version of i nteracti ve- i nterpreter adds two new features. First, \nit uses the macro handler-case^ to handle errors. This macro evaluates its first \nargument, and normally just returns that value. However, if an error occurs, the \nsubsequent arguments are checked for an error condition that matches the error that \noccurred. In this use, the case error matches all errors, and the action taken is to \nprint the error condition and continue. \n\nThis version also allows the prompt to be either a string or a function of no \narguments that will be called to print the prompt. The function prompt-generator, \nfor example, returns a function that will print prompts of the form [1], C2], and \nso forth. \n\n(defun interactive-interpreter (prompt transformer) \n\"Read an expression, transform it, and print the result.\" \n(loop \n\n(handler-case \n(progn \n\n(if (stringp prompt) \n(print prompt) \n(funcall prompt)) \n\n(print (funcall transformer (read)))) \nIn case of error, do this: \n(error (condition) \n(format t \"'^&;; Error ~a ignored, back to top level. \" \ncondition))))) \n\n(defun prompt-generator (&optional (num 0) (ctl-string \"C^d] \")) \n\"Return a function that prints prompts like [1]. C2]. etc.\" \n#*(lambda () (format t ctl-string (incf num)))) \n\n6.2 A Pattern-Matching Tool \nThe pat-match function was a pattern matcher defined specifically for the ELIZA \nprogram. Subsequent programs will need pattern matchers too, and rather than \nwrite specialized matchers for each new program, it is easier to define one general \n\n^The macro hand! er-case is only in ANSI Common Lisp. \n\n\f\n<a id='page-179'></a>\npattern matcher that can serve most needs, and is extensible in case novel needs \ncome up. \n\nThe problem in designing a \"general\" tool is deciding what features to provide. \nWe can try to define features that might be useful, but it is also a good idea to make \nthe list of features open-ended, so that new ones can be easily added when needed. \n\nFeatures can be added by generalizing or specializing existing ones. For example, \nwe provide segment variables that match zero or more input elements. We can \nspecialize this by providing for a kind of segment variable that matches one or more \nelements, or for an optional variable that matches zero or one element. Another \npossibility is to generalize segment variables to specify a match of m to . elements, for \nany specified m and n. These ideas come from experience with notations for writing \nregular expressions, as well as from very general heuristics for generalization, such \nas \"consider important special cases\" and \"zero and one are likely to be important \nspecial cases.\" \n\nAnother useful feature is to allow the user to specify an arbitrary predicate that \na match must satisfy. The notation (?i s ?n numberp) could be used to match any \nexpression that is a number and bind it to the variable ?n. This would look like: \n\n> (pat-match '(x = (?is ?n numberp)) '(x = 34)) => ((?n . 34)) \n\n> (pat-match '(x = (?is ?n numberp)) '(x = x)) => NIL \n\nSince patterns are like boolean expressions, it makes sense to allow boolean operators \non them. Following the question-mark convention, we will use ?and, ?or and ?not \nfor the operators.^ Here is a pattern to match a relational expression with one of three \nrelations. It succeeds because the < matches one of the three possibiUties specified \nby(?or < = >). \n\n> (pat-match '(?x (?or < = >) ?y) *(3 < 4)) => ((?Y . 4) (?X . 3)) \n\nHere is an example of an ?and pattern that checks if an expression is both a number \nand odd: \n\n> (pat-match *(x = (?and (?is ?n numberp) (?is ?n oddp))) \n'(x = 3)) \n((?N . 3)) \n\n^An alternative would be to reserve the question mark for variables only and use another \nnotation for these match operators. Keywords would be a good choice, such as : and,: or,: i s, \netc. \n\n\f\n<a id='page-180'></a>\n\nThe next pattern uses ?not to insure that two parts are not equal: \n\n> (pat-match '(?x /= (?not ?x)) '(3 /= 4)) => ((?X . 3)) \n\nThe segment matching notation we have seen before. It is augmented to allow for \nthree possibilities: zero or more expressions; one or more expressions; and zero or \none expressions. Finally, the notation (?if exp) can be used to test a relationship \nbetween several variables. It has to be Usted as a segment pattern rather than a single \npattern because it does not consume any of the input at all: \n\n> (pat-match '(?x > ?y (?if (> ?x ?y))) '(4 > 3)) => \n((?Y . 3) (?X . 4)) \n\nWhen the description of a problem gets this complicated, it is a good idea to \nattempt a more formal specification. The following table describes a grammar of \npatterns, using the same grammar rule format described in chapter 2. \n\npat => var match any one expression \n\nconstant match just this atom \n\nsegment-pat match something against a sequence \n\nsingle-pat match something against one expression \n\n(pat. pat) match the first and the rest \nsingle-pat =4^ (lis var predicate) test predicate on one expression \n(lor pat...) match any pattern on one expression \n(?andpai...) match every pattern on one expression \n(?not pat...) succeed if pattern(s) do not match \nsegment-pat ((\nl*var)\n(d+var)\n((V.var)\n((?if \n...) \n...) \n...) \nexp)...) \nmatch zero or more expressions \nmatch one or more expressions \nmatch zero or one expression \ntest if exp (which may contain \nvariables) is true \n\n. chars a symbol starting with ? \n\nvar-\n\natom any nonvariable atom \n\nconstant \n\n\nDespite the added complexity, all patterns can still be classified into five cases. \nThe pattern must be either a variable, constant, a (generalized) segment pattern, \na (generalized) single-element pattern, or a cons of two patterns. The following \ndefinition of pat -match reflects the five cases (along with two checks for failure): \n\n\f\n<a id='page-181'></a>\n(defun pat-match (pattern input &optional (bindings no-bindings)) \n\"Match pattern against input in the context of the bindings\" \n(cond ((eq bindings fail) fail) \n\n((variable-p pattern) \n\n(match-variable pattern input bindings)) \n((eql pattern input) bindings) \n((segment-pattern-p pattern) \n\n(segment-matcher pattern input bindings)) \n((single-pattern-p pattern) ; *** \n(single-matcher pattern input bindings)) ; *** \n((and (consp pattern) (consp input)) \n(pat-match (rest pattern) (rest input) \n(pat-match (first pattern) (first input) \nbindings))) \n(t fail))) \n\nFor completeness, we repeat here the necessary constants and low-level functions \nfrom ELIZA: \n\n(defconstant fail nil \"Indicates pat-match failure\") \n\n(defconstant no-bindings '((t . t)) \n\"Indicates pat-match success, with no variables.\") \n\n(defun variable-p (x) \n\"Is . a variable (a symbol beginning with '?*)?\" \n(and (symbolp x) (equal (char (symbol-name x) 0) #\\?))) \n\n(defun get-binding (var bindings) \n\"Find a (variable . value) pair in a binding list. \" \n(assoc var bindings)) \n\n(defun binding-var (binding) \n\"Get the variable part of a single binding.\" \n(car binding)) \n\n(defun binding-val (binding) \n\"Get the value part of a single binding.\" \n(cdr binding)) \n\n(defun make-binding (var val) (cons var val)) \n\n(defun lookup (var bindings) \n\"Get the value part (for var) from a binding list. \" \n(binding-val (get-binding var bindings))) \n\n\f\n<a id='page-182'></a>\n\n(defun extend-bindings (var val bindings) \n\n\"Add a (var . value) pair to a binding list.\" \n\n(cons (make-binding var val) \n\nOnce we add a \"real\" binding, \n\nwe can get rid of the dummy no-bindings \n\n(if (eq bindings no-bindings) \n\nnil \n\nbindings) \n\n(defun match-variable (var input bindings) \n\n\"Does VAR match input? Uses (or updates) and returns bindings.\" \n\n(let ((binding (get-binding var bindings))) \n\n(cond ((not binding) (extend-bindings var input bindings)) \n\n((equal input (binding-val binding)) bindings) \n\n(t fail)))) \n\nThe next step is to define the predicates that recognize generalized segment and \nsingle-element patterns, and the matching functions that operate on them. We could \nimplementsegment-matcherandsingle-matcherwithcasestatementsthatconsider \nall possible cases. However, that would make it difficult to extend the matcher. A \nprogrammer who wanted to add a new kind of segment pattern would have to edit \nthe definitions of both segment-pattern-p and segment-matcher to install the new \nfeature. This by itself may not be too bad, but consider what happens when two \nprogrammers each add independent features. If you want to use both, then neither \nversion of segment-matcher (or segment-pattern-p) will do. You'll have to edit the \nfunctions again, just to merge the two extensions. \n\nThe solution to this dilemma is to write one version of segment-pattern-p and \nsegment-matcher, once and for all, but to have these functions refer to a table of \npattern/action pairs. The table would say \"if you see ?* in the pattern, then use \nthe function segment-match,\" and so on. Then programmers who want to extend \nthe matcher just add entries to the table, and it is trivial to merge different extensions \n(unless of course two programmers have chosen the same symbol to mark \ndifferent actions). \n\nThis style of programming, where pattern/action pairs are stored in a table, is \ncalled data-driven programming. It is a very flexible style that is appropriate for writing \nextensible systems. \n\nThere are many ways to implement tables in Conunon Lisp, as discussed in \nsection 3.6, [page 73](chapter3.md#page-73). In this case, the keys to the table will be symbols (like ?*), \nand it is fine if the representation of the table is distributed across memory. Thus, \nproperty lists are an appropriate choice. We will have two tables, represented by \nthe segment-match property and the si ngl e-match property of symbols like ?*. The \nvalue of each property will be the name of a function that implements the match. \nHere are the table entries to implement the granunar listed previously: \n\n\f\n<a id='page-183'></a>\n(setf (get '?is 'single-match) 'match-is) \n(setf (get '?or 'single-match) 'match-or) \n(setf (get '?and 'single-match) 'match-and) \n(setf (get '?not 'single-match) 'match-not) \n\n(setf (get '? * 'segment-match) 'segment-match) \n(setf (get '?+ 'segment-match) 'segment-match+) \n(setf (get '?? 'segment-match) 'segment-match?) \n(setf (get '?if 'segment-match) 'match-if) \n\nWith the table defined, we need to do two things. First, define the \"glue\" that holds \nthe table together: the predicates and action-taking functions. A function that looks \nupadata-driven function and calls it (such as segment-matcher and single-matcher) \nis called a dispatch function. \n\n(defun segment-pattern-p (pattern) \n\"Is this a segment-matching pattern like ((?* var) . pat)?\" \n(and (consp pattern) (consp (first pattern)) \n\n(symbolp (first (first pattern))) \n(segment-match-fn (first (first pattern))))) \n\n(defun single-pattern-p (pattern) \n\"Is this a single-matching pattern? \n\nE.g. (?is X predicate) (?and . patterns) (?or . patterns).\" \n(and (consp pattern) \n(single-match-fn (first pattern)))) \n\n(defun segment-matcher (pattern input bindings) \n\"Call the right function for this kind of segment pattern.\" \n(funcall (segment-match-fn (first (first pattern))) \n\npattern input bindings)) \n\n(defun single-matcher (pattern input bindings) \n\"Call the right function for this kind of single pattern.\" \n(funcall (single-match-fn (first pattern)) \n\n(rest pattern) input bindings)) \n\n(defun segment-match-fn (x) \n\"Get the segment-match function for x. \nif it is a symbol that has one.\" \n(when (symbolp x) (get . 'segment-match))) \n\n(defun single-match-fn (x) \n\"Get the single-match function for x, \nif it is a symbol that has one.\" \n(when (symbolp x) (get . 'single-match))) \n\n\f\n<a id='page-184'></a>\n\nThe last thing to do is define the individual matching functions. First, the single-\npattern matching functions: \n\n(defun match-is (var-and-pred input bindings) \n\"Succeed and bind var if the input satisfies pred, \nwhere var-and-pred is the list (var pred).\" \n(let* ((var (first var-and-pred)) \n\n(pred (second var-and-pred)) \n(new-bindings (pat-match var input bindings))) \n(if (or (eq new-bindings fail) \n\n(not (funcall pred input))) \nfail \nnew-bindings))) \n\n(defun match-and (patterns input bindings) \n\"Succeed if all the patterns match the input.\" \n(cond ((eq bindings fail) fail) \n\n((null patterns) bindings) \n(t (match-and (rest patterns) input \n(pat-match (first patterns) input \nbindings))))) \n\n(defun match-or (patterns input bindings) \n\"Succeed if any one of the patterns match the input.\" \n(if (null patterns) \n\nfail \n(let ((new-bindings (pat-match (first patterns) \ninput bindings))) \n\n(if (eq new-bindings fail) \n(match-or (rest patterns) input bindings) \nnew-bindings)))) \n\n(defun match-not (patterns input bindings) \n\"Succeed if none of the patterns match the input. \nThis will never bind any variables.\" \n(if (match-or patterns input bindings) \n\nfail \nbindings)) \n\nNow the segment-pattern matching functions, segment-match is similar to the version \npresented as part of ELIZA. The difference is in how we determine pos, the \nposition of the first element of the input that could match the next element of the \npattern after the segment variable. In ELIZA, we assumed that the segment variable \nwas either the last element of the pattern or was followed by a constant. In the \nfollowing version, we allow nonconstant patterns to follow segment variables. The \nfunction first -match - pos is added to handle this. If the following element is in fact \na constant, the same calculation is done using posi ti on. If it is not a constant, then \n\n\f\n<a id='page-185'></a>\nwe just return the first possible starting position—unless that would put us past the \nend of the input, in which case we return nil to indicate failure: \n\n(defun segment-match (pattern input bindings &optional (start 0)) \n\"Match the segment pattern ((?* var) . pat) against input.\" \n(let ((var (second (first pattern))) \n\n(pat (rest pattern))) \n\n(if (null pat) \n(match-variable var input bindings) \n(let ((pos (first-match-pos (first pat) input start))) \n\n(if (null pos) \nfail \n(let ((b2 (pat-match \n\npat (subseq input pos) \n(match-variable var (subseq input 0 pos) \nbindings)))) \nIf this match failed, try another longer one \n\n(if (eq b2 fail) \n(segment-match pattern input bindings (+ pos 1)) \nb2))))))) \n\n(defun first-match-pos (patl input start) \n\"Find the first position that patl could possibly match input, \nstarting at position start. If patl is non-constant, then just \nreturn start.\" \n(cond ((and (atom patl) (not (variable-p patl))) \n\n(position patl input :start start :test #*equal)) \n((< start (length input)) start) \n(t nil))) \n\nIn the first example below, the segment variable ?x matches the sequence (b c). In \nthe second example, there are two segment variables in a row. The first successful \nmatch is achieved with the first variable, ?x, matching the empty sequence, and the \nsecond one, ?y, matching (be). \n\n> (pat-match '(a (?* ?x) d) '(a b c d)) => ((?X . .) \n\n> (pat-match '(a (?* ?x) (?* ?y) d) '(a b c d)) => ((?Y . C) (?X)) \n\nIn the next example, ?x is first matched against nil and ?y against (be d), but that \nfails, so we try matching ?x against a segment of length one. That fails too, but \nfinally the match succeeds with ?x matching the two-element segment (be), and ?y \nmatching (d). \n\n\f\n<a id='page-186'></a>\n\n> (pat-match '(a (?* ?x) (?* ?y) ?x ?y) \n'(a b c d (b c) (d))) ((?Y D) (?X . .) \n\nGiven segment - match, it is easy to define the function to match one-or-more elements \nand the function to match zero-or-one element: \n\n(defun segment-match+ (pattern input bindings) \n\"Match one or more elements of input.\" \n(segment-match pattern input bindings D) \n\n(defun segment-match? (pattern input bindings) \n\"Match zero or one element of input.\" \n(let ((var (second (first pattern))) \n\n(pat (rest pattern))) \n(or (pat-match (cons var pat) input bindings) \n(pat-match pat input bindings)))) \n\nFinally, we supply the function to test an arbitrary piece of Lisp code. It does this \nby evaluating the code with the bindings implied by the binding list. This is one of \nthe few cases where it is appropriate to call eval: when we want to give the user \nunrestricted access to the Lisp interpreter. \n\n(defun match-if (pattern input bindings) \n\"Test an arbitrary expression involving variables. \nThe pattern looks like ((?if code) . rest).\" \n(and (progv (mapcar #*car bindings) \n\n(mapcar #'cdr bindings) \n(eval (second (first pattern)))) \n(pat-match (rest pattern) input bindings))) \n\nHere are two examples using ?i f. The first succeeds because (+ 3 4) is indeed 7, \nand the second fails because (> 3 4) is false. \n\n> (pat-match '(?x ?op ?y is ?z (?if (eql (?op ?x ?y) ?z))) \n'(3 + 4 is 7)) \n((?Z . 7) (?Y . 4) (?0P . +) (?X . 3)) \n\n> (pat-match '(?x ?op ?y (?if (?op ?x ?y))) \n'(3 > 4)) \nNIL \n\nThe syntax we have defined for patterns has two virtues: first, the syntax is very \ngeneral, so it is easy to extend. Second, the syntax can be easily manipulated by \npat-match. However, there is one drawback: the syntax is a little verbose, and some \nmay find it ugly. Compare the following two patterns: \n\n\f\n<a id='page-187'></a>\n(a (?* ?x) (?* ?y) d) \n\n(a ?x* ?y* d) \n\nMany readers find the second pattern easier to understand at a glance. We could \nchange pat-match to allow for patterns of the form ?x*, but that would mean \npat-match would have a lot more work to do on every match. An alternative is \nto leave pat-match as is, but define another level of syntax for use by human readers \nonly. That is, a programmer could type the second expression above, and have it \ntranslated into the first, which would then be processed by pat-match. \n\nIn other words, we will define a facility to define a kind of pattern-matching \nmacro that will be expanded the first time the pattern is seen. It is better to do this \nexpansion once than to complicate pat-match and in effect do the expansion every \ntime a pattern is used. (Of course, if a pattern is only used once, then there is no \nadvantage. But in most programs, each pattern will be used again and again.) \n\nWe need to define two functions: one to define pattern-matching macros, and \nanother to expand patterns that may contain these macros. We will only allow \nsymbols to be macros, so it is reasonable to store the expansions on each symbol's \nproperty list: \n\n(defun pat-match-abbrev (symbol expansion) \n\"Define symbol as a macro standing for a pat-match pattern.\" \n(setf (get symbol *expand-pat-match-abbrev) \n\n(expand-pat-match-abbrev expansion)) \n\n(defun expand-pat-match-abbrev (pat) \n\"Expand out all pattern matching abbreviations in pat.\" \n(cond ((and (symbolp pat) (get pat 'expand-pat-match-abbrev))) \n\n((atom pat) pat) \n(t (cons (expand-pat-match-abbrev (first pat)) \n(expand-pat-match-abbrev (rest pat)))))) \n\nWe would use this facility as follows: \n\n> (pat-match-abbrev '?x* '(?* ?x)) => (?* ?X) \n\n> (pat-match-abbrev '?y* '(?* ?y)) (?* ?Y) \n\n> (setf axyd (expand-pat-match-abbrev '(a ?x* ?y* d))) \n(A (?* ?X) (?* ?Y) D) \n\n> (pat-match axyd '(a b c d)) ((?Y . C) (?X)) \n\n&#9635; Exercise 6.1 [m] Go back and change the ELIZA rules to use the abbreviation facility. \nDoes this make the rules easier to read? \n\n\f\n<a id='page-188'></a>\n\n&#9635; Exercise 6.2 [h] In the few prior examples, every time there was a binding of \npattern variables that satisfied the input, that binding was found. Informally, show \nthat pat-match will always find such a binding, or show a counterexample where it \nfails to find one. \n\n6.3 A Rule-Based Translator Tool \nAs we have defined it, the pattern matcher matches one input against one pattern. In \nel i . a, we need to match each input against a number of patterns, and then return a \nresult based on the rule that contains the first pattern that matches. To refresh your \nmemory, here is the function use-el i za - rul es: \n\n(defun use-eliza-rules (input) \n\"Find some rule with which to transform the input.\" \n(some #*(lambda (rule) \n\n(let ((result (pat-match (rule-pattern rule) input))) \n(if (not (eq result fail)) \n(sublis (switch-viewpoint result) \n(random-elt (rule-responses rule)))))) \n*eliza-rules*)) \n\nIt turns out that this will be a quite common thing to do: search through a list of rules \nfor one that matches, and take action according to that rule. To turn the structure of \nuse-el i za-rules into a software tool, we will allow the user to specify each of the \nfollowing: \n\n* What kind of rule to use. Every rule will be characterized by an if-part and a \nthen-part, but the ways of getting at those two parts may vary. \n* What list of rules to use. In general, each appHcation will have its own list of \nrules. \n* How to see if a rule matches. By default, we will use pat-match, but it should \nbe possible to use other matchers. \n* What to do when a rule matches. Once we have determined which rule to use, \nwe have to determine what it means to use it. The default is just to substitute \nthe bindings of the match into the then-part of the rule. \n\f\n<a id='page-189'></a>\nThe rule-based translator tool now looks like this: \n\n(defun rule-based-translator \n(input rules &key (matcher #'pat-match) \n\n(rule-if #*first) (rule-then #*rest) (action #*sublis)) \n\"Find the first rule in rules that matches input, \nand apply the action to that rule.\" \n(some \n\n#'(lambda (rule) \n(let ((result (funcall matcher (funcall rule-if rule) \ninput))) \n(if (not (eq result fail)) \n(funcall action result (funcall rule-then rule))))) \nrules)) \n\n(defun use-eliza-rules (input) \n\"Find some rule with which to transform the input.' \n(rule-based-translator input *eliza-rules* \n\nlaction #.(lambda (bindings responses) \n(sublis (switch-viewpoint bindings) \n(random-elt responses))))) \n\n6.4 A Set of Searching Tools \nThe GPS program can be seen as a problem in search. In general, a search problem \ninvolves exploring from some starting state and investigating neighboring states \nuntil a solution is reached. As in GPS, state means a description of any situation or \nstate of affairs. Each state may have several neighbors, so there will be a choice of \nhow to search. We can travel down one path until we see it is a dead end, or we can \nconsider lots of different paths at the same time, expanding each path step by step. \nSearch problems are called nondeterministic because there is no way to determine \nwhat is the best step to take next. AI problems, by their very nature, tend to be \nnondeterministic. This can be a source of confusion for programmers who are used \nto deterministic problems. In this section we will try to clear up that confusion. \nThis section also serves as an example of how higher-order functions can be used to \nimplement general tools that can be specified by passing in specific functions. \n\nAbstractly, a search problem can be characterized by four features: \n\n* The siarf state. \n* The^Oiz/state (or states). \n\f\n<a id='page-190'></a>\n\n* The successors, or states that can be reached from any other state. \n* The strategy that determines the order in which we search. \nThe first three features are part of the problem, while the fourth is part of the \nsolution. In GPS, the starting state was given, along with a description of the goal \nstates. The successors of a state were determined by consulting the operators. The \nsearch strategy was means-ends analysis. This was never spelled out explicitly but \nwas impUcit in the structure of the whole program. In this section we will formulate \na general searching tool, show how it can be used to implement several different \nsearch strategies, and then show how GPS could be implemented with this tool. \n\nThe first notion we have to define is the state space, or set of all possible states. \nWe can view the states as nodes and the successor relation as links in a graph. Some \nstate space graphs will have a small number of states, while others have an infinite \nnumber, but they can still be solved if we search cleverly. Some graphs will have \na regular structure, while others will appear random. We will start by considering \nonly trees—that is, graphs where a state can be reached by only one unique sequence \nof successor links. Here is a tree: \n\nSearching Trees \n\nWe will call our first searching tool tree-search, because it is designed to search \nstate spaces that are in the form of trees. It takes four arguments: (1) a list of valid \nstarting states, (2) a predicate to decide if we have reached a goal state, (3) a function \nto generate the successors of a state, and (4) a function that decides in what order \n\n\f\n<a id='page-191'></a>\nto search. The first argument is a hst rather than a single state so that tree-search \ncan recursively call itself after it has explored several paths through the state space. \nThink of the first argument not as a starting state but as a list of possible states from \nwhich the goal may be reached. This lists represents the fringe of the tree that has \nbeen explored so far. tree-search has three cases: If there are no more states to \nconsider, then give up and return f ai 1. If the first possible state is a goal state, \nthen return the succesful state. Otherwise, generate the successors of the first state \nand combine them with the other states. Order this combined list according to the \nparticular search strategy and continue searching. Note that tree - search itself does \nnot specify any particular searching strategy. \n\n(defun tree-search (states goal-p successors combiner) \n\"Find a state that satisfies goal-p. Start with states, \nand search according to successors and combiner.\" \n(dbg :search \"\"&;; Search: ~a\" states) \n(cond ((null states) fail) \n\n((funcall goal-p (first states)) (first states)) \n(t (tree-search \n\n(funcall combiner \n(funcall successors (first states)) \n(rest states)) \n\ngoal-p successors combiner)))) \n\nThe first strategy we will consider is called depth-first search. In depth-first search, \nthe longest paths are considered first. In other words, we generate the successors \nof a state, and then work on the first successor first. We only return to one of the \nsubsequent successors if we arrive at a state that has no successors at all. This \nstrategy can be implemented by simply appending the previous states to the end \nof the Ust of new successors on each iteration. The function depth-first-search \ntakes a single starting state, a goal predicate, and a successor function. It packages \nthe starting state into a Hst as expected by tree-search, and specifies append as the \ncombining function: \n\n(defun depth-first-search (start goal-p successors) \n\"Search new states first until goal is reached.\" \n(tree-search (list start) goal-p successors #'append)) \n\nLet's see how we can search through the binary tree defined previously. First, we \ndefine the successor function binary-tree. It returns a list of two states, the two \nnumbers that are twice the input state and one more than twice the input state. So the \nsuccessors of 1 will be 2 and 3, and the successors of 2 will be 4 and 5. The bi na ry - tree \nfunction generates an infinite tree of which the first 15 nodes are diagrammed in our \nexample. \n\n\f\n<a id='page-192'></a>\n\n(defun binary-tree (.) (list (* 2 .) (+ 1 (* 2 .)))) \n\n.. make it easier to specify a goal, we define the function i s as a function that returns \na predicate that tests for a particular value. Note that 1 s does not do the test itself. \nRather, it returns a function that can be called to perform tests: \n\n(defun is (value) #*(lambda (x) (eql . value))) \n\nNow we can turn on the debugging output and search through the binary tree, starting \nat 1, and looking for, say, 12, as the goal state. Each line of debugging output shows \nthe list of states that have been generated as successors but not yet examined: \n\n> (debug :search) => (SEARCH) \n\n> (depth-first-search 1 (is 12) #*binary-tree) \n\n;; Search; (1) \n\n;: Search: (2 3) \n\n;; Search: (4 5 3) \n\n;; Search: (8 9 5 3) \n\nSearch: (16 17 9 5 3) \n\n:; Search: (32 33 17 9 5 3) \n\n;; Search: (64 65 33 17 9 5 3) \n\nSearch: (128 129 65 33 17 9 5 3) \n\nSearch: (256 257 129 65 33 17 9 5 3) \n\n;: Search: (512 513 257 129 65 33 17 9 5 3) \n\n;; Search: (1024 1025 513 257 129 65 33 17 9 5 3) \n\nSearch: (2048 2049 1025 513 257 129 65 33 17 9 5 3) \n\n[Abort] \n\nThe problem is that we are searching an infinite tree, and the depth-first search \nstrategy just dives down the left-hand branch at every step. The only way to stop the \ndoomed search is to type an interrupt character. \n\nAn alternative strategy isbreadth-first search, where the shortest path is extended \nfirst at each step. It can be implemented simply by appending the new successor \nstates to the end of the existing states: \n\n(defun prepend (x y) \"Prepend y to start of x\" (append y .)) \n\n(defun breadth-first-search (start goal-p successors) \n\"Search old states first until goal is reached.\" \n(tree-search (list start) goal-p successors #'prepend)) \n\nThe only difference between depth-first and breadth-first search is the difference \nbetween append and prepend. Here we see breadth-first-search inaction: \n\n\f\n<a id='page-193'></a>\n\n> (breadth-first-search 1 (is 12) *binary-tree) \nSearch: (1) \nSearch: (2 3) \nSearch: (3 4 5) \nSearch: (4 5 6 7) \nSearch: (56789) \nSearch: (6 7 8 9 10 11) \nSearch: (7 8 9 10 11 12 13) \nSearch: (8 9 10 11 12 13 14 15) \nSearch: (9 10 11 12 13 14 15 16 17) \nSearch: (10 11 12 13 14 15 16 17 18 19) \nSearch: (11 12 13 14 15 16 17 18 19 20 21) \nSearch: (12 13 14 15 16 17 18 19 20 21 22 23) \n\n12 \n\nBreadth-first search ends up searching each node in numerical order, and so it will \neventually find any goal. It is methodical, but therefore plodding. Depth-first search \nwill be much faster—if it happens to find the goal at all. For example, if we were \nlooking for 2048, depth-first search would find it in 12 steps, while breadth-first \nwould take 2048 steps. Breadth-first search also requires more storage, because it \nsaves more intermediate states. \n\nIf the search tree is finite, then either breadth-first or depth-first will eventually \nfind the goal. Both methods search the entire state space, but in a different order. We \nwill now show a depth-first search of the 15-node binary tree diagrammed previously. \nIt takes about the same amount of time to find the goal (12) as it did with breadth-first \nsearch. It would have taken more time to find 15; less to find 8. The big difference is \nin the number of states considered at one time. At most, depth-first search considers \nfour at a time; in general it will need to store only log2 . states to search a n-node tree, \nwhile breadth-first search needs to store n/2 states. \n\n(defun finite-binary-tree (n) \n\"Return a successor function that generates a binary tree \nwith . nodes.\" \n#'(lambda (x) \n\n(remove-if #*(lambda (child) (> child n)) \n(binary-tree x)))) \n\n> (depth-first-search 1 (is 12) (finite-binary-tree 15)) \n\n;; Search: (1) \nSearch: (2 3) \nSearch: (4 5 3) \nSearch: (8 9 5 3) \nSearch: (9 5 3) \n\n:: Search: (5 3) \n:: Search: (10 11 3) \n;: Search: (11 3) \n\n\f\n<a id='page-194'></a>\n\nSearch: (3) \nSearch: (6 7) \nSearch: (12 13 7) \n\n12 \n\nGuiding the Search \n\nWhile breadth-first search is more methodical, neither strategy is able to take advantage \nof any knowledge about the state space. They both search blindly. In most real \napplications we will have some estimate of how far a state is from the solution. In \nsuch cases, we can implement a best-first search. The name is not quite accurate; if \nwe could really search best first, that would not be a search at all. The name refers to \nthe fact that the state that appears to be best is searched first. \n\nTo implement best-first search we need to add one more piece of information: a \ncost function that gives an estimate of how far a given state is from the goal. \n\nFor the binary tree example, we will use as a cost estimate the numeric difference \nfrom the goal. So if we are looking for 12, then 12 has cost 0, 8 has cost 4 and 2048 \nhas cost 2036. The higher-order function d i ff, shown in the following, returns a cost \nfunction that computes the difference from a goal. The higher-order function sorter \ntakes a cost function as an argument and returns a combiner function that takes the \nlists of old and new states, appends them together, and sorts the result based on the \ncost function, lowest cost first. (The built-in function sort sorts a list according to \na comparison function. In this case the smaller numbers come first, sort takes an \noptional : key argument that says how to compute the score for each element. Be \ncareful—sort is a destructive function.) \n\n(defun diff (num) \n\"Return the function that finds the difference from num.\" \n#'(lambda (x) (abs (- . num)))) \n\n(defun sorter (cost-fn) \n\"Return a combiner function that sorts according to cost-fn.\" \n#'(lambda (new old) \n\n(sort (append new old) #'< :key cost-fn))) \n\n(defun best-first-search (start goal-p successors cost-fn) \n\"Search lowest cost states first until goal is reached.\" \n(tree-search (list start) goal-p successors (sorter cost-fn))) \n\nNow, using the difference from the goal as the cost function, we can search using \nbest-first search: \n\n\f\n<a id='page-195'></a>\n> (best-first-search 1 (is 12) #'binary-tree (diff 12)) \nSearch: (1) \n\n;; Search: (3 2) \nSearch: (7 6 2) \nSearch: (14 15 6 2) \nSearch: (15 6 2 28 29) \n\n;; Search: (6 2 28 29 30 31) \nSearch: (12 13 2 28 29 30 31) \n12 \n\nThe more we know about the state space, the better we can search. For example, if we \nknow that all successors are greater than the states they come from, then we can use \na cost function that gives a very high cost for numbers above the goal. The function \nprice-is-right is like diff, except that it gives a high penalty for going over the \ngoal.\"^ Using this cost function leads to a near-optimal search on this example. It \nmakes the \"mistake\" of searching 7 before 6 (because 7 is closer to 12), but does not \nwaste time searching 14 and 15: \n\n(defun price-is-right (price) \n\"Return a function that measures the difference from price, \nbut gives a big penalty for going over price.\" \n#'(lambda (x) (if (> . price) \n\nmost-positive-fixnum \n(- price x)))) \n\n> (best-first-search 1 (is 12) #'binary-tree (price-is-right 12)) \nSearch: (1) \nSearch: (3 2) \nSearch: (7 6 2) \nSearch: (6 2 14 15) \nSearch: (12 2 13 14 15) \n\n12 \n\nAll the searching methods we have seen so far consider ever-increasing lists of states \nas they search. For problems where there is only one solution, or a small number of \nsolutions, this is unavoidable. To find a needle in a haystack, you need to look at a \nlot of hay. But for problems with many solutions, it may be worthwhile to discard \nunpromising paths. This runs the risk of failing to find a solution at all, but it can \nsave enough space and time to offset the risk. A best-first search that keeps only a \nfixed number of alternative states at any one time is known as a beam search. Think \nof searching as shining a light through the dark of the state space. In other search \n\n^The built-in constant most-positive-fixnum is a large integer, the largest that can be \nexpressed without using bignums. Its value depends on the implementation, but in most \nLisps it is over 16 million. \n\n\f\n<a id='page-196'></a>\n\nstrategies the light spreads out as we search deeper, but in beam search the light \nremains tightly focused. Beam search is a variant of best-first search, but it is also \nsimilar to depth-first search. The difference is that beam search looks down several \npaths at once, instead of just one, and chooses the best one to look at next. But \nit gives up the ability to backtrack indefinitely. The function beam-search is just \nlike best-first-search, except that after we sort the states, we then take only the \nfirst beam-width states. This is done with subseq; (subseq list start end) returns the \nsublist that starts at position start and ends just before position end. \n\n(defun beam-search (start goal-p successors cost-fn beam-width) \n\"Search highest scoring states first until goal is reached, \nbut never consider more than beam-width states at a time.\" \n(tree-search (list start) goal-p successors \n\n#'(lambda (old new) \n(let ((sorted (funcall (sorter cost-fn) oldnew))) \n(if (> beam-width (length sorted)) \nsorted \n\n(subseq sorted0 beam-width)))))) \n\nWe can successfully search for 12 in the binary tree using a beam width of only 2: \n\n> (beam-search 1 (is 12) #*binary-tree (price-is-right 12) 2) \nSearch; (1) \nSearch; (3 2) \n\n;; Search; (7 6) \nSearch; (6 14) \nSearch; (12 13) \n\n12 \n\nHowever, if we go back to the scoring function that just takes the difference from 12, \nthen beam search fails. When it generates 14 and 15, it throws away 6, and thus loses \nits only chance to find the goal: \n\n> (beam-search 1 (is 12) #'binary-tree (diff 12) 2) \nSearch; (1) \nSearch; (3 2) \nSearch; (7 6) \nSearch; (14 15) \nSearch; (15 28) \nSearch; (28 30) \nSearch; (30 56) \nSearch; (56 60) \nSearch; (60 112) \nSearch; (112 120) \nSearch; (120 224) \n\n\f\n<a id='page-197'></a>\n\n[Abort] \n\nThis search would succeed if we gave a beam width of 3. This illustrates a general \nprinciple: we can find a goal either by looking at more states, or by being smarter \nabout the states we look at. That means having a better ordering function. \n\nNotice that with a beam width of infinity we get best-first search. With a beam \nwidth of 1, we get depth-first search with no backup. This could be called \"depth-only \nsearch,\" but it is more commonly known as hill-climbing. Think of a mountaineer \ntrying to reach a peak in a heavy fog. One strategy would be for the moimtaineer to \nlook at adjacent locations, climb to the highest one, and look again. This strategy \nmay eventually hit the peak, but it may also get stuck at the top of a foothill, or local \nmanmum. Another strategy would be for the mountaineer to turn back and try again \nwhen the fog lifts, but in AI, unfortunately, the fog rarely lifts.^ \n\nAs a concrete example of a problem that can be solved by search, consider the \ntask of planning a flight across the North American continent in a small airplane, one \nwhose range is limited to 1000 kilometers. Suppose we have a list of selected cities \nwith airports, along with their position in longitude and latitude: \n\n(defstruct (city (:type list)) name long lat) \n\n(defparameter *cities* \n\n'((Atlanta 84.23 33.45) (Los-Angeles 118.15 34.03) \n(Boston 71.05 42.21) (Memphis 90.03 35.09) \n(Chicago 87.37 41.50) (New-York 73.58 40.47) \n(Denver 105.00 39.45) (Oklahoma-City 97.28 35.26) \n(Eugene 123.05 44.03) (Pittsburgh 79.57 40.27) \n(Flagstaff 111.41 35.13) (Quebec 71.11 46.49) \n(Grand-Jet 108.37 39.05) (Reno 119.49 39.30) \n(Houston 105.00 34.00) (San-Francisco 122.26 37.47) \n(Indianapolis 86.10 39.46) (Tampa 82.27 27.57) \n(Jacksonville 81.40 30.22) (Victoria 123.21 48.25) \n(Kansas-City 94.35 39.06) (Wilmington 77.57 34.14))) \n\nThis example introduces a new option to defstruct. Instead of just giving the name \nof the structure, it is also possible to use: \n\n(defstruct {structure-name {option value),,,) 'Optionaldoc'' slot,,,) \n\nFor city, the option : type is specified as 1 i st. This means that cities will be implemented \nas lists of three elements, as they are in the initial value for *ci ti es*. \n\n^In chapter 8 we will see an example where the fog did lift: symbolic integration was once \nhandled as a problem in search, but new mathematical results now make it possible to solve \nthe same class of integration problems without search. \n\n\f\n<a id='page-198'></a>\n\nFigure 6.1: A Map of Some Cities \n\nThe cities are shown on the map in figure 6.1, which has cormections between \nall cities within the 1000 kilometer range of each other.^ This map was drawn with \nthe help of ai r-di stance, a function that retiutis the distance in kilometers between \ntwo cities \"as the crow flies.\" It will be defined later. Two other useful fimctions are \nnei ghbors, which finds all the cities within 1000 kilometers, and ci ty, which maps \nfrom a name to a city. The former uses f i nd - a 11 - i f, which was defined on [page 101](chapter3.md#page-101) \nas a synonym for remove- i f-not. \n\n(defun neighbors (city) \n\"Find all cities within 1000 kilometers.\" \n(find-all-if #'(lambda (c) \n\n(and (not (eq c city)) \n(< (air-distance c city) 1000.0))) \n*cities*)) \n\n(defun city (name) \n\"Find the city with this name.\" \n(assoc name *cities*)) \n\nWe are now ready to plan a trip. The fimction trip takes the name of a starting and \ndestination city and does a beam search of width one, considering all neighbors as \n\n^The astute reader will recognize that this graph is not a tree. The difference between trees \nand graphs and the implications for searching will be covered later. \n\n\f\n<a id='page-199'></a>\nsuccessors to a state. The cost for a state is the air distance to the destination city: \n\n(defun trip (start dest) \n\"Search for a way from the start to dest.\" \n(beam-search start (is dest) #'neighbors \n\n#'(1ambda (c) (air-distance c dest)) \n\nD) \n\nHere we plan a trip from San Francisco to Boston. The result seems to be the best \npossible path: \n\n> (trip (city 'san-francisco) (city 'boston)) \nSearch: ((SAN-FRANCISCO 122.26 37.47)) \nSearch: ((RENO 119.49 39.3)) \nSearch: ((GRAND-JCT 108.37 39.05)) \nSearch: ((DENVER 105.0 39.45)) \nSearch: ((KANSAS-CITY 94.35 39.06)) \nSearch: ((INDIANAPOLIS 86.1 39.46)) \nSearch: ((PITTSBURGH 79.57 40.27)) \n\n:; Search: ((BOSTON 71.05 42.21)) \n(BOSTON 71.05 42.21) \n\nBut look what happens when we plan the return trip. There are two detours, to \nChicago and Flagstaff: \n\n> (trip (city 'boston) (city 'san-francisco)) \nSearch: ((BOSTON 71.05 42.21)) \nSearch: ((PITTSBURGH 79.57 40.27)) \nSearch: ((CHICAGO 87.37 41.5)) \nSearch: ((KANSAS-CITY 94.35 39.06)) \nSearch: ((DENVER 105.0 39.45)) \nSearch: ((FLAGSTAFF 111.41 35.13)) \nSearch: ((RENO 119.49 39.3)) \nSearch: ((SAN-FRANCISCO 122.26 37.47)) \n\n(SAN-FRANCISCO 122.26 37.47) \n\nWhy did tri . go from Denver to San Francisco via Flagstaff? Because Flagstaff is \ncloser to the destination than Grand Junction. The problem is that we are minimizing \nthe distance to the destination at each step, when we should be minimizing the sum \nof the distance to the destination plus the distance already traveled. \n\n\f\n<a id='page-200'></a>\n\nSearch Paths \n\nTo minimize the total distance, we need some way to talk about the path that leads \nto the goal. But the functions we have defined so far only deal with individual states \nalong the way. Representing paths would lead to another advantage: we could \nreturn the path as the solution, rather than just return the goal state. As it is, tri . \nonly returns the goal state, not the path to it. So there is no way to determine what \ntrip has done, except by reading the debugging output. \n\nThe data structure path is designed to solve both these problems. A path has \nfour fields: the current state, the previous partial path that this path is extending, \nthe cost of the path so far, and an estimate of the total cost to reach the goal. Here is \nthe structure definition for path. It uses the : pri nt-function option to say that all \npaths are to be printed with the function pr i nt - pa th, which will be defined below. \n\n(defstruct (path (:print-function print-path)) \nstate (previous nil) (cost-so-far 0) (total-cost 0)) \n\nThe next question is how to integrate paths into the searching routines with the \nleast amount of disruption. Clearly, it would be better to make one change to \ntree-search rather than to change depth-first-search, breadth-first-search, \nand beam-search. However, looking back at the definition of tree-search, we see \nthat it makes no assumptions about the structure of states, other than the fact that \nthey can be manipulated by the goal predicate, successor, and combiner fimctions. \nThis suggests that we can use tree-search unchanged if we pass it paths instead of \nstates, and give it functions that can process paths. \n\nIn the following redefinition of tri ., the beam- sea rch function is called with five \narguments. Instead of passing it a city as the start state, we pass a path that has \nthe city as its state field. The goal predicate should test whether its argument is a \npath whose state is the destination; we assume (and later define) a version of i s that \naccommodates this. The successor function is the most difficult. Instead of just \ngenerating a Ust of neighbors, we want to first generate the neighbors, then make \neach one into a path that extends the current path, but with an updated cost so far \nand total estimated cost. The function path - saver returns a function that will do just \nthat. Finally, the cost function we are trying to minimize is path-total - cost, and \nwe provide a beam width, which is now an optional argument to tri . that defaults \nto one: \n\n(defun trip (start dest &optional (beam-width 1)) \n\n\"Search for the best path from the start to dest.\" \n\n(beam-search \n\n(make-path :state start) \n\n(is dest :key #*path-state) \n\n(path-saver #'neighbors #'air-distance \n\n\f\n<a id='page-201'></a>\n#'(lambda (c) (air-distance c dest))) \n#*path-total-cost \nbeam-width)) \n\nThe calculation of ai r-di stance involves some complicated conversion of longitude \nand latitude to x-y-z coordinates. Since this is a problem in solid geometry, not AI, \nthe code is presented without further comment: \n\n(defconstant earth-diameter 12765.0 \n\"Diameter of planet earth in kilometers.\") \n\n(defun air-distance (cityl city2) \n\"The great circle distance between two cities.\" \n(let ((d (distance (xyz-coords cityl) (xyz-coords city2)))) \n\nd is the straight-1ine chord between the two cities. \n;; The length of the subtending arc is given by: \n(* earth-diameter (asin (/ d 2))))) \n\n(defun xyz-coords (city) \n\"Returns the x.y.z coordinates of a point on a sphere. \nThe center is (0 0 0) and the north pole is (0 0 D.\" \n(let ((psi (deg->radians (city-lat city))) \n\n(phi (deg->radians (city-long city)))) \n\n(list (* (cos psi) (cos phi)) \n(* (cos psi) (sin phi)) \n(sin psi)))) \n\n(defun distance (pointl point2) \n\"The Euclidean distance between two points. \nThe points are coordinates in n-dimensional space.\" \n(sqrt (reduce #*+ (mapcar #'(lambda (a b) (expt (- a b) 2)) \n\npointl point2)))) \n\n(defun deg->radians (deg) \n\"Convert degrees and minutes to radians. \" \n(* (+ (truncate deg) (* (rem deg 1) 100/60)) pi 1/180)) \n\nBefore showing the auxiliary functions that implement this, here are some examples \nthat show what it can do. With a beam width of 1, the detour to Flagstaff is eliminated, \nbut the one to Chicago remains. With a beam width of 3, the correct optimal path is \nfound. In the following examples, each call to the new version of t r i . returns a path, \nwhich is printed by s how- ci ty - pa th: \n\n> (show-city-path (trip (city 'san-francisco) (city 'boston) 1)) \n#<Path 4514.8 km: San-Francisco - Reno - Grand-Jet - Denver Kansas-\nCity - Indianapolis - Pittsburgh - Boston> \n\n\f\n<a id='page-202'></a>\n\n> (show-city-path (trip (city 'boston) (city 'san-francisco) 1)) \n#<Path 4577.3 km: Boston - Pittsburgh - Chicago - Kansas-City Denver \n- Grand-Jet - Reno - San-Francisco> \n\n> (show-city-path (trip (city 'boston) (city 'san-francisco) 3)) \n#<Path 4514.8 km: Boston - Pittsburgh - Indianapolis Kansas-\nCity - Denver - Grand-Jet - Reno - San-Francisco> \n\nThis example shows how search is susceptible to irregularities in the search space. It \nwas easy to find the correct path from west to east, but the return trip required more \nsearch, because Flagstaff is a falsely promising step. In general, there may be even \nworse dead ends lurking in the search space. Look what happens when we limit the \nairplane's range to 700 kilometers. The map is shown in figure 6.2. \n\nFigure 6.2: A Map of Cities within 700km \n\nIf we try to plan a trip from Tampa to Quebec, we can run into problems with \nthe dead end at Wilmington, North Carolina. With a beam width of 1, the path to \nJacksonville and then Wilmington will be tried first. From there, each step of the path \nalternates between Atlanta and Wilmington. The search never gets any closer to the \ngoal. But with a beam width of 2, the path from Tampa to Atlanta is not discarded, \nand it is eventually continued on to Indianapolis and eventually to Quebec. So the \ncapability to back up is essential in avoiding dead ends. \n\nNow for the implementation details. The function i s still returns a predicate that \ntests for a value, but now it accepts : key and : test keywords: \n\n\f\n<a id='page-203'></a>\n(defun is (value &key (key #'identity) (test #'eql)) \n\"Returns a predicate that tests for a given value.\" \n#'(lambda (path) (funcall test value (funcall key path)))) \n\nThe path - saver function returns a function that will take a path as an argument and \ngenerate successors paths, path-saver takes as an argument a successor function \nthat operates on bare states. It calls this function and, for each state returned, builds \nup a path that extends the existing path and stores the cost of the path so far as well \nas the estimated total cost: \n\n(defun path-saver (successors cost-fn cost-left-fn) \n#*(lambda (old-path) \n(let ((old-state (path-state old-path))) \n(mapcar \n#*(lambda (new-state) \n(let ((old-cost \n(+ (path-cost-so-far old-path) \n(funcall cost-fn old-state new-state)))) \n\n(make-path \n:state new-state \nrprevious old-path \n:cost-so-far old-cost \n:total-cost (+ old-cost (funcall cost-left-fn \n\nnew-state))))) \n(funcall successors old-state))))) \n\nBy default a path structure would be printed as #S (PATH ...). But because each path \nhas a previ ous field that is filled by another path, this output would get quite verbose. \nThat is why we installed pr i nt- pat h as the print function for paths when we defined \nthe structure. It uses the notation #<...>, which is a Common Lisp convention for \nprinting output that can not be reconstructed by read. The function show- ci ty - pa th \nprints a more complete representation of a path. We also define map-path to iterate \nover a path, collecting values: \n\n(defun print-path (path &optional (stream t) depth) \n(declare (ignore depth)) \n(format stream \"#<Path to '\"a cost ~.lf> \" \n\n(path-state path) (path-total-cost path))) \n\n(defun show-city-path (path &optional (stream t)) \n\"Show the length of a path, and the cities along it.\" \n(format stream \"#<Path ~,lf km: \"{^..^.^ -~}>\" \n\n(path-total-cost path) \n(reverse (map-path #'city-name path))) \n(values)) \n\n\f\n<a id='page-204'></a>\n\n(defun map-path (fn path) \n\n\"Can fn on each state in the path, collecting results.\" \n\n(if (null path) \n\nnil \n\n(cons (funcall fn (path-state path)) \n\n(map-path fn (path-previous path))))) \n\nGuessing versus Guaranteeing a Good Solution \n\nElementary AI textbooks place a great emphasis on search algorithms that are gusiranteed \nto find the best solution. However, in practice these algorithms are hardly \never used. The problem is that guaranteeing the best solution requires looking at a lot \nof other solutions in order to rule them out. For problems with large search spaces, \nthis usually takes too much time. The alternative is to use an algorithm that will \nprobably return a solution that is close to the best solution, but gives no guarantee. \nSuch algorithms, traditionally known as non-admissible heuristic search algorithms, \ncan be much faster. \n\nOf the algorithms we have seen so far, best-first search almost, but not quite, \nguarantees the best solution. The problem is that it terminates a little too early. \nSuppose it has calculated three paths, of cost 90, 95 and 110. It will expand the 90 \npath next. Suppose this leads to a solution of total cost 100. Best-first search will \nthen retimi that solution. But it is possible that the 95 path could lead to a solution \nwith a total cost less than 100. Perhaps the 95 path is only one unit away from the \ngoal, so it could result in a complete path of length 96. This means that an optimal \nsearch should examine the 95 path (but not the 110 path) before exiting. \n\nDepth-first seeu-ch and beam search, on the other hand, are definitely heuristic \nalgorithms. Depth-first search finds a solution without any regard to its cost. With \nbeam search, picking a good value for the beam width can lead to a good, quick \nsolution, while picking the wrong value can lead to failure, or to a poor solution. \nOne way out of this dilemma is to start with a narrow beam width, and if that does \nnot lead to an acceptable solution, widen the beam and try again. We will call this \niterative widening, although that is not a standard term. There are many variations on \nthis theme, but here is a simple one: \n\n(defun iter-wide-search (start goal-p successors cost-fn \n\n&key (width 1) (max 100)) \n\n\"Search, increasing beam width from width to max. \n\nReturn the first solution found at any width.\" \n\n(dbg .-search \"; Width: ~d\" width) \n\n(unless (> width max) \n\n(or (beam-search start goal-p successors cost-fn width) \n\n(iter-wide-search start goal-p successors cost-fn \n\n\f\n<a id='page-205'></a>\n:width (+ width 1) :max max)))) \n\nHere i ter-wide-search is used to search through a binary tree, failing with beam \nwidth 1 and 2, and eventually succeeding with beam width 3: \n\n> (iter-wide-search 1 (is 12) (finite-binary-tree 15) (diff 12)) \n\nWidth: 1 \n\n; Search: (1) \n\n; Search: (3) \n\n; Search: (7) \n\n: Search: (14) \n\n; Search: NIL \n\nWidth: 2 \n\n; Search: (1) \n\n; Search: (3 2) \n\n: Search: (7 6) \n\n: Search: (14 15) \n\n; Search: (15) \n\n: Search: NIL \n\nWidth: 3 \n\n; Search: (1) \n\n; Search: (3 2) \n\n; Search: (7 6 2) \n\n; Search: (14 15 6) \n\n; Search: (15 6) \n\n; Search: (6) \n\n; Search: (12 13) \n\n12 \n\nThe name iterative widening is derived from the established term iterative deepening. \nIterative deepening is used to control depth-first search when we don't know the \ndepth of the desired solution. The idea is first to limit the search to a depth of 1, \nthen 2, and so on. That way we are guaranteed to find a solution at the minimum \ndepth, just as in breadth-first search, but without wasting as much storage space. Of \ncourse, iterative deepening does waste some time because at each increasing depth \nit repeats all the work it did at the previous depth. But suppose that the average \nstate has ten successors. That means that increasing the depth by one results in ten \ntimes more search, so only 10% of the time is wasted on repeated work. So iterative \ndeepening uses only slightly more time and much less space. We will see it again in \nchapters 11 and 18. \n\n\f\n<a id='page-206'></a>\n\nSearching Graphs \n\nSo far, tree-search has been the workhorse behind all the searching routines. This \nis curious, when we consider that the city problem involves a graph that is not a tree \nat all. The reason tree - sea rch works is that any graph can be treated as a tree, if we \nignore the fact that certain nodes are identical. For example, the graph in figure 6.3 \ncan be rendered as a tree. Figure 6.4 shows only the top four levels of the tree; each \nof the bottom nodes (except the 6s) needs to be expanded further. \n\nJ L \n\nFigure 6.3: A Graph with Six Nodes \n\nIn searching for paths through the graph of cities, we were implicitly turning the \ngraph into a tree. That is, if tree - sea rch found two paths from Pittsburgh to Kansas \nCity (via Chicago or Indianapolis), then it would treat them as two independent \npaths, just as if there were two distinct Kansas Cities. This made the algorithms \nsimpler, but it also doubles the number of paths left to examine. If the destination is \nSan Francisco, we will have to search for a path from Kansas City to San Francisco \ntwice instead of once. In fact, even though the graph has only 22 cities, the tree is \ninfinite, because we can go back and forth between adjacent cities any number of \ntimes. So, while it is possible to treat the graph as a tree, there are potential savings \nin treating it as a true graph. \n\nThe function g raph- sea rch does just that. It is similar to tree - sea rch, but accepts \ntwo additional cirguments: a comparison function that tests if two states are equal, \nand a list of states that are no longer being considered, but were examined in the past. \nThe difference between graph-search and tree -search is in the call to new-states, \nwhich generates successors but eliminates states that are in either the list of states \ncurrently being considered or the list of old states considered in the past. \n\n(defun graph-search (states goal-p successors combiner \n&optional (state= #'eql) old-states) \n\"Find a state that satisfies goal-p. Start with states. \n\n\f\n<a id='page-207'></a>\nFigure 6.4: The Corresponding Tree \n\nand search according to successors and combiner. \nDon't try the same state twice.\" \n(dbg :search \"\"&;; Search: '\"a\" states) \n(cond ((null states) fail) \n\n((funcall goal-p (first states)) (first states)) \n(t (graph-search \n\n(funcall \ncombiner \n(new-states states successors state= old-states) \n(rest states)) \n\ngoal-p successors combiner state= \n(adjoin (first states) old-states \n:test state=))))) \n\n(defun new-states (states successors state= old-states) \n\"Generate successor states that have not been seen before.\" \n(remove-if \n\n#'(lambda (state) \n(or (member state states :test state=) \n(member state old-states :test state=^))) \n(funcall successors (first states)))) \n\nUsing the successor function next2, we can search the graph shown here either as a \ntree or as a graph. If we search it as a graph, it takes fewer iterations and less storage \nspace to find the goal. Of course, there is additional overhead to test for identical \n\n\f\n<a id='page-208'></a>\n\nStates, but on graphs Uke this one we get an exponential speed-up for a constant \namount of overhead. \n\n(defun next2 (x) (list (+ . 1) (+ . 2))) \n> (tree-search '(1) (is 6) #'next2 #*prepend) \n\nSearch: (1) \nSearch: (2 3) \nSearch: 4) \nSearch: 4 5) \nSearch: 5 4 5) \nSearch: 4 5 5 6) \nSearch: 5 5 6 5 6) \nSearch: 5 6 5 6 6 7) \nSearch: 6 5 6 6 7 5 6) \nSearch: 5 6 6 7 5 6 6 7) \nSearch: 6 6 7 5 6 6 7 6 7) \n\n> (graph-search '(1) (is 6) #'next2 #*prepend) \nSearch: (1) \nSearch: (2 3) \nSearch: (3 4) \nSearch: (4 5) \nSearch: (5 6) \nSearch: (6 7) \n\nThe next step is to extend the graph-sea rch algorithm to handle paths. The complication \nis in deciding which path to keep when two paths reach the same state. If we \nhave a cost function, then the answer is easy: keep the path with the cheaper cost. \nBest-first search of a graph removing duplicate states is called A * search. \n\nA* search is more complicated than graph-search because of the need both to \nadd and to delete paths to the lists of current and old paths. For each new successor \nstate, there are three possibilities. The new state may be in the list of current paths, in \nthe Ust of old paths, or in neither. Within the first two cases, there are two subcases. \nIf the new path is more expensive than the old one, then ignore the new path—it can \nnot lead to a better solution. If the new path is cheaper than a corresponding path \nin the list of current paths, then replace it with the new path. If it is cheaper than a \ncorresponding path in the list of the old paths, then remove that old path, and put \nthe new path in the list of current paths. \n\nAlso, rather than sort the paths by total cost on each iteration, they are kept sorted, \nand new paths are inserted into the proper place one at a time using i nsert-path. \nTwo more functions, better-path and find-path, are used to compare paths and \nsee if a state has already appeared. \n\n\f\n<a id='page-209'></a>\n(defun a*-search (paths goal-p successors cost-fn cost-left-fn \n\n&optional (state= #'eql) old-paths) \n\"Find a path whose state satisfies goal-p. Start with paths, \nand expand successors, exploring least cost first. \nWhen there are duplicate states, keep the one with the \nlower cost and discard the other.\" \n(dbg :search \";; Search: ~a\" paths) \n(cond \n\n((null paths) fail) \n((funcall goal-p (path-state (first paths))) \n(values (first paths) paths)) \n(t (let* ((path (pop paths)) \n(state (path-state path))) \n;; Update PATHS and OLD-PATHS to reflect \n\nthe new successors of STATE: \n(setf old-paths (insert-path path old-paths)) \n(dolist (state2 (funcall successors state)) \n\n(let* ((cost (+ (path-cost-so-far path) \n\n(funcall cost-fn state state2))) \n(cost2 (funcall cost-left-fn state2)) \n(path2 (make-path \n\n:state state2 :previous path \n:cost-so-far cost \n:total-cost (+ cost cost2))) \n\n(old nil) \nPlace the new path, path2, in the right list: \n(cond \n((setf old (find-path state2 paths state=)) \n(when (better-path path2 old) \n(setf paths (insert-path \npath2 (delete old paths))))) \n((setf old (find-path state2 old-paths state=)) \n\n(when (better-path path2 old) \n(setf paths (insert-path path2 paths)) \n(setf old-paths (delete old old-paths)))) \n\n(t (setf paths (insert-path path2 paths)))))) \nFinally, call A* again with the updated path lists: \n(a*-search paths goal-p successors cost-fn cost-left-fn \nstate= old-paths))))) \n\n\f\n<a id='page-210'></a>\n\nHere are the three auxiliary functions: \n\n(defun find-path (state paths state=) \n\"Find the path with this state among a list of paths.\" \n(find state paths :key #'path-state :test state=)) \n\n(defun better-path (pathl path2) \n\"Is pathl cheaper than path2?\" \n(< (path-total-cost pathl) (path-total-cost path2))) \n\n(defun insert-path (path paths) \n\"Put path into the right position, sorted by total cost.\" \nMERGE is a built-in function \n(merge 'list (list path) paths #'< :key #'path-total-cost)) \n\n(defun path-states (path) \n\"Collect the states along this path.\" \n(if (null path) \n\nnil \n(cons (path-state path) \n(path-states (path-previous path))))) \n\nBelow we use a*-search to search for 6 in the graph previously shown in figure 6.3. \nThe cost function is a constant 1 for each step. In other words, the total cost is the \nlength of the path. The heuristic evaluation function is just the difference from the \ngoal. The A* algorithm needs just three search steps to come up with the optimal \nsolution. Contrast that to the graph search algorithm, which needed five steps, and \nthe tree search algorithm, which needed ten steps—and neither of them found the \noptimal solution. \n\n> (path-states \n(a*-search (list (make-path :state D) (is 6) \n\n#'next2 #'(lambda (x y) 1) (diff 6))) \nSearch: (#<Path to 1 cost 0.0>) \nSearch: (#<Path to 3 cost 4.0> #<Path to 2 cost 5.0>) \nSearch: (#<Path to 5 cost 3.0> #<Path to 4 cost 4.0> \n\n#<Path to 2 cost 5.0>) \nSearch: (#<Path to 6 cost 3.0> #<Path to 7 cost 4.0> \n#<Path to 4 cost 4.0> #<Path to 2 cost 5.0>) \n(6 5 3 1) \n\nIt may seem limiting that these search functions all return a single answer. In some \napplications, we may want to look at several solutions, or at all possible solutions. \nOther applications are more naturally seen as optimization problems, where we \ndon't know ahead of time what counts as achieving the goal but are just trying to find \nsome action with a low cost. \n\n\f\n<a id='page-211'></a>\nIt turns out that the functions we have defined are not Umiting at all in this respect. \nThey can be used to serve both these new purposes—provided we carefully specify \nthe goal predicate. To find all solutions to a problem, all we have to do is pass in a \ngoal predicate that always fails, but saves all the solutions in a list. The goal predicate \nwill see all possible solutions and save away just the ones that are real solutions. \nOf course, if the search space is infinite this will never terminate, so the user has \nto be careful in applying this technique. It would also be possible to write a goal \npredicate that stopped the search after finding a certain number of solutions, or after \nlooking at a certain number of states. Here is a function that finds all solutions, using \nbeam search: \n\n(defun search-all (start goal-p successors cost-fn beam-width) \n\"Find all solutions to a search problem, using beam search.\" \n\nBe careful: this can lead to an infinite loop, \n(let ((solutions nil)) \n(beam-search \nstart #'(lambda (x) \n\n(when (funcall goal-p x) (push . solutions)) \nnil) \nsuccessors cost-fn beam-width) \nsolutions)) \n\n6.5 GPS as Search \nThe GPS program can be seen as a problem in search. For example, in the three-block \nblocks world, there are only 13 different states. They could be arranged in a graph and \nsearched just as we searched for a route between cities. Figure 6.5 shows this graph. \n\nThe function search-gps does just that. Like the gps function on [page 135](chapter4.md#page-135), it \ncomputes a final state and then picks out the actions that lead to that state. But \nit computes the state with a beam search. The goal predicate tests if the current \nstate satisfies every condition in the goal, the successor function finds all applicable \noperators and applies them, and the cost function simply sums the number of actions \ntaken so far, plus the number of conditions that are not yet satisfied: \n\n\f\n<a id='page-212'></a>\n\n. \nI. \n. \n. \n.. . \n. C \n. \nFigure 6.5: The Blocks World as a Graph \n(defun search-gps (start goal &optional (beam-width 10)) \n\"Search for a sequence of operators leading to goal.\" \n(find-all-i f \n#*action-p \n(beam-search \n(cons '(start) start) \n#'(lambda (state) (subsetp goal state :test #*equal)) \n#'gps-successors \n#'(lambda (state) \n(+ (count-if #'action-p state) \n(count-if #'(lambda (con) \n(not (member-equal con state))) \ngoal))) \nbeam-width))) \nHere is the successor function: \n(defun gps-successors (state) \n\"Return a lis t of states reachable from this one using ops.\" \n(mapcar \n#.(lambda (op) \n\n\f\n<a id='page-213'></a>\n(append \n(remove-if #'(lambda (x) \n(member-equal . (op-del-list op))) \nstate) \n(op-add-list op))) \n(applicable-ops state))) \n\n(defun applicable-ops (state) \n\"Return a list of all ops that are applicable now.\" \n(find-all-if \n\n#'(lambda (op) \n(subsetp (op-preconds op) state :test #'equal)) \n*ops*)) \n\nThe search technique finds good solutions quickly for a variety of problems. Here \nwe see the solution to the Sussman anomaly in the three-block blocks world: \n\n(setf start '((c on a) (a on table) (b on table) (space on c) \n(space on b) (space on table))) \n\n> (search-gps start '((a on b) (b on c))) \n\n((START) \n(EXECUTING (MOVE C FROM A TO TABLE)) \n(EXECUTING (MOVE . FROM TABLE TO O ) \n(EXECUTING (MOVE A FROM TABLE TO B))) \n\n> (search-gps start '((b on c) (a on b))) \n\n((START) \n(EXECUTING (MOVE C FROM A TO TABLE)) \n(EXECUTING (MOVE . FROM TABLE TO O ) \n(EXECUTING (MOVE A FROM TABLE TO B))) \n\nIn these solutions we search forward from the start to the goal; this is quite different \nfrom the means-ends approach of searching backward from the goal for an appropriate \noperator. But we could formulate means-ends analysis as forward search simply \nby reversing start and goal: GPS's goal state is the search's start state, and the search's \ngoal predicate tests to see if a state matches GPS's start state. This is left as an exercise. \n\n6.6 History and References \nPattern matching is one of the most important tools for AI. As such, it is covered \nin most textbooks on Lisp. Good treatments include Abelson and Sussman \n(1984), Wilensky (1986), Winston and Horn (1988), and Kreutzer and McKenzie \n(1990). An overview is presented in the \"pattern-matching\" entry in Encyclopedia of \n.. (Shapiro 1990). \n\n\f\n<a id='page-214'></a>\n\nNilsson's Problem-Solving Methods in Artificial Intelligence (1971) was an early textbook \nthat emphasized search as the most important defining characteristic of AI. \nMore recent texts give less importance to search; Winston's Artificial Intelligence \n(1984) gives a balanced overview, and his Lisp (1988) provides implementations of \nsome of the algorithms. They are at a lower level of abstraction than the ones in \nthis chapter. Iterative deepening was first presented by Korf (1985), and iterative \nbroadening by Ginsberg and Harvey (1990). \n6.7 Exercises \n&#9635; Exercise 6.3 [m] Write a version of i . te ra et i ve -i nterpreter that is more general \nthan the one defined in this chapter. Decide what features can be specified, and \nprovide defaults for them. \n\n&#9635; Exercise 6.4 [m] Define a version of compose that allows any number of arguments, \nnot just two. Hint: You may want to use the function reduce. \n\n&#9635; Exercise 6.5 [m] Define a version of compose that allows any number of arguments \nbut is more efficient than the answer to the previous exercise. Hint: try to make \ndecisions when compose is called to build the resulting function, rather than making \nthe same decisions over and over each time the resulting function is called. \n\n&#9635; Exercise 6.6 [m] One problem with pat-match is that it gives special significance \nto symbols starting with ?, which means that they can not be used to match a literal \npattern. Define a pattern that matches the input literally, so that such symbols can \nbe matched. \n\n&#9635; Exercise 6.7 [m] Discuss the pros and cons of data-driven programming compared \nto the conventional approach. \n\n&#9635; Exercise 6.8 [m]\nrecursion. \nWrite a version of tree-searc h using an explicit loop rather than \n\n&#9635; Exercise 6.9 [m] The sorte r function is inefficient for two reasons: it calls append, \nwhich has to make a copy of the first argument, and it sorts the entire result, rather \nthan just inserting the new states into the already sorted old states. Write a more \nefficient sorter . \n\n\f\n<a id='page-215'></a>\n\n&#9635; Exercise 6.10 [m] Write versions of graph-search and a*-search that use hash \ntables rather than lists to test whether a state has been seen before. \n\n&#9635; Exercise 6.11 [m] Write a function that calls beam-searchtofindthefirstnsolution s \nto a problem and returns them in a list. \n\n&#9635; Exercise 6.12 [m] On personal computers without floating-point hardware, the \nai r-di stanc e calculation will be rather slow. If this is a problem for you, arrange \nto compute the xyz-coords of each city only once and then store them, or store \na complete table of air distances between cities. Also precompute and store the \nneighbors of each city. \n\n&#9635; Exercise 6.13 [d] Write a version of GPS that uses A* search instead of beam search. \nCompare the two versions in a variety of domains. \n\n&#9635; Exercise 6.14 [d] Write a version of GPS that allows costs for each operator. For \nexample, driving the child to school might have a cost of 2, but calling a limousine \nto transport the child might have a cost of 100. Use these costs instead of a constant \ncost of 1 for each operation. \n\n&#9635; Exercise 6.15 [d] Write a version of GPS that uses the searching tools but does \nmeans-ends analysis. \n6.8 Answers \nAnswer 6.2 Unfortunately, pat -match does not always find the answer. The problem \nis that it will only rebind a segment variable based on a failure to match the \nrest of the pattern after the segment variable. In all the examples above, the \"rest of \nthe pattern after the segment variable\" was the whole pattern, so pat-match always \nworked properly. But if a segment variable appears nested inside a list, then the rest \nof the segment variable's sublist is only a part of the rest of the whole pattern, as the \nfollowing example shows: \n> (pat-match '(((? * ?x) (?* ?y)) ?x ?y) \n'(( a b c d ) (a b) (c d))) ^ NIL \n\nThe correct answer with ?x bound to (a b) and ?y bound to (c d) is not found \nbecause the inner segment match succeeds with ?x bound to () and ?y bound to (a \n\n\f\n<a id='page-216'></a>\n\nbed), and once we leave the inner match and return to the top level, there is no \ngoing back for alternative bindings. \n\nAnswer 6.3 The following version lets the user specify all four components of the \nprompt-read-eval-print loop, as well as the streams to use for input and output. \nDefaults are set up as for a Lisp interpreter. \n\n(defun interactive-interpreter \n(&key (read #'read) (eval #'eval) (print #*print) \n\n(prompt \"> \") (input t) (output t)) \n\"Read an expression, evaluate it, and print the result.\" \n(loop \n\n(fresh-line output) \n(princ prompt output) \n(funcall print (funcall eval (funcall read input)) \noutput))) \n\nHere is another version that does all of the above and also handles multiple values \nand binds the various \"history variables\" that the Lisp top-level binds. \n\n(defun interactive-interpreter \n(&key (read #'read) (eval #'eval) (print #'print) \n\n(prompt \"> \") (input t) (output t)) \n\"Read an expression, evaluate it, and print the result(s). \nDoes multiple values and binds: ***'''-++++++/// ///\" \n(let ('**'*'-++++++/ // /// vals) \n\nThe above variables are all special, except VALS \nThe variable - holds the current input \n\n' ape the 3 most recent values \n+ ++ +++ are the 3 most recent inputs \n/ // /// are the 3 most recent lists of multiple-values \n(loop \n(fresh-line output) \n(princ prompt output) \n\nFirst read and evaluate an expression \n(setf - (funcall read input) \nvals (multiple-value-list (funcall eval -))) \nNow update the history variables \n\n(setf +++ ++ /// // *** (first ///) \n++ + // / (first //) \n+ -/ vals * (first /)) \n\nFinally print the computed value(s) \n(dolist (value vals) \n(funcall print value output))))) \n\n\f\n<a id='page-217'></a>\n\nAnswer 6.4 \n\n(defun compose (&rest functions) \n\"Return the function that is the composition of all the args. \n\ni.e. (compose f g h) = (lambda (x) (f (g (h x)))).\" \n#*(lambda (x) \n(reduce #'funcan functions :from-end t .-initial-value x))) \n\nAnswer 6.5 \n\n(defun compose (&rest functions) \n\"Return the function that is the composition of all the args. \n\ni.e. (compose f g h) = (lambda (x) (f (g (h x)))).\" \n(case (length functions) \n(0 #'identity) \n(1 (first functions)) \n(2 (let ((f (first functions)) \n\n(g (second functions))) \n#'(lambda (x) (funcall f (funcall g x))))) \n(t #*(lambda (x) \n(reduce #'funcall functions :from-end t \n:initial-value x))))) \n\nAnswer 6.8 \n\n(defun tree-search (states goal-p successors combiner) \n\"Find a state that satisfies goal-p. Start with states, \nand search according to successors and combiner.\" \n(loop \n\n(cond ((null states) (RETURN fail)) \n((funcall goal-p (first states)) \n(RETURN (first states)) \n(t (setf states \n\n(funcall combiner \n(funcall successors (first states)) \n(rest states)))))))) \n\nAnswer 6.9 \n\n(defun sorter (cost-fn) \n\"Return a combiner function that sorts according to cost-fn.\" \n#'(lambda (new old) \n\n(merge 'list (sort new #'> :key cost-fn) \nold #'> :key cost-fn))) \n\n\f\n<a id='page-218'></a>\n\nAnswer 6.11 \n\n(defun search-n (start . goal-p successors cost-fn beam-width) \n\"Find . solutions to a search problem, using beam search.\" \n(let ((solutions nil)) \n\n(beam-search \nstart #*(lambda (x) \n\n(cond ((not (funcall goal-p x)) nil) \n((= . 0) X) \n(t (decf n) \n\n(push X solutions) \nnil))) \nsuccessors cost-fn beam-width) \nsolutions)) \n\n\f\n## Chapter 7\n<a id='page-219'></a>\n\nSTUDENT: Solving Algebra \nWord Problems \n\n[This] is an example par excellence of the power of \nusing meaning to solve linguistic problems. \n\n-Marvin Minsky (1968) \nMIT computer scientist \n\nS\nS\nTUDENT was another early language understanding program, written by Daniel Bobrow \nas his Ph.D. research project in 1964. It was designed to read and solve the kind of word \nproblems found in high school algebra books. An example is: \n\nIf the number of customers Tom gets is twice the square of 20% of the number of advertisements \nhe runs, and the number of advertisements is 45, then what is the number of customers \nTom gets? \n\nSTUDENT could correctly reply that the number of customers is 162. To do this, STUDENT must be \nfar more sophisticated than ELIZA; it must process and \"understand\" a great deal of the input, \nrather than just concentrate on a few key words. And it must compute a response, rather than \njust fill in blanks. However, we shall see that the STUDENT program uses little more than the \npattern-matching techniques of ELIZA to translate the input into a set of algebraic equations. \nFrom there, it must know enough algebra to solve the equations, but that is not very difficult. \n\n\f\n<a id='page-220'></a>\n\nThe version of STUDENT we develop here is nearly a full implementation of the \noriginal. However, remember that while the original was state-of-the-art as of 1964, \nAI has made some progress in a quarter century, as subsequent chapters will attempt \nto show. \n\n7.1 Translating English into Equations \nThe description of STUDENT is: \n\n1. Break the input into phrases that will represent equations. \n2. Break each phrase into a pair of phrases on either side of the = sign. \n3. Break these phrases down further into sums and products, and so on, until \nfinally we bottom out with numbers and variables. (By \"variable\" here, I mean \n\"mathematical variable,\" which is distinct from the idea of a \"pattern-matching \nvariable\" as used in pat-match in chapter 6). \n4. Translate each English phrase into a mathematical expression. We use the idea \nof a rule-based translator as developed for ELIZA. \n5. Solve the resulting mathematical equations, coming up with a value for each \nunknown variable. \n6. Print the values of all the variables. \nFor example, we might have a pattern of the form (I f ?x then ?y), with an associated \nresponse that says that ?x and ?y will each be equations or lists of equations. \nApplying the pattern to the input above, ?y would have the value (what is the \nnumber of customers Tom gets). Another pattern of the form (?x i s ?y) could have \na response corresponding to an equation where ?x and ?y are the two sides of the \nequation. We could then make up a mathematical variable for (what) and another \nfor (the number of customers Tom gets). We would recognize this later phrase as \na variable because there are no patterns to break it down further. In contrast, the \nphrase (twice the square of 20 per cent of the number of advertisements \nhe r uns) could match a pattern of the form (twi ce ?x) and transform to (* 2 (the \nsquare of 20 per cent of the number of advertisements he runs)), and by \nfurtherapplyingpatternsof the form (the square of ?x) and (?x per cent of \n?y) we could arrive at a final response of (* 2 (expt (* (/ 20 100) n) 2)), where \n. is the variable generated by (the number of advertisements he runs). \n\nThus, we need to represent variables, expressions, equations, and sets of equations. \nThe easiest thing to do is to use something we know: represent them just as \nLisp itself does. Variables will be symbols, expressions and equations will be nested \n\n\f\n<a id='page-221'></a>\nlists with prefix operators, and sets of equations will be lists of equations. With that \nin mind, we can define a list of pattern-response rules corresponding to the type of \nstatements found in algebra word problems. The structure definition for a rule is \nrepeated here, and the structure exp, an expression, is added. 1 hs and rhs stand for \nleft- and right-hand side, respectively. Note that the constructor mkexp is defined as a \nconstructor that builds expressions without taking keyword arguments. In general, \nthe notation (: constructor fn args) creates a constructor function with the given \nname and argument Ust.^ \n\n(defstruct (rule (:type list)) pattern response) \n\n(defstruct (exp (:type list) \n(:constructor mkexp (Ihs op rhs))) \nop Ihs rhs) \n\n(defun exp-p (x) (consp x)) \n(defun exp-args (x) (rest x)) \n\nWe ignored commas and periods in ELIZA, but they are crucial for STUDENT, SO we \nmust make allowances for them. The problem is that a \",\" in Lisp normally can be \nused only within a backquote construction, and a \".\" normally can be used only as a \ndecimal point or in a dotted pair. The special meaning of these characters to the Lisp \nreader can be escaped either by preceding the character with a backslash (\\,) or by \nsurrounding the character by vertical bars (I J) . \n\n(pat-match-abbrev '?x* '(?* ?x)) \n(pat-match-abbrev '?y* *(?* ?y)) \n\n(defparameter *student-rules* (mapcar #'expand-pat-match-abbrev \n\n'(((?x* I.I) ?x) \n((?x* I.I ?y*) (?x ?y)) \n((if ?x* IJ then ?y*) (?x ?y)) \n((if ?x* then ?y*) (?x ?y)) \n((if ?x* IJ ?y*) (?x ?y)) \n((?x* . and ?y*) (?x ?y)) \n((find ?x* and ?y*) ((= to-find-1 ?x) (= to-find-2 ?y))) \n((find ?x*) (= to-find ?x)) \n((?x* equals ?y*) (= ?x ?y)) \n((?x* same as ?y*) (= ?x ?y)) \n((?x* = ?y*) (= ?x ?y)) \n((?x* is equal to ?y*) (= ?x ?y)) \n((?x* is ?y*) (= ?x ?y)) \n((?x* - ?y*) (- ?x ?y)) \n((?x* minus ?y*) (- ?x ?y)) \n\n^Page 316 of Common Lisp the Language says, \"Because a constructor of this type operates \nBy Order of Arguments, it is sometimes known as a BOA constructor.\" \n\n\f\n<a id='page-222'></a>\n\n((difference between ?x* and ?y*) (- ?y ?x)) \n((difference ?x* and ?y*) (- ?y ?x)) \n((?x* + ?y*) (+ ?x ?y)) \n((?x* plus ?y*) (+ ?x ?y)) \n((sum ?x* and ?y*) (+ ?x ?y)) \n((product ?x* and ?y*) (* ?x ?y)) \n((?x* * ?y*) (* ?x ?y)) \n((?x* times ?y*) (* ?x ?y)) \n((?x* / ?y*) (/ ?x ?y)) \n((?x* per ?y*) (/ ?x ?y)) \n((?x* divided by ?y*) (/ ?x ?y)) \n((half ?x*) (/ ?x 2)) \n((one half ?x*) (/ ?x 2)) \n((twice ?x*) (* 2 ?x)) \n((square ?x*) (* ?x ?x)) \n((?x* % less than ?y*) (* ?y (/ (- 100 ?x) 100))) \n((?x* % more than ?y*) (* ?y (/ (+ 100 ?x) 100))) \n((?x* % ?y*) (* (/ ?x 100) ?y))))) \n\nThe main section of STUDENT will search through the list of rules for a response, just \n\nas ELIZA did. The first point of deviation is that before we substitute the values of the \n\npat-match variables into the response, we must first recursively translate the value \n\nof each variable, using the same list of pattern-response rules. The other difference \n\nis that once we're done, we don't just print the response; instead we have to solve the \n\nset of equations and print the answers. The program is summarized in figure 7.1. \nBefore looking carefully at the program, let's try a sample problem: \"If . is 3, what \nis twice z?\" Applying the rules to the input gives the following trace: \n\nInput: (If . is 3. what is twice z) \nRule: ((if ?x IJ ?y) (?x ?y)) \nBinding: ((?x . (z is 3)) (?y . (what is twice z))) \n\nInput: (z is 3) \nRule: ((?x is ?y) (= ?x ?y)) \nResult: (= . 3) \n\nInput: (what is twice . ?) \nRule: ((?x is ?y) (= ?x ?y)) \nBinding: ((?x . what) (?y . (twice z))) \n\nInput: (twice z) \nRule: ((twice ?x) (* 2 ?x)) \nResult: (* 2 z) \n\nResult: (= what (* 2 z)) \nResult: ((= . 3) (= what (* 2 z))) \n\nThere are two minor complications. First, we agreed to implement sets of equations \nas lists of equations. For this example, everything worked out, and the response \n\n\f\n<a id='page-223'></a>\nTop-Level Function \n\nStudent Solve certain algebra word problems. \n\nSpecial Variables \n\n*student-rules* A list of pattern/response pairs. \n\nData Types \n\nexp An operator and its arguments. \nrule A pattern and response. \n\nMajor Functions \n\ntranslate-to-expression Translate an English phrase into an equation or expression. \ntranslate-pair Translate the value part of the pair into an equation or expression. \ncreate-list-of-equations Separate out equations embedded in nested parens. \nsolve-equations Print the equations and their solution. \nsolve Solve a system of equations by constraint propagation. \n\nAuxiliary Fimctions \n\nisolate Isolate the lone variable on the left-hand side of an expression. \n\nnoise-word-p Is this a low-content word that can be safely ignored? \n\nmake-variable Create a variable name based on the given list of words. \n\nprint-equations Print a list of equations. \n\ninverse-op I.e., the inverse of + is -. \nunknown-p Is the argument an unknown (variable)? \n\nin-exp True if X appears anywhere in exp. \nno-unknown Returns true if there are no unknowns in exp. \none-unknown Returns the single unknown in exp, if there is exactly one. \n\ncommutative-p Is the operator commutative? \n\nsolve-arithmetic Perform arithmetic on rhs of an equation. \n\nbinary-exp-p Is this a binary expression? \n\nprefix->infix Translate prefix to infix expressions. \n\nmkexp Make an expression. \n\nPreviously Defined Functions \n\npat-match Match pattern against an input, (p. 180) \nrule-based-translator Apply a set of rules, (p. 189) \n\nFigure 7.1: Glossary for the STUDENT Program \n\nwas a list of two equations. But if nested patterns are used, the response could be \nsomething like (( = a 5) ((= b (+ a 1)) (= c (->-a b)))), which is not a list of \nequations. The function create -1 i st-of-equati ons transforms a response like this \ninto a proper list of equations. The other complication is choosing variable names. \nGivenalistof words like (the number of customers Tom gets), we want to choose \na symbol to represent it. We will see below that the symbol customers is chosen, but \nthat there are other possibilities. \n\nHere is the main function for STUDENT. It first removes words that have no content, \nthen translates the input to one big expression with translate-to-expression, \nand breaks that into separate equations with create-list-of-equations. Finally, \nthe function solve-equations does the mathematics and prints the solution. \n\n\f\n<a id='page-224'></a>\n\n(defun Student (words) \n\"Solve certain Algebra Word Problems.\" \n(solve-equations \n\n(create-list-of-equations \n(translate-to-expression (remove-if #*noise-word-p words))))) \n\nThe function translate-to-expression is a rule-based translator. It either finds \nsome rule in *student-rules* to transform the input, or it assumes that the entire input \nrepresents a single variable. The function translate-pair takes a variable/value \nbinding pair and translates the value by a recursive call to translate-to - express ion. \n\n(defun translate-to-expression (words) \n\"Translate an English phrase into an equation or expression.\" \n(or (rule-based-translator \n\nwords *student-rules* \n:rule-if #'rule-pattern :rule-then #*rule-response \n:action #'(lambda (bindings response) \n\n(sublis (mapcar #'translate-pair bindings) \nresponse))) \n(make-variable words))) \n\n(defun translate-pair (pair) \n\"Translate the value part of the pair into an equation or expression.\" \n(cons (binding-var pair) \n\n(translate-to-expression (binding-val pair)))) \n\nThe function create-1 ist-of-equations takes a single expression containing embedded \nequations and separates them into a list of equations: \n\n(defun create-1ist-of-equations (exp) \n\"Separate out equations embedded in nested parens.\" \n(cond ((null exp) nil) \n\n((atom (first exp)) (list exp)) \n(t (append (create-1ist-of-equations (first exp)) \n(create-1ist-of-equations (rest exp)))))) \n\nFinally, the function make-vari abl e creates a variable to represent a Ust of v^ords. \nWe do that by first removing all \"noise words\" from the input, and then taking the \nfirst symbol that remains. So, for example, \"the distance John traveled\" and \"the \ndistance traveled by John\" will both be represented by the same variable, di stance, \nwhich is certainly the right thing to do. However, \"the distance Mary traveled\" will \nalso be represented by the same variable, which is certainly a mistake. For (the \nnumber of customers Tom gets), the variable will be customers, since the, of and \nnumber are all noise words. This will match (the customers mentioned above) and \n\n\f\n<a id='page-225'></a>\n(the number of customers), but not (Tom's customers). For now, we will accept \nthe first-non-noise-word solution, but note that exercise 7.3 asks for a correction. \n\n(defun make-variable (words) \n\"Create a variable name based on the given list of words\" \nThe list of words will already have noise words removed \n(first words)) \n\n(defun noise-word-p (word) \n\"Is this a low-content word that can be safely ignored?\" \n(member word '(a an the this number of $))) \n\n7.2 Solving Algebraic Equations \nThe next step is to write the equation-solving section of STUDENT. This is more an \nexercise in elementary algebra than in AI, but it is a good example of a symbol-\nmanipulation task, and thus an interesting programming problem. \n\nThe STUDENT program mentioned the function sol ve-equati ons, passing it one \nargument, a Hst of equations to be solved, sol ve-equati ons prints the Hst of equations, \nattempts to solve them using sol ve, and prints the result. \n\n(defun solve-equations (equations) \n\"Print the equations and their solution \" \n(print-equations \"The equations to be solved are:\" equations) \n(print-equations \"The solution is:\" (solve equations nil))) \n\nThe real work is done by sol ve, which has the following specification: (1) Find \nan equation with exactly one occurrence of an unknown in it. (2) Transform that \nequation so that the unknown is isolated on the left-hand side. This can be done if \nwe limit the operators to +, -, *, and /. (3) Evaluate the arithmetic on the right-hand \nside, yielding a numeric value for the unknown. (4) Substitute the numeric value \nfor the unknown in all the other equations, and remember the known value. Then \ntry to solve the resulting set of equations. (5) If step (1) fails—if there is no equation \nwith exactly one unknown—then just return the known values and don't try to solve \nanything else. \n\nThe function sol ve is passed a system of equations, along with a list of known \nvariable/value pairs. Initially no variables are known, so this list will be empty, \nsol ve goes through the list of equations searching for an equation with exactly one \nunknown. If it can find such an equation, it caHs isolate to solve the equation \nin terms of that one unknown, solve then substitutes the value for the variable \nthroughout the list of equations and calls itself recursively on the resulting list. Each \n\n\f\n<a id='page-226'></a>\n\ntime solve calls itself, it removes one equation from the Ust of equations to be solved, \nand adds one to the Ust of known variable/value pairs. Since the list of equations is \nalways growing shorter, sol ve must eventually terminate. \n\n(defun solve (equations known) \n\n\"Solve a system of equations by constraint propagation.\" \nTry to solve for one equation, and substitute its value into \nthe others. If that doesn't work, return what is known, \n\n(or (some #*(lambda (equation) \n(let ((x (one-unknown equation))) \n(when X \n(let ((answer (solve-arithmetic \n(isolate equation x)))) \n(solve (subst (exp-rhs answer) (exp-lhs answer) \n(remove equation equations)) \n(cons answer known)))))) \nequations) \nknown)) \n\nisolate is passed an equation guaranteed to have one unknown. It returns an \nequivalent equation with the unknown isolated on the left-hand side. There are \nfive cases to consider: when the unknown is alone on the left, we're done. The \nsecond case is when the unknown is anywhere on the right-hand side. Because \nis commutative, we can reduce the problem to solving the equivalent equation with \nleft- and right-hand sides reversed. \n\nNext we have to deal with the case where the unknown is in a complex expression \non the left-hand side. Because we are allowing four operators and the unknown can \nbe either on the right or the left, there are eight possibilities. Letting X stand for \nan expression containing the unknown and A and . stand for expressions with no \nunknowns, the possibilities and their solutions are as follows: \n\n(1)X*A=B X=B/A (5)A*X=B X=B/A \n(2)X+A=B ^ X=B-A (6)A+X=B ^ X=B-A \n(3)X/A=B => X=B*A (7)A/X=B X=A/B \n(4)X-A=B X=B+A (8)A-X=B => X=A-B \n\nPossibilities (1) through (4) are handled by case III, (5) and (6) by case IV, and (7) \nand (8) by case V. In each case, the transformation does not give us the final answer, \nsince X need not be the unknown; it might be a complex expression involving the \nunknown. So we have to caU i sol ate again on the resulting equation. The reader \nshould try to verify that transformations (1) to (8) are valid, and that cases III to V \nimplement them properly. \n\n\f\n<a id='page-227'></a>\n(defun isolate (e x) \n\n\"Isolate the lone . in e on the left-hand side of e.\" \nThis assumes there is exactly one . in e, \nand that e is an equation, \n\n(cond ((eq (exp-lhs e) x) \nCase I: X = A -> X = . \ne) \n\n((in-exp X (exp-rhs e)) \n;; Case II: A = f(X) -> f(X) = A \n(isolate (mkexp (exp-rhs e) '= (exp-lhs e)) x)) \n\n((in-exp X (exp-lhs (exp-lhs e))) \nCase III: f(X)*A = . -> f(X) = B/A \n(isolate (mkexp (exp-lhs (exp-lhs e)) *= \n\n(mkexp (exp-rhs e) \n(inverse-op (exp-op (exp-lhs e))) \n(exp-rhs (exp-lhs e)))) x)) \n\n((commutative-p (exp-op (exp-lhs e))) \n:; Case IV: A*f(X) = . -> f(X) = B/A \n(isolate (mkexp (exp-rhs (exp-lhs e)) ' = \n\n(mkexp (exp-rhs e) \n(inverse-op (exp-op (exp-lhs e))) \n(exp-lhs (exp-lhs e)))) x)) \n\n(t :; Case V: A/f(X) = . -> f(X) = A/B \n(isolate (mkexp (exp-rhs (exp-lhs e)) ' = \n\n(mkexp (exp-lhs (exp-lhs e)) \n(exp-op (exp-lhs e)) \n(exp-rhs e))) x)))) \n\nRecall that to prove a function is correct, we have to prove both that it gives the correct \nanswer when it terminates and that it will eventually terminate. For a recursive \nfunction with several alternative cases, we must show that each alternative is valid, \nand also that each alternative gets closer to the end in some way (that any recursive \ncalls involve 'simpler' arguments). For i sol ate, elementary algebra will show that \neach step is valid—or at least nearly valid. Dividing both sides of an equation by \n0 does not yield an equivalent equation, and we never checked for that. It's also \npossible that similar errors could sneak in during the call to eval. However, if we \nassume the equation does have a single valid solution, then i sol ate performs only \nlegal transformations. \n\nThe hard part is to prove that 1 sol ate terminates. Case I clearly terminates, and \nthe others all contribute towards isolating the unknown on the left-hand side. For \nany equation, the sequence will be first a possible use of case II, followed by a number \nof recursive calls using cases III to V. The number of calls is bounded by the number \nof subexpressions in the equation, since each successive call effectively removes an \nexpression from the left and places it on the right. Therefore, assuming the input is \n\n\f\n<a id='page-228'></a>\n\nof finite size, we must eventually reach a recursive call to i sol ate that will use case I \nand terminate. \n\nWhen i sol ate returns, the right-hand side must consist only of numbers and \noperators. We could easily write a function to evaluate such an expression. However, \nwe don't have to go to that effort, since the function already exists. The data structure \nexp was carefully selected to be the same structure (lists with prefix functions) used \nby Lisp itself for its own expressions. So Lisp will find the right-hand side to be an \nacceptable expression, one that could be evaluated if typed in to the top level. Lisp \nevaluates expressions by calling the function eval, so we can call eval directly and \nhave it return a number. The function sol ve -a ri t hmet i c returns an equation of the \nform (=var number). \n\nAuxiliary functions for sol ve are shown below. Most are straightforward, but \nI will remark on a few of them. The function pref ix->inf ix takes an expression \nin prefix notation and converts it to a fully parenthesized infix expression. Unlike \ni sol ate, it assumes the expressions will be implemented as lists, pref i x->i nf i . is \nused by pri nt-equati ons to produce more readable output. \n\n(defun print-equations (header equations) \n\"Print a list of equations.\" \n(format t \"~%~a\"'{~% ~{ ~a~}~}~%\" header \n\n(mapcar #*prefix->infix equations))) \n\n(defconstant operators-and-inverses \n'((+ -) (- +) (* /) (/ *) (= =))) \n\n(defun inverse-op (op) \n(second (assoc op operators-and-inverses))) \n\n(defun unknown-p (exp) \n(symbolp exp)) \n\n(defun in-exp (x exp) \n\"True if X appears anywhere in exp\" \n(or (eq . exp) \n\n(and (exp-p exp) \n(or (in-exp . (exp-lhs exp)) (in-exp . (exp-rhs exp)))))) \n\n(defun no-unknown (exp) \n\"Returns true if there are no unknowns in exp.\" \n(cond ((unknown-p exp) nil) \n\n((atom exp) t) \n((no-unknown (exp-lhs exp)) (no-unknown (exp-rhs exp))) \n(t nil))) \n\n\f\n<a id='page-229'></a>\n(defun one-unknown (exp) \n\"Returns the single unknown in exp, if there is exactly one.\" \n(cond ((unknown-p exp) exp) \n\n((atom exp) nil) \n((no-unknown (exp-lhs exp)) (one-unknown (exp-rhs exp))) \n((no-unknown (exp-rhs exp)) (one-unknown (exp-lhs exp))) \n(t nil))) \n\n(defun commutative-p (op) \n\"Is operator commutative?\" \n(member op '(+*=))) \n\n(defun solve-arithmetic (equation) \n\"Do the arithmetic for the right-hand side.\" \nThis assumes that the right-hand side is in the right form, \n(mkexp (exp-lhs equation) *= (eval (exp-rhs equation)))) \n\n(defun binary-exp-p (x) \n(and (exp-p x) (= (length (exp-args x)) 2))) \n\n(defun prefix->infix (exp) \n\"Translate prefix to infix expressions.\" \n(if (atom exp) exp \n\n(mapcar #'prefix->infix \n\n(if (binary-exp-p exp) \n(list (exp-lhs exp) (exp-op exp) (exp-rhs exp)) \nexp)))) \n\nHere's an example of sol ve-equati ons in action, with a system of two equations. \n\nThe reader should go through the trace, discovering which case was used at each call \n\nto i sol ate, and verifying that each step is accurate. \n\n> (trace isolate solve) \n(isolate solve) \n\n> (solve-equations '((= (+ 3 4) (* (- 5 (+ 2 x)) 7)) \n(= (+ (* 3 X) y) 12))) \n\nThe equations to be solved are: \n(3 + 4) = ((5 - (2 + X)) * 7) \n((3 * X) + Y) = 12 \n\n(1 ENTER SOLVE: ((= (+ 3 4) (* (- 5 (+ 2 X)) 7)) \n(= (+ (* 3 X) Y) 12)) NIL) \n(1 ENTER ISOLATE: (= (+ 3 4) (* (- 5 (+ 2 X)) 7)) X) \n(2 ENTER ISOLATE: (= (* (- 5 (+ 2 X)) 7) (+ 3 4)) X) \n(3 ENTER ISOLATE: (= (- 5 (+ 2 X)) (/ (+ 3 4) 7)) X) \n\n(4 ENTER ISOLATE: (= (+ 2 X) (- 5 (/ (+ 3 4) 7))) X) \n(5 ENTER ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2)) X) \n(5 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2))) \n\n(4 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2))) \n\n\f\n<a id='page-230'></a>\n\n(3 EXIT ISOLATE: (= . (- (- 5 (/ (+ 3 4) 7)) 2))) \n\n(2 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2))) \n\n(1 EXIT ISOLATE: (= X (- (- 5 (/ (+ 3 4) 7)) 2))) \n\n(2 ENTER SOLVE: ((= (+ (* 3 2) Y) 12)) ((= X 2))) \n\n(1 ENTER ISOLATE: (= (+ (* 3 2) Y) 12) Y) \n\n(2 ENTER ISOLATE: (= Y (- 12 (* 3 2))) Y) \n\n(2 EXIT ISOLATE: (= Y (- 12 (* 3 2)))) \n\n(1 EXIT ISOLATE: (= Y (- 12 (* 3 2)))) \n\n(3 ENTER SOLVE: NIL ((= Y 6) (= X 2))) \n\n(3 EXIT SOLVE: ((= Y 6) (= X 2))) \n\n(2 EXIT SOLVE: ((= Y 6) (= X 2))) \n\n(1 EXIT SOLVE: ((= Y 6) (= X 2))) \n\nThe solution is: \n\nY = 6 \n\nX = 2 \n\nNIL \n\nNow let's tackle the format string \"'^%~a~{~% \"{ ~a''}~}~%\" in print-equations. \nThis may look like random gibberish, but there is actually sense behind it. format \nprocesses the string by printing each character, except that\"\"\" indicates some special \nformatting action, depending on the following character. The combination \"~%\" \nprints a newline, and \"~a\" prints the next argument to format that has not been \nused yet. Thus the first four characters of the format string, \" \", print a newline \nfollowed by the argument header. The combination \"~{\" treats the corresponding \nargument as a list, and processes each element according to the specification between \nthe \" ~{\" and the next\" ~}\". In this case, equati ons is a list of equations, so each one \ngets printed with a newline (\"\") followed by two spaces, followed by the processing \nof the equation itself as a list, where each element is printed in the \"~a\" format and \npreceded by a blank. The t given as the first argument to format means to print to \nthe standard output; another output stream may be specified there. \n\nOne of the annoying minor holes in Lisp is that there is no standard convention on \nwhere to print newlines! In C, for example, the very first line of code in the reference \nmanual is \n\nprintfC'hello, worldXn\"); \n\nThis makes it clear that newlines are printed after each line. This convention is so \ningrained in the UNIX world that some UNIX programs will go into an infinite loop \nif the last line in a file is not terminated by a newline. In Lisp, however, the function \npri nt puts in a newline before the object to be printed, and a space after. Some Lisp \nprograms carry the newline-before policy over to format, and others use the newline-\naf ter policy. This only becomes a problem when you want to combine two programs \nwritten under different policies. How did the two competing policies arise? In UNIX \nthere was only one reasonable policy, because all input to the UNIX interpreter (the \n\n\f\n<a id='page-231'></a>\n\nshell) is terminated by newlines, so there is no need for a newline-before. In some \nLisp interpreters, however, input can be terminated by a matching right parenthesis. \nIn that case, a newline-before is needed, lest the output appear on the same line as \nthe input. \n\n&#9635; Exercise 7.1 [m] Implement pri nt-equati ons using only primitive printing functions \nsuch as terpri and pri nc, along with explicit loops. \n\n7.3 Examples \nNow we move on to examples, taken from Bobrow's thesis. In the first example, it is \nnecessary to insert a \"then\" before the word \"what\" to get the right answer: \n\n> (student '(If the number of customers Tom gets is twice the square of \n20 % of the number of advertisements he runs I.I \nand the number of advertisements is 45 I J \nthen what is the number of customers Tom gets ?)) \n\nThe equations to be solved are: \nCUSTOMERS = (2 * (((20 / 100) * ADVERTISEMENTS) * \n\n((20 / 100) * ADVERTISEMENTS))) \nADVERTISEMENTS = 45 \nWHAT = CUSTOMERS \n\nThe solution is: \nWHAT = 162 \nCUSTOMERS = 162 \nADVERTISEMENTS = 45 \n\nNIL \n\nNotice that our program prints the values for all variables it can solve for, while \nBobrow's program only printed the values that were explicitly asked for in the text. \nThis is an example of \"more is less\"—it may look impressive to print all the answers, \nbut it is actually easier to do so than to decide just what answers should be printed. \nThe following example is not solved correctly: \n\n\f\n<a id='page-232'></a>\n\n> (student '(The daily cost of living for a group is the overhead cost plus \nthe running cost for each person times the number of people in \nthe group I.I This cost for one group equals $ 100 I,I \nand the number of people in the group is 40 I.I \nIf the overhead cost is 10 times the running cost I,I \nfind the overhead and running cost for each person I.I)) \n\nThe equations to be solved are: \nDAILY = (OVERHEAD + (RUNNING * PEOPLE)) \nCOST = 100 \nPEOPLE = 40 \nOVERHEAD = (10 * RUNNING) \nTO-FIND-1 = OVERHEAD \nTO-FIND-2 = RUNNING \n\nThe solution is: \nPEOPLE = 40 \nCOST = 100 \n\nNIL \n\nThis example points out two important limitations of our version of student as \ncompared to Bobrow's. The first problem is in naming of variables. The phrases \"the \ndaily cost of living for a group\" and \"this cost\" are meant to refer to the same quantity, \nbut our program gives them the names daily and cost respectively. Bobrow's \nprogram handled naming by first considering phrases to be the same only if they \nmatched perfectly. If the resulting set of equations could not be solved, he would try \nagain, this time considering phrases with words in common to be identical. (See the \nfollowing exercises.) \n\nThe other problem is in our sol ve function. Assuming we got the variables \nequated properly, sol ve would be able to boil the set of equations down to two: \n\n100 = (OVERHEAD + (RUNNING * 40)) \nOVERHEAD = (10 * RUNNING) \n\nThis is a set of two linear equations in two unknowns and has a unique solution at \nRUNNING = 2, OVERHEAD = 20. But our version of sol ve couldn't find this solution, \nsince it looks for equations with one unknown. Here is another example that student \nhandles well: \n\n> (student '(Fran's age divided by Robin's height is one half Kelly's 10 I.I \nKelly's IQ minus 80 is Robin's height I.I \nIf Robin is 4 feet tall 1,1 how old is Fran ?)) \n\nThe equations to be solved are: \n(FRAN / ROBIN) = (KELLY / 2) \n(KELLY - 80) = ROBIN \nROBIN = 4 \n\n\f\n<a id='page-233'></a>\n\nHOW = FRAN \n\nThe solution is: \nHOW = 168 \nFRAN = 168 \nKELLY = 84 \nROBIN = 4 \n\nNIL \n\nBut a slight variation leads to a problem: \n\n> (student '(Fran's age divided by Robin's height is one half Kelly's IQ I.I \nKelly's IQ minus 80 is Robin's height I.I \nIf Robin is 0 feet tall . how old is Fran ?)) \n\nThe equations to be solved are: \n(FRAN / ROBIN) = (KELLY / 2) \n(KELLY - 80) = ROBIN \nROBIN = 0 \nHOW = FRAN \n\nThe solution is: \nHOW = 0 \nFRAN = 0 \nKELLY = 80 \nROBIN = 0 \n\nNIL \n\nThere is no valid solution to this problem, because it involves dividing by zero (Robin's \nheight). But student is willing to transform the first equation into: \n\nFRAN = ROBIN * (KELLY / 2) \n\nand then substitutes to get 0 for FRAN. Worse, dividing by zero could also come up \ninside eval: \n\n> (student '(Fran's age times Robin's height is one half Kelly's IQ I.I \nKelly's IQ minus 80 is Robin's height I.I \nIf Robin is 0 feet tall IJ how old is Fran ?)) \n\nThe equations to be solved are: \n(FRAN * ROBIN) = (KELLY / 2) \n(KELLY - 80) = ROBIN \nROBIN = 0 \nHOW = FRAN \n\n\f\n<a id='page-234'></a>\n\n>Error: There was an attempt to divide a number by zero \n\nHowever, one could claim that nasty examples with division by zero don't show up \nin algebra texts. \n\nIn summary, STUDENT behaves reasonably well, doing far more than the toy \nprogram ELIZA. STUDENT is also quite efficient; on my machine it takes less than \none second for each of the prior examples. However, it could still be extended to \nhave more powerful equation-solving capabilities. Its linguistic coverage is another \nmatter. While one could add new patterns, such patterns are really just tricks, and \ndon't capture the underlying structure of English sentences. That is why the STUDENT \napproach was abandoned as a research topic. \n\n7.4 History and References \nBobrow's Ph.D. thesis contains a complete description of STUDENT. It is reprinted \nin Minsky 1968. Since then, there have been several systems that address the same \ntask, with increased sophistication in both their mathematical and linguistic ability. \nWong (1981) describes a system that uses its understanding of the problem to get \na better linguistic analysis. Sterling et al. (1982) present a much more powerful \nequation solver, but it does not accept natural language input. Certainly Bobrow's \nlanguage analysis techniques were not very sophisticated by today's measures. But \nthat was largely the point: if you know that the language is describing an algebraic \nproblem of a certain type, then you don't need to know very much linguistics to get \nthe right answer most of the time. \n\n7.5 Exercises \n&#9635; Exercise 7.2 [h] We said earlier that our program was unable to solve pairs of linear \nequations, such as: \n\n100 = (OVERHEAD + (RUNNING * 40)) \n\nOVERHEAD = (10 * RUNNING) \n\nThe original STUDENT could solve these equations. Write a routine to do so. You may \nassume there will be only two equations in two unknowns if you wish, or if you are \nmore ambitious, you could solve a system of . linear equations with . unknowns. \n\n&#9635; Exercise 7.3 [h] Implement a version of Bobrow's variable-naming algorithm. Instead \nof taking the first word of each equation, create a unique symbol, and associate \n\n\f\n<a id='page-235'></a>\nwith it the entire list of words. In the first pass, each nonequal list of words will be \nconsidered a distinct variable. If no solution is reached, word lists that share words \nin common are considered to be the same variable, and the solution is attempted \nagain. For example, an input that contains the phrases \"the rectangle's width\" and \n\"the width of the rectangle\" might assign these two phrases the variables . 1 and .2. If \nan attempt to solve the problem yields no solutions, the program should realize that \nvl and . 2 have the words \"rectangle\" and \"width\" in common, and add the equation \n(= vl v2) and try again. Since the variables are arbitrary symbols, the printing \nroutine should probably print the phrases associated with each variable rather than \nthe variable itself. \n\n&#9635; Exercise 7.4 [h] The original STUDENT also had a set of \"common knowledge\" equations \nthat it could use when necessary. These were mostly facts about conversion \nfactors, such as (1 inch = 2.54 cm). Also included wereequations like (distance \nequals rate times time), which could be used to solve problems like \"If the distance \nfrom Anabru to Champaign is 10 miles and the time it takes Sandy to travel \nthis distance is 2 hours, what is Sandy's rate of speed?\" Make changes to incorporate \nthis facility. It probably only helps in conjunction with a solution to the previous \nexercise. \n\n&#9635; Exercise 7.5 [h] Change student so that it prints values only for those variables \nthat are being asked for in the problem. That is, given the problem \"X is 3. Y is 4. \nHow much is X + Y?\" it should not print values for X and Y. \n\n&#9635; Exercise 7.6 [m] Try STUDENT on the following examples. Make sure you handle \nspecial characters properly: \n\n(a) The price of a radio is 69.70 dollars. If this price is 15% less than the marked \nprice, find the marked price. \n(b) The number of soldiers the Russians have is one half of the number of guns \nthey have. The number of guns they have is 7000. What is the number of soldiers \nthey have? \n(c) If the number of customers Tom gets is twice the square of 20 % of the number \nof advertisements he runs, and the number of advertisements is 45, and the profit \nTom receives is 10 times the number of customers he gets, then what is the profit? \n(d) The average score is 73, The maximum score is 97. What is the square of the \ndifference between the average and the maximum? \n(e) Tom is twice Mary's age, and Jane's age is half the difference between Mary \nand Tom. If Mary is 18 years old, how old is Jane? \n(f)Whatis4 + 5*14/7? \n\n{g)xxb = c-\\-d.bxc = x.x = b-\\-b.b = 5. \n\n\f\n<a id='page-236'></a>\n\n&#9635; Exercise 7.7 [h] Student's infix-to-prefix rules account for the priority of operators \nproperly, but they don't handle associativity in the standard fashion. For example, \n(12 6 \n3) \ntranslates to (- 12 (- 6 3)) or 9, when the usual convention is to \ninterpret this as ((- \n12 6) 3) or 3. Fix student to handle this convention. \n\n&#9635; Exercise 7.8 [d] Find a mathematically oriented domain that is sufficiently limited \nso that STUDENT can solve problems in it. The chemistry of solutions (calculating pH \nconcentrations) might be an example. Write the necessary *student-rules* , and \ntest the resulting program. \n\n&#9635; Exercise 7.9 [m]\nefficient version. \nAnalyze the complexity of one-unknown and implement a more \n\n&#9635; Exercise 7.10 [h] Bobrow's paper on STUDENT (1968) includes an appendix that \nabstractly characterizes all the problems that his system can solve. Generate a \nsimilar characterization for this version of the program. \n\n7.6 Answers \nAnswer 7.1 \n\n(defun print-equations (header(terpri) \n(princ header) \n(dolist (equation equations) \n\n(terpri) \n(princ \" \") \n\n equations) \n\n(dolist (x (prefix->infix equation)) \n(princ \" \") \n(princ x)))) \n\n\f\n<a id='page-237'></a>\n\nAnswer 7.9 one-unknown is very inefficient because it searches each subcomponent \nof an expression twice. For example, consider the equation: \n\n(= (+ (+ . 2) (+ 3 4)) (+ (+ 5 6) (+ 7 8))) \n\nTo decide if this has one unknown, one - unknown will call no - unknown on the left-hand \nside, and since it fails, call it again on the right-hand side. Although there are only \neight atoms to consider, it ends up calling no-unknown 17 times and one-unknown 4 \ntimes. In general, for a tree of depth n, approximately 2^ calls to no-unknown are \nmade. This is clearly wasteful; there should be no need to look at each component \nmore than once. \n\nThe following version uses an auxiliary function, f i nd - one - un known, that has an \naccumulator parameter, unknown. This parameter can take on three possible values: \nnil, indicating that no unknown has been found; or the single unknown that has \nbeen found so far; or the number 2 indicating that two unknowns have been found \nand therefore the final result should be nil. The function f i nd - one - unknown has four \ncases: (1) If we have already found two unknowns, then return 2 to indicate this. (2) If \nthe input expression is a nonatomic expression, then first look at its left-hand side \nfor unknowns, and pass the result found in that side as the accumulator to a search \nof the right-hand side. (3) If the expression is an unknown, and if it is the second one \nfound, return 2; otherwise return the unknown itself. (4) If the expression is an atom \nthat is not an unknown, then just return the accumulated result. \n\n(defun one-unknown (exp) \n\"Returns the single unknown in exp, if there is exactly one.\" \n(let ((answer (find-one-unknown exp nil))) \n\n;; If there were two unknowns, return nil; \notherwise return the unknown (if there was one) \n\n(if (eql answer 2) \nnil \nanswer))) \n\n(defun find-one-unknown (exp unknown) \n\"Assuming UNKNOWN is the unknown(s) found so far, decide \nif there is exactly one unknown in the entire expression.\" \n(cond ((eql unknown 2) 2) \n\n((exp-p exp) \n\n(find-one-unknown \n(exp-rhs exp) \n(find-one-unknown (exp-lhs exp) unknown))) \n\n((unknown-p exp) \n\n(if unknown \n2 \nexp)) \n\n(t unknown))) \n\n\f\n## Chapter 8\n<a id='page-238'></a>\nCHAPTER 8 \n\nSymbolic Mathematics: \nA Simplification Program \n\nOur life is frittered away by detail— \nSimplify, simplify. \n-Henry David Thoreau, Waiden (1854) \n\n\"Symbolic mathematics\" is to numerical mathematics as algebra is to arithmetic: it deals \nwith variables and expressions rather than just numbers. Computers were first developed \nL..^primarily to solve arithmetic problems: to add up large columns of numbers, to multiply \nmany-digit numbers, to solve systems of linear equations, and to calculate the trajectories of \nballistics. Encouraged by success in these areas, people hoped that computers could also be used \non more complex problems; to differentiate or integrate a mathematical expression and come \nup with another expression as the answer, rather than just a number. Several programs were \ndeveloped along these lines in the 1960s and 1970s. They were used primarily by professional \nmathematicians and physicists with access to large mainframe computers. Recently, programs \nlike MATHLAB, DERIVE, and .......... have given these capabilities to the average personal \ncomputer user. \n\n\f\n<a id='page-239'></a>\n\nIt is interesting to look at some of the history of symbolic algebra, beginning \nin 1963 with SAINT, James Slagle's program to do symbolic integration. Originally, \nSAINT was heralded as a triumph of AI. It used general problem-solving techniques, \nsimilar in kind to GPS, to search for solutions to difficult problems. The program \nworked its way through an integration problem by choosing among the techniques \nknown to it and backing up when an approach failed to pan out. SAINT'S behavior \non such problems was originally similar to (and eventually much better than) the \nperformance of undergraduate calculus students. \n\nOver time, the AI component of symbolic integration began to disappear. Joel \nMoses implemented a successor to SAINT called SiN. It used many of the same techniques, \nbut instead of relying on search to find the right combination of techniques, \nit had additional mathematical knowledge that led it to pick the right technique at \neach step, without any provision for backing up and trying an alternative. SiN solved \nmore problems and was much faster than SAINT, although it was not perfect: it still \noccasionally made the wrong choice and failed to solve a problem it could have. \n\nBy 1970, the mathematician R. Risch and others developed algorithms for indefinite \nintegration of any expression involving algebraic, logarithmic, or exponential \nextensions of rational functions. In other words, given a \"normal\" function, the Risch \nalgorithm will return either the indefinite integral of the function or an indication \nthat no closed-form integral is possible in terms of elementary functions. Such work \neffectively ended the era of considering integration as a problem in search. \n\nSIN was further refined, merged with parts of the Risch algorithm, and put into the \nevolving MACSYMA^ program. For the most part, refinement of MACSYMA consisted \nof the incorporation of new algorithms. Few heuristics of any sort survive. Today \nMACSYMA is no longer considered an AI program. It is used daily by scientists and \nmathematicians, while ELIZA and STUDENT are now but historical footnotes. \n\nWith ELIZA and STUDENT we were able to develop miniature programs that duplicated \nmost of the features of the original. We won't even try to develop a program \nworthy of the name MACSYMA; instead we will settle for a modest program to do symbolic \nsimplification, which we will call (simply) simpli f i er. Then, we will extend \nsimpli f i er to do differentiation, and some integration problems. The idea is that \ngiven an expression like (2-1)a: + 0, we want the program to compute the simplified \nform X. \n\nAccording to the Mathematics Dictionary Qames and James 1949), the word \"simplified\" \nis \"probably the most indefinite term used seriously in mathematics.\" The \nproblem is that \"simplified\" is relative to what you want to use the expression for \nnext. Which is simpler, x^ 3x + 2 or (x -\\-l){x -\\-2)? The first makes it easier to \n\n^MACSYMA is the Project MAC SYMbolic MAthematics program. Project MAC is the MIT \nresearch organization that was the precursor of MIT's Laboratory for Computer Science. \nMAC stood either for Machine-Aided Cognition or Multiple-Access Computer, according to \none of their annual reports. The cynical have claimed that MAC really stood for Man Against \nComputer. \n\n\f\n<a id='page-240'></a>\n\nintegrate or differentiate, the second easier to find roots. We will be content to limit \nourselves to \"obvious\" simplifications. For example, . is almost always preferable \ntoIx + 0. \n\n8.1 Converting Infix to Prefix Notation \nWe will represent simplifications as a list of rules, much like the rules for STUDENT \nand ELIZA. But since each simplification rule is an algebraic equation, we will store \neach one as an exp rather than as a rul e. To make things more legible, we will write \neach expression in infix form, but store them in the prefix form expected by exp. This \nrequires an i nf i x->pref i . function to convert infix expressions into prefix notation. \nWe have a choice as to how general we want our infix notation to be. Consider: \n\n(((a * (X ^ 2)) + (b * X)) + c) \n(a*x^2 + b*x + c) \n(a . ^ 2 + b . + c) \na x^2 + b*x+c \n\nThe first is fully parenthesized infix, the second makes use of operator precedence \n(multiplication binds tighter than addition and is thus performed first), and the third \nmakes use of implicit multiplication as well as operator precedence. The fourth \nrequires a lexical analyzer to break Lisp symbols into pieces. \n\nSuppose we only wanted to handle the fully parenthesized case. To write \ni nf i x->pref i ., one might first look at pref i x->i nf i . (on [page 228](chapter7.md#page-228)) trying to adapt \nit to our new purposes. In doing so, the careful reader might discover a surprise: \ninfix->prefix and pref ix->inf ix are in fact the exact same function! Both leave \natoms unchanged, and both transform three-element lists by swapping the exp-op \nand exp -1 hs. Both apply themselves recursively to the (possibly rearranged) input \nlist. Once we discover this fact, it would be tempting to avoid writing i .f i . - >p ref i x, \nand just call pref i x->i nf i . instead. Avoid this temptation at all costs. Instead, define \ni nf i x->pref i . as shown below. The intent of your code will be clearer: \n\n(defun infix->prefix (infix-exp) \n\"Convert fully parenthesized infix-exp to a prefix expression\" \n;; Don't use this version for non-fully parenthesized exps! \n(prefix->infix infix-exp)) \n\nAs we saw above, fully parenthesized infix can be quite ugly, with all those extra \nparentheses, so instead we will use operator precedence. There are a number of \nways of doing this, but the easiest way for us to proceed is to use our previously \ndefined tool rule-based-translator and its subtool, pat-match. Note that the third \n\n\f\n<a id='page-241'></a>\nclause of infix->prefix, the one that calls rule-based-translator is unusual in \nthat it consists of a single expression. Most cond-clauses have two expressions: a test \nand a result, but ones like this mean, \"Evaluate the test, and if it is non-nil, return it. \nOtherwise go on to the next clause.\" \n\n(defun infix->prefix (exp) \n\"Translate an infix expression into prefix notation.\" \nNote we cannot do implicit multiplication in this system \n\n(cond ((atom exp) exp) \n((= (length exp) 1) (infix->prefix (first exp))) \n((rule-based-translator exp *infix->prefix-rules* \n\n:rule-if #'rule-pattern :rule-then #*rule-response \n\n:action \n\n#*(lambda (bindings response) \n(sublis (mapcar \n#*(lambda (pair) \n(cons (first pair) \n(infix->prefix (rest pair)))) \nbindings) \nresponse)))) \n((symbolp (first exp)) \n\n(list (first exp) (infix->prefix (rest exp)))) \n(t (error \"Illegal exp\")))) \n\nBecause we are doing mathematics in this chapter, we adopt the mathematical con\n\n\nvention of using certain one-letter variables, and redefine vari abl e-p so that vari\n\n\nables are only the symbols m through z. \n\n(defun variable-p (exp) \n\"Variables are the symbols . through Z.\" \nput x.y.z first to find them a little faster \n(member exp '(xyzmnopqrstuvw))) \n\n(pat-match-abbrev 'x+ *(?+ x)) \n(pat-match-abbrev 'y+ '(?+ y)) \n\n(defun rule-pattern (rule) (first rule)) \n(defun rule-response (rule) (second rule)) \n\n\f\n<a id='page-242'></a>\n\n(defpa rameter *i nfi x->prefi x-rules* \n(mapcar #'expand-pat-match-abbrev \n\n'(((x+ = y+) (= X y)) \n((- x+) (- X)) \n((+X+) (+x)) \n((x+ + y+) (+ X y)) \n((x+ - y+) (-X y)) \n((x+ * y+) (* X y)) \n((x+ / y+) (/ X y)) \n((x+ ^ y+) r X y)))) \n\n\"A list of rules, ordered by precedence.\") \n\n8.2 Simplification Rules \nNow we are ready to define the simplification rules. We use the definition of the data \ntypes rule and exp ([page 221](chapter7.md#page-221)) and prefix->inf ix ([page 228](chapter7.md#page-228)) from STUDENT. They \nare repeated here: \n\n(defstruct (rule (:type list)) pattern response) \n\n(defstruct (exp (:type list) \n(.'constructor mkexp (Ihs op rhs))) \nop Ihs rhs) \n\n(defun exp-p (x) (consp x)) \n(defun exp-args (x) (rest x)) \n\n(defun prefix->infix (exp) \n\"Translate prefix to infix expressions.\" \n(if (atom exp) exp \n\n(mapcar #'prefix->infix \n\n(if (binary-exp-p exp) \n(list (exp-lhs exp) (exp-op exp) (exp-rhs exp)) \nexp)))) \n\n(defun binary-exp-p (x) \n(and (exp-p x) (= (length (exp-args x)) 2))) \n\nWe also use rule-based-translator ([page 188](chapter6.md#page-188)) once again, this time on a list of \n\nsimplification rules. A reasonable list of simplification rules is shown below. This \n\nlist covers the four arithmetic operators, addition, subtraction, multipHcation, and \n\ndivision, as well as exponentiation (raising to a power), denoted by the symbol \nAgain, it is important to note that the rules are ordered, and that later rules will \nbe applied only when earlier rules do not match. So, for example, 0/0 simplifies to \n\n\f\n<a id='page-243'></a>\nundef i ned, and not to 1 or 0, because the rule for 0 / 0 comes before the other rules. \nSee exercise 8.8 for a more complete treatment of this. \n\n(defparameter *simplification-rules* (mapcar #'infix->prefix *( \n(x + 0 = X) \n(0 + X = X) \n(x + X = 2 * X) \n(X -0 = X) \n(0 -X = - X) \n(X -X = 0) \n(--X = X) \n(X * 1 = X) \n(1 * X = X) \n(X * 0 = 0) \n(0 * X = 0) \n(X * X = X ^ 2) \n(X / 0 = undefined) \n(0 / X = 0) \n(X / 1 = X) \n(X / X = 1) \n(0 ^ 0 = undefined) \n(X ^ 0 = 1) \n(0 X = 0) \n(1 X = 1) \n(X ^ 1 = X) \n(X ^ -1 = 1 / X) \n(X * (y / X) = y) \n((y / X) * X = y) \n((y * X) / X = y) \n((X * y) / X = y) \n(x + -X = 0) \n((- X) + X = 0) \n(x + y -X = y) \n))) \n\n(defun \" (x y) \"Exponentiation\" (expt . y)) \n\nWe are now ready to go ahead and write the simplif ier. The main function, s i mp 11 f i e r \nwill repeatedly print a prompt, read an input, and print it in simplified form. Input \nand output is in infix and the computation is in prefix, so we need to convert accordingly; \nthe function simp does this, and the function simpl 1 fy takes care of a single \nprefix expression. It is summarized in figure 8.1. \n\n\f\n<a id='page-244'></a>\n\nTop-Level Functions \n\nsimplifier A read-simplify-print loop. \nsimp Simplify an infix expression. \nsimplify Simplify a prefix expression. \n\nSpecial Variables \n\n*infix->prefix-rules* Rules to translate from infix to prefix. \n*s i mpli fi cati on-rules* Rules to simplify an expression. \n\nData Types \n\nexp A prefix expression. \n\nAtixiliary Functions \n\nsimplify-exp Simplify a non-atomic prefix expression. \ninfix->prefix Convert infix to prefix notation. \nvariable-p The symbols m through . are variables. \n\nAn alias for expt, exponentiation. \nevaluable Decide if an expression can be numerically evaluated. \nsimp-rule Transform a rule into proper format. \nlength=1 Is the argument a list of length 1? \n\nPrevious Functions \n\npat-match Match pattern against an input, (p. 180) \nrule-based-translator Apply a set of rules, (p. 189) \npat-match-abbrev Define an abbreviation for use in pat-match. \n\nFigure 8.1: Glossary for the Simplifier \n\nHere is the program: \n\n(defun simplifier () \n\"Read a mathematical expression, simplify it, and print the result.\" \n(loop \n\n(print 'simplifier>) \n(print (simp (read))))) \n\n(defun simp (inf) (prefix->infix (simplify (infix->prefix inf)))) \n\n(defun simplify (exp) \n\"Simplify an expression by first simplifying its components.\" \n(if (atom exp) exp \n\n(simplify-exp (mapcar #'simplify exp)))) \n\n(defun simplify-exp (exp) \n\"Simplify using a rule, or by doing arithmetic.\" \n(cond ((rule-based-translator exp *simplification-rules* \n\n:rule-if #'exp-lhs :rule-then #'exp-rhs \n.'action #'(lambda (bindings response) \n\n(simplify (sublis bindings response))))) \n((evaluable exp) (eval exp)) \n(t exp))) \n\n\f\n<a id='page-245'></a>\n\n(defun evaluable (exp) \n\"Is this an arithmetic expression that can be evaluated?\" \n(and (every #'numberp (exp-args exp)) \n\n(or (member (exp-op exp) '(+-*/)) \n(and (eq (exp-op exp) '\") \n(integerp (second (exp-args exp))))))) \n\nThe function simplify assures that any compound expression will be simplified by \nfirst simplifying the arguments and then calling simplify-exp. This latter function \nsearches through the simplification rules, much like use-eliza-rules and \ntranslate-to-expression. When it finds a match, simplify-exp substitutes in the \nproper variable values and calls simplify on the result, simplify-exp also has the \nability to call eval to simplify an arithmetic expression to a number. As in STUDENT, \nit is for the sake of this eval that we require expressions to be represented as lists in \nprefix notation. Numeric evaluation is done after checking the rules so that the rules \ncan intercept expressions like (/ 1 0) and simplify them to undefined. If we did the \nnumeric evaluation first, these expressions would yield an error when passed to e va 1. \nBecause Common Lisp supports arbitrary precision rational numbers (fractions), we \nare guaranteed there will be no round-off error, unless the input explicitly includes \ninexact (floating-point) numbers. Notice that we allow computations involving the \nfour arithmetic operators, but exponentiation is only allowed if the exponent is an \ninteger. That is because expressions like (\" 4 1/2) are not guaranteed to return 2 \n(the exact square root of 4); the answer might be 2.0 (an inexact number). Another \nproblem is that -2 is also a square root of 4, and in some contexts it is the correct \none to use. \n\nThe following trace shows some examples of the simplifier in action. First we \nshow that it can be used as a calculator; then we show more advanced problems. \n\n> (simplifier) \n\nSIMPLIFIER> (2 + 2) \n\n4 \n\nSIMPLIFIER> (5 * 20 + 30 + 7) \n\n137 \n\nSIMPLIFIER> (5 * . - (4 + 1) * x) \n0 \n\nSIMPLIFIER> (y / . * (5 * . - (4 + 1) * .)) \nO \n\nSIMPLIFIER> ((4 - 3) * . + (y / y - 1) * .) \nX \n\nSIMPLIFIER> (1 * f(x) + 0) \n(F X) \nSIMPLIFIER> (3 * 2 * X) \n(3 * (2 * X)) \nSIMPLIFIER> [Abort] \n> \n\n\f\n<a id='page-246'></a>\n\nHere we have terminated the loop by hitting the abort key on the terminal. (The details \nof this mechanism varies from one implementation of Common Lisp to another.) The \nsimplifier seems to workfairlywell, although it errs on the last example: (3 * (2 * \nX)) should simplify to (6 * X). In the next section, we will correct that problem. \n\n8.3 Associativity and Commutativity \nWe could easily add a rule to rewrite (3 * (2 *X))as((3 * 2) * X) and hence \n(6 * X). The problem is that this rule would also rewrite (X*(2*3))as((X* \n\n2) * 3), unless we had a way to limit the rule to apply only when it would group \nnumbers together. Fortunately, pat-match does provide just this capability, with the \n?i s pattern. We could write this rule: \n(((?is . numberp) * ((?is m numberp) * x)) = ((n * m) * x)) \n\nThis transforms (3 * (2 * x)) into ((3 * 2) * .), and hence into (6 * x). \nUnfortunately, the problem is not as simple as that. We also want to simplify ((2 * \n\nx) * (y* 3)) to (6 *(x * y)). We can do a better job of gathering numbers together \nby adopting three conventions. First, make numbers first in products: change . * \n3 to 3 * X. Second, combine numbers in an outer expression with a number in an \ninner expression: change 3 *(5*x)to(3*5)*x. Third, move numbers out \nof inner expressions whenever possible: change (3 *x) *yto3*(x*y) . We \nadopt similar conventions for addition, except that we prefer numbers last there: . \n+ 1 instead of 1 + x. \nDefine . and m as numbers; s as a non-number: \n(pat-match-abbrev *n '(lis . numberp)) \n(pat-match-abbrev 'm '(?is m numberp)) \n(pat-match-abbrev *s '(?is s not-numberp)) \n\n(defun not-numberp (x) (not (numberp x))) \n\n(defun simp-rule (rule) \n\"Transform a rule into proper format.\" \n(let ((exp (infix->prefix rule))) \n\n(mkexp (expand-pat-match-abbrev (exp-lhs exp)) \n(exp-op exp) (exp-rhs exp)))) \n\n\f\n<a id='page-247'></a>\n\n(setf *simplification-rules* \n(append *simplification-rules* (mapcar #'simp-rule \n\n'((s * . = . * s) \n(. * (m * X) = (. * m) * .) \n(. * (. * y) = . * (. * y)) \n((. * .) * y = . * (. * y)) \n(. + s = s + .) \n((. + m) + . = . + . ->- m) \n(. + (y + .) = (. + y) + .) \n((. + .) + y = (. + y) + .))))) \n\nWith the new rules in place, we are ready to try again. For some problems we get just \nthe right answers: \n\n> (simplifier) \n\nSIMPLIFIER> (3 * 2 * x) \n(6 * X) \n\nSIMPLIFIER> (2 * . * . * 3) \n(6 * (. 2)) \n\nSIMPLIFIER> (2*x*3*y*4*z*5*6) \n(720 * (X * (Y * .))) \n\nSIMPLIFIER> (3 + . + 4 + .) \n((2 * .) + 7) \n\n$IMPLIFIER> (2 *. *3 *. *4*(1 /. )*5*6) \n(720 * .) \n\nUnfortunately, there are other problems that aren't simplified properly: \n\nSIMPLIFIER> (3 + . + 4 - x) \n((X + (4 - X)) + 3) \nSIMPLIFIER> (x + y + y + x) \n(X + (Y + (Y + .))) \nSIMPLIFIER> (3 * . + 4 * .) \n((3 * .) + (4 * .)) \n\nWe will return to these problems in section 8.5. \n\n&#9635; Exercise 8.1 Verify that the set of rules just prior does indeed implement the desired \nconventions, and that the conventions have the proper effect, and always terminate. \nAs an example of a potential problem, what would happen if we used the rule (. * \n. = . * .) instead of the rule (s * . = . * s)? \n\n\f\n<a id='page-248'></a>\n\n8.4 Logs, Trig, and Differentiation \nIn the previous section, we restricted ourselves to the simple arithmetic functions, \nso as not to intimidate those who are a little leery of complex mathematics. In this \nsection, we add a little to the mathematical complexity, without having to alter the \nprogram itself one bit. Thus, the mathematically shy can safely skip to the next \nsection without feeling they are missing any of the fun. \n\nWe start off by representing some elementary properties of the logarithmic and \ntrigonometric functions. The new rules are similar to the \"zero and one\" rules we \nneeded for the arithmetic operators, except here the constants e and . i (e = 2.71828... \nand &pi; = 3.14159...) are important in addition to 0 and 1. We also throw in some rules \nrelating logs and exponents, and for sums and differences of logs. The rules assume \nthat complex numbers are not allowed. If they were, log (and even x^) would have \nmultiple values, and it would be wrong to arbitrarily choose one of these values. \n\n(setf *simplification-rules* \n\n(append *simplification-ru1es* (mapcar #*simp-rule *( \n(log 1 = 0) \n(log 0 = undefined) \n(log e =1) \n(sin 0 =0) \n(sin pi = 0) \n(cos 0 =1) \n(cos pi = -1) \n(sin(pi / 2) =1) \n(cos(pi / 2) =0) \n(log (e \" x) = x) \n(e ^ (log x) = x) \n((x ^ y) * (x ^ z) = . My + z)) \n((x ^ y) / (x M) = . My - z)) \n(log . + log y = log(x * y)) \n(log X - log y = log(x / y)) \n((sin X) ^ 2 + (cos X) ^ 2 = 1) \n)))) \n\nNow we would like to go a step further and extend the system to handle differentiation. \nThis is a favorite problem, and one which has historical significance: in the \nsummer of 1958 John McCarthy decided to investigate differentiation as an interesting \nsymbolic computation problem, which was difficult to express in the primitive \nprogramming languages of the day. This investigation led him to see the importance \nof functional arguments and recursive functions in the field of symbolic computation. \nFor example, McCarthy invented what we now call mapcar to express the idea \nthat the derivative of a sum is the sum of the derivative function applied to each \nargument. Further work led McCarthy to the publication in October 1958 of MIT \n\n\f\n<a id='page-249'></a>\nAI Lab Memo No. 1: \"An Algebraic Language for the Manipulation of Symbolic \nExpressions/' which defined the precursor of Lisp. \n\nIn McCarthy's work and in many subsequent texts you can see symbolic differentiation \nprograms with a simplification routine tacked on the end to make the output \nmore readable. Here, we take the opposite approach: the simplification routine is \ncentral, and differentiation is handled as just another operator, with its own set of \nsimplification rules. We will require a new infix-to-prefix translation rule. While \nwe're at it, we'll add a rule for indefinite integration as well, although we won't write \nsimplification rules for integration yet. Here are the new notations: \n\nmath infix prefix \n\ndy/dx d y / d X/ydx Int y d X\n\nAnd here are the necessary infix-to-prefix rules: \n\n(defparameter *infix->prefix-rules* \n(mapcar #'expand-pat-match-abbrev \n\n (d y x) \n(int y .) \n\n'(((x+ = y+) (= . y)) \n((- x+) (- .)) \n((+.+) (+x)) \n((X-H + y+) (+ X y)) \n\n((x+ - y+) (- . y)) \n((d y+ / d x) (d y x))\n((Int y+ d x) (int y .))\n((x+ * y+) (* . y)) \n((x+ / y+) (/ . y)) \n((x+ ^ y+) r . y))))) \n\n New rule \nNew rule \n\nSince the new rule for differentiation occurs before the rule for division, there won't \nbe any confusion with a differential being interpreted as a quotient. On the other \nhand, there is a potential problem with integrals that contain d as a variable. The \nuser can always avoid the problem by using (d) instead of d inside an integral. \n\nNow we augment the simplification rules, by copying a differentiation table out \nof a reference book: \n\n(setf *simplification-rules* \n\n(append *simplification-rules* (mapcar #*simp-rule '( \n(d . / d . =1) \n(d (u + V) / d . = (d u / d X) + (d V / d X)) \n(d (u - V) / d . = (d u / d X) - (d V / d x)) \n(d (- u) / d X = - (d u / d X)) \n(d (u * V) / d X = u * (d V / d X) + V * (d u / d X)) \n(d (u / V) / d X = (V * (d u / d X) - u * (d V / d X)) \n\n/ V ^ 2) \n\n\f\n<a id='page-250'></a>\n\n(d (u ^ n) / d X = . * u Mn - 1) * (d u / d X)) \n(d (u V) / d X = V * u Mv - 1) * (d u / d X) \n\n+ u ^ V * (log u) * (d V / d x)) \n(d (log u) / d X = (d u / d X) / u) \n(d (sin u) / d X = (cos u) * (d u / d x)) \n(d (cos u) / d X = - (sin u) * (d u / d x)) \n(d (e ^ u) / d X = (e ^ u) * (d u / d X)) \n(d u / d X = 0))))) \nWe have added a default rule, (d u / d . = 0); this should only apply when the \nexpression u is free of the variable . (that is, when u is not a function of x). We could \nuse ?1 f to check this, but instead we rely on the fact that differentiation is closed over \nthe list of operators described here—as long as we don't introduce any new operators, \nthe answer will always be correct. Note that there are two rules for exponentiation, \none for the case when the exponent is a number, and one when it is not. This was \nnot strictly necessary, as the second rule covers both cases, but that was the way the \nrules were written in the table of differentials I consulted, so I left both rules in. \n\nSIMPLIFIER> (d (x + x) / d x) \n2 \nSIMPLIFIER> (d (a * x ^ 2 + b * x + c) / d x) \n((2 * (A * X)) + B) \nSIMPLIFIER> (d ((a * x ^ 2 + b * x + c) / x) / d x) \n((((A * (X ^ 2)) + ((B * X) + O) - (X * ((2 * (A * X)) + B))) \n\n/ (X ^ 2)) \nSIMPLIFIER> (log ((d (x + .) / d x) / 2)) \n0 \nSIMPLIFIER> (log(x + x) - log x) \n(LOG 2) \nSIMPLIFIER> (x cos pi) \n(1 / X) \nSIMPLIFIER> (d (3 * x + (cos x) / x) / d x) \n((((COS X) - (X * (- (SIN X)))) / (X ^ 2)) + 3) \nSIMPLIFIER> (d ((cos x) / x) / d x) \n(((COS X) - (X * (- (SIN X)))) / (X ^ 2)) \nSIMPLIFIER> (d (3 * x ^ 2 + 2 * . + 1) / d x) \n((6 * X) + 2) \nSIMPiIFIER> (sin(x + x) ^ 2 + cos(d . ^ 2 / d x) ^ 2) \n1 \nSIMPLIFIER> (sin(x + x) * sin(d . \" 2 / d x) + \n\ncos(2 * X)* cos(x * d 2 * y / d y)) \n1 \n\nThe program handles differentiation problems well and is seemingly clever in its use \nof the identity sin^ . -f cos^ . = 1. \n\n\f\n<a id='page-251'></a>\n8.5 Limits of Rule-Based Approaches \nIn this section we return to some examples that pose problems for the simplifier. \nHere is a simple one: \n\nSIMPLIFIER> (x + y + y + .) => (X + (Y + (Y + X))) \n\nWe would prefer 2 * (x + y). The problem is that, although we went to great trouble \nto group numbers together, there was no effort to group non-numbers. We could \nwrite rules of the form: \n\n(y + (y + x) = (2 * y) + x) \n\n(y + (x + y) = (2 * y) + x) \n\nThesewouldworkfortheexampleathand, but they would not work for (. + y + . \n\n+ y + .). For that we would need more rules: \n(y + (. + (y + X)) = (2 * y) + X + .) \n\n(y + (. + (. + y)) = (2 * y) + . + .) \n\n(y + ((y + .) + .) = (2 * y) + . + .) \n\n(y + ((. + y) + .) = (2 * y) + . + .) \n\n.. handle all the cases, we would need an infinite number of rules. The pattern-\nmatching language is not powerful enough to express this succintly. It might help \nif nested sums (and products) were unnested; that is, if we allowed + to take an \narbitrary number of arguments instead of just one. Once the arguments are grouped \ntogether, we could sort them, so that, say, all the ys appear before . and after x. Then \nlike terms could be grouped together. We have to be careful, though. Consider these \nexamples: \n\nSIMPLIFIER> (3 * . + 4 * x) \n\n((3 * X) + (4 * X)) \n\nSIMPLIFIER> (3 *x + y + x + 4 *x) \n\n((3 * X) + (Y + (X + (4 * X)))) \n\nWe would want (3 * .) to sort to the same place as . and (4 * .) so that they could \nall be combined to (8 * x). In chapter 15, we develop a new version of the program \nthat handles this problem. \n\n\f\n<a id='page-252'></a>\n\n8.6 Integration \nSo far, the algebraic manipulations have been straightforward. There is a direct \nalgorithm for computing the derivative of every expression. When we consider \nintegrals, or antiderivatives,^ the picture is much more complicated. As you may \nrecall from freshman calculus, there is a fine art to computing integrals. In this \nsection, we try to see how far we can get by encoding just a few of the many tricks \navailable to the calculus student. \n\nThe first step is to recognize that entries in the simplification table will not be \nenough. Instead, we will need an algorithm to evaluate or \"simplify\" integrals. \nWe will add a new case to simpl ify-exp to check each operator to see if it has a \nsimplification function associated with it. These simplification functions will be \nassociated with operators through the functions set-simp-fn and simp-fn. If an \noperator does have a simplification function, then that function will be called instead \nof consulting the simplification rules. The simplification function can elect not to \nhandle the expression after all by returning nil, in which case we continue with the \nother simplification methods. \n\n(defun simp-fn (op) (get op 'simp-fn)) \n(defun set-simp-fn (op fn) (setf (get op 'simp-fn) fn)) \n\n(defun simplify-exp (exp) \n\"Simplify using a rule, or by doing arithmetic, \nor by using the simp function supplied for this operator.\" \n(cond ((simplify-by-fn exp)) \n\n((rule-based-translator exp *simplification-rules* \n:rule-if #'exp-lhs :rule-then #'exp-rhs \nraction #*(lambda (bindings response) \n\n(simplify (sublis bindings response))))) \n((evaluable exp) (eval exp)) \n(t exp))) \n\n(defun simplify-by-fn (exp) \n\"If there is a simplification fn for this exp, \nand if applying it gives a non-null result, \nthen simplify the result and return that.\" \n(let* ((fn (simp-fn (exp-op exp))) \n\n(result (if fn (funcall fn exp)))) \n\n(if (null result) \nnil \n(simplify result)))) \n\nFreshman calculus classes teach a variety of integration techniques. Fortunately, \none technique—the derivative-divides technique—can be adopted to solve most of the \n\n^The term antiderivative is more correct, because of branch point problems. \n\n\f\n<a id='page-253'></a>\nproblems that come up at the freshman calculus level, perhaps 90% of the problems \ngiven on tests. The basic rule is: \n\njf{x)dx =\n\n Jm^dx. \n\nAs an example, consider / xsin{x^)dx. Using the substitution u = x^, we can \ndifferentiate to get du/dx = 2x, Then by applying the basic rule, we get: \n\n&int; x sin{x^2)dx = 1/2 &int; sin(u)du/dx dx = 1/2 &int sin(u) du. \n\nAssume we have a table of integrals that includes the rule / sin(x) dx = - cos(x). \nThen we can get the final answer: \n\n--cos{x^). \n\nAbstracting from this example, the general algorithm for integrating an expression \ny with respect to . is: \n\n1. Pick a factor of y, calling it f{u). \n2. Compute the derivative du/dx. \n3. Divide y by f{u) . du/dx, calling the quotient k. \n4. If/c is a constant (with respect to x), then the result is A: / f{u)du. \nThis algorithm is nondeterrninistic, as there may be many factors of y. In our \nexample, f{u) = sin(x^),w = x^, and du/dx = 2x. So k = \\, and the answer is \n\n-^COs(x2). \n\nThe first step in implementing this technique is to make sure that division is done \ncorrectly. We need to be able to pick out the factors of y, divide expressions, and then \ndetermine if a quotient is free of x. The function f acton* ze does this. It keeps a list \nof factors and a running product of constant factors, and augments them with each \ncall to the local function f ac. \n\n\f\n<a id='page-254'></a>\n\n(defun factorize (exp) \n\"Return a list of the factors of exp^n, \nwhere each factor is of the form . y .).\" \n(let ((factors nil) \n\n(constant 1)) \n(labels \n((fac (X n) \n(cond \n((numberp x) \n(setf constant (* constant (expt . .)))) \n\n((starts-with . **) \n(fac (exp-lhs x) n) \n(fac (exp-rhs x) n)) \n\n((starts-with . V) \n(fac (exp-lhs x) n) \n(fac (exp-rhs x) (- n))) \n\n((and (starts-with . *-) (length=1 (exp-args x))) \n(setf constant (- constant)) \n(fac (exp-lhs x) n)) \n\n((and (starts-with . '\") (numberp (exp-rhs x))) \n(fac (exp-lhs x) (* . (exp-rhs x)))) \n(t (let ((factor (find . factors :key #'exp-lhs \n:test #'equal))) \n\n(if factor \n(incf (exp-rhs factor) n) \n(push . ,x ,n) factors))))))) \n\n;; Body of factorize: \n(fac exp 1) \n(case constant \n\n(0 *{r 0 1))) \n(1 factors) \n(t '{. .constant 1) ..factors)))))) \n\nfactor i ze maps from an expression to a list of factors, but we also need unf actor i ze \nto turn a list back into an expression: \n\n(defun unfactorize (factors) \n\"Convert a list of factors back into prefix form.\" \n(cond ((null factors) 1) \n\n((length=1 factors) (first factors)) \n(t .(* .(first factors) .(unfactorize (rest factors)))))) \n\nThe derivative-divides method requires a way of dividing two expressions. We do this \nby factoring each expression and then dividing by cancelling factors. There may be \ncases where, for example, two factors in the numerator could be multiplied together \n\n\f\n<a id='page-255'></a>\nto cancela factor in the denominator, but this possibility is not considered. It turns \nout that most problems from freshman calculus do not require such sophistication. \n\n(defun divide-factors (numer denom) \n\"Divide a list of factors by another, producing a third.\" \n(let ((result (mapcar #'copy-list numer))) \n\n(dolist (d denom) \n(let ((factor (find (exp-lhs d) result :key #*exp-lhs \n:test #*equal))) \n\n(if factor \n(decf (exp-rhs factor) (exp-rhs d)) \n(push *r ,(exp-lhs d) .(- (exp-rhs d))) result)))) \n\n(delete 0 result :key #'exp-rhs))) \n\nFinally, the predicate free-of returns true if an expression does not have any occurrences \nof a particular variable in it. \n\n(defun free-of (exp var) \n\"True if expression has no occurrence of var.\" \n(not (find-anywhere var exp))) \n\n(defun find-anywhere (item tree) \n\"Does item occur anywhere in tree? If so. return it.\" \n(cond ((eql item tree) tree) \n\n((atom tree) nil) \n((find-anywhere item (first tree))) \n((find-anywhere item (rest tree))))) \n\nIn factorize we made use of the auxiliary function length=1. The function call \n(length=1 x) is faster than (= (length x) 1) because the latter has to compute \nthe length of the whole list, while the former merely has to see if the list has a rest \nelement or not. \n\n(defun length=1 (x) \n\"Is X a list of length 1?\" \n(and (consp x) (null (rest x)))) \n\nGiven these preliminaries, the function i ntegrate is fairly easy. We start with \nsome simple cases for integrating sums and constant expressions. Then, we factor \nthe expression and split the list of factors into two: a Ust of constant factors, and \na list of factors containing x. (This is done with partition-if, a combination of \nremove-if and remove-if-not.) Finally, we call deri .-divides, giving it a chance \nwith each of the factors. If none of them work, we return an expression indicating \nthat the integral is unknown. \n\n\f\n<a id='page-256'></a>\n\n(defun integrate (exp x) \nFirst try some trivial cases \n\n(cond \n((free-of exp x) *(* ,exp x)) Int c dx = c*x \n((starts-with exp *+) Int f + g = \n\n*(+ .(integrate (exp-lhs exp) x) Int f + Int g \n.(integrate (exp-rhs exp) x))) \n((starts-with exp *-) \n\n(ecase (length (exp-args exp)) \n(1 (integrate (exp-lhs exp) x)) Int -f = - Int f \n(2 '(- .(integrate (exp-lhs exp) x) Int f -g = \n\n.(integrate (exp-rhs exp) x))))) ; Int f - Int g \nNow move the constant factors to the left of the integral \n((multiple-value-bind (const-factors x-factors) \n(partition-if #'(lambda (factor) (free-of factor x)) \n(factorize exp)) \n(simplify \n.(* .(unfactorize const-factors) \nAnd try to integrate: \n.(cond ((null x-factors) x) \n((some #'(lambda (factor) \n(deriv-divides factor x-factors x)) \n\nx-factors)) \n;; <other methods here> \n(t *(int? .(unfactorize x-factors) .x))))))))) \n\n(defun partition-if (pred list) \n\"Return 2 values: elements of list that satisfy pred. \nand elements that don't.\" \n(let ((yes-list nil) \n\n(no-list nil)) \n(dolist (item list) \n\n(if (funcall pred item) \n(push item yes-list) \n(push item no-list))) \n\n(values (nreverse yes-list) (nreverse no-list)))) \n\n\f\n<a id='page-257'></a>\nNote that the place in integrate where other techniques could be added is \nmarked. We will only implement the derivative-divides method. It turns out that \nthe function is a little more complicated than the simple four-step algorithm outlined \nbefore: \n\n(defun deriv-divides (factor factors x) \n(assert (starts-with factor \n(let* ((u (exp-lhs factor)) ; factor = u^n \n\n(n (exp-rhs factor)) \n(k (divide-factors \nfactors (factorize '(* .factor ,(deriv u x)))))) \n(cond ((free-of k x) \n\nInt k*u\"n*du/dx dx = k*Int u\"n du \n= k*u^(n+l)/(n+l) for . /= -1 \n= k*log(u) for . = -1 \n\n(if (= . -1) \n'(* .(unfactorize k) (log .u)) \n*(/ (* ,(unfactorize k) . ,u .(+ . 1))) \n\n,(+ . 1)))) \n((and (= . 1) (in-integral-table? u)) \nInt y'*f(y) dx = Int f(y) dy \n\n(let ((k2 (divide-factors \nfactors \n(factorize *(* ,u ,(deriv (exp-lhs u) x)))))) \n\n(if (free-of k2 x) \n.(* .(integrate-from-table (exp-op u) (exp-lhs u)) \n.(unfactorize k2)))))))) \n\nThere are three cases. In any case, all factors are of the form (\" u .), so we separate \nthe factor into a base, u, and exponent, n. li u or u\"^ evenly divides the original \nexpression (here represented as factors), then we have an answer. But we need to \ncheck the exponent, because / u'^du is u'^~^'^/{n -h 1) forn -1, but it is log(u) for \n. = -1, But there is a third case to consider. The factor may be something like ( \n(sin X 2)) 1), in which case we should consider /(..) = sin(x^). This case is \nhandled with the help of an integral table. We don't need a derivative table, because \n\nwe can just use the simplifier for that. \n\n(defun deriv (y x) (simplify *(d ,y .x))) \n\n(defun integration-table (rules) \n(dolist (i-rule rules) \n(let ((rule (infix->prefix i-rule))) \n(setf (get (exp-op (exp-lhs (exp-lhs rule))) 'int) \nrule)))) \n\n\f\n<a id='page-258'></a>\n\n(defun in-integral-table? (exp) \n(and (exp-p exp) (get (exp-op exp) 'int))) \n\n(defun integrate-from-table (op arg) \n(let ((rule (get op 'int))) \n(subst arg (exp-lhs (exp-lhs (exp-lhs rule))) (exp-rhs rule)))) \n\n(integration-table \n\n'((Int log(x) d . = . * log(x) - .) \n(Int exp(x) d . = exp(x)) \n(Int sin(x) d X = - cos(x)) \n(Int cos(x) d X = sin(x)) \n(Int tan(x) d . = - log(cos(x))) \n(Int sinh(x) d . = cosh(x)) \n(Int cosh(x) d X = sinh(x)) \n(Int tanh(x) d . = log(cosh(x))) \n)) \n\nThe last step is to install integrate as the simplification function for the operator \nInt. The obvious way to do this is: \n\n(set-simp-fn 'Int 'integrate) \n\nUnfortunately, that does not quite work. The problem is that integrate expects \ntwo arguments, corresponding to the two arguments y and xin ilnt y x). But the \nconvention for simplification functions is to pass them a single argument, consisting \nof the whole expression (Int y jc). We could go back and edit simpl Ify-exp to \nchange the convention, but instead I choose to make the conversion this way: \n\n(set-simp-fn 'Int #'(lambda (exp) \n(integrate (exp-lhs exp) (exp-rhs exp)))) \n\nHere are some examples, taken from chapters 8 and 9 of Calculus (Loomis 1974): \n\nSIMPLIFIER> (Int . * sin(x 2) d x) \n(1/2 * (- (COS (X ^ 2)))) \nSIMPLIFIER> (Int ((3 * . ^ 3) - 1 / (3 * . ^ 3)) d x) \n((3 * ((X ^ 4) / 4)) - (1/3 * ((X ^ -2) / -2))) \nSIMPLIFIER> (Int (3 * . + 2) ^ -2/3 d x) \n(((3 * X) + 2) 1/3) \nSIMPLIFIER> (Int sin(x) ^ 2 * cos(x) d x) \n(((SIN X) ^ 3) / 3) \nSIMPLIFIER> (Int sin(x) / (1 + cos(x)) d x) \n(-1 * (LOG ((COS X) + 1))) \nSIMPLIFIER> (Int (2 * . + 1) / (x ^ 2 + . - 1) d x) \n\n\f\n<a id='page-259'></a>\n\n(LOG ((X ^ 2) + (X - 1))) \nSIMPLIFIER> (Int 8 * . ^ 2 / (x ^ 3 + 2) ^ 3 d x) \n(8 * ((1/3 * (((X ^ 3) + 2) -2)) / -2)) \n\nAll the answers are correct, although the last one could be made simpler. One quick \nway to simplify such an expression is to factor and unfactor it, and then simplify \nagain: \n\n(set-simp-fn 'Int \n#'(lambda (exp) \n(unfactorize \n(factorize \n\n(integrate (exp-lhs exp) (exp-rhs exp)))))) \n\nWith this change, we get: \nSIMPLIFIER> (Int 8 * . ^ 2 / (x 3 + 2) ^ 3 d x) \n(-4/3 * (((X ^ 3) + 2) ^ -2)) \n\n8.7 History and References \nA brief history is given in the introduction to this chapter. An interesting point is that \nthe history of Lisp and of symbolic algebraic manipulation are deeply intertwined. \nIt is not too gross an exaggeration to say that Lisp was invented by John McCarthy \nto express the symbolic differentiation algorithm. And the development of the first \nhigh-quality Lisp system, MacLisp, was driven largely by the needs of MACSYMA, \none of the first large Lisp systems. See McCarthy 1958 for early Lisp history and \nthe differentiation algorithm, and Martin and Fateman 1971 and Moses (1975) for \nmore details on MACSYMA. A comprehensive book on computer algebra systems \nis Davenport 1988. It covers the MACSYMA and REDUCE systems as well as the \nalgorithms behind those systems. \n\nBecause symbolic differentiation is historically important, it is presented in a \nnumber of text books, from the original Lisp 1.5 Primer (Weissman 1967) and Allen's \ninfluential Anatomy of Lisp (1978) to recent texts like Brooks 1985, Hennessey 1989, \nand Tanimoto 1990. Many of these books use rules or data-driven programming, \nbut each treats differentiation as the main task, with simplification as a separate \nproblem. None of them use the approach taken here, where differentiation is just \nanother kind of simplification. \n\nThe symbolic integration programs SAINT and SiN are covered in Slagle 1963 and \nMoses 1967, respectively. The mathematical solution to the problem of integration \n\n\f\n<a id='page-260'></a>\n\nin closed term is addressed in Risch 1969, but be warned; this paper is not for the \nmathematically naive, and it has no hints on programming the algorithm. A better \nreference is Davenport et al. 1988. \nIn this book, techniques for improving the efficiency of algebraic manipulation \nare covered in sections 9.6 and 10.4. Chapter 15 presents a reimplementation that \ndoes not use pattern-matching, and is closer to the techniques used in MACSYMA. \n8.8 Exercises \n&#9635; Exercise 8.2 [s] Some notations use the operator ** instead of \" to indicate exponentiation. \nFix i nf ix->pref i . so that either notation is allowed. \n\n&#9635; Exercise 8.3 [m] Can the system as is deal with imaginary numbers? What are \nsome of the difficulties? \n&#9635; Exercise 8.4 [h] There are some simple expressions involving sums that are not \nhandled by the i ntegrate function. The function can integrate axx^-\\-bxx-\\-c \nbut not 5 X {a X x^ b X X + c) . Similarly, it can integrate x^ + 2x x^ -\\- x^ but not \n(.2 + x)^^ and it can do + + . -h 1 but not (x^ -f 1) . (x + 1). Modify i ntegrate \nso that it expands out products (or small exponents) of sums. You will probably want \nto try the usual techniques first, and do the expansion only when that fails. \n\n&#9635; Exercise 8.5 [d] Another very general integration technique is called integration \nby parts. It is based on the rule: &int; udv = uv - &int; vdu \nSo, for example, given \nX cos xdx/\nwe can take u = x,dv = cos xdx. Then we can determine . = sin . by integration, \nand come up with the solution: \nJX cos xdx = X sin ^ ~J ^ ^ ~ ^ ^^\" ^ \n\nIt is easy to program an integration by parts routine. The hard part is to program \nthe control component. Integration by parts involves a recursive call to i ntegrate, \nand of all the possible ways of breaking up the original expression into a u and a dv, \n\n\f\n<a id='page-261'></a>\n\nfew, if any, will lead to a successful integration. One simple control rule is to allow \nintegration by parts only at the top level, not at the recursive level. Implement this \napproach. \n\n&#9635; Exercise 8.6 [d] A more complicated approach is to try to decide which ways of \nbreaking up the original expression are promising and which are not. Derive some \nheuristics for making this division, and reimplement i ntegrate to include a search \ncomponent, using the search tools of chapter 6. \n\nLook in a calculus textbook to see how / sin^ xdx is evaluated by two integrations \nby parts and a division. Implement this technique as well. \n\n&#9635; Exercise 8.7 [m] Write simplification rules for predicate calculus expressions. For \nexample, \n\n(true and . = x) \n(false and . = false) \n(true or X = true) \n(false or X = false) \n\n&#9635; Exercise 8.8 [m] The simplification rule (. / 0 = undef i ned) is necessary to avoid \nproblems with division by zero, but the treatment of undef i ned is inadequate. For \nexample, the expression ((0/0) - (0/0)) will simplify to zero, when it should \nsimplify to undef i ned. Add rules to propagate undef i ned values and prevent them \nfrom being simplified away. \n\n&#9635; Exercise 8.9 [d] Extend the method used to handle undef i ned to handle +i nf i ni ty \nand -i nf ini ty as well. \n\n\f\n## Chapter 9\n<a id='page-265'></a>\n\nEfficiency issues \n\nALisp programmer knows the value of every thing, \nbut the cost of nothing. \n\n-Alan J. Perils \n\nLisp is not inherently less efficient than other \nhigh-level languages. \n\n—Richard J. Fateman \n\nO\nO\nne of the reasons Lisp has enjoyed a long history is because it is an ideal language for \nwhat is now called rapid-prototyping—developing a program quickly, with little regards \nfor details. That is what we have done so far in this book: concentrated on getting a \nworking algorithm. Unfortunately, when a prototype is to be turned into a production-quality \nprogram, details can no longer be ignored. Most \"real\" AI programs deal with large amounts of \ndata, and with large search spaces. Thus, efficiency considerations become very important. \n\nHowever, this does not mean that writing an efficient program is fundamentaly different \nfrom writing a working program. Ideally, developing an efficient program should be a three-step \nprocess. First, develop a working program, using proper abstractions so that the program will be \neasy to change if necessary. Second,instrument the program to determine where it is spending \nmost of the time. Third, replace the slow parts with faster versions, while maintaining the \nprogram's correctness. \n\n\f\n<a id='page-266'></a>\n\nThe term efficiency will be used primarily to talk about the speed or run time of a \nprogram. To a lesser extent, efficiency is also used to refer to the space or amount of \nstorage consumed by a program. We will also talk about the cost of a program. This \nis partly a use of the metaphor \"time is money,\" and partly rooted in actual monetary \ncosts—if a critical program runs unacceptably slowly, you may need to buy a more \nexpensive computer. \n\nLisp has been saddled with a reputation as an \"inefficient language.\" Strictly \nspeaking, it makes no sense to call a language efficient or inefficient. Rather, it is only \na particular implementation of the language executing a particular program that can be \nmeasured for efficiency. So saying Lisp is inefficient is partly a historical claim: some \npast implementations have been inefficient. It is also partly a prediction: there are \nsome reasons why future implementations are expected to suffer from inefficiencies. \nThese reasons mainly stem from Lisp's flexibility. Lisp allows many decisions to be \ndelayed until run time, and that can make the run time take longer. In the past decade, \nthe \"efficiency gap\" between Lisp and \"conventional languages\" Uke FORTRAN or \nC has narrowed. Here are the reasons—some deserved, some not—behind Lisp's \nreputation for inefficiency: \n\n* Early implementations were interpreted rather than compiled, which made \nthem inherently inefficient. Common Lisp implementations have compilers, \nso this is no longer a problem. While Lisp is (primarily) no longer an interpreted \nlanguage, it is still an interactive language, so it retains its flexibility. \n* Lisp has often been used to write interpreters for embedded languages, thereby \ncompounding the problem. Consider this quote from Cooper and Wogrin's \n(1988) book on the rule-based programming language OPS5: \nThe efficiency of implementations that compile rules into executable code \ncompares favorably to that of programs wntten in most sequential languages \nsuch as FORTRAN or Pascal Implementations that compile rules \ninto data structures to be interpreted, as do many Lisp-based ones, could be \nnoticeably slower. \n\nHere Lisp is guilty by association. The fallacious chain of reasoning is: Lisp has \nbeen used to write interpreters; interpreters are slow; therefore Lisp is slow. \nWhile it is true that Lisp makes it very easy to write interpreters, it also makes \nit easy to write compilers. This book is the first that concentrates on using Lisp \nas both the implementation and target language for compilers. \n\n* Lisp encourages a style with lots of function calls, particularly recursive calls. \nIn some older systems, function calls were expensive. But it is now understood \nthat a function call can be compiled into a simple branch instruction, and that \n\f\n<a id='page-267'></a>\n\nmany recursive calls can be made no more expensive than an equivalent iterative \nloop (see chapter 22). It is also possible to instruct a Common Lisp compiler \nto compile certain functions inline, so there is no calling overhead at all. \n\nOn the other hand, many Lisp systems require two fetches instead of one to find \nthe code for a function, and thus will be slower. This extra level of indirection \nis the price paid for the freedom of being able to redefine functions without \nreloading the whole program. \n\nRun-time type-checking is slow. Lisp provides a repertoire of generic functions. \nFor example, we can write (+ x y) without bothering to declare if . and y are integers, \nfloatingpoint, bignums, complex numbers, rationals, or some combination \nof the above. This is very convenient, but it means that type checks must be \nmade at run time, so the generic+will be slower than, say, a 16-bit integer addition \nwith no check for overflow. If efficiency is important. Common Lisp allows \nthe programmer to include declarations that can eUminate run-time checks. \n\nIn fact, once the proper declarations are added. Lisp can be as fast or faster \nthan conventional languages. Fateman (1973) compared the FORTRAN cube \nroot routine on the PDP-10 to a MacLisp transliteration. The MacLisp version \nproduced almost identical numerical code, but was 18% faster overall, due to \na superior function-calling sequence.^ The epigraph at the beginning of this \nchapter is from this article. \n\nBerlin and Weise (1990) show that with a special compilation technique called \npartial evaluation, speeds 7 to 90 times faster than conventionally compiled code \ncan be achieved. Of course, partial evaluation could be used in any language, \nbut it is very easy to do in Lisp. \n\nThe fact remains that Lisp objects must somehow represent their type, and \neven with declarations, not all of this overhead can be eliminated. Most Lisp \nimplementations optimize access to lists and fixnums but pay the price for the \nother, less commonly used data types. \n\nLisp automatically manages storage, and so it must periodically stop and collect \nthe unused storage, or garbage. In early systems, this was done by periodically \nsweeping through all of memory, resulting in an appreciable pause. Modern \nsystems tend to use incremental garbage-collection techniques, so pauses are \nshorter and usually unnoticed by the user (although the pauses may still be too \nlong for real-time applications such as controlling a laboratory instrument). \nThe problem with automatic garbage collection these days is not that it is \nslow-in fact, the automatic systems do about as well as handcrafted storage \n\n^One could say that the FORTRAN compiler was \"broken.\" This underscores the problem \n\nof defining the efficiency of a language-do we judge by the most popular compiler, by the best \ncompiler available, or by the best compiler imaginable? \n\n\f\n<a id='page-268'></a>\n\nallocation. The problem is that they make it convenient for the programmer \nto generate a lot of garbage in the first place. Programmers in conventional \nlanguages, who have to clean up their own garbage, tend to be more careful \nand use static rather than dynamic storage more often. If garbage becomes a \nproblem, the Lisp programmer can just adopt these static techniques. \n\nLisp systems are big and leave little room for other programs. Most Lisp systems \nare designed to be complete environments, within which the programmer \ndoes all program development and execution. For this kind of operation, it \nmakes sense to have a large language like Common Lisp with a huge set of \ntools. However, it is becoming more common to use Lisp as just one component \nin a computing environment that may include UNIX, X Windows, emacs, \nand other interacting programs. In this kind of heterogeneous environment, \nit would be useful to be able to define and run small Lisp processes that do \nnot include megabytes of unused tools. Some recent compilers support this \noption, but it is not widely available yet. \n\nLisp is a complicated high-level language, and it can be difficult for the programmer \nto anticipate the costs of various operations. In general, the problem \nis not that an efficient encoding is impossible but that it is difficult to arrive at \nthat efficient encoding. In a language like C, the experienced programmer has \na pretty good idea how each statement will compile into assembly language \ninstructions. But in Lisp, very similar statements can compile into widely different \nassembly-level instructions, depending on subtle interactions between \nthe declarations given and the capabilities of the compiler. Page 318 gives an \nexample where adding a declaration speeds up a trivial function by 40 times. \nNonexperts do not understand when such declarations are necessary and are \nfrustrated by the seeming inconsistencies. With experience, the expert Lisp \nprogrammer eventually develops a good \"efficiency model,\" and the need for \nsuch declarations becomes obvious. Recent compilers such as CMU's Python \nprovide feedback that eases this learning process. \n\nIn summary. Lisp makes it possible to write programs in a wide variety of styles, \n\nsome efficient, some less so. The programmer who writes Lisp programs in the \n\nsame style as C programs will probably find Lisp to be of comparable speed, perhaps \n\nslightly slower. The programmer who uses some of the more dynamic features of \n\nLisp typically finds that it is much easier to develop a working program. Then, if \n\nthe resulting program is not efficient enough, there will be more time to go back \n\nand improve critical sections. Deciding which parts of the program use the most \n\nresources is called instrumentation. It is foolhardy to try to improve the efficiency of \n\na program without first checking if the improvement will make a real difference. \nOne route to efficiency is to use the Lisp prototype as a specification and reimplement \nthat specification in a lower-level language, such as C or C++. Some commercial \n\n\f\n<a id='page-269'></a>\n\nAI vendors are taking this route. An alternative is to use Lisp as the language for both \nthe prototype and the final implementation. By adding declarations and making \nminor changes to the original program, it is possible to end up with a Lisp program \nthat is similar in efficiency to a C program. \n\nThere are four very general and language-independent techniques for speeding \nup an algorithm: \n\n* Caching the results of computations for later reuse. \n* Compiling so that less work is done at run time. \n* Delaying the computation of partial results that may never be needed. \n* Indexing a data structure for quicker retrieval. \nThis chapter covers each of the four techniques in order. It then addresses the \nimportant problem of instrumentation. The chapter concludes with a case study of \nthe s i mpl i fy program. The techniques outlined here result in a 130-fold speed-up in \nthis program. \n\nChapter 10 concentrates on lower-level \"tricks\" for improving efficiency further. \n\n9.1 Caching Results of Previous Computations: \nMemoization \nWe start with a simple mathematical function to demonstrate the advantages of \ncaching techniques. Later we will demonstrate more complex examples. \n\nThe Fibonacci sequence is defined as the numbers 1,1,2,3,5,8,... where each \nnumber is the sum of the two previous numbers. The most straightforward function \nto compute the nth number in this sequence is as follows: \n\n(defun fib (n) \n\"Compute the nth number in the Fibonacci sequence.\" \n(if (<= . 1) 1 \n\n(+ (fib (- . D) (fib (- . 2))))) \n\nThe problem with this function is that it computes the same thing over and over \nagain. To compute (fib 5) means computing (fib 4) and (fib 3), but (fib 4) \nalso requires (fib 3), they both require (fib 2), and so on. There are ways to rewrite \nthe function to do less computation, but wouldn't it be nice to write the function as \nis, and have it automatically avoid redundant computation? Amazingly, there is \na way to do just that. The idea is to use the function fib to build a new function \nthat remembers previously computed results and uses them, rather than recompute \n\n\f\n<a id='page-270'></a>\n\nthem. This process is called memoization. The function memo below is a higher-order \nfunction that takes a function as input and returns a new function that will compute \nthe same results, but not do the same computation twice. \n\n(defun memo (fn) \n\"Return a memo-function of fn.\" \n(let ((table (make-hash-table))) \n\n#'(lambda (x) \n(multiple-value-bind (val found-p) \n(gethash . table) \n\n(if found-p \nval \n(setf (gethash . table) (funcall fn x))))))) \n\nThe expression (memo #'fib) will produce a function that remembers its results \nbetween calls, so that, for example, if we apply it to 3 twice, the first call will do the \ncomputation of (f i b 3), but the second will just look up the result in a hash table. \nWith f i b traced, it would look like this: \n\n> (setf memo-fib (memo #'fib)) ^ #<CLOSURE -67300731> \n\n> (funcall memo-fib 3) \n(1 ENTER FIB: 3) \n\n(2 ENTER FIB: 2) \n(3 ENTER FIB: 1) \n(3 EXIT FIB: 1) \n(3 ENTER FIB: 0) \n(3 EXIT FIB: 1) \n\n(2 EXIT FIB: 2) \n(2 ENTER FIB: 1) \n(2 EXIT FIB: 1) \n\n(1 EXIT FIB: 3) \n3 \n\n> (funcall memo-fib 3) 3 \n\nThe second time we call memo -fi b with 3 as the argument, the answer is just retrieved \nrather than recomputed. But the problem is that during the computation of (fib \n3), we still compute (f i b 2) multiple times. It would be better if even the internal, \nrecursive calls were memoized, but they are calls to f i b, which is unchanged, not to \nmemo -fib . We can solve this problem easily enough with the function memoi ze: \n\n\f\n<a id='page-271'></a>\n(defun memoize (fn-name) \n\"Replace fn-name's global definition with a memoized version.\" \n(setf (symbol-function fn-name) (memo (symbol-function fn-name)))) \n\nWhen passed a symbol that names a function, memoi ze changes the global definition \nof the function to a memo-function. Thus, any recursive calls will go first to the \nmemo-function, rather than to the original function. This is just what we want. In \nthe following, we contrast the memoized and unmemoized versions of f i b. First, a \ncall to (fi b 5) with f i b traced: \n\n> (fib 5) \n(1 ENTER FIB: 5) \n(2 ENTER FIB: 4) \n(3 ENTER FIB: 3) \n\n(4 ENTER FIB: 2) \n(5 ENTER FIB: 1) \n(5 EXIT FIB: 1) \n(5 ENTER FIB: 0) \n(5 EXIT FIB: 1) \n\n(4 EXIT FIB: 2) \n(4 ENTER FIB: 1) \n(4 EXIT FIB: 1) \n\n(3 EXIT FIB: 3) \n\n(3 ENTER FIB: 2) \n(4 ENTER FIB: 1) \n(4 EXIT FIB: 1) \n(4 ENTER FIB: 0) \n(4 EXIT FIB: 1) \n\n(3 EXIT FIB: 2) \n(2 EXIT FIB: 5) \n(2 ENTER FIB: 3) \n\n(3 ENTER FIB: 2) \n(4 ENTER FIB: 1) \n(4 EXIT FIB: 1) \n(4 ENTER FIB: 0) \n(4 EXIT FIB: 1) \n\n(3 EXIT FIB: 2) \n(3 ENTER FIB: 1) \n(3 EXIT FIB: 1) \n\n(2 EXIT FIB: 3) \n(1 EXIT FIB: 8) \n8 \n\nWe see that (fib 5) and (fib 4) are each computed once, but (fi b 3) is computed \ntwice, (fib 2)threetimes,and (fib 1) five times. Below we call (memoize 'fib) and \nrepeat the calculation. This time, each computation is done only once. Furthermore, \n\n\f\n<a id='page-272'></a>\n\nwhen the computation of (f i b 5) is repeated, the answer is returned immediately \nwith no intermediate computation, and a further call to (f i b 6) can make use of the \nvalueofCfib 5). \n\n> (memoize 'fib) => #<CLOSURE 76626607> \n\n> (fib 5) \n\n(1 ENTER FIB: 5) \n\n(2 ENTER FIB: 4) \n\n(3 ENTER FIB: 3) \n\n(4 ENTER FIB: 2) \n\n(5 ENTER FIB: 1) \n\n(5 EXIT FIB: 1) \n\n(5 ENTER FIB: 0) \n\n(5 EXIT FIB: 1) \n\n(4 EXIT FIB: 2) \n\n(3 EXIT FIB: 3) \n\n(2 EXIT FIB: 5) \n\n(1 EXIT FIB: 8) \n\n8 \n\n> (fib 5) ^ 8 \n\n> (fib 6) => \n\n(1 ENTER FIB: 6) \n\n(1 EXIT FIB: 13) \n\n13 \n\nUnderstanding why this works requires a clear understanding of the distinction \nbetween functions and function names. The original (defun fib ...) form does two \nthings: builds a function and stores it as the symbol -function value of f i b. Within \nthat function there are two references to f i b; these are compiled (or interpreted) as \ninstructions to fetch the symbol - function of f i b and apply it to the argument. \n\nWhat memo i ze does is fetch the original function and transform it with memo to a \nfunction that, when called, will first look in the table to see if the answer is already \nknown. If not, the original function is called, and a new value is placed in the table. \nThe trick is that memoi ze takes this new function and makes it the symbol - function \nvalue of the function name. This means that all the references in the original function \nwill now go to the new function, and the table will be properly checked on each \nrecursive call. One further complication to memo: the function gethash returns both \nthe value found in the table and an indicator of whether the key was present or not. \nWe use mul ti pi e - va 1 ue - bi nd to capture both values, so that we can distinguish the \ncase when nil is the value of the function stored in the table from the case where \nthere is no stored value. \n\nIf you make a change to a memoized function, you need to recompile the original \ndefinition, and then redo the call to memoize. In developing your program, rather \n\n\f\n<a id='page-273'></a>\n\nthan saying (memoize *f), it might be easier to wrap appropriate definitions in a \nmemoi ze form as follows: \n\n(memoize \n(defun f (X) ...) \n) \n\nOr define a macro that combines defun and memoi ze: \n\n(defmacro defun-memo (fn args &body body) \n\"Define a memoized function.\" \n*(memoize (defun ,fn ,args . ,body))) \n\n(defun-memo f (x) ...) \n\nBoth of these approaches rely on the fact that defun returns the name of the function \ndefined. \n\n. (fib n) unmemoized memoized memoized up to \n25 121393 1.1 .010 0 \n26 196418 1.8 .001 25 \n27 317811 2.9 .001 26 \n28 514229 4.7 .001 27 \n29 832040 8.2 .001 28 \n30 1346269 12.4 .001 29 \n31 2178309 20.1 .001 30 \n32 3524578 32.4 .001 31 \n33 5702887 52.5 .001 32 \n34 9227465 81.5 .001 33 \n50 2.0el0 &mdash; .014 34 \n100 5.7e20 &mdash; .031 50 \n200 4.5e41 &mdash; .096 100 \n500 2.2el04 &mdash; .270 200 \n1000 7.0e208 &mdash; .596 500 \n1000 7.0e208 &mdash; .001 1000 \n1000 7.0e208 &mdash; .876 0 \n\nNow we show a table giving the values of (f i b .) for certain n, and the time in \nseconds to compute the value, before and after (memoi ze ' f i b). For larger values \nof ., approximations are shown in the table, although f i b actually returns an exact \ninteger. With the unmemoized version, I stopped at . = 34, because the times were \ngetting too long. For the memoized version, even . = 1000 took under a second. \n\n\f\n<a id='page-274'></a>\n\nNote there are three entries for (f i b 1000). The first entry represents the incremental \ncomputation when the table contains the memoized values up to 500, the \nsecond entry shows the time for a table lookup when (fib 1000) is already computed, \nand the third entry is the time for a complete computation starting with an \nempty table. \n\nIt should be noted that there are two general approaches to discussing the efficiency \nof an algorithm. One is to time the algorithm on representative inputs, as we \ndid in this table. The other is to analyze the asymptotic complexity of the algorithm. For \nthe f i b problem, an asymptotic analysis considers how long it takes to compute (fib \nn) as n approaches infinity. The notation 0(/(n)) is used to describe the complexity. \nFor example, the memoized version f i b is an 0(n) algorithm because the computation \ntime is bounded by some constant times n, for any value of n. The unmemoized \nversion, it turns out, is O (1.7^), meaning computing f i b of n+1 can take up to 1.7 times \nas long as f i b of n. In simpler terms, the memoized version has linear complexity, \nwhile the unmemoized version has exponential complexity. Exercise 9.4 ([page 308](chapter9.md#page-308)) \ndescribes where the 1.7 comes from, and gives a tighter bound on the complexity. \n\nThe version of memo presented above is inflexible in several ways. First, it only \nworks for functions of one argument. Second, it only returns a stored value for \narguments that are eql, because that is how hash tables work by default. For some \napplications we want to retrieve the stored value for arguments that are equa 1. Third, \nthere is no way to delete entries from the hash table. In many applications there are \ntimes when it would be good to clear the hash table, either because it has grown too \nlarge or because we have finished a set of related problems and are moving on to a \nnew problem. \n\nThe versions of memo and memoi ze below handle these three problems. They are \ncompatible with the previous version but add three new keywords for the extensions. \nThe name keyword stores the hash table on the property list of that name, so it can \nbe accessed by cl ear-memoi ze. The test kejword tells what kind of hash table to \ncreate: eq, eql, or equal. Finally, the key keyword tells which arguments of the \nfunction to index under. The default is the first argument (to be compatible with the \nprevious version), but any combination of the arguments can be used. If you want \nto use all the arguments, specify 1 dent i ty as the key. Note that if the key is a Ust of \narguments, then you will have to use equal hash tables. \n\n(defun memo (fn name key test) \n\n\"Return a memo-function of fn. \" \n\n(let ((table (make-hash-table :test test))) \n\n(setf (get name 'memo) table) \n\n#'(lambda (&rest args) \n\n(let ((k (funcall key args))) \n\n(multiple-value-bind (val found-p) \n\n(gethash k table) \n\n(if found-p val \n\n\f\n<a id='page-275'></a>\n(setf (gethash k table) (apply fn args)))))))) \n\n(defun memoize (fn-name &key (key #*first) (test #'eql)) \n\"Replace fn-name's global definition with a memoized version.\" \n(setf (symbol-function fn-name) \n\n(memo (symbol-function fn-name) fn-name key test))) \n\n(defun clear-memoize (fn-name) \n\"Clear the hash table from a memo function.\" \n(let ((table (get fn-name 'memo))) \n\n(when table (clrhash table)))) \n\n9.2 Compiling One Language into Another \nIn chapter 2 we defined a new language—the language of grammar rules—which was \nprocessed by an interpreter designed especially for that language. An interpreter is \na program that looks at some data structure representing a \"program\" or sequence \nof rules of some sort and interprets or evaluates those rules. This is in contrast to a \ncompiler, which translates some set of rules in one language into a program in another \nlanguage. \n\nThe function generate was an interpreter for the \"language\" defined by the set of \ngrammar rules. Interpreting these rules is straightforward, but the process is somewhat \ninefficient, in that generate must continually search through the *gramma r* to \nfind the appropriate rule, then count the length of the right-hand side, and so on. \n\nA compiler for this rule-language would take each rule and translate it into a function. \nThese functions could then call each other with no need to search through the \n*grammar*. We implement this approach with the function compi 1 e - rul e. It makes \nuse of the auxiliary functions one-of and rule-lhs and rule-rhs from [page 40](chapter2.md#page-40), \nrepeated here: \n\n(defun rule-lhs (rule) \n\"The left-hand side of a rule.\" \n(first rule)) \n\n(defun rule-rhs (rule) \n\"The right-hand side of a rule.\" \n(rest (rest rule))) \n\n(defun one-of (set) \n\"Pick one element of set, and make a list of it.\" \n(list (random-elt set))) \n\n\f\n<a id='page-276'></a>\n\n(defun random-elt (choices) \n\"Choose an element from a list at random.\" \n(elt choices (random (length choices)))) \n\nThe function compile-rule turns a rule into a function definition by building up \nLisp code that implements all the actions that generate would take in interpreting \nthe rule. There are three cases. If every element of the right-hand side is an atom, \nthen the rule is a lexical rule, which compiles into a call to one-of to pick a word at \nrandom. If there is only one element of the right-hand side, then bui 1 d - code is called \nto generate code for it. Usually, this will bea call to append to build up a list. Finally, \nif there are several elements in the right-hand side, they are each turned into code \nby build-code; are given a number by build-cases; and then a case statement is \nconstructed to choose one of the cases. \n\n(defun compile-rule (rule) \n\"Translate a grammar rule into a LISP function definition.\" \n(let ((rhs (rule-rhs rule))) \n\n'(defun ,(rule-lhs rule) () \n\n.(cond ((every #*atom rhs) *(one-of '.rhs)) \n((length=1 rhs) (build-code (first rhs))) \n(t '(case (random .(length rhs)) \n\n.(build-cases 0 rhs))))))) \n\n(defun build-cases (number choices) \n\"Return a list of case-clauses\" \n(when choices \n\n(cons (list number (build-code (first choices))) \n(build-cases (+ number 1) (rest choices))))) \n\n(defun build-code (choice) \n\"Append together multiple constituents\" \n(cond ((null choice) nil) \n\n((atom choice) (list choice)) \n((length=1 choice) choice) \n(t '(append .(mapcar #'build-code choice))))) \n\n(defun length=1 (x) \n\"Is X a list of length 1?\" \n(and (consp x) (null (rest x)))) \n\nThe Lisp code built by compile-rule must be compiled or interpreted to make it \navailable to the Lisp system. We can do that with one of the following forms. \nNormally we would want to call compi1 e, but during debugging it may be easier \nnot to. \n\n\f\n<a id='page-277'></a>\n(dolist (rule ^grammar*) (eval (compile-rule rule))) \n(dolist (rule *grammar*) (compile (eval (compile-rule rule)))) \n\nOne frequent way to use compilation is to define a macro that expands into the code \ngenerated by the compiler. That way, we just type in calls to the macro and don't \nhave to worry about making sure all the latest rules have been compiled. We might \nimplement this as follows: \n\n(defmacro defrule (&rest rule) \n\"Define a grammar rule\" \n(compile-rule rule)) \n\n(defrule Sentence -> (NP VP)) \n\n(defrule NP -> (Art Noun)) \n\n(defrule VP -> (Verb NP)) \n\n(defrule Art -> the a) \n\n(defrule Noun -> man ball woman table) \n\n(defrule Verb -> hit took saw liked) \n\nActually, the choice of using one big list of rules (like *g r ammar *) versus using individual \nmacros to define rules is independent of the choice of compiler versus interpreter. \nWecould justas easily definedef rule simply to push the ruleonto*grammar*. Macros \nlike def rul e are useful when you want to define rules in different places, perhaps in \nseveral separate files. The def parameter method is appropriate when all the rules \ncan be defined in one place. \n\nWe can see the Lisp code generated by compi 1 e - rul e in two ways: by passing it \na rule directly: \n\n> (compile-rule '(Sentence -> (NP VP))) \n(DEFUN SENTENCE () \n(APPEND (NP) (VP))) \n\n> (compile-rule '(Noun -> man ball woman table)) \n(DEFUN NOUN () \n(ONE-OF '(MAN BALL WOMAN TABLE))) \n\nor by macroexpanding a def rul e expression. The compiler was designed to produce \nthe same code we were writing in our first approach to the generation problem (see \n[page 35](chapter2.md#page-35)). \n\n\f\n<a id='page-278'></a>\n\n> (macroexpand '(defrule Adj* -> () Adj (AdJ Adj*))) \n(DEFUN ADJ* () \n\n(CASE (RANDOM 3) \n(0 NIL) \n(1 (ADJ)) \n(2 (APPEND (ADJ) (ADJ*))))) \n\nInterpreters are usually easier to write than compilers, although in this case, even \nthe compiler was not too difficult. Interpreters are also inherently more flexible than \ncompilers, because they put off making decisions until the last possible moment. \nFor example, our compiler considers the right-hand side of a rule to be a list of words \nonly if every element is an atom. In all other cases, the elements are treated as \nnonterminals. This could cause problems if we extended the definition of Noun to \ninclude the compound noun \"chow chow\": \n\n(defrule Noun -> man ball woman table (chow chow)) \n\nThe rule would expand into the following code: \n\n(DEFUN NOUN () \n\n(CASE (RANDOM 5) \n(0 (MAN)) \n(1 (BALD) \n(2 (WOMAN)) \n(3 (TABLE)) \n(4 (APPEND (CHOW) (CHOW))))) \n\nThe problem is that ma. and ball and all the others are suddenly treated as functions, \nnot as literal words. So we would get a run-time error notifying us of undefined \nfunctions. The equivalent rule would cause no trouble for the interpreter, which waits \nuntil it actually needs to generate a symbol to decide if it is a word or a nonterminal. \nThus, the semantics of rules are different for the interpreter and the compiler, and \nwe as program implementors have to be very careful about how we specify the actual \nmeaning of a rule. In fact, this was probably a bug in the interpreter version, since \nit effectively prohibits words like \"noun\" and \"sentence\" from occurring as words if \nthey are also the names of categories. One possible resolution of the conflict is to \nsay that an element of a right-hand side represents a word if it is an atom, and a list \nof categories if it is a list. If we did indeed settle on that convention, then we could \nmodify both the interpreter and the compiler to comply with the convention. Another \npossibility would be to represent words as strings, and categories as symbols. \n\nThe flip side of losing run-time flexibility is gaining compile-time diagnostics. For \nexample, it turns out that on the Common Lisp system I am currently using, I get \nsome useful error messages when I try to compile the buggy version of Noun: \n\n\f\n<a id='page-279'></a>\n> (defrule Noun -> man ball woman table (chow chow)) \nThe following functions were referenced but don't seem defined: \n\nCHOW referenced by NOUN \n\nTABLE referenced by NOUN \n\nWOMAN referenced by NOUN \n\nBALL referenced by NOUN \n\nMAN referenced by NOUN \nNOUN \n\nAnother problem with the compilation scheme outlined here is the possibility of name \nclashes. Under the interpretation scheme, the only names used were the function \ngenerate and the variable ^grammar*. With compilation, every left-hand side of a \nrule becomes the name of a function. The grammar writer has to make sure he or \nshe is not using the name of an existing Lisp function, and hence redefining it. Even \nworse, if more than one grammar is being developed at the same time, they cannot \nhave any functions in common. If they do, the user will have to recompile with \nevery switch from one grammar to another. This may make it difficult to compare \ngrammars. The best away around this problem is to use the Common Lisp idea of \npackages, but for small exercises name clashes can be avoided easily enough, so we \nwill not explore packages until section 24.1. \n\nThe major advantage of a compiler is speed of execution, when that makes a \ndifference. For identical grammars running in one particular implementation of \nCommon Lisp on one machine, our interpreter generates about 75 sentences per \nsecond, while the compiled approach turns out about 200. Thus, it is more than twice \nas fast, but the difference is negligible unless we need to generate many thousands of \nsentences. In section 9.6 we will see another compiler with an even greater speed-up. \n\nThe need to optimize the code produced by your macros and compilers ultimately \ndepends on the quality of the underlying Lisp compiler. For example, consider the \nfollowing code: \n\n> (defun fl (n 1) \n(let ((11 (first D) \n(12 (second 1))) \n(expt (* 1 (+ . 0)) \n(- 4 (length (list 11 12)))))) \nFl \n\n> (defun f2 (n 1) (* . n)) F2 \n\n> (disassemble 'fl ) \n6 PUSH ARG 10 ; . \n7 MOVEM PDL-PUSH \n8 * PDL-POP \n9 RETURN PDL-POP \nFl \n\n\f\n<a id='page-280'></a>\n\n> (disassemble 'f2) \n\n6 PUSH ARGO ; . \n\n7 MOVEM PDL-PUSH \n\n8 * PDL-POP \n\n9 RETURN PDL-POP \n\nF2 \n\nThis particular Lisp compiler generates the exact same code for f 1 and f 2. Both \nfimctions square the argument n, and the four machine instructions say, \"Take the \n0th argument, make a copy of it, multiply those two numbers, and return the result.\" \nIt's clear the compiler has some knowledge of the basic Lisp functions. In the case \nof f 1, it was smart enough to get rid of the local variables 11 and 12 (and their \ninitialization), as well as the calls to first, second, length, and 1 i st and most of the \narithmetic. The compiler could do this because it has knowledge about the functions \nlength and 1 i st and the arithmetic functions. Some of this knowledge might be in \nthe form of simplification rules. \n\nAs a user of this compiler, there's no need for me to write clever macros or \ncompilers that generate streamlined code as seen in f 2; I can blindly generate code \nwith possible inefficiencies Uke those in f 1, and assume that the Lisp compiler \nwill cover up for my laziness. With another compiler that didn't know about such \noptimizations, I would have to be more careful about the code I generate. \n\n9.3 Delaying Computation \nBack on [page 45](chapter2.md#page-45), we saw a program to generate all strings derivable from a grammar. \nOne drawback of this program was that some grammars produce an infinite number \nof strings, so the program would not terminate on those grammars. \n\nIt turns out that we often want to deal with infinite sets. Of course, we can't \nenumerate all the elements of an infinite set, but we should be able to represent the \nset and pick elements out one at a time. In other words, we want to be able to specify \nhow a set (or other object) is constructed, but delay the actual construction, perhaps \ndoing it incrementally over time. This soimds like a job for closures: we can specify \nthe set constructor as a function, and then call the function some time later. We will \nimplement this approach with the sjmtax used in Scheme—the macro del ay builds a \nclosure to be computed later, and the function force calls that function and caches \naway the value. We use structures of type del ay to implement this. A delay structure \nhas two fields: the value and the function. Initially, the value field is undefined, and \nthe function field holds the closure that will compute the value. The first time the \ndelay is forced, the function is called, and its result is stored in the value field. The \nfunction field is then set to nil to indicate that there is no need to call the function \nagain. The function force checks if the fimction needs to be called, and returns the \n\n\f\n<a id='page-281'></a>\n\nvalue. If force is passed an argument that is not a delay, it just returns the argument. \n\n(defstruct delay (value nil) (function nil)) \n\n(defmacro delay (&rest body) \n\"A computation that can be executed later by FORCE.\" \n*(make-delay :function #'(lambda () . .body))) \n\n(defun force (x) \n\"Find the value of x. by computing if it is a delay.\" \n(if (not (delay-p x)) \n\n. \n(progn \n(when (delay-function x) \n(setf (delay-value x) \n(funcall (delay-function x))) \n(setf (delay-function x) nil)) \n(delay-value x)))) \n\nHere's an example of the use of del ay. The list . is constructed using a combination \nof normal evaluation and delayed evaluation. Thus, the 1 is printed when . is created, \nbut the 2 is not: \n\n> (setf X (list (print 1) (delay (print 2)))) \n\n1 \n\n(1 #S(DELAY .-FUNCTION (LAMBDA () (PRINT 2)))) \n\nThe second element is evaluated (and printed) when it is forced. But then forcing it \nagain just retrieves the cached value, rather than calling the function again: \n\n> (force (second x)) \n\n2 \n\n2 \n\n> X => (1 #S(DELAY :VALUE 2)) \n\n> (force (second x)) 2 \n\nNow let's see how delays can be used to build infinite sets. An infinite set will be \nconsidered a special case of what we will call a pipe: a list with a first component \nthat has been computed, and a rest component that is either a normal list or a \ndelayed value. Pipes have also been called delayed Usts, generated lists, and (most \ncommonly) streams. We will use the term pipe because stream already has a meaning \nin Common Lisp. The bookArtificial Intelligence Programming (Charniak et al. 1987) \n\n\f\n<a id='page-282'></a>\n\nalso calls these structures pipes, reserving streams for delayed structures that do not \ncache computed results. \n\nTo distinguish pipes from lists, we will use the accessors head and tai 1 instead \nof first and rest. We will also use empty-pipe instead of ni 1, make-pipe instead \nof cons, and pipe-el t instead of el t. Note that make-pipe is a macro that delays \nevaluation of the tail. \n\n(defmacro make-pipe (head tail) \n\"Create a pipe by evaluating head and delaying tail.\" \n'(cons .head (delay .tail))) \n\n(defconstant empty-pipe nil) \n\n(defun head (pipe) (first pipe)) \n(defun tail (pipe)(force (rest pipe))) \n\n(defun pipe-elt (pipe i) \n\"The i-th element of a pipe. 0-based\" \n(if (= i 0) \n\n(head pipe) \n(pipe-elt (tail pipe) (-i 1)))) \n\nHere's a function that can be used to make a large or infinite sequence of integers \nwith delayed evaluation: \n\n(defun integers (&optional (start 0) end) \n\"A pipe of integers from START to END. \nIf END is nil. this is an infinite pipe.\" \n(if (or (null end) (<= start end)) \n\n(make-pipe start (integers (+ start 1) end)) \nnil)) \n\nAnd here is an example of its use. The pipe c represents the numbers from 0 to infinity. \nWhen it is created, only the zeroth element, 0, is evaluated. The computation \nof the other elements is delayed. \n\n> (setf c (integers 0)) ^ (0 . #S(DELAY :FUNCTION #<CLOSURE -77435477>)) \n\n> (pipe-elt c 0) =.> 0 \n\nCalling pi pe - el t to look at the third element causes the first through third elements \nto be evaluated. The numbers 0 to 3 are cached in the correct positions, and further \nelements remain unevaluated. Another call to pi pe-el t with a larger index would \nforce them by evaluating the delayed function. \n\n\f\n<a id='page-283'></a>\n> (pipe-elt c 3) ^ 3 \n\n> c => \n\n(0 . #S(DELAY \n:VALUE \n(1 . #S(DELAY \n:VALUE \n(2 . #S(DELAY \n:VALUE \n(3 . #S(DELAY \n:FUNCTION \n#<CLOSURE -77432724>))))))) \nWhile this seems to work fine, there is a heavy price to pay. Every delayed value must \nbe stored in a two-element structure, where one of the elements is a closure. Thus, \nthere is some storage wasted. There is also some time wasted, as ta . or pi pe-elt \nmust traverse the structures. \n\nAn alternate representation for pipes is as(value. closure) pairs, where the closure \nvalues are stored into the actual cons cells as they are computed. Previously we \nneeded structures of type del ay to distinguish a delayed from a nondelayed object, \nbut in a pipe we know the rest can be only one of three things: nil, a list, or a delayed \nvalue. Thus, we can use the closures directly instead of using del ay structures, if we \nhave some way of distinguishing closures from lists. Compiled closures are atoms, so \nthey can always be distinguished from lists. But sometimes closures are implemented \nas lists beginning with 1 ambda or some other implementation-dependent symbol.^ \nThe built-in function functionp is defined to be true of such lists, as well as of all \nsymbols and all objects returned by compi 1 e. But using functionp means that we \ncan not have a pipe that includes the symbol 1 ambda as an element, because it will be \nconfused for a closure: \n\n> (functionp (last '(theta iota kappa lambda))) ^ . \n\nIf we consistently use compiled functions, then we could eliminate the problem by \ntesting with the built-in predicate compi 1 ed-function-p. The following definitions \ndo not make this assumption: \n\n(defmacro make-pipe (head tail) \n\"Create a pipe by evaluating head and delaying tail.\" \n'(cons .head #'(lambda () .tail))) \n\n^In KCL, the symbol 1 ambda -cl osure is used, and in Allegro, it is excl:. 1 exi cal - cl osure. \n\n\f\n<a id='page-284'></a>\n\n(defun tail (pipe) \n\"Return tail of pipe or list, and destructively update \nthe tail if it is a function.\" \n(if (functionp (rest pipe)) \n\n(setf (rest pipe) (funcall (rest pipe))) \n(rest pipe))) \n\nEverything else remains the same. If we recompile integers (because it uses the \nmacro make -pi pe), we see the following behavior. First, creation of the infinite pipe \nc is similar: \n\n> (setf c (integers 0)) (0 , #<CLOSURE 77350123>) \n\n> (pipe-elt c 0) => 0 \n\nAccessing an element of the pipe forces evaluation of all the intervening elements, \nand as before leaves subsequent elements unevaluated: \n\n> (pipe-elt c 5) => 5 \n\n> c => (0 1 2 3 4 5 . #<CLOSURE 77351636> \n\nPipes can also be used for finite lists. Here we see a pipe of length 11: \n\n> (setf i (integers 0 10)) => (0 . #<CLOSURE 77375357>) \n\n> (pipe-elt i 10) ^ 10 \n\n> (pipe-elt i 11) => NIL \n\n> i ^ (0 1 2 3 4 5 6 7 8 9 10) \n\nClearly, this version wastes less space and is much neater about cleaning up after \nitself. In fact, a completely evaluated pipe turns itself into a list! This efficiency was \ngained at the sacrifice of a general principle of program design. Usually we strive \nto build more complicated abstractions, like pipes, out of simpler ones, like delays. \nBut in this case, part of the functionality that delays were providing was duplicated \nby the cons cells that make up pipes, so the more efficient implementation of pipes \ndoes not use delays at all. \n\nHere are some more utility functions on pipes: \n\n(defun enumerate (pipe &key count key (result pipe)) \n\"Go through all (or count) elements of pipe, \npossibly applying the KEY function. (Try PRINT.)\" \n\nReturns RESULT, which defaults to the pipe itself, \n(if (or (eq pipe empty-pipe) (eql count 0)) \n\n\f\n<a id='page-285'></a>\nresult \n\n(progn \n(unless (null key) (funcall key (head pipe))) \n(enumerate (tail pipe) :count (if count (- count 1)) \n\n:key key :result result)))) \n\n(defun filter (pred pipe) \n\"Keep only items in pipe satisfying pred.\" \n(if (funcall pred (head pipe)) \n\n(make-pipe (head pipe) \n(filter pred (tail pipe))) \n(filter pred (tail pipe)))) \n\nAnd here's an application of pipes: generating prime numbers using the sieve of \nEratosthenes algorithm: \n\n(defun sieve (pipe) \n(make-pipe (head pipe) \n(filter #'(lambda (x) (/= (mod . (headpipe)) 0)) \n(sieve (tail pipe))))) \n\n(defvar *primes* (sieve (integers 2))) \n\n> *primes* ^ (2 . #<CLOSURE 3075345>) \n\n> (enumerate *primes* icount 10) => \n(2 3 5 7 11 13 17 19 23 29 31 . #<CLOSURE 5224472> \n\nFinally, let's return to the problem of generating all strings in a grammar. First we're \ngoing to need some more utility functions: \n\n(defun map-pipe (fn pipe) \n\"Map fn over pipe, delaying all but the first fn call.\" \n(if (eq pipe empty-pipe) \n\nempty-pipe \n(make-pipe (funcall fn (head pipe)) \n(map-pipe fn (tail pipe))))) \n\n(defun append-pipes (x y) \n\"Return a pipe that appends the elements of . and y.\" \n(if (eq X empty-pipe) \n\ny \n(make-pipe (head x) \n(append-pipes (tail x) y)))) \n\n\f\n<a id='page-286'></a>\n\n(defun mappend-pipe (fn pipe) \n\"Lazily map fn over pipe, appending results.\" \n(if (eq pipe empty-pipe) \n\nempty-pipe \n(let ((X (funcall fn (head pipe)))) \n(make-pipe (head x) \n(append-pipes (tail x) \n(mappend-pipe \nfn (tail pipe))))))) \n\nNow we can rewrite generate-all and combine-all to use pipes instead of lists. \nEverything else is the same as on [page 45](chapter2.md#page-45). \n\n(defun generate-all (phrase) \n\"Generate a random sentence or phrase\" \n(if (listp phrase) \n\n(if (null phrase) \n(list nil) \n(combine-all-pipes \n\n(generate-all (first phrase)) \n(generate-all (rest phrase)))) \n(let ((choices (rule-rhs (assoc phrase *grammar*)))) \n\n(if choices \n(mappend-pipe #*generate-all choices) \n(list (list phrase)))))) \n\n(defun combine-all-pipes (xpipe ypipe) \n\"Return a pipe of pipes formed by appending a y to an x\" \n;; In other words, form the cartesian product, \n(mappend-pipe \n\n#'(lambda (y) \n(map-pipe #'(lambda (x) (append-pipes . y)) \nxpipe)) \nypipe)) \n\nWith these definitions, here's the pipe of all sentences from *grammar2* (from \n[page 43](chapter2.md#page-43)): \n\n> (setf ss (generate-all 'sentence)) \n((THE . #<CLOSURE 27265720>) . #<CLOSURE 27266035> \n\n\f\n<a id='page-287'></a>\n\n> (enumerate ss rcount 5) =i> \n\n((THE . #<CLOSURE 27265720>) \n\n(A . #<CLOSURE 27273143> \n(THE . #<CLOSURE 27402545>) \n(A . #<CLOSURE 27404344>) \n(THE . #<CLOSURE 27404527>) \n(A . #<CLOSURE 27405473> . #<CLOSURE 27405600>) \n> (enumerate ss .-count 5 :key #'enumerate) \n\n((THE MAN HIT THE MAN) \n(A MAN HIT THE MAN) \n(THE BIG MAN HIT THE MAN) \n(A BIG MAN HIT THE MAN) \n(THE LITTLE MAN HIT THE MAN) \n(THE . #<CLOSURE 27423236>) . #<CL0SURE 27423343> \n\n> (enumerate (pipe-elt ss 200)) \n\n(THE ADIABATIC GREEN BLUE MAN HIT THE MAN) \n\nWhile we were able to represent the infinite set of sentences and enumerate instances \nof it, we still haven't solved all the problems. For one, this enumeration will never \nget to a sentence that does not have \"hit the man\" as the verb phrase. We will see \nlonger and longer lists of adjectives, but no other change. Another problem is that \nleft-recursive rules will still cause infinite loops. For example, if the expansion for \nAdj*hadbeen (Adj* -> (Adj*Adj) ()) instead of (Adj* -> () (Adj Adj*)), \nthen the enumeration would never terminate, because pipes need to generate a first \nelement. \n\nWe have used delays and pipes for two main purposes: to put off until later \ncomputations that may not be needed at all, and to have an expHcit representation of \nlarge or infinite sets. It should be mentioned that the language Prolog has a different \nsolution to the first problem (but not the second). As we shall see in chapter 11, Prolog \ngenerates solutions one at a time, automatically keeping track of possible backtrack \npoints. Where pipes allow us to represent an infinite number of alternatives in the \ndata, Prolog allows us to represent those alternatives in the program itself. \n\n&#9635; Exercise 9.1 [h] When given a function f and a pipe p. mappend-pipe returns a \nnew pipe that will eventually enumerate all of ( f (first .)), then all of ( f (second \n.)), and so on. This is deemed \"unfair\" if ( f (first .)) has an infinite number of \nelements. Define a function that will fairly interleave elements, so that all of them are \neventually enumerated. Show that the function works by changing generate -a 11 to \nwork with it. \n\n\f\n<a id='page-288'></a>\n\n9.4 Indexing Data \nLisp makes it very easy to use lists as the universal data structure. A list can represent \na set or an ordered sequence, and a list with sublists can represent a tree or graph. \nFor rapid prototyping, it is often easiest to represent data in lists, but for efficiency \nthis is not always the best idea. To find an element in a list of length . will take n/2 \nsteps on average. This is true for a simple list, an association list, or a property list. \nIf . can be large, it is worth looking at other data structures, such as hash tables, \nvectors, property lists, and trees. \n\nPicking the right data structure and algorithm is as important in Lisp as it is in \nany other programming language. Even though Lisp offers a wide variety of data \nstructures, it is often worthwhile to spend some effort on building just the right data \nstructure for frequently used data. For example. Lisp's hash tables are very general \nand thus can be inefficient. You may want to build your own hash tables if, for \nexample, you never need to delete elements, thus making open hashing an attractive \npossibility. We will see an example of efficient indexing in section 9.6 ([page 297](chapter9.md#page-297)). \n\n9.5 Instrumentation: Deciding What \nto Optimize \nBecause Lisp is such a good rapid-prototyping language, we can expect to get a \nworking implementation quickly. Before we go about trying to improve the efficiency \nof the implementation, it is a good idea to see what parts are used most often. \nImproving little-used features is a waste of time. \n\nThe minimal support we need is to count the number of calls to selected functions, \nand then print out the totals. This is called profiling the functions.^ For each function \nto be profiled, we change the definition so that it increments a counter and then calls \nthe original function. \n\nMost Lisp systems have some built-in profiling mechanism. If your system has \none, by all means use it. The code in this section is provided for those who lack such \na feature, and as an example of how functions can be manipulated. The following is \na simple profiling facility. For each profiled function, it keeps a count of the number \nof times it is called under the prof i 1 e - count property of the function's name. \n\n^The terms metering and monitoring are sometimes used instead of profiling. \n\n\f\n<a id='page-289'></a>\n(defun profilel (fn-name) \n\n\"Make the function count how often it is called\" \nFirst save away the old, unprofiled function \nThen make the name be a new function that increments \na counter and then calls the original function \n\n(let ((fn (symbol-function fn-name))) \n(setf (get fn-name 'unprofiled-fn) fn) \n(setf (get fn-name 'profile-count) 0) \n(setf (symbol-function fn-name) \n\n(profiled-fn fn-name fn)) \nfn-name)) \n\n(defun unprofilel (fn-name) \n\"Make the function stop counting how often it is called.\" \n(setf (symbol-function fn-name) (get fn-name 'unprofiled-fn)) \nfn-name) \n\n(defun profiled-fn (fn-name fn) \n\"Return a function that increments the count.\" \n#'(lambda (&rest args) \n\n(incf (get fn-name 'profile-count)) \n\n(apply fn args))) \n\n(defun profile-count (fn-name) (get fn-name 'profile-count)) \n\n(defun profile-report (fn-names &optional (key #'profile-count)) \n\"Report profiling statistics on given functions.\" \n(loop for name in (sort fn-names #'> :key key) do \n\n(format t \"~&~7D ~A\" (profile-count name) name))) \n\nThat's all we need for the bare-bones functionality. However, there are a few ways \nwe could improve this. First, it would be nice to have macros that, like trace and \nuntrace, allow the user to profile multiple functions at once and keep track of what \nhas been profiled. Second, it can be helpful to see the length of time spent in each \nfunction, as well as the number of calls. \n\nAlso, it is important to avoid profiling a function twice, since that would double \nthe number of calls reported without alerting the user of any trouble. Suppose we \nentered the following sequence of commands: \n\n(defun f (X) (g x)) \n(profilel 'f) \n(profilel 'f) \n\nThen the definition of f would be roughly: \n\n\f\n<a id='page-290'></a>\n\n(lambda (&rest args) \n(incf (get 'f 'profile-count)) \n(apply #'(lambda (&rest args) \n\n(incf (get 'f 'profile-count)) \n(apply #'(lambda (x) (g x)) \nargs)) \nargs)) \n\nThe result is that any call to f will eventually call the original f, but only after \nincrementing the count twice. \n\nAnother consideration is what happens when a profiled function is redefined by \nthe user. The only way we could ensure that a redefined function would continue \nprofiling would be to change the definition of the macro defun to look for functions \nthat should be profiled. Changing system functions like defun is a risky prospect, \nand in Common Lisp the Language, 2d edition, it is explicitly disallowed. Instead, \nwe'll do the next best thing: ensure that the next call to prof i 1 e will reprofile any \nfunctions that have been redefined. We do this by keeping track of both the original \nunprofiled function and the profiled function. We also keep a list of all functions \nthat are currently profiled. \n\nIn addition, we will count the amount of time spent in each function. However, \nthe user is cautioned not to trust the timing figures too much. First, they include the \noverhead cost of the profiling facility. This can be significant, particularly because \nthe facility conses, and thus can force garbage collections that would not otherwise \nhave been done. Second, the resolution of the system clock may not be fine enough \nto make accurate timings. For functions that take about 1/10 of a second or more, the \nfigures will be reliable, but for quick functions they may not be. \n\nHere is the basic code for prof i 1 e and unprof i 1 e: \n\n(defvar *profiled-functions* nil \n\"Function names that are currently profiled\") \n\n(defmacro profile (&rest fn-names) \n\"Profile fn-names. With no args, list profiled functions.\" \n'(mapcar #'profilel \n\n(setf *profiled-functions* \n(union *profiled-functions* ',fn-names)))) \n\n(defmacro unprofile (&rest fn-names) \n\"Stop profiling fn-names. With no args, stop all profiling.\" \n'(progn \n\n(mapcar #'unprofilel \n,(if fn-names \",fn-names '*profiled-functions*)) \n(setf *profiled-functions* \n.(if (null fn-names) \nnil \n\n\f\n<a id='page-291'></a>\n'(set-difference *profiled-functions* \n*,fn-names))))) \n\nThe idiom *',fn-names deserves comment, since it is common but can be confusing \nat first. It may be easier to understand when written in the equivalent form \n' (quote ,fn-names). As always, the backquote builds a structure with both constant \nand evaluated components. In this case, the quote is constant and the variable \nfn-names is evaluated. In MacLisp, the function kwote was defined to serve this \npurpose: \n\n(defun kwote (x) (list 'quote x)) \n\nNow we need to change prof i1 el and unprof i1 el to do the additional bookkeeping: \nFor prof i1 el, there are two cases. If the user does a prof i 1 el on the same function \nname twice in a row, then on the second time we will notice that the current function \nis the same as the functioned stored under the profiled-fn property, so nothing \nmore needs to be done. Otherwise, we create the profiled function, store it as the \ncurrent definition of the name under the prof i1 ed-f . property, save the unprofiled \nfunction, and initialize the counts. \n\n(defun profilel (fn-name) \n\n\"Make the function count how often it is called\" \nFirst save away the old, unprofiled function \nThen make the name be a new function that increments \na counter and then calls the original function \n\n(let ((fn (symbol-function fn-name))) \n(unless (eq fn (get fn-name 'profiled-fn)) \n(let ((new-fn (profiled-fn fn-name fn))) \n\n(setf (symbol-function fn-name) new-fn \n(get fn-name 'profiled-fn) new-fn \n(get fn-name 'unprofiled-fn) fn \n(get fn-name 'profile-time) 0 \n(get fn-name 'profile-count) 0)))) \n\nfn-name) \n\n(defun unprofilel (fn-name) \n\"Make the function stop counting how often it is called.\" \n(setf (get fn-name 'profile-time) 0) \n(setf (get fn-name 'profile-count) 0) \n(when (eq (symbol-function fn-name) (get fn-name 'profiled-fn)) \n\n;; normal case: restore unprofiled version \n(setf (symbol-function fn-name) \n(get fn-name 'unprofiled-fn))) \nfn-name) \n\n\f\n<a id='page-292'></a>\n\nNow we look into the question of timing. There is a built-in Common Lisp function, \nget-internal -real -time, that returns the elapsed time since the Lisp session \nstarted. Because this can quickly become a bignum, some implementations \nprovide another timing function that wraps around rather than increasing forever, \nbut which may have a higher resolution than get-internal - real - time. For example, \non TI Explorer Lisp Machines, get-internal-real-time measures 1/60second \nintervals, while time:microsecond-time measures l/l,000,000-second intervals, \nbut the value returned wraps around to zero every hour or so. The function \ntime:microsecond-time-difference is used to compare two of these numbers \nwith compensation for wraparound, as long as no more than one wraparound \nhas occurred. \n\nIn the code below, I use the conditional read macro characters #+ and #- to define \nthe right behavior on both Explorer and non-Explorer machines. We have seeen \nthat # is a special character to the reader that takes different action depending on \nthe following character. For example, #' f . is read as (function f .). The character \nsequence #+ is defined so that ^+feature expression reads as expression if thefeature is \ndefined in the current implementation, and as nothing at all if it is not. The sequence \n#- acts in just the opposite way. For example, on a TI Explorer, we would get the \nfollowing: \n\n> '(hi #+TI t #+Symbolics s #-Explorer e #-Mac m) ^ (HI . .) \n\nThe conditional read macro characters are used in the following definitions: \n\n(defun get-fast-time () \n\"Return the elapsed time. This may wrap around; \nuse FAST-TIME-DIFFERENCE to compare.\" \n#+Explorer (time:microsecond-time) ; do this on an Explorer \n#-Explorer (get-internal-real-time)) ; do this on a non-Explorer \n\n(defun fast-time-difference (end start) \n\"Subtract two time points.\" \n#+Explorer (time:microsecond-time-difference end start) \n#-Explorer (- end start)) \n\n(defun fast-time->seconds (time) \n\"Convert a fast-time interval into seconds.\" \n#+Explorer (/ time 1000000.0) \n#-Explorer (/ time internal-time-units-per-second)) \n\nThe next step is to update prof i1 ed - f . to keep track of the timing data. The simplest \nway to do this would be to set a variable, say start, to the time when a function is \nentered, run the function, and then increment the function's time by the difference between \nthe current time and start. The problem with this approach is that every func\n\n\n\f\n<a id='page-293'></a>\ntion in the call stack gets credit for the time of each called function. Suppose the function \nf calls itself recursively five times, with each call and return taking place a second \napart, so that the whole computation takes nine seconds. Then f will be charged nine \nseconds for the outer call, seven seconds for the next call, and so on, for a total of \n25 seconds, even though in reality it only took nine seconds for all of them together. \n\nA better algorithm would be to charge each function only for the time since the \nlast call or return. Then f would only be charged the nine seconds. The variable \n*prof i le-call -stack* is used to holdastack of functionname/entry time pairs. This \nstack is manipulated by prof i 1 e-enter and prof i 1 e-exi t to get the right timings. \n\nThe functions that are used on each call to a profiled function are declared inline. \nIn most cases, a call to a function compiles into machine instructions that set up the \nargument list and branch to the location of the function's definition. With an i nl i ne \nfunction, the body of the function is compiled in line at the place of the function \ncall. Thus, there is no overhead for setting up the argument list and branching to the \ndefinition. An i nl i ne declaration can appear anywhere any other declaration can \nappear. In this case, the function proel aim is used to register a global declaration. \nInline declarations are discussed in more depth on [page 317](chapter10.md#page-317). \n\n(proclaim '(inline profile-enter profile-exit inc-profile-time)) \n\n(defun profiled-fn (fn-name fn) \n\"Return a function that increments the count, and times.\" \n#'(lambda (&rest args) \n\n(profile-enter fn-name) \n\n(multiple-value-progl \n(apply fn args) \n(profile-exit fn-name)))) \n\n(defvar *profile-call-stack* nil) \n\n(defun profile-enter (fn-name) \n(incf (get fn-name 'profile-count)) \n(unless (null *profile-call-stack*) \n\nTime charged against the calling function: \n(inc-profile-time (first *profile-call-stack*) \n\n(car (first *profile-call-stack*)))) \n;; Put a new entry on the stack \n(push (cons fn-name (get-fast-time)) \n\n*profi le-call-stack*)) \n\n(defun profile-exit (fn-name) \nTime charged against the current function: \n(inc-profile-time (pop *profile-call-stack*) \nfn-name) \nChange the top entry to reflect current time \n(unless (null *profile-call-stack*) \n(setf (cdr (first *profile-call-stack*)) \n(get-fast-time)))) \n\n\f\n<a id='page-294'></a>\n\n(defun inc-profile-time (entry fn-name) \n(incf (get fn-name 'profile-time) \n(fast-time-difference (get-fast-time) (cdr entry)))) \n\nFinally, we need to update prof i 1 e- report to print the timing data as well as the \ncounts. Note that the default f .- names is a copy of the global list. That is because we \npass f .- names to sort, which is a destructive function. We don't want the global list \nto be modified as a result of this sort. \n\n(defun profile-report (&optional \n(fn-names (copy-list *profiled-functions*)) \n(key #'profile-count)) \n\n\"Report profiling statistics on given functions.\" \n(let ((total-time (reduce #'+ (mapcar #'profile-time fn-names)))) \n(unless (null key) \n(setf fn-names (sort fn-names #'> :key key))) \n(format t \"~&Total elapsed time: ~d seconds.\" \n\n(fast-time->seconds total-time)) \n(format t \"~& Count Sees Time% Name\") \n(loop for name in fn-names do \n\n(format t \"~&~7D ~6,2F  ~3d% ~A\" \n(profile-count name) \n(fast-time->seconds (profile-time name)) \n(round (/ (profile-time name) total-time) .01) \nname)))) \n\n(defun profile-time (fn-name) (get fn-name 'profile-time)) \n\nThese functions can be used by calling profile, then doing some representative com\n\n\nputation, then calling prof i 1 e - report, and finally unprof i 1 e. It can be convenient \n\nto provide a single macro for doing all of these at once: \n\n(defmacro with-profiling (fn-names &rest body) \n\n'(progn \n(unprofile . ,fn-names) \n(profile . .fn-names) \n(setf *profile-call-stack* nil) \n(unwind-protect \n\n(progn . .body) \n(profile-report',fn-names) \n(unprofile . .fn-names)))) \n\nNote the use of unwi nd - protect to produce the report and call unprof i 1 e even if the \ncomputation is aborted, unwind-protect is a special form that takes any number \nof arguments. It evaluates the first argument, and if all goes well it then evaluates \n\n\f\n<a id='page-295'></a>\nthe other arguments and returns the first one, just like progl. But if an error occurs \nduring the evaluation of the first argument and computation is aborted, then the \nsubsequent arguments (called cleanup forms) are evaluated anyway. \n\n9.6 A Case Study in Efficiency: The \nSIMPLIFY Program \nSuppose we wanted to speed up the simplify program of chapter 8. This section \nshows how a combination of general techniques—memoizing, indexing, and \ncompiling—can be used to speed up the program by a factor of 130. Chapter 15 will \nshow another approach: replace the algorithm with an entirely different one. \n\nThe first step to a faster program is defining a benchmark, a test suite representing \na typical work load. The following is a short list of test problems (and their answers) \nthat are typical of the s impli f y task. \n\n(defvar nest-data* (mapcar #'infix->prefix \n\n'((d (a*x^2 + b*x + c)/dx) \n(d ((a * . 2 + b * . + c) / x) / d x) \n(d ((a * . ^ 3 + b * . ^ 2 + c * . + d) / . ^ 5) / d x) \n((sin (X + X)) * (sin (2 * x)) + (cos (d (x ^ 2) / d x)) ^ 1) \n(d (3 * X + (cos X) / X) / d X)))) \n(defvar ^^answers* (mapcar #'simplify *test-data*)) \n\nThe function test-it runs through the test data, making sure that each answer is \ncorrect and optionally printing profiling data. \n\n(defun test-it (&optional (with-profiling t)) \n\"Time a test run, and make sure the answers are correct.\" \n(let ((answers \n\n(if with-profiling \n(with-profiling (simplify simplify-exp pat-match \nmatch-variable variable-p) \n(mapcar #*simplify nest-data*)) \n\n(time (mapcar #'simplify *test-data*))))) \n(mapc #*assert-equal answers *answers*) \nt)) \n\n(defun assert-equal (x y) \n\"If X is not equal to y, complain.\" \n(assert (equal . y) (. y) \n\n\"Expected \"a to be equal to ~a\" . y)) \n\nHere are the results of (test - i t) with and without profiling: \n\n\f\n<a id='page-296'></a>\n\n> (test-it nil) \nEvaluation of (MAPCAR #'SIMPLIFY *TEST-DATA*) took 6.612 seconds. \n\n> (test-it t) \nTotal elapsed time: 22.819614 seconds. \n\nCount Sees Time% Name \n51690 11.57 51% PAT-MATCH \n37908 8.75 38% VARIABLE-P \n1393 0.32 1% MATCH-VARIABLE \n906 0.20 1% SIMPLIFY \n274 1.98 9% SIMPLIFY-EXP \n\nRunning the test takes 6.6 seconds normally, although the time triples when the \nprofiling overhead is added in. It should be clear that to speed things up, we have \nto either speed up or cut down on the number of calls to pat-match or vari abl e-p, \nsince together they account for 89% of the calls (and 89% of the time as well). We \nwill look at three methods for achieving both those goals. \n\nMemoization \n\nConsider the rule that transforms (x + x) into (2 * .). Once this is done, we have \nto simplify the result, which involves resimplifying the components. If x were some \ncomplex expression, this could be time-consuming, and it will certainly be wasteful, \nbecause . is already simplified and cannot change. We have seen this type of problem \nbefore, and the solution is memoization: make simpl i fy remember the work it has \ndone, rather than repeating the work. We can just say: \n\n(memoize 'simplify :test #'equal) \n\nTwo questions are unclear: what kind of hash table to use, and whether we should \nclear the hash table between problems. The simplifier was timed for all four combinations \nof eq or equal hash tables and resetting or nonresetting between problems. \nThe fastest result was equal hashing and nonresetting. Note that with eq hashing, \nthe resetting version was faster, presumably because it couldn't take advantage of \nthe common subexpressions between examples (since they aren't eq). \n\nhashing resetting time \nnone — 6.6 \nequal yes 3.8 \nequal no 3.0 \neq yes 7.0 \neq no 10.2 \n\n\f\n<a id='page-297'></a>\nThis approach makes the function simpl i fy remember the work it has done, in \na hash table. If the overhead of hash table maintenance becomes too large, there is \nan alternative: make the data remember what simplify has done. This approach was \ntaken in MACSYMA: it represented operators as lists rather than as atoms. Thus, instead \nof (* 2 X), MACSYMA would use ((*) 2 .). The simplification function would \ndestructively insert a marker into the operator list. Thus, the result of simplifying 2x \nwould be ((* s i mp) 2 .). Then, when the simplifier was called recursively on this \nexpression, it would notice the s i mp marker and return the expression as is. \n\nThe idea of associating memoization information with the data instead of with the \nfunction will be more efficient unless there are many functions that all want to place \ntheir marks on the same data. The data-oriented approach has two drawbacks: it \ndoesn't identify structures that are equal but not eq, and, because it requires explicitly \naltering the data, it requires every other operation that manipulates the data to know \nabout the markers. The beauty of the hash table approach is that it is transparent; no \ncode needs to know that memoization is taking place. \n\nIndexing \n\nWe currently go through the entire list of rules one at a time, checking each rule. This \nis inefficient because most of the rules could be trivially ruled out—if only they were \nindexed properly. The simplest indexing scheme would be to have a separate list \nof rules indexed under each operator. Instead of having simpl ify-exp check each \nmember of *s i mpl i f i cat i on - rul es*, it could look only at the smaller list of rules for \nthe appropriate operator. Here's how: \n\n(defun simplify-exp (exp) \n\"Simplify using a rule, or by doing arithmetic, \nor by using the simp function supplied for this operator. \nThis version indexes simplification rules under the operator.\" \n(cond ((simplify-by-fn exp)) \n\n((rule-based-translator exp (rules-for (exp-op exp)) \n:rule-if #'exp-lhs :rule-then #'exp-rhs \n:action #'(lambda (bindings response) \n\n(simplify (sublis bindings response))))) \n((evaluable exp) (eval exp)) \n(t exp))) \n\n(defvar *rules-for* (make-hash-table :test #*eq)) \n\n(defun main-op (rule) (exp-op (exp-lhs rule))) \n\n\f\n<a id='page-298'></a>\n\n(defun index-rules (rules) \n\"Index all the rules under the main op.\" \n(clrhash *rules-for*) \n(dolist (rule rules) \n\n:; nconc instead of push to preserve the order of rules \n(setf (gethash (main-op rule) *rules-for*) \n(nconc (gethash (main-op rule) *rules-for*) \n(list rule))))) \n\n(defun rules-for (op) (gethash op *rules-for*)) \n\n(i ndex-rules *s i mpli fi cati on-rul es*) \n\nTiming the memoized, indexed version gets us to .98 seconds, down from 6.6 seconds \nfor the original code and 3 seconds for the memoized code. If this hadn't helped, we \ncould have considered more sophisticated indexing schemes. Instead, we move on \nto consider other means of gaining efficiency. \n\n&#9635; Exercise 9.2 [m] The list of rules for each operator is stored in a hash table with \nthe operator as key. An alternative would be to store the rules on the property list \nof each operator, assuming operators must be symbols. Implement this alternative, \nand time it against the hash table approach. Remember that you need some way of \nclearing the old rules—trivial with a hash table, but not automatic with property lists. \n\nCompilation \n\nYou can look at simpl i fy-exp as an interpreter for the simplification rule language. \nOne proven technique for improving efficiency is to replace the interpreter with a \ncompiler. Forexample, the rule (x + . = 2 * .) could be compiled into something \nlike: \n\n(lambda (exp) \n(if (and (eq (exp-op exp) '+) (equal (exp-lhs exp) (exp-rhs exp))) \n(make-exp :op '* :lhs 2 :rhs (exp-rhs exp)))) \n\nThis eliminates the need for consing up and passing around variable bindings, and \nshould be faster than the general matching procedure. When used in conjunction \nwith indexing, the individual rules can be simpler, because we already know we have \nthe right operator. For example, with the above rule indexed under \"->-\", it could now \nbe compiled as: \n\n\f\n<a id='page-299'></a>\n(lambda (exp) \n(if (equal (exp-lhs exp) (exp-rhs exp)) \n(make-exp :op '* :lhs 2 :rhs (exp-lhs exp)))) \n\nIt is important to note that when these functions return nil, it means that they \nhave failed to simplify the expression, and we have to consider another means of \nsimplification. \n\nAnother possibility is to compile a set of rules all at the same time, so that the \nindexing is in effect part of the compiled code. As an example, I show here a small set \nof rules and a possible compilation of the rule set. The generated function assumes \nthat . is not an atom. This is appropriate because we are replacing simpl 1 fy-exp, \nnot simpl ify. Also, we will return nil to indicate that . is already simplified. I \nhave chosen a slightly different format for the code; the main difference is the let \nto introduce variable names for subexpressions. This is useful especially for deeply \nnested patterns. The other difference is that I explicitly build up the answer with a \ncall to 1 i St, rather than make-exp. This is normally considered bad style, but since \nthis is code generated by a compiler, I wanted it to be as efficient as possible. If the \nrepresentation of the exp data type changed, we could simply change the compiler; a \nmuch easier task than hunting down all the references spread throughout a human-\nwritten program. The comments following were not generated by the compiler. \n\n(x * 1 = x) \n(1 * . = x) \n(x * 0 = 0) \n(0 * . = 0) \n(X * X = . ^ 2) \n\n(lambda (x) \n(let ((xT (exp-lhs x)) \n(xr (exp-rhs x))) \n(or (if (eql xr *1) \nxl) \n(if (eql xl *1) \nxr) \n(if (eql xr *0) \n.) \n(if (eql xl .) \n.) \n(if (equal xr xl) \n(list Xl '2))))) \n\n; (x 1 = X) \n; (1 ' X = X) \n; (X ' 0 = 0) \n; (0 ' X = 0) \n: (X * X = X ^ 2) \n\nI chose this format for the code because I imagined (and later show) that it would be \nfairly easy to write the compiler for it. \n\n\f\n<a id='page-300'></a>\n\nThe Single-Rule Compiler \n\nHere I show the complete single-rule compiler, to be followed by the indexed-rule-set \ncompiler. The single-rule compiler works like this: \n\n> (compile-rule '(= (+ . x) (* 2 x))) \n(LAMBDA (X) \n(IF (OP? X '+) \n(LET ((XL (EXP-LHS X)) \n(XR (EXP-RHS X))) \n(IF (EQUAL XR XL) \n(SIMPLIFY-EXP (LIST '* '2 XL)))))) \n\nGiven a rule, it generates code that first tests the pattern and then builds the right-\nhand side of the rule if the pattern matches. As the code is generated, correspondences \nare built between variables in the pattern, like x, and variables in the generated \ncode, like xl. These are kept in the association Ust *bi ndi ngs*. The matching can be \nbroken down into four cases: variables that haven't been seen before, variables that \nhave been seen before, atoms, and lists. For example, the first time we run across \n. in the rule above, no test is generated, since anything can match x. But the entry \n\n(x . xl) is added to the *bi ndi ngs* Hst to mark the equivalence. When the second . \nis encountered, the test (equal xr xl) is generated. \nOrganizing the compiler is a little tricky, because we have to do three things at \nonce: return the generated code, keep track of the *b i ndi ngs*, andkeep track of what \nto do \"next\"—that is, when a test succeeds, we need to generate more code, either \nto test further, or to build the result. This code needs to know about the bindings, \nso it can't be done before the first part of the test, but it also needs to know where it \nshould be placed in the overall code, so it would be messy to do it after the first part \nof the test. The answer is to pass in a function that will tell us what code to generate \nlater. This way, it gets done at the right time, and ends up in the right place as well. \nSuch a function is often called a continuation, because it tells us where to continue \ncomputing. In our compiler, the variable consequent is a continuation function. \n\nThe compiler is called compi 1 e - rul e. It takes a rule as an argument and returns \na lambda expression that implements the rule. \n\n(defvar *bindings* nil \n\"A list of bindings used by the rule compiler.\") \n\n(defun compile-rule (rule) \n\"Compile a single rule.\" \n(let ((*bindings* nil)) \n\n'(lambda (x) \n,(compile-exp 'x (exp-lhs rule) ; . is the lambda parameter \n(delay (build-exp (exp-rhs rule) \n\n\f\n<a id='page-301'></a>\n^bindings*)))))) \n\nAll the work is done by compi 1 e-exp, which takes three arguments: a variable that \nwill represent the input in the generated code, a pattern that the input should be \nmatched against, and a continuation for generating the code if the test passes. There \nare five cases: (1) If the pattern is a variable in the list of bindings, then we generate \nan equality test. (2) If the pattern is a variable that we have not seen before, then \nwe add it to the binding list, generate no test (because anything matches a variable) \nand then generate the consequent code. (3) If the pattern is an atom, then the match \nsucceeds only if the input is eql to that atom. (4) If the pattern is a conditional like \n(?i s . numberp), then we generate the test (numberp .). Other such patterns could \nbe included here but have not been, since they have not been used. Finally, (5) if the \npattern is a list, we check that it has the right operator and arguments. \n\n(defun compile-exp (var pattern consequent) \n\"Compile code that tests the expression, and does consequent \nif it matches. Assumes bindings in *bindings*.\" \n(cond ((get-binding pattern *bindings*) \n\nTest a previously bound variable \n*(if (equal ,var ,(lookup pattern *bindings*)) \n,(force consequent))) \n\n((variable-p pattern) \n;; Add a new bindings; do type checking if needed, \n(push (cons pattern var) *bindings*) \n(force consequent)) \n\n((atom pattern) \nMatch a literal atom \n*(if (eql ,var pattern) \n,(force consequent))) \n((starts-with pattern '?is) \n(push (cons (second pattern) var) *bindings*) \n\n'(if(,(third pattern) ,var) \n,(force consequent))) \n;; So, far, only the ?is pattern is covered, because \n;; it is the only one used in simplification rules. \n;; Other patterns could be compiled by adding code here. \n\nOr we could switch to a data-driven approach, \n(t Check the operator and arguments \n'(if (op? ,var *,(exp-op pattern)) \n,(compile-args var pattern consequent))))) \n\nThe function compi 1 e - a rgs is used to check the arguments to a pattern. It generates \na let form binding one or two new variables (for a unary or binary expression), and \nthen calls compi 1 e-exp to generate code that actually makes the tests. It just passes \nalong the continuation, consequent, to compi 1 e-exp. \n\n\f\n<a id='page-302'></a>\n\n(defun compile-args (var pattern consequent) \n\"Compile code that checks the arg or args, and does consequent \nif the arg(s) match.\" \n\nFirst make up variable names for the arg(s). \n(let ((L (symbol var 'D) \n(R (symbol var 'R))) \n(if (exp-rhs pattern) \n;; two arg case \n\n'(let ((,L (exp-lhs ,var)) \n(,R (exp-rhs ,var))) \n,(compile-exp L (exp-lhs pattern) \n(delay \n(compile-exp R (exp-rhs pattern) \nconsequent)))) \none arg case \n\n'(let ((,L (exp-lhs ,var))) \n,(compile-exp L (exp-lhs pattern) consequent))))) \nThe remaining functions are simpler, bui 1 d-exp generates code to build the right-\nhand side of a rule, op? tests if its first argument is an expression with a given \noperator, and symbol constructs a new symbol. Also given is new-symbol, although \nit is not used in this program. \n\n(defun build-exp (exp bindings) \n\"Compile code that will build the exp, given the bindings.\" \n(cond ((assoc exp bindings) (rest (assoc exp bindings))) \n\n((variable-p exp) \n(error \"Variable ~a occurred on right-hand side,~ \n\nbut not left.\" exp)) \n((atom exp) \",exp) \n(t (let ((new-exp (mapcar #*(lambda (x) \n\n(build-exp . bindings)) \nexp))) \n\n'(simplify-exp (list .,new-exp)))))) \n(defun op? (exp op) \n\"Does the exp have the given op as its operator?\" \n(and (exp-p exp) (eq (exp-op exp) op))) \n\n(defun symbol (&rest args) \n\"Concatenate symbols or strings to form an interned symbol\" \n(intern (format nil \"-{-a^}\" args))) \n\n(defun new-symbol (&rest args) \n\"Concatenate symbols or strings to form an uninterned symbol\" \n(make-symbol (format nil \"'\"{^a\"}\" args))) \n\n\f\n<a id='page-303'></a>\nHere are some examples of the compiler: \n\n> (compile-rule '(= (log (^ e x)) x)) \n(LAMBDA (X) \n(IF (OP? X 'LOG) \n(LET ((XL (EXP-LHS X))) \n(IF (OP? XL \n(LET ((XLL (EXP-LHS XL)) \n(XLR (EXP-RHS XL))) \n(IF (EQL XLL .) \nXLR)))))) \n\n> (compile-rule (simp-rule '(n * (m * x) = (n * m) * x))) \n(LAMBDA (X) \n(IF (OP? X .*) \n(LET ((XL (EXP-LHS X)) \n(XR (EXP-RHS X))) \n(IF (NUMBERP XL) \n(IF (OP? XR '*) \n(LET ((XRL (EXP-LHS XR)) \n(XRR (EXP-RHS XR))) \n(IF (NUMBERP XRL) \n(SIMPLIFY-EXP \n\n(LIST .* \n(SIMPLIFY-EXP (LIST '* XL XRL)) \nXRR))))))))) \n\nThe Rule-Set Compiler \n\nThe next step is to combine the code generated by this single-rule compiler to generate \nmore compact code for sets of rules. We'll divide up the complete set of rules into \nsubsets based on the main operator (as we did with the rules-for function), and \ngenerate one big function for each operator. We need to preserve the order of the \nrules, so only certain optimizations are possible, but if we make the assumption \nthat no function has side effects (a safe assumption in this application), we can \nstill do pretty well. We'll use the simp-fn facility to install the one big function for \neach operator. \n\nThe function compi1 e - rul e- set takes an operator, finds all the rules for that operator, \nand compiles each rule individually. (It uses compi1 e -i ndexed -rule rather than \ncompi 1 e -rul e, because it assumes we have already done the indexing for the main operator.) \nAfter each rule has been compiled, they are combined with combi ne- rul es, \nwhich merges similar parts of rules and concatenates the different parts. The result \nis wrapped in a 1 ambda expression and compiled as the final simplification function \nfor the operator. \n\n\f\n<a id='page-304'></a>\n\n(defun compile-rule-set (op) \n\"Compile all rules indexed under a given main op. \nand make them into the simp-fn for that op.\" \n(set-simp-fn op \n\n(compile nil \n'(lambda (x) \n.(reduce #'combine-rules \n(mapcar #*compile-indexed-rule \n(rules-for op))))))) \n\n(defun compile-indexed-rule (rule) . \n\"Compile one rule into lambda-less code, \nassuming indexing of main op.\" \n(let ((*bindings* nil)) \n\n(compile-args \n'x (exp-lhs rule) \n\n(delay (build-exp (exp-rhs rule) ^bindings*))))) \n\nHere are two examples of what compi 1 e - i ndexed - rul e generates: \n> (compile-indexed-rule '(= (log 1) 0)) \n(LET ((XL (EXP-LHS X))) \n(IF (EQL XL .) \n.)) \n\n> (compile-indexed-rule *(= (log (\" e x)) x)) \n(LET ((XL (EXP-LHS X))) \n(IF (OP? XL *n \n(LET ((XLL (EXP-LHS XL)) \n(XLR (EXP-RHS XL))) \n(IF (EQL XLL .) \nXLR)))) \n\nThenextstepis to combine several of these rules into one. The function comb i ne- rul es \ntakes two rules and merges them together as much as possible. \n\n(defun combine-rules (a b) \n\n\"Combine the code for two rules into one, maintaining order.\" \nIn the default case, we generate the code (or a b), \nbut we try to be cleverer and share common code, \non the assumption that there are no side-effects, \n\n(cond ((and distp a) distp b) \n(= (length a) (length b) 3) \n(equal (first a) (first b)) \n(equal (second a) (second b))) \n\n;; a=(f . y), b=(f . .) => (f . (combine-rules y .)) \nThis can apply when f=IF or f=LET \n\n\f\n<a id='page-305'></a>\n(list (first a) (second a) \n\n(combine-rules((matching-ifs a b) \n\n'(if .(second a) \n.(combine-rules.(combine-rules\n\n((starts-with a Or) \n\n (third a) (third b)))) \n\n (third a) (third b)) \n(fourth a) (fourth b)))) \n\na=(or ... (if . y)). b=(if . .) => \n(or ... (if . (combine-rules y .))) \n\nelse \na=(or ...) b => (or ... b) \n(if (matching-ifs (lastl a) b) \n(append (butlast a) \n(list (combine-rules(append a (list b)))) \n(t a. b => (or a b) \n'(or .a .b)))) \n\n(defun matching-ifs (a b) \n\n (lastl a) b))) \n\n\"Are a and b if statements with the same predicate?\" \n(and (starts-with a 'if) (starts-with b 'if) \n(equal (second a) (second b)))) \n\n(defun lastl (list) \n\"Return the last element (not last cons cell) of list\" \n(first (last list))) \n\nHere is what combi ne- rul es does with the two rules generated above: \n\n> (combine-rules \n'(let ((xl (exp-lhs x))) (if (eql xl .) .)) \n'(let ((xl (exp-lhs x))) \n\n(if (op? xl '^) \n(let ((xll (exp-lhs xD) \n(xlr (exp-rhs xl))) \n(if (eql xll 'e) xlr))))) \n(LET ((XL (EXP-LHS X))) \n(OR (IF (EQL XL .) .) \n(IF (OP? XL \"^) \n(LET ((XLL (EXP-LHS XL)) \n(XLR (EXP-RHS XL))) \n(IF (EQL XLL .) XLR))))) \n\nNow we run the compiler by calling compi 1 e-all - rul es-indexed and show the \ncombined compiled simplification function for 1 og. The comments were entered by \nhand to show what simplification rules are compiled where. \n\n\f\n<a id='page-306'></a>\n\n(defun compile-all-rules-indexed (rules) \n\"Compile a separate fn for each operator, and store it \nas the simp-fn of the operator.\" \n(index-rules rules) \n(let ((all-ops (delete-duplicates (mapcar #*main-op rules)))) \n\n(mapc #'compile-rule-set all-ops))) \n\n> (compile-all-rules-indexed *simplification-rules*) \n(SIN COS LOG ^ * / - + D) \n\n> (simp-fn 'log) \n(LAMBDA (X) \n(LET ((XL (EXP-LHS X))) \n(OR (IF (EQL XL .) \n.) logl = 0 \n(IF (EQL XL .) \n'UNDEFINED) log 0 -undefined \n(IF (EQL XL '.) \n.) loge = l \n(IF (OP? XL '^) \n(LET ((XLL (EXP-LHS XL)) \n(XLR (EXP-RHS XL))) \n(IF (EQL XLL .) \nXLR)))))) lloge\"\" = X \n\nIf we want to bypass the rule-based simplifier altogether, we can change si mp1 i fy- exp \nonce again to eliminate the check for rules: \n\n(defun simplify-exp (exp) \n\"Simplify by doing arithmetic, or by using the simp function \nsupplied for this operator. Do not use rules of any kind.\" \n(cond ((simplify-by-fn exp)) \n\n((evaluable exp) (eval exp)) \n(t exp))) \n\nAt last, we are in a position to run the benchmark test on the new compiled code; the \nfunction test -it runs in about .15 seconds with memoization and .05 without. Why \nwould memoization, which helped before, now hurt us? Probably because there is a \nlot of overhead in accessing the hash table, and that overhead is only worth it when \nthere is a lot of other computation to do. \n\nWe've seen a great improvement since the original code, as the following table \nsummarizes. Overall, the various efficiency improvements have resulted in a 130fold \nspeed-up—we can do now in a minute what used to take two hours. Of course, \none must keep in mind that the statistics are only good for this one particular set of \n\n\f\n<a id='page-307'></a>\ntest data on this one machine. It is an open question what performance you will get \non other problems and on other machines. \nThe following table summarizes the execution time and number of function calls \non the test data: \n\noriginal memo memo+index memo+comp comp \nrun time (sees) 6.6 3.0 .98 .15 .05 \nspeed-up — 2 7 44 130 \ncalls \npat-match 51690 20003 5159 0 0 \nvariable-p 37908 14694 4798 0 0 \nmatch-vari able 1393 551 551 0 0 \nsimplify 906 408 408 545 906 \nsimplify-exp 274 118 118 118 274 \n\n9.7 History and References \nThe idea of memoization was introduced by Donald Michie 1968. He proposed \nusing a list of values rather than a hash table, so the savings was not as great. In \nmathematics, the field of dynamic programming is really just the study of how to \ncompute values in the proper order so that partial results will already be cached away \nwhen needed. \n\nA large part of academic computer science covers compilation; Aho and Ullman \n1972 is just one example. The technique of compiling embedded languages (such as \nthe language of pattern-matching rules) is one that has achieved much more attention \nin the Lisp community than in the rest of computer science. See Emanuelson and \nHaraldsson 1980, for an example. \n\nChoosing the right data structure, indexing it properly, and defining algorithms \nto operate on it is another important branch of computer science; Sedgewick 1988 is \none example, but there are many worthy texts. \n\nDelaying computation by packaging it up in a 1 ambda expression is an idea that \ngoes back to Algol's use of thunks—a mechanism to implement call-by-name parameters, \nessentially by passing functions of no arguments. The name thunk comes from \nthe fact that these functions can be compiled: the system does not have to think \nabout them at run time, because the compiler has already thunk about them. Peter \nIngerman 1961 describes thunks in detail. Abelson and Sussman 1985 cover delays \nnicely. The idea of eliminating unneeded computation is so attractive that entire languages \nhave built around the concept of lazy evaluation—don't evaluate an expression \nuntil its value is needed. See Hughes 1985 or Field and Harrison 1988. \n\n\f\n<a id='page-308'></a>\n\n9.8 Exercises \n&#9635; Exercise 9.3 [d] In this chapter we presented a compiler for s i mp1 i fy. It is not too \nmuch harder to extend this compiler to handle the full power of pat-match. Instead \nof looking at expressions only, allow trees with variables in any position. Extend and \ngeneralize the definitions of compi 1 e -rul e and compi 1 e - rul e-set so that they can \nbe used as a general tool for any application program that uses pat-match and/or \nrule-based -trans1 ator. Make sure that the compiler is data-driven, so that the \nprogrammer who adds a new kind of pattern to pat-match can also instruct the \ncompiler how to deal with it. One hard part will be accounting for segment variables. \nIt is worth spending a considerable amount of effort at compile time to make this \nefficient at run time. \n\n&#9635; Exercise 9.4 [m] Define the time to compute (fib n) without memoization as T<sub>n</sub>. \nWrite a formula to express T<sub>n</sub>. Given that T<sub>25</sub> &asymp; 1.1 seconds, predict T<sub>100</sub>.\n\n&#9635; Exercise 9.5 [m] Consider a version of the game of Nim played as follows: there is \na pile of . tokens. Two players alternate removing tokens from the pile; on each turn \na player must take either one, two, or three tokens. Whoever takes the last token \nwins. Write a program that, given n, returns the number of tokens to take to insure \na win, if possible. Analyze the execution times for your program, with and without \nmemoization. \n\n&#9635; Exercise 9.6 [m] A more complicated Nim-like game is known as Grundy's game. \nThe game starts with a single pile of . tokens. Each player must choose one pile and \nsplit it into two uneven piles. The first player to be unable to move loses. Write a \nprogram to play Grundy's game, and see how memoization helps. \n\n&#9635; Exercise 9.7 [h] This exercise describes a more challenging one-person game. In \nthis game the player rolls a six-sided die eight times. The player forms four two-digit \ndecimal numbers such that the total of the four numbers is as high as possible, but \nnot higher than 170. A total of 171 or more gets scored as zero. \n\nThe game would be deterministic and completely boring if not for the requirement \nthat after each roll the player must immediately place the digit in either the ones or \ntens column of one of the four numbers. \n\nHere is a sample game. The player first rolls a 3 and places it in the ones column \nof the first number, then rolls a 4 and places it in the tens column, and so on. On the \nlast roll the player rolls a 6 and ends up with a total of 180. Since this is over the limit \nof 170, the player's final score is 0. \n\n\f\n<a id='page-309'></a>\n\nroll 3 4 6 6 3 5 3 6 \n\n1st num. -3 43 43 43 43 43 43 43 \n\n2nd num. -6 -6 36 36 36 36 \n\n-\n\n-\n\n3rd num. -6 -6 -6 36 36 \n\n-\n\n4th num. -5 -5 65 \ntotal 03 43 49 55 85 90 120 0 \n\nWrite a function that allows you to play a game or a series of games. The function \nshould take as argument a function representing a strategy for playing the game. \n\n&#9635; Exercise 9.8 [h] Define a good strategy for the dice game described above. (Hint: \nmy strategy scores an average of 143.7.) \n\n&#9635; Exercise 9.9 [m] One problem with playing games involving random numbers is \nthe possibility that a player can cheat by figuring out what random is going to do next. \nRead the definition of the function random and describe how a player could cheat. \nThen describe a countermeasure. \n\n&#9635; Exercise 9.10 [m] On [page 292](chapter9.md#page-292) we saw the use of the read-time conditionals, and \n# -, where #+ is the read-time equivalent of when, and #- is the read-time equivalent \nof unless. Unfortunately, there is no read-time equivalent of case. Implement one. \n\n&#9635; Exercise 9.11 [h] Write a compiler for ELIZA that compiles all the rules at once into \na single function. How much naore efficient is the compiled version? \n\n&#9635; Exercise 9.12 [d] Write some rules to simplify Lisp code. Some of the algebraic \nsimplification rules will still be valid, but new ones will be needed to simplify nonalgebraic \nfunctions and special forms. (Since ni1 is a valid expression in this domain, \nyou will have to deal with the semipredicate problem.) Here are some example rules \n(using prefix notation): \n\n= (+ . 0) .) \n= 'nil nil) \n= (car (cons . y)) .) \n= (cdr (cons . y)) y) \n= (if t . y) .) \n= (if nil X y) y) \n= (length nil) 0) \n= (expt y (?if X numberp)) (expt (expt y (/ . 2)) 2)) \n\n\f\n<a id='page-310'></a>\n\n&#9635; Exercise 9.13 [m] Consider the following two versions of the sieve of Eratosthenes \nalgorithm. The second explicitly binds a local variable. Is this worth it? \n\n(defun sieve (pipe) \n(make-pipe (head pipe) \n(filter #*(lambda (x)(/= (mod . (headpipe)) 0)) \n(sieve (tail pipe))))) \n\n(defun sieve (pipe) \n(let ((first-num (head pipe))) \n(make-pipe first-num \n(filter #'(lambda (x) (/= (mod . first-num) 0)) \n(sieve (tail pipe)))))) \n\n9.9 Answers \nAnswer 9.4 Let Fn denote (fib .). Then the time to compute Fn, Tn, is a small \nconstant for . < 1, and is roughly equal to Tn-\\ plus Tn-i for larger n. Thus, Tn is \nroughly proportional to Fn'. \n\nT<sub>n</sub> = F<sub>n</sub> T<sub>i</sub> / F<sub>i</sub> \n\nWe could use some small value of Ti to calculate Tioo if we knew Fioo- Fortunately, \nwe can use the equation: \n\nwhere &phi; = ^J{5))/2 &asymp; 1.618. This equation was derived by de Moivre in 1718 \n(see Knuth, Donald E. Fundamental Algorithms, pp. 78-83), but the number . has a \nlong interesting history. Euclid called it the \"extreme and mean ratio,\" because the \nratio of A to . is the ratio of A -h J5 to A if A/JB is .. In the Renaissance it was called \nthe \"divine proportion,\" and in the last century it has been known as the \"golden \nratio,\" because a rectangle with sides in this ratio can be divided into two smaller \nrectangles that both have the same ratio between sides. It is said to be a pleasing \nproportion when employed in paintings and architecture. Putting history aside, \ngiven T25 &asymp; 1.1sec we can now calculate: \n\nT<sub>100</sub> &asymp; &phi;<sup>100</sup> 1.1sec/&phi;<sup>25</sup> &asymp; 5 x10<sup>15</sup>sec \n\nwhich is roughly 150 million years. We can also see that the timing data in the table \nfits the equation fairly well. However, we would expect some additional time for \nlarger numbers because it takes longer to add and garbage collect bignums than \nfixnums. \n\n\f\n<a id='page-311'></a>\n\nAnswer 9.5 First we'll define the notion of a forced win. This occurs either when \nthere are three or fewer tokens left or when you can make a move that gives your \nopponent a possible loss. A possible loss is any position that is not a forced win. If \nyou play perfectly, then a possible loss for your opponent will in fact be a win for you, \nsince there are no ties. See the functions wi . and 1 oss below. Now your strategy \nshould be to win the game outright if there are three or fewer tokens, or otherwise \nto choose the largest number resulting in a possible loss for your opponent. If there \nis no such move available to you, take only one, on the grounds that your opponent \nis more likely to make a mistake with a larger pile to contend with. This strategy is \nembodied in the function nim below. \n\n(defun win (n) \n\"Is a pile of . tokens a win for the player to move?\" \n(or (<= . 3) \n\n(loss (- . D) \n(loss (- . 2)) \n(loss (- . 3)))) \n\n(defun loss (n) (not (win n))) \n\n(defun nim (n) \n\"Play Nim: a player must take 1-3; taking the last one wins.\" \n(cond ((<= . 3) n) ; an immediate win \n(doss (- . 3)) 3) ; an eventual win \n(doss (- . 2)) 2) ; an eventual win \n(doss (- . 1)) 1) ; an eventual win \n(t 1))) ; a loss; the 1 is arbitrary \n\n(memoize doss) \n\nFrom this we are able to produce a table of execution times (in seconds), with and \nwithout memoization. Only 1 oss need be memoized. (Why?) Do you have a good \nexplanation of the times for the unmemoized version? What happens if you change \nthe order of the loss clauses in wi . and/or . i m? \n\nAnswer 9.6 We start by defining a function, moves, which generates all possible \nmoves from a given position. This is done by considering each pile of . tokens within \na set of piles s. Any pile bigger than two tokens can be split. We take care to eliminate \nduplicate positions by sorting each set of piles, and then removing the duplicates. \n\n(defun moves (s) \n\"Return a list of all possible moves in Grundy's game\" \n;; S is a list of integers giving the sizes of the piles \n(remove-duplicates \n\n(loop for . in s append (make-moves . s)) \n\n:test #'equal)) \n\n\f\n<a id='page-312'></a>\n\n(defun make-moves (n s) \n(when (>= . 2) \n(let ((s/n (remove . s icount 1))) \n(loop for i from 1 to (- (ceiling . 2) 1) \ncollect (sort* (list* i (-ni) s/n) \n#'>)))) \n\n(defun sort* (seq pred &key key) \n\"Sort without altering the sequence\" \n(sort (copy-seq seq) pred :key key)) \n\nThis time a loss is defined as a position from which you have no moves, or one from \nwhich your opponent can force a win no matter what you do. A winning position \nis one that is not a loss, and the strategy is to pick a move that is a loss for your \nopponent, or if you can't, just to play anything (here we arbitrarily pick the first move \ngenerated). \n\n(defun loss (s) \n(let ((choices (moves s))) \n(or (null choices) \n(every #'win choices)))) \n\n(defun win (s) (not (loss s))) \n\n(defun grundy (s) \n(let ((choices (moves s))) \n(or (find-if #'loss choices) \n(first choices)))) \n\nAnswer 9.7 The answer assumes that a strategy function takes four arguments: \nthe current die roll, the score so far, the number of remaining positions in the tens \ncolumn, and the number of remaining positions in the ones column. The strategy \nfunction should return 1 or 10. \n\n(defun play-games (&optional (n-games 10) (player 'make-move)) \n\"A driver for a simple dice game. In this game the player \nrolls a six-sided die eight times. The player forms four \ntwo-digit decimal numbers such that the total of the four \nnumbers is as high as possible, but not higher than 170. \nA total of 171 or more gets scored as zero. After each die \nis rolled, the player must decide where to put it. \nThis function returns the player's average score.\" \n(/ (loop repeat n-games summing (play-game player 0 4 4)) \n\n(float n-games))) \n\n\f\n<a id='page-313'></a>\n\n(defun play-game (player &optional (total 0) (tens 4) (ones 4)) \n\n(cond ((or (> total 170) <tens 0) (< ones 0)) 0) \n((and (= tens 0) (= ones 0)) total) \n(t (let ((die (roll-die))) \n\n(case (funcall player die total tens ones) \n(1 (play-game player {+ total die) \ntens (- ones 1))) \n(10 (play-game player (+ total (* 10 die)) \n(- tens 1) ones)) \n\n(t 0)))))) \n\n(defun roll-die () (+ 1 (random 6))) \n\nSo, the expression (play-games 5 #'make-move) would play five games with a \nstrategy called make-move. This returns only the average score of the games; if you \nwant to see each move as it is played, use this function: \n\n(defun show (player) \n\"Return a player that prints out each move it makes.\" \n#'(lambda (die total tens ones) \n\n(when (= total 0) (fresh-line)) \n\n(let ((move (funcall player die total tens ones))) \n(incf total (* die move)) \n(format t \"~2d->~3d I ~@[*~]\" (* move die) total (> total 170)) \nmove))) \n\nand call (pi ay-games 5 (show #'make-moves)). \n\nAnswer 9.9 The expression (random 6 (make-random-state)) returns the next \nnumber that rol 1 -di e will return. To guard against this, we can make rol 1 -di e use \na random state that is not accessible through a global variable: \n\n(let ((state (make-random-state t))) \n(defun roll-die () (+ 1 (random 6 state)))) \n\nAnswer 9.10 Because this has to do with read-time evaluation, it must be implemented \nas a macro or read macro. Here's one way to do it: \n\n(defmacro read-time-case (first-case &rest other-cases) \n\"Do the first case, where normally cases are \nspecified with #+ or possibly #- marks.\" \n(declare (ignore other-cases)) \nfirst-case) \n\n\f\n<a id='page-314'></a>\n\nA fanciful example, resurrecting a number of obsolete Lisps, follows: \n\n(defun get-fast-time 0 \n\n(read-time-case \n#+Explorer (ti me:mi crosecond-ti me) \n#+Franz (sysitime) \n#+(or PSL UCI) (time) \n\n#+YKT (currenttime) \n#+MTS (status 39) \n#+Interlisp (clock 1) \n#+Lispl.5 (tempus-fugit) \notherwise \n(get-internal-real-time)) ) \n\nAnswer 9.13 Yes. Computing (head pipe) may be a trivial computation, but it \nwill be done many times. Binding the local variable makes sure that it is only done \nonce. In general, things that you expect to be done multiple times should be moved \nout of delayed functions, while things that may not be done at all should be moved \ninside a delay. \n\n\f\n## Chapter 10\n<a id='page-315'></a>\n\n### Low-Level Efficiency Issues \n\n> There are only two qualities in the world: efficiency \nand inefficiency; and only two sorts of people: the \nefficient and the inefficient \n>\n> —George Bernard Shaw, \n> *John Bull's Other Island* (1904) \n\nThe efficiency techniques of the previous chapter all involved fairly significant changes \nto an algorithm. But what happens when you already are using the best imaginable \nalgorithms, and performance is still a problem? One answer is to find what parts of the \nprogram are used most frequently and make micro-optimizations to those parts. This chapter \ncovers the following six optimization techniques. If your programs all run quickly enough, then \nfeel free to skip this chapter. But if you would like your programs to run faster, the techniques \ndescribed here can lead to speed-ups of 40 times or more. \n\n\f\n<a id='page-316'></a>\n\n* Use declarations. \n* Avoid generic functions. \n* Avoid complex argument lists. \n* Provide compiler macros. \n* Avoid unnecessary consing. \n* Use the right data structure. \n\n### 10.1 Use Declarations \nOn general-purpose computers running Lisp, much time is spent on type-checking. \nYou can gain efficiency at the cost of robustness by declaring, or promising, that \ncertain variables will always be of a given type. For example, consider the following \nfunction to compute the sum of the squares of a sequence of numbers: \n\n```lisp\n(defun sum-squares (seq) \n  (let ((sum 0)) \n    (dotimes (i (length seq)) \n      (incf sum (square (elt seq i)))) \n    sum)) \n\n(defun square (x) (* . x)) \n```\n\nIf this function will only be used to sum vectors of fixnums, we can make it a lot faster \nby adding declarations: \n\n```lisp\n(defun sum-squares (vect) \n  (declare (type (simple-array fixnum *) vect) \n           (inline square) (optimize speed (safety 0))) \n\n  (let ((sum 0)) \n    (declare (fixnum sum)) \n    (dotimes (i (length vect)) \n      (declare (fixnum i)) \n    (incf sum (the fixnum (square (svref vect i))))))) \n  sum)) \n```\n\nThe fixnum declarations let the compiler use integer arithmetic directly, rather than \nchecking the type of each addend. The `(the fixnum ... )` special form is a promise \nthat the argument is a fixnum. The `(optimize speed (safety 0))` declaration tells \nthe compiler to make the function run as fast as possible, at the possible expense of \n<a id='page-317'></a>\nmaking the code less safe (by ignoring type checks and so on). Other quantities that \ncan be optimized are `compilation-speed`, `space` and in ANSI Common Lisp only, \n`debug` (ease of debugging). Quantities can be given a number from 0 to 3 indicating \nhow important they are; 3 is most important and is the default if the number is left out. \n\nThe `(inline square)` declaration allows the compiler to generate the multiplication \nspecified by `square` right in the loop, without explicitly making a function \ncall to square. The compiler will create a local variable for `(svref vect i)` and will \nnot execute the reference twice—inline functions do not have any of the problems \nassociated with macros as discussed on [page 853](chapter24.md#page-853). However, there is one drawback: \nwhen you redefine an inline function, you may need to recompile all the functions \nthat call it. \n\nYou should declare a function `inline` when it is short and the function-calling \noverhead will thus be a significant part of the total execution time. You should not \ndeclare a function `inline` when the function is recursive, when its definition is likely \nto change, or when the function's definition is long and it is called from many places. \n\nIn the example at hand, declaring the function `inline` saves the overhead of \na function call. In some cases, further optimizations are possible. Consider the \npredicate `starts-with`: \n\n```lisp\n(defun starts-with (list x) \n  \"Is this a list whose first element is x?\" \n  (and (consp list) (eql (first list) x))) \n```\n\nSuppose we have a code fragment like the following: \n\n```lisp\n(if (consp list) (starts-with list x) ...) \n```\n\nIf `starts-with` is declared `inline` this will expand to: \n\n```lisp\n(if (consp list) (and (consp list) (eql (first list) x)) ...) \n```\n\nwhich many compilers will simplify to: \n\n```lisp\n(if (consp list) (eql (first list) x) ...) \n```\n\nVery few compilers do this kind of simplification across functions without the hint \nprovided by `inline`. \n\nBesides eliminating run-time type checks, declarations also allow the compiler \nto choose the most efficient representation of data objects. Many compilers support \nboth *boxed* and *unboxed* representations of data objects. A boxed representation \nincludes enough information to determine the type of the object. An unboxed \nrepresentation is just the \"raw bits\" that the computer can deal with directly. Consider \n<a id='page-318'></a>\nthe following function, which is used to clear a 1024x1024 array of floating point \nnumbers, setting each one to zero: \n\n```lisp\n(defun clear-m-array (array) \n  (declare (optimize (speed 3) (safety 0))) \n  (declare (type (simple-array single-float (1024 1024)) array)) \n  (dotimes (i 1024) \n    (dotimes (j 1024) \n      (setf (aref array i j) 0.0)))) \n```\n\nIn Allegro Common Lisp on a Sun SPARCstation, this compiles into quite good code, \ncomparable to that produced by the C compiler for an equivalent C program. If the \ndeclarations are omitted, however, the performance is about 40 times worse. \n\nThe problem is that without the declarations, it is not safe to store the raw floating \npoint representation of `0.0` in each location of the array. Instead, the program \nhas to box the `0.0`, allocating storage for a typed pointer to the raw bits. This \nis done inside the nested loops, so the result is that each call to the version of \n`clear-m-array` without declarations calls the floating-point-boxing function 1048567 \ntimes, allocating a megaword of storage. Needless to say, this is to be avoided. \n\nNot all compilers heed all declarations; you should check before wasting time \nwith declarations your compiler may ignore. The function `disassemble` can be used \nto show what a function compiles into. For example, consider the trivial function to \nadd two numbers together. Here it is with and without declarations: \n\n```lisp\n(defun f (x y) \n  (declare (fixnum . y) (optimize (safety 0) (speed 3))) \n  (the fixnum (+ . y))) \n(defun g (x y) (+ . y)) \n```\n\nHere is the disassembled code for f from Allegro Common Lisp for a Motorola \n68000-series processor: \n\n```\n> (disassemble 'f) \n;; disassembling #<Function f @ #x83ef79> \n;; formals: x y \n;; code vector @ #x83ef44 \n0:      link    a6.#0 \n4:      move.l  a2.-(a7) \n6:      move.l  a5,-(a7) \n8:      move.l  7(a2),a5 \n12:     move.l  8(a6),d4 y \n16:     add.l   12(a6),d4 ; X \n20:     move.l  #l,d1 \n```\n<a id='page-319'></a>\n```\n22:     move.l  -8(a6),a5 \n26:     unlk    a6 \n28:     rtd     #8 \n```\n\nThis may look intimidating at first glance, but you don't have to be an expert at 68000 \nassembler to gain some appreciation of what is going on here. The instructions \nlabeled 0-8 (labels are in the leftmost column) comprise the typical function preamble \nfor the 68000. They do subroutine linkage and store the new function object and \nconstant vector into registers. Since `f` uses no constants, instructions 6, 8, and 22 \nare really unnecessary and could be omitted. Instructions 0,4, and 26 could also be \nomitted if you don't care about seeing this function in a stack trace during debugging. \nMore recent versions of the compiler will omit these instructions. \n\nThe heart of function `f` is the two-instruction sequence 12-16. Instruction 12 \nretrieves `y`, and 16 adds `y` to `x`, leaving the result in `d4`, which is the \"result\" register. \nInstruction 20 sets `d1`, the \"number of values returned\" register, to 1. \n\nContrast this to the code for `g`, which has no declarations and is compiled at \ndefault speed and safety settings: \n\n```\n> (disassemble 'g) \n;; disassembling #<Function g @ #x83dbd1> \n;; formals: x y \n;; code vector @ #x83db64 \n0:      add.l   #8.31(a2) \n4:      sub.w   #2,dl \n6:      beq.s   12 \n8:      jmp     16(a4) ; wnaerr \n12:     link    a6.#0 \n16:     move.l  a2,-(a7) \n18:     move.l  a5,-(a7) \n20:     move.l  7(a2),a5 \n24:     tst.b   -208(a4) ; signal-hit \n28:     beq.s   34 \n30:     jsr     872(a4) ; process-sig \n34:     move.l  8(a6),d4 ; y \n38:     move.l  12(a6),d0 ; X \n42:     or.l    d4,d0 \n44:     and.b   #7.d0 \n48:     bne.s   62 \n50:     add.l   12(a6),d4 ; X \n54:     bvc.s   76 \n56:     jsr     696(a4) ; add-overflow \n60:     bra.s   76 \n62:     move.l  12(a6),-(a7) ; . \n66:     move.l  d4.-(a7) \n68:     move.l  #2.dl \n```\n<a id='page-320'></a>\n\n```\n70:     move.l  -304(a4),a 0 ; +-2op \n74:     jsr     (a4) \n76:     move.l  #1,d1 \n78:     move.l  -8(a6),a5 \n82:     unlk    a6 \n84:     rtd     #8 \n```\n\nSee how much more work is done. The first four instructions ensure that the right \nnumber of arguments have been passed to `g`. If not, there is a jump to `wnaerr` (wrong-number-\nof-arguments-error). Instructions 12-20 have the argument loading code \nthat was at 0-8 in `f`. At 24-30 there is a check for asynchronous signals, such as the \nuser hitting the abort key. After `x` and `y` are loaded, there is a type check (42-48). If \nthe arguments are not both fixnums, then the code at instructions 62-74 sets up a \ncall to `+_2op`, which handles type coercion and non-fixnum addition. If all goes well, \nwe don't have to call this routine, and do the addition at instruction 50 instead. But \neven then we are not done—just because the two arguments were fixnums does not \nmean the result will be. Instructions 54-56 check and branch to an overflow routine \nif needed. Finally, instructions 76-84 return the final value, just as in `f`. \n\nSome low-quality compilers ignore declarations altogether. Other compilers \ndon't need certain declarations, because they can rely on special instructions in the \nunderlying architecture. On a Lisp Machine, both `f` and `g` compile into the same \ncode: \n\n```\n6 PUSH      ARG|0     ; X \n7 +         ARG|1     ; Y \n8 RETURN    PDL-POP \n```\n\nThe Lisp Machine has a microcoded `+` instruction that simultaneously does a fixnum \nadd and checks for non-fixnum arguments, branching to a subroutine if either argument \nis not a fixnum. The hardware does the work that the compiler has to do on a \nconventional processor. This makes the Lisp Machine compiler simpler, so compiling \na function is faster. However, on modern pipelined computers with instruction \ncaches, there is little or no advantage to microcoding. The current trend is away from \nmicrocode toward reduced instruction set computers (RISC). \n\nOn most computers, the following declarations are most likely to be helpful: \n\n* `fixnum` and `float`. Numbers declared as fixnums or floating-point numbers \ncan be handled directly by the host computer's arithmetic instructions. On \nsome systems, `float` by itself is not enough; you have to say `single-float` \nor `double-float`. Other numeric declarations will probably be ignored. For \nexample, declaring a variable as `integer` does not help the compiler much, \nbecause bignums are integers. The code to add bignums is too complex to put \n<a id='page-321'></a>\ninline, so the compiler will branch to a general-purpose routine (like `+_2op` in \nAllegro), the same routine it would use if no declarations were given. \n\n* `list` and `array`. Many Lisp systems provide separate functions for the list- and \narray- versions of commonly used sequence functions. For example, `(delete \nX (the list l))` compiles into `(sys: delete-list-eql x 1)` on a TI Explorer \nLisp Machine. Another function, `sys:delete-vector`, is used for arrays, and \nthe generic function `delete` is used only when the compiler can't tell what type \nthe sequence is. So if you know that the argument to a generic function is either \na `list` or an `array`, then declare it as such. \n* `simple-vector` and `simple-array`. Simple vectors and arrays are those that \ndo not share structure with other arrays, do not have fill pointers, and are \nnot adjustable. In many implementations it is faster to `aref` a `simple-vector` \nthan a `vector`. It is certainly much faster than taking an `elt` of a sequence of \nunknown type. Declare your arrays to be simple (if they in fact are). \n* `(array` *type*`)`. It is often important to specialize the type of array elements. For \nexample, an `(array short-float)` may take only half the storage of a general \narray, and such a declaration will usually allow computations to be done using \nthe CPU's native floating-point instructions, rather than converting into and \nout of Common Lisp's representation of floating points. This is very important \nbecause the conversion normally requires allocating storage, but the direct \ncomputation does not. The specifiers `(simple-array type)` and `(vector type)` \nshould be used instead of `(array type)` when appropriate. A very common \nmistake is to declare `(simple-vector type)`. This is an error because Common \nLisp expects `(simple-vector size)`—don't ask me why. \n* `(array * dimensions)`. The full form of an `array` or `simple-array` type specifier \nis `(array type dimensions)`. So, for example, `(array bit (* *))` is a two-\ndimensional bit array, and `(array bit (1024 1024))` is a 1024 &times; 1024 bit array. \nIt is very important to specify the number of dimensions when known, and less \nimportant to specify the exact size, although with multidimensional arrays, \ndeclaring the size is more important. The format for a `vector` type specifier is \n`(vector type size)`. \nNote that several of these declarations can apply all at once. For example, in \n\n```lisp\n(position #\\. (the simple-string file-name)) \n```\n\nthe variable `filename` has been declared to be a vector, a simple array, and a sequence \nof type `string-char`. All three of these declarations are helpful. The type \n`simple-string` is an abbreviation for `(simple-array string-char)`. \n\n\f\n<a id='page-322'></a>\n\nThis guide applies to most Common Lisp systems, but you should look in the \nimplementation notes for your particular system for more advice on how to fine-tune \nyour code. \n\n### 10.2 Avoid Generic Functions \nCommon Lisp provides functions with great generality, but someone must pay the \nprice for this generality. For example, if you write `(elt x 0)`, different machine \ninstruction will be executed depending on if `x` is a list, string, or vector. Without \ndeclarations, checks will have to be done at runtime. You can either provide declarations, \nas in `(elt (the list x) O)`, or use a more specific function, such as `(first x)` \nin the case of lists, `(char x 0)` for strings, `(aref x 0)` for vectors, and `(svref x 0)` \nfor simple vectors. Of course, generic functions are useful—I wrote `random-elt` \nas shown following to work on lists, when I could have written the more efficient \n`random-mem` instead. The choice paid off when I wanted a function to choose a random \ncharacter from a string—`random-elt` does the job unchanged, while `random-mem` \ndoes not. \n``` lisp\n(defun random-elt (s) (elt s (random (length s)))) \n(defun random-mem (1) (nth (random (length (the list 1))) 1)) \n```\n\nThis example was simple, but in more complicated cases you can make your sequence \nfunctions more efficient by having them explicitly check if their arguments are lists \nor vectors. See the definition of `map-into` on [page 857](chapter24.md#page-857). \n\n### 10.3 Avoid Complex Argument Lists \nFunctions with keyword arguments suffer a large degree of overhead. This may also \nbe true for optional and rest arguments, although usually to a lesser degree. Let's \nlook at some simple examples: \n\n```lisp\n(defun reg (a b c d) (list a b c d)) \n(defun rst (a b c &rest d) (list* a b c d)) \n(defun opt (&optional a b (c 1) (d (sqrt a))) (list a b c d)) \n(defun key (&key a b (c 1) (d (sqrt a))) (list a b c d)) \n```\n\nWe can see what these compile into for the TI Explorer, but remember that your \ncompiler may be quite different. \n\n\f\n<a id='page-323'></a>\n\n```\n> (disassemble 'reg) \n   8 PUSH           ARG|0    ; A \n   9 PUSH           ARG|I    ; B \n  10 PUSH           ARG|2    ; C \n  11 PUSH           ARG|3    ; D \n  12 TAIL-REC CALL-4  FEF|3  ; #'LIST \n\n> (disassemble 'rst) \n   8 PUSH           ARG|0    ; A \n   9 PUSH           ARG|1    ; B \n  10 PUSH           ARG|2    ; C \n  11 PUSH           LOCAL|0  ; D \n  12 RETURN CALL-4  FEF|3    ; #'LIST* \n```\n\nWith the regular argument list, we just push the four variables on the argument stack \nand branch to the list function. (Chapter 22 explains why a tail-recursive call is just \na branch statement.) \n\nWith a rest argument, things are almost as easy. It turns out that on this machine, \nthe microcode for the calling sequence automatically handles rest arguments, storing \nthem in local variable 0. Let's compare with optional arguments: \n\n```lisp\n(defun opt (&optional a b (c 1) (d (sqrt a))) (list a b c d)) \n\n> (disassemble 'opt) \n24 DISPATCH       FEF|5     ; [0=>25;1=>25;2=>25;3=>27;ELSE=>30]\n25 PUSH-NUMBER    1 \n26 POP            ARG|2     ; C \n27 PUSH           ARG|0     ; A \n28 PUSH CALL-1    FEF|3     ; #'SQRT \n29 POP            ARG|3     ; D \n30 PUSH           ARG|0     ; A \n31 PUSH           ARG|1     ; B \n32 PUSH           ARG|2     ; C \n33 PUSH           ARG|3     ; D \n34 TAIL-REC CALL-4 FEFI4    ; #'LIST \n```\n\nAlthough this assembly language may be harder to read, it turns out that optional \narguments are handled very efficiently. The calling sequence stores the number of \noptional arguments on top of the stack, and the `DISPATCH` instruction uses this to \nindex into a table stored at location `FEF|5` (an offset five words from the start of \nthe function). The result is that in one instruction the function branches to just the \nright place to initialize any unspecified arguments. Thus, a function with optional \narguments that are all supplied takes only one more instruction (the dispatch) than \nthe \"regular\" case. Unfortunately, keyword arguments don't fare as well: \n\n```lisp\n(defun key (&key a b (c 1) (d (sqrt a))) (list a b c d)) \n```\n\n\f\n<a id='page-324'></a>\n\n```lisp\n> (disassemble 'key) \n14 PUSH-NUMBER      1 \n15 POP              LOCAL|3   ; C \n16 PUSH             FEF|3     ; SYS::KEYWORD-GARBAGE \n17 POP              LOCAL|4 \n18 TEST             LOCAL|0 \n19 BR-NULL      24 \n20 PUSH             FEF|4     ; '(:A :B :C :D) \n21 SET-NIL          PDL-PUSH \n22 PUSH-LOC         LOCAL|1   ; A\n23 (AUX) %STORE-KEY-WORD-ARGS \n24 PUSH             LOCAL|1   ; A \n25 PUSH             LOCAL|2   ; B \n26 PUSH             LOCAL|3   ; C \n27 PUSH             LOCAL|4 \n28 EQ               FEF|3     ; SYS::KEYWORD-GARBAGE \n29 BR-NULL      33 \n30 PUSH             LOCAL|1   ; A \n31 PUSH CALL-1      FEF|5     ; #'SQRT \n32 RETURN CALL-4    FEF|6     ; #'LIST \n33 PUSH             LOCAL|4 \n34 RETURN CALL-4    FEF|6     ; #'LIST \n```\n\nIt is not important to be able to read all this assembly language. The point is that there \nis considerable overhead, even though this architecture has a specific instruction \n`(%STORE-KEY-WORD-ARGS)` to help deal with keyword arguments. \n\nNow let's look at the results on another system, the Allegro compiler for the \n68000. First, here's the assembly code for `reg`, to give you an idea of the minimal \ncalling sequence:[1](#fn-10-1)\n\n```\n> (disassemble 'reg) \n;; disassembling #<Function reg @ #x83db59> \n;; formals: a b c d \n;; code vector @ #x83db1c \n0:      link    a6,#0 \n4:      move.l  a2.-(a7) \n6:      move.l  a5.-(a7) \n8:      move.l  7(a2),a5 \n12:     move.l  20(a6),-(a7)    ; a \n16:     move.l  16(a6).-(a7)    ; b \n20:     move.l  12(a6),-(a7)    ; c \n24:     move.l  8(a6).-(a7)     ; d \n28:     move.l  #4.dl \n30:     jsr     848(a4)         ; list \n```\n\n[fn-10-1] These are all done with safety 0 and speed 3. \n\n<a id='page-325'></a>\n\n```\n34:     move.l  -8(a6).a5 \n38:     unlk    a6 \n40:     rtd     #10 \n```\n\nNow we see that &rest arguments take a lot more code in this system: \n\n### WIP\n\n> (disassemble 'rst) \n;; disassembling #<Function rst @ #x83de89> \n;; formals: a D c &rest d \n11 code vector @ #x83de34 \n0: sub.w #3,dl \n2: bge.s 8 \n\n4: jmp 16(a4) ; wnaerr \n8: move.l (a7)+.al \n10 move.l d3.-(a7) ; nil \n12 sub.w #l,dl \n14 blt.s 38 \n16 move.l al,-52(a4) ; c-protected-retaddr \n20 jsr 40(a4) ; cons \n24 move.l d4,-(a7) \n26 dbra dl,20 \n30 move.l -52(a4).al ; C-protected-retaddr \n34 clr.l -52(a4) ; C-protected-retaddr \n38 move.l al.-(a7) \n40 link a6.#0 \n44 move.l a2.-(a7) \n46 move.l a5,-(a7) \n48 move.l 7(a2).a5 \n52 move.l -332(a4),a0 ; list* \n56 move.l -8(a6),a5 \n60 unlk a6 \n62 move.l #4,dl \n64 jmp (a4) \nThe loop from 20-26 builds up the &rest list one cons at a time. Part of the difficulty \nis that cons could initiate a garbage collection at any time, so the list has to be built \nin a place that the garbage collector will know about. The function with optional \narguments is even worse, taking 34 instructions (104 bytes), and keywords are worst \nof all, weighing in at 71 instructions (178 bytes), and including a loop. The overhead \nfor optional arguments is proportional to the number of optional arguments, while \nfor keywords it is proportional to the product of the number of parameters allowed \nand the number of arguments actually supplied. \n\nA good guideline to follow is to use keyword arguments primarily as an interface \nto infrequently used functions, and to provide versions of these functions without \nkeywords that can be used in places where efficiency is important. Consider: \n\n\f\n<a id='page-326'></a>\n\n(proclaim '(inline key)) \n(defun key (&key a b (c 1) (d (sqrt a))) (*no-key abed)) \n(defun *no-key (abed) (list abed)) \n\nHere the function key is used as an interface to the function no - key, which does the \nreal work. The inline proclamation should allow the compiler to compile a call to key \nas a call to no - key with the appropriate arguments: \n\n> (disassemble #'(lambda (x y) (key :b . :a y))) \n\n10 PUSH ARG II Y \n11 PUSH ARG 10 X \n12 PUSH-NUMBER 1 \n13 PUSH ARG II Y \n14 PUSH CALL-1 FEFI3 #'SQRT \n15 TAIL-REC CALL-4 FEFI4 #*NO-KEY \n\nThe overhead only comes into play when the keywords are not known at compile \ntime. In the following example, the compiler is forced to call key, not no- key, because \nit doesn't know what the keyword k will be at run time: \n\n> (disassemble #*(lambda (k . y) (key k . :a y))) \n10 PUSH ARGIO . \n11 PUSH ARG 11 . \n12 PUSH FEFI3 ':. \n13 PUSH ARG 12 . \n14 TAIL-REC CALL-4 FEFI4 #... \n\nOf course, in this simple example I could have replaced no-key with 1 i st, but in \ngeneral there will be some more complex processing. If I had proclaimed no-key \ninline as well, then I would get the following: \n\n> (disassemble #'(lambda (x y) (key :b . :a y))) \n\n10 PUSH ARG 11 ; Y \n\n11 PUSH ARG 10 ; . \n\n12 PUSH-NUMBER 1 \n\n13 PUSH ARG II ; Y \n\n14 PUSH CALL-1 FEFI3 ; #'SQRT \n\n15 TAIL-REC CALL-4 FEFI4 ; #'LIST \n\nIf you like, you can define a macro to automatically define the interface to the keyword-\nless function: \n\n\f\n<a id='page-327'></a>\n\n(defmacro defun* (fn-name arg-list &rest body) \n\"Define two functions, one an interface to a &keyword-less \nversion. Proclaim the interface function inline.\" \n(if (and (member '&key arg-list) \n\n(not (member *&rest arg-list))) \n(let ((no-key-fn-name (symbol fn-name '*no-key)) \n(args (mapcar #'first-or-self \n\n(set-difference \narg-list \n1ambda-list-keywords)))) \n\n'(progn \n(proclaim '(inline ,fn-name)) \n(defun ,no-key-fn-name ,args \n\n..body) \n(defun ,fn-name ,arg-list \n(,no-key-fn-name ..args)))) \n'(defun ,fn-name ,arg-list \n..body))) \n\n> (macroexpand '(defun* key (&key a b (c 1) (d (sqrt a))) \n(list a b c d))) \n\n(PROGN (PROCLAIM '(INLINE KEY)) \n(DEFUN KEY*NO-KEY (A . C D) (LIST A . C D)) \n(DEFUN KEY (&KEY A . (C 1) (D (SQRT A))) \n\n(KEY*NO-KEY A . C D))) \n\n> (macroexpand '(defun* reg (abed) (list abed))) \n(DEFUN REG (A . C D) (LIST A . C D)) \n\nThere is one disadvantage to this approach: a user who wants to declare key inHne \nor not inline does not get the expected result. The user has to know that key is \nimplemented with key*no- key, and declare key*no- key inline. \n\nAn alternative is just to proclaim the function that uses &key to be inline. Rob \nMacLachlan provides an example. In CMU Lisp, the function member has the following \ndefinition, which is proclaimed inline: \n\n(defun member (item list &key (key #'identity) \n(test #'eql testp)(test-not nil notp)) \n(do ((list list (cdr list))) \n((null list) nil) \n(let ((car (car list))) \n(if (cond \n(testp \n(funcall test item \n(funcall key car))) \n(notp \n(not \n\n\f\n<a id='page-328'></a>\n\n(funcall test-not item \n(funcall key car)))) \n(t \n(funcall test item \n(funcall key car)))) \n(return list))))) \n\nA call like (member ch 1 :key #'first-letter rtest #'cha r=) expands into the \nequivalent of the following code. Unfortunately, not all compilers are this clever with \ninline declarations. \n\n(do ((list list (cdr list))) \n((null list) nil) \n(let ((car (car list))) \n(if (char= ch (first-letter car)) \n(return list)))) \n\nThis chapter is concerned with efficiency and so has taken a stand against the use \nof keyword parameters in frequently used functions. But when maintainability \nis considered, keyword parameters look much better. When a program is being \ndeveloped, and it is not clear if a function will eventually need additional arguments, \nkeyword parameters may be the best choice. \n\n10.4 Avoid Unnecessary Consing \nThe cons function may appear to execute quite quickly, but like all functions that \nallocate new storage, it has a hidden cost. When large amounts of storage are \nused, eventually the system must spend time garbage collecting. We have not \nmentioned it earlier, but there are actually two relevant measures of the amount of \nspace consumed by a program: the amount of storage allocated, and the amount of \nstorage retained. The difference is storage that is used temporarily but eventually \nfreed. Lisp guarantees that unused space will eventually be reclaimed by the garbage \ncollector. This happens automatically—the programmer need not and indeed can not \nexplicitly free storage. The problem is that the efficiency of garbage collection can \nvary widely. Garbage collection is particularly worrisome for real-time systems, \nbecause it can happen at any time. \n\nThe antidote to garbage woes is to avoid unnecessary copying of objects in often-\nused code. Try using destructive operations, like nreverse, delete, and nconc, \nrather than their nondestructive counterparts, (like reverse, remove, and append) \nwhenever it is safe to do so. Or use vectors instead of lists, and reuse values rather \nthan creating copies. As usual, this gain in efficiency may lead to errors that can \n\n\f\n<a id='page-329'></a>\nbe difficult to debug. However, the most common kind of unnecessary copying \ncan be eliminated by simple reorganization of your code. Consider the following \nversion of f 1 a tten, which returns a list of all the atoms in its input, preserving order. \nUnlike the version in chapter 5, this version returns a single list of atoms, with no \nembedded lists. \n\n(defun flatten (input) \n\"Return a flat list of the atoms in the input. \nEx: (flatten '((a) (b (c) d))) => (a b c d).\" \n(cond ((null input) nil) \n\n((atom input) (list input)) \n(t (append (flatten (first input)) \n(flatten (rest input)))))) \n\nThis definition is quite simple, and it is easy to see that it is correct. However, each \ncall to append requires copying the first argument, so this version can cons O(n^) cells \non an input with . atoms. The problem with this approach is that it computes the \nlist of atoms in the first and rest of each subcomponent of the input. But the first \nsublist by itself is not part of the final answer—that's why we have to call append. We \ncould avoid generating garbage by replacing append with nconc, but even then we \nwould still be wasting time, because nconc would have to scan through each sublist \nto find its end. \n\nThe version below makes use of an accumulator to keep track of the atoms that \nhave been collected in the rest, and to add the atoms in the first one at a time with \ncons, rather than building up unnecessary sublists and appending them. This way \nno garbage is generated, and no subcomponent is traversed more than once. \n\n(defun flatten (input &optional accumulator) \n\"Return a flat list of the atoms in the input. \nEx: (flatten '((a) (b (c) d))) => (a b c d).\" \n(cond ((null input) accumulator) \n\n((atom input) (cons input accumulator)) \n\n(t (flatten (first input) \n(flatten (rest input) accumulator))))) \n\nThe version with the accumulator may be a little harder to understand, but it is far \nmore efficient than the original version. Experienced Lisp programmers become \nquite skilled at replacing calls to append with accumulators. \n\nSome of the early Lisp machines had unreliable garbage-collection, so users \njust turned garbage collection off, used the machine for a few days, and rebooted \nwhen they ran out of space. With a large virtual memory system this is a feasible \napproach, because virtual memory is a cheap resource. The problem is that real \nmemory is still an expensive resource. When each page contains mostly garbage \n\n\f\n<a id='page-330'></a>\n\nand only a little live data, the system will spend a lot of time paging data in and out. \nCompacting garbage-collection algorithms can relocate live data, packing it into a \nminimum number of pages. \n\nSome garbage-collection algorithms have been optimized to deal particularly well \nwith just this case. If your system has an ephemeral or generational garbage collector, \nyou need not be so concerned with short-lived objects. Instead, it will be the medium-\naged objects that cause problems. The other problem with such systems arises when \nan object in an old generation is changed to point to an object in a newer generation. \nThis is to be avoided, and it may be that reverse is actually faster than nreverse in \nsuch cases. To decide what works best on your particular system, design some test \ncases and time them. \n\nAs an example of efficient use of storage, here is a version of pat-match that \neliminates (almost) all consing. The original version of pat-match, as used in ELIZA \n([page 180](chapter6.md#page-180)), used an association list of variable/value pairs to represent the binding \nlist. This version uses two sequences: a sequence of variables and a sequence of \nvalues. The sequences are implemented as vectors instead of lists. In general, vectors \ntake half as much space as lists to store the same information, since half of every list \nis just pointing to the next element. \n\nIn this case, the savings are much more substantial than just half. Instead of \nbuilding up small binding lists for each partial match and adding to them when the \nmatch is extended, we will allocate a sufficiently large vector of variables and values \njust once, and use them over and over for each partial match, and even for each \ninvocation of pat-match. To do this, we need to know how many variables we are \ncurrently using. We could initialize a counter variable to zero and increment it each \ntime we found a new variable in the pattern. The only difficulty would be when the \ncounter variable exceeds the size of the vector. We could just give up and print an \nerror message, but there are more user-friendly alternatives. For example, we could \nallocate a larger vector for the variables, copy over the existing ones, and then add in \nthe new one. \n\nIt turns out that Common Lisp has a built-in facility to do just this. When a \nvector is created, it can be given a fill pointer. This is a counter variable, but one that \nis conceptually stored inside the vector. Vectors with fill pointers act like a cross \nbetween a vector and a stack. You can push new elements onto the stack with the \nfunctions vector -push or vector-push-extend. The latter will automatically allocate \na larger vector and copy over elements if necessary. You can remove elements with \nvector - pop, or you can explicitly look at the fill pointer with f .1 - poi . te r, or change \nit with a setf. Here are some examples (with *print-array* set to t so we can see \nthe results): \n\n> (setf a (make-array 5 :fiH-pointer 0)) ^ #() \n\n> (vector-push 1 a) 0 \n\n\f\n<a id='page-331'></a>\n> (vector-push 2 a) =.> 1 \n\n> a => #(1 2) \n\n> (vector-pop a) => 2 \n\n> a #(1) \n\n> (dotimes (i 10) (vector-push-extend 'x a)) NIL \n\n>a=:^#(lXXXXXXXXXX) \n\n> (fill-pointer a) => 11 \n\n> (setf (fill-pointer a) 1) 1 \n\n> a => #(1) \n\n> (find *x a) => NIL NIL ; FIND can't find past the fill pointer \n\n> (aref a 2) => X ;But AREF can see beyond the fill pointer \n\nUsing vectors with fill pointers in pat-match, the total storage for binding lists is \njust twice the number of variables in the largest pattern. I have arbitrarily picked \n10 as the maximum number of variables, but even this is not a hard limit, because \nvector -push-extend can increase it. In any case, the total storage is small, fixed \nin size, and amortized over all calls to pat-match. These are just the features that \nindicate a responsible use of storage. \n\nHowever, there is a grave danger with this approach: the value returned must \nbe managed carefully. The new pat-match returns the value of success when it \nmatches, success is bound to a cons of the variable and value vectors. These can be \nfreely manipulated by the calling routine, but only up until the next call to pa t - ma tch. \nAt that time, the contents of the two vectors can change. Therefore, if any calling \nfunction needs to hang on to the returned value after another call to pat-match, it \nshould make a copy of the returned value. So it is not quite right to say that this \nversion of pat-match eliminates all consing. It will cons when vector-push-extend \nruns out of space, or when the user needs to make a copy of a returned value. \n\nHere is the new definition of pat-match. It is implemented by closing the defi\n\n\nnition of pat-match and its two auxilliary functions inside a let that establishes the \n\nbindings of vars, val s, and success, but that is not crucial. Those three variables \n\ncould have been implemented as global variables instead. Note that it does not sup\n\n\nport segment variables, or any of the other options implemented in the pat-match \n\nof chapter 6. \n\n(let* ((vars (make-array 10 :fill-pointer 0 ladjustable t)) \n(vals (make-array 10 :fill-pointer 0 :adjustable t)) \n(success (cons vars vals))) \n\n\f\n<a id='page-332'></a>\n\n(defun efficient-pat-match (pattern input) \n\"Match pattern against input.\" \n(setf (fill-pointer vars) 0) \n(setf (fill-pointer vals) 0) \n(pat-match-1 pattern input)) \n\n(defun pat-match-1 (pattern input) \n\n(cond ((variable-p pattern) (match-var pattern input)) \n((eql pattern input) success) \n((and (consp pattern) (consp input)) \n\n(and (pat-match-1 (first pattern) (first input)) \n(pat-match-1 (rest pattern) (rest input)))) \n(t fail))) \n\n(defun match-var (var input) \n\"Match a single variable against input.\" \n(let ((i (position var vars))) \n\n(cond ((null i) \n(vector-push-extend var vars) \n(vector-push-extend input vals) \nsuccess) \n\n((equal input (aref vals i)) success) \n\n(t fail))))) \n\nAn example of its use: \n\n> (efficient-pat-match '(Tx + ?x = ?y . ?z) \n'(2 + 2 = (3 + 1) is true)) \n(#(?X ?Y 11) . #(2 (3 + 1) (IS TRUE))) \n\nExtensible vectors with fill pointers are convenient, and much more efficient than \nconsing up lists. However, there is some overhead involved in using them, and for \nthose sections of code that must be most efficient, it is best to stick with simple \nvectors. The following version of ef f i cient-pat-match explicitly manages the size \nof the vectors and explicitly replaces them with new ones when the size is exceeded: \n\n(let* ((current-size 0) \n(max-size 1) \n(vars (make-array max-size)) \n(vals (make-array max-size)) \n(success (cons vars vals))) \n\n(declare (simple-vector vars vals) \n(fixnum current-size max-size)) \n\n\f\n<a id='page-333'></a>\n\n(defun efficient-pat-match (pattern input) \n\"Match pattern against input.\" \n(setf current-size 0) \n(pat-match-1 pattern input)) \n\npat-match-1 is unchanged \n\n(defun match-var (var input) \n\"Match a single variable against input.\" \n(let ((i (position var vars))) \n\n(cond \n((null i) \n(when (= current-size max-size) \nMake new vectors when we run out of space \n\n(setf max-size (* 2 max-size) \nvars (replace (make-array max-size) vars) \nvals (replace (make-array max-size) vals) \nsuccess (cons vars vals))) \n\n;; Store var and its value in vectors \n(setf (aref vars current-size) var) \n(setf (aref vals current-size) input) \n(incf current-size) \nsuccess) \n\n((equal input (aref vals i)) success) \n\n(t fail))))) \n\nIn conclusion, replacing lists with vectors can often save garbage. But when you \nmust use lists, it pays to use a version of cons that avoids consing when possible. The \nfollowing is such a version: \n\n(proclaim '(inline reuse-cons)) \n\n(defun reuse-cons (x y x-y) \n\"Return (cons . y), or just x-y if it is equal to (cons . y). \" \n(if (and (eql . (car x-y)) (eql y (cdr x-y))) \n\nx-y \n\n(cons X y))) \n\nThe trick is based on the definition of subst in Steele's Common Lisp the Language. \nHere is a definition for a version of remove that uses reuse- cons: \n\n\f\n<a id='page-334'></a>\n\n(defun remq (item list) \n\"Like REMOVE, but uses EQ, and only works on lists. \" \n(cond ((null list) nil) \n\n((eq item (first list)) (remq item (rest list))) \n\n(t (reuse-cons (first list) \n(remq item (rest list)) \nlist)))) \n\nAvoid Consing: Unique Lists \n\nOf course, reuse - cons only works when you have candidate cons cells around. That \nis, (reuse-cons a b c) only saves space when c is (or might be) equal to (cons a b). \nFor some applications, it is useful to have a version of cons that returns a unique cons \ncell without needing c as a hint. We will call this version ucons for \"unique cons.\" \nucons maintains a double hash table: *uni q- cons - tabl e* is a hash table whose keys \nare the cars of cons cells. The value for each car is another hash table whose keys \nare the cdrs of cons cells. The value of each cdr in this second table is the original \ncons cell. So two different cons cells with the same ca r and cdr will retrieve the same \nvalue. Here is an implementation of ucons: \n\n(defvar *uniq-cons-table* (make-hash-table :test #'eq)) \n\n(defun ucons (x y) \n\"Return a cons s.t. (eq (ucons . y) (ucons . y)) is true.\" \n(let ((car-table (or (gethash . *uniq-cons-table*) \n\n(setf (gethash . *uniq-cons-table*) \n(make-hash-table :test #'eq))))) \n(or (gethash y car-table) \n(setf (gethash y car-table) (cons . y))))) \n\nucons, unlike cons, is a true function: it will always return the same value, given \nthe same arguments, where \"same\" is measured by eq. However, if ucons is given \narguments that are equal but not eq, it will not return a unique result. For that \nwe need the function unique. It has the property that (unique x) is eq to (unique \n\ny) whenever . and y are equal. unique uses a hash table for atoms in addition to \nthe double hash table for conses. This is necessary because strings and arrays can \nbe equal without being eq. Besides unique, we also define ul ist and uappend for \nconvenience. \n(defvar *uniq-atom-table* (make-hash-table .-test #'equal)) \n\n\f\n<a id='page-335'></a>\n(defun unique (exp) \n\"Return a canonical representation that is EQUAL to exp. \nsuch that (equal . y) implies (eq (unique x) (unique y)).\" \n(typecase exp \n\n(symbol exp) \n(fixnum exp) Remove if fixnums are not eq in your Lisp \n(atom (or (gethash exp *uniq-atom-table*) \n\n(setf (gethash exp *uniq-atom-table*) exp))) \n(cons (unique-cons (car exp) (cdr exp))))) \n\n(defun unique-cons (x y) \n\"Return a cons s.t. (eq (ucons . y) (uconswhenever (equal . x2) and (equal y y2) are(ucons (unique x) (unique y))) \n\n(defun ulist (&rest args) \n\"A uniquified list.\" \n(unique args)) \n\n(defun uappend (x y) \n\"A unique list equal to (append . y). \" \n(if (null X) \n(unique y) \n\n x2 y2)) is true \ntrue.\" \n\n(ucons (first x) (uappend (rest x) y)))) \n\nThe above code works, but it can be improved. The problem is that when uni que is \napplied to a tree, it always traverses the tree all the way to the leaves. The function \nunique-cons is like ucons, except that unique-cons assumes its arguments are not \nyet unique. We can modify uni que- cons so that it first checks to see if its arguments \nare unique, by looking in the appropriate hash tables: \n\n(defun unique-cons (x y) \n\"Return a cons s.t. (eq (ucons . y) (ucons x2 y2)) is true \nwhenever (equal . x2) and (equal y y2) are true.\" \n(let ((ux) (uy)) : unique . and y \n\n(let ((car-table \n\n(or (gethash . *uniq-cons-table*) \n(gethash (setf ux (unique x)) *uniq-cons-table*) \n(setf (gethash ux *uniq-cons-table*) \n\n(make-hash-table :test #*eq))))) \n\n(or (gethash y car-table) \n(gethash (setf uy (unique y)) car-table) \n(setf (gethash uy car-table) \n\n(cons ux uy)))))) \n\nAnother advantage of uni que is that it can help in indexing. If lists are unique, \nthen they can be stored in an eq hash table instead of a equal hash table. This can \n\n\f\n<a id='page-336'></a>\n\nlead to significant savings v^hen the list structures are large. An eq hash table for \nlists is almost as good as a property list on symbols. \n\nAvoid Consing: Multiple Values \n\nParameters and multiple values can also be used to pass around values, rather than \nbuilding up lists. For example, instead of: \n\n(defstruct point \"A point in 3-D cartesian space.\" . y z) \n\n(defun scale-point (k pt) \n\n\"Multiply a point by a constant, K.\" \n\n(make-point :x (* k (point-x pt)) \n\n:y (* k (point-y pt)) \n\n:z (* k (point-z pt)))) \n\none could use the following approach, which doesn't generate structures: \n\n(defun scale-point (k . y z) \n\n\"Multiply the point (x,y,z) by a constant, K.\" \n\n(values (* k x) (* k y) (* k z))) \n\nAvoid Consing: Resources \n\nSometimes it pays to manage explicitly the storage of instances of some data type. A \npool of these instances may be called a resource. Explicit management of a resource \nis appropriate when: (1) instances are frequently created, and are needed only \ntemporarily; (2) it is easy/possible to be sure when instances are no longer needed; \nand (3) instances are fairly large structures or take a long time to initialize, so that it \nis worth reusing them instead of creating new ones. Condition (2) is the crucial one: \nIf you deallocate an instance that is still being used, that instance will mysteriously \nbe altered when it is reallocated. Conversely, if you fail to deallocate unneeded \ninstances, then you are wasting valuable memory space. (The memory management \nscheme is said to leak in this case.) \n\nThe beauty of using Lisp's built-in memory management is that it is guaranteed \nnever to leak and never to deallocate structures that are in use. This eliminates two \npotential bug sources. The penalty you pay for this guarantee is some inefficiency of \nthe general-purpose memory management as compared to a custom user-supplied \nmanagement scheme. But beware: modern garbage-collection techniques are highly \noptimized. In particular, the so-called generation scavenging or ephemeral garbage \ncollectors look more often at recently allocated storage, on the grounds that recently \nmade objects are more likely to become garbage. If you hold on to garbage in your \nown data structures, you may end up with worse performance. \n\n\f\n<a id='page-337'></a>\n\nWith all these warnings in mind, here is some code to manage resources: \n\n(defmacro defresource (name &key constructor (initial-copies 0) \n(size (max initial-copies 10))) \n\n(let ((resource (symbol name '-resource)) \n(deallocate (symbol 'deallocate- name)) \n(allocate (symbol 'allocate- name))) \n\n'(let ((.resource (make-array .size ifill-pointer 0))) \n\n(defun .allocate () \n\"Get an element from the resource pool, or make one.\" \n(if (= (fill-pointer .resource) 0) \n\n.constructor \n(vector-pop .resource))) \n\n(defun .deallocate (.name) \n\"Place a no-longer-needed element back in the pool.\" \n(vector-push-extend .name .resource)) \n\n.(if (> initial-copies 0) \n'(mapc #'.deallocate (loop repeat .initial-copies \ncollect (.allocate)))) \n'.name))) \n\nLet's say we had some structure called a buffer which we were constantly making \ninstances of and then discarding. Furthermore, suppose that buffers are fairly \ncomplex objects to build, that we know we'll need at least 10 of them at a time, and \nthat we probably won't ever need more than 100 at a time. We might use the buffer \nresource as follows: \n\n(defresource buffer :constructor (make-buffer) \n:size 100 :initial-copies 10) \n\nThis expands into the following code: \n\n(let ((buffer-resource (make-array 100 :fil 1-pointer 0))) \n\n(defun allocate-buffer () \n\"Get an element from the resource pool, or make one.\" \n(if (= (fil1-pointer buffer-resource) 0) \n\n(make-buffer) \n(vector-pop buffer-resource))) \n\n(defun deallocate-buffer (buffer) \n\"Place a no-longer-needed element back in the pool.\" \n(vector-push-extend buffer buffer-resource)) \n\n(mapc #'deanocate-buffer \n(loop repeat 10 collect (allocate-buffer))) \n'buffer) \n\n\f\n<a id='page-338'></a>\n\nWe could then use: \n\n(let ((b (allocate-buffer))) \n\n(process b) \n\n(deallocate-buffer b))) \n\nThe important thing to remember is that this works only if the buffer b really can \nbe deallocated. If the function process stored away a pointer to b somewhere, \nthen it would be a mistake to deallocate b, because a subsequent allocation could \nunpredictably alter the stored buffer. Of course, if process stored a copy of b, then \neverything is alright. This pattern of allocation and deallocation is so common that \nwe can provide a macro for it: \n\n(defmacro with-resource ((var resource &optional protect) &rest body) \n\"Execute body with VAR bound to an instance of RESOURCE.\" \n(let ((allocate (symbol 'allocate- resource)) \n\n(deallocate (symbol 'deallocate- resource))) \n(if protect \n\n'(let ((.var nil)) \n(unwind-protect \n(progn (setf ,var (.allocate)) .body) \n(unless (null .var) (.deallocate .var)))) \n\n'(let ((.var (.allocate))) \n.body \n(.deallocate .var))))) \nThe macro allows for an optional argument that sets up an unwi nd - protect environment, \nso that the buffer gets deallocated even when the body is abnormally exited. \nThe following expansions should make this clearer: \n\n> (macroexpand '(with-resource (b buffer) \n\"...\" (process b) \"...\")) \n(let ((b (allocate-buffer))) \n\n. It \n\n(process b) \n\n11 II \n\n(deallocate-buffer b)) \n\n> (macroexpand '(with-resource (b buffer t) \n\"...\" (process b) \"...\")) \n(let ((b nil)) \n(unwind-protect \n(progn (setf b (allocate-buffer)) \n\n\f\n<a id='page-339'></a>\n(process b) \n\"...\") \n(unless (null b) \n(deallocate-buffer b)))) \n\nAn alternative to full resources is to just save a single data object. Such an approach \nis simpler because there is no need to index into a vector of objects, but it is sufficient \nfor some applications, such as a tail-recursive function call that only uses one object \nat a time. \n\nAnother possibility is to make the system slower but safer by having the \ndeal 1 ocate function check that its argument is indeed an object of the correct type. \n\nKeep in mind that using resources may put you at odds with the Lisp system's own \nstorage management scheme. In particular, you should be concerned with paging \nperformance on virtual memory systems. A common problem is to have only a few \nlive objects on each page, thus forcing the system to do a lot of paging to get any work \ndone. Compacting garbage collectors can collect live objects onto the same page, but \nusing resources may interfere with this. \n\n10.5 Use the Right Data Structures \nIt is important to implement key data types with the most efficient implementation. \nThis can vary from machine to machine, but there are a few techniques that are \nuniversal. Here we consider three case studies. \n\nThe Right Data Structure: Variables \n\nAs an example, consider the implementation of pattern-matching variables. We saw \nfrom the instrumentation of s i mp1 if y that variable-p was one of the most frequently \nused functions. In compiling the matching expressions, I did away with all calls to \nvari abl e-p, but let's suppose we had an application that required run-time use of \nvariables. The specification of the data type vari abl e will include two operators, \nthe recognizer vari abl e-p, and the constructor make-vari abl e, which gives a new, \npreviously unused variable. (This was not needed in the pattern matchers shown so \nfar, but will be needed for unification with backward chaining.) One implementation \nof variables is as symbols that begin with the character #\\?: \n\n(defun variable-p (x) \n\"Is X a variable (a symbol beginning with *?')?\" \n(and (symbolp x) (equal (elt (symbol-name x) 0) #\\?))) \n\n\f\n<a id='page-340'></a>\n\n(defun make-variable () \"Generate a new variable\" (gentemp \"?\")) \n\nWe could try to speed things up by changing the implementation of variables to be \nkeywords and making the functions inline: \n\n(proclaim '(inline variable-p make-variable)) \n(defun variable-p (x) \"Is . a variable?\" (keywordp x)) \n(defun make-variable () (gentemp \"X\" #.(find-package \"KEYWORD\"))) \n\n(The reader character sequence #. means to evaluate at read time, rather than at \nexecution time.) On my machine, this implementation is pretty fast, and I accepted \nit as a viable compromise. However, other implementations were also considered. \nOne was to have variables as structures, and provide a read macro and print function: \n\n(defstruct (variable (iprint-function print-variable)) name) \n\n(defvar *vars* (make-hash-table)) \n\n(set-macro-character #\\? \n#'(lambda (stream char) \n\nFind an old var, or make a new one with the given name \n(declare (ignore char)) \n(let ((name (read stream t nil t))) \n\n(or (gethash name *vars*) \n(setf (gethash name *vars*) (make-variable mame name)))))) \n\n(defun print-variable (var stream depth) \n(declare (ignore depth)) \n(format stream \"?~a\" (var-name var))) \n\nIt turned out that, on all three Lisps tested, structures were slower than keywords \nor symbols. Another alternative is to have the ? read macro return a cons whose \nfirst is, say, : var. This requires a special output routine to translate back to the ? \nnotation. Yet another alternative, which turned out to be the fastest of all, was to \nimplement variables as negative integers. Of course, this means that the user cannot \nuse negative integers elsewhere in patterns, but that turned out to be acceptable for \nthe application at hand. The moral is to know which features are done well in your \nparticular implementation and to go out of your way to use them in critical situations, \nbut to stick with the most straightforward implementation in noncritical sections. \n\nLisp makes it easy to rely on lists, but one must avoid the temptation to overuse \nlists; to use them where another data structure is more appropriate. For example, if \nyou need to access elements of a sequence in arbitrary order, then a vector is more \nappropriate than list. If the sequence can grow, use an adjustable vector. Consider \nthe problem of maintaining information about a set of people, and searching that set. \nA naive implementation might look like this: \n\n\f\n<a id='page-341'></a>\n(defvar *people* nil \"Will hold a list of people\") \n\n(defstruct person name address id-number) \n\n(defun person-with-id (id) \n(find id *people* :key #'person-id-number)) \n\nIn a traditional language like C, the natural solution is to include in the person \nstructure a pointer to the next person, and to write a loop to follow these pointers. \nOf course, we can do that in Lisp too: \n\n(defstruct person name address id-number next) \n\n(defun person-with-id (id) \n\n(loop for person = *people* then (person-next person) \n\nuntil (null person) \n\ndo (when (eql id (person-id-number person)) \n\n(RETURN person)))) \n\nThis solution takes less space and is probably faster, because it requires less memory \naccesses: one for each person rather than one for each person plus one for each \ncons cell. So there is a small price to pay for using lists. But Lisp programmers feel \nthat price is worth it, because of the convenience and ease of coding and debugging \nafforded by general-purpose functions like f i nd. \n\nIn any case, if there are going to be a large number of people, the list is definitely \nthe wrong data structure. Fortunately, Lisp makes it easy to switch to more efficient \ndata structures, for example: \n\n(defun person-with-id (id) \n(gethash id *people*)) \n\nThe Right Data Structure: Queues \n\nAqueue is a data structure where one can add elements at the rear and remove them \nfrom the front. This is almost like a stack, except that in a stack, elements are both \nadded and removed at the same end. \n\nLists can be used to implement stacks, but there is a problem in using lists to \nimplement queues: adding an element to the rear requires traversing the entire list. \nSo collecting . elements would be O(n^) instead of 0{n). \n\nAn alternative implementation of queues is as a cons of two pointers: one to the \nlist of elements of the queue (the contents), and one to the last cons cell in the list. \nInitially, both pointers would be nil. This implementation in fact existed in BBN Lisp \nand UCI Lisp under the function name tconc: \n\n\f\n<a id='page-342'></a>\n\n;;; A queue is a (contents . last) pair \n\n(defun tconc (item q) \n\"Insert item at the end of the queue.\" \n(setf (cdr q) \n\n(if (null (cdr q)) \n(setf (car q) (cons item nil)) \n(setf (rest (cdr q)) \n\n(cons item nil))))) \n\nThe tconc implementation has the disadvantage that adding the first element to \nthe contents is different from adding subsequent elements, so an i f statement is \nrequired to decide which action to take. The definition of queues given below avoids \nthis disadvantage with a clever trick. First, the order of the two fields is reversed. \nThe car of the cons cell is the last element, and the cdr is the contents. Second, the \nempty queue is a cons cell where the cdr (the contents field) is nil, and the car (the \nlast field) is the cons itself. In the definitions below, we change the name tconc to \nthe more standard enqueue, and provide the other queue functions as well: \n\n;;; A queue is a (last . contents) pair \n\n(proclaim '(inline queue-contents make-queue enqueue dequeue \nfront empty-queue-p queue-nconc)) \n\n(defun queue-contents (q) (cdr q)) \n\n(defun make-queue () \n\"Build a new queue, with no elements.\" \n(let ((q (cons nil nil))) \n\n(setf (car q) q))) \n\n(defun enqueue (item q) \n\"Insert item at the end of the queue.\" \n(setf (car q) \n\n(setf (rest (car q)) \n(cons item nil))) \nq) \n\n(defun dequeue (q) \n\"Remove an item from the front of the queue.\" \n(pop (cdr q)) \n\n(if (null (cdr q)) (setf (car q) q)) \nq) \n\n(defun front (q) (first (queue-contents q))) \n\n(defun empty-queue-p (q) (null (queue-contents q))) \n\n\f\n<a id='page-343'></a>\n\n(defun queue-nconc (q list) \n\"Add the elements of LIST to the end of the queue.\" \n(setf (car q) \n\n(last (setf (rest (car q)) list)))) \n\nThe Right Data Structure: Tables \n\nA table is a data structure to which one can insert a key and associate it with a value, \nand later use the key to look up the value. Tables may have other operations, like \ncounting the number of keys, clearing out all keys, or mapping a function over each \nkey/value pair. \n\nLisp provides a wide variety of choices to implement tables. An association list \nis perhaps the simplest: it is just a list of key/value pairs. It is appropriate for small \ntables, up to a few dozen pairs. The hash table is designed to be efficient for large \ntables, but may have significant overhead for small ones. If the keys are symbols, \nproperty lists can be used. If the keys are integers in a narrow range (or can be \nmapped into them), then a vector may be the most efficient choice. \n\nHere we implement an alternative data structure, the trie. A trie implements a \ntable for keys that are composed of a finite sequence of components. For example, \nif we were implementing a dictionary as a trie, each key would be a word, and \neach letter of the word would be a component. The value of the key would be the \nword's definition. At the top of the dictionary trie is a multiway branch, one for each \npossible first letter. Each second-level node has a branch for every possible second \nletter, and so on. To find an n-letter word requires . reads. This kind of organization \nis especially good when the information is stored on secondary storage, because a \nsingle read can bring in a node with all its possible branches. \n\nIf the keys can be arbitrary list structures, rather than a simple sequence of letters, \nwe need to regularize the keys, transforming them into a simple sequence. One way \nto do that makes use of the fact that any tree can be written as a linear sequence \nof atoms and cons operations, in prefix form. Thus, we would make the following \ntransformation: \n\n(a (b c) d) = \n(cons a (cons (cons b (cons c nil)) (cons d nil))) = \n(cons a cons cons b cons c nil cons d nil) \n\nIn the implementation of tries below, this transformation is done on the fly: The four \nuser-level functions are make-trie to create a new trie, put-trie and get-trie to \nadd and retrieve key/value pairs, and del ete-tri e to remove them. \n\nNotice that we use a distinguished value to mark deleted elements, and that \nget-trie returns two values: the actual value found, and a flag saying if anything \n\n\f\n<a id='page-344'></a>\n\nwas found or not. This is consistent with the interface to gethash and find, and \nallows us to store null values in the trie. It is an inobtrusive choice, because the \nprogrammer who decides not to store null values can just ignore the second value, \nand everything will work properly. \n\n(defstruct trie (value nil) (arcs nil)) \n(defconstant trie-deleted \"deleted\") \n\n(defun put-trie (key trie value) \n\"Set the value of key in trie.\" \n(setf (trie-value (find-trie key t trie)) value)) \n\n(defun get-trie (key trie) \n\"Return the value for a key in a trie, and t/nil if found.\" \n(let* ((key-trie (find-trie key nil trie)) \n\n(val (if key-trie (trie-value key-trie)))) \n\n(if (or (null key-trie) (eq val trie-deleted)) \n(values nil nil) \n(values val t)))) \n\n(defun delete-trie (key trie) \n\"Remove a key from a trie.\" \n(put-trie key trie trie-deleted)) \n\n(defun find-trie (key extend? trie) \n\"Find the trie node for this key. \nIf EXTEND? is true, make a new node if need be.\" \n(cond ((null trie) nil) \n\n((atom key) \n(follow-arc key extend? trie)) \n\n(t (find-trie \n(cdr key) extend? \n(find-trie \n\n(car key) extend? \n(find-trie \n\".\" extend? trie)))))) \n\n(defun follow-arc (component extend? trie) \n\"Find the trie node for this component of the key. \nIf EXTEND? is true, make a new node if need be.\" \n(let ((arc (assoc component (trie-arcs trie)))) \n\n(cond ((not (null arc)) (cdr arc)) \n((not extend?) nil) \n(t (let ((new-trie (make-trie))) \n\n(push (cons component new-trie) \n(trie-arcs trie)) \nnew-trie))))) \n\n\f\n<a id='page-345'></a>\nThere are a few subtleties in the implementation. First, we test for deleted entries \n\nwith an eq comparison to a distinguished marker, the string tri e-deleted. No other \n\nobject will be eq to this string except tri e-del eted itself, so this is a good test. We \n\nalso use a distinguished marker, the string \".\", to mark cons cells. Components are \n\nimplicitly compared against this marker with an eql test by the assoc in fol 1 ow- arc. \n\nMaintaining the identity of this string is crucial; if, for example, you recompiled \n\nthe definition of f i nd-tri e (without changing the definition at all), then you could \n\nno longer find keys that were indexed in an existing trie, because the \".\" used by \n\nfi nd-tri e would be a different one from the \".\" in the existing trie. \n\nArtificial Intelligence Programming (Charniak et al. 1987) discusses variations on \nthe trie, particularly in the indexing scheme. If we always use proper lists (no non-null \ncdrs), then a more efficient encoding is possible. As usual, the best type of indexing \ndepends on the data to be indexed. It should be noted that Charniak et al. call the trie \na discrimination net. In general, that term refers to any tree with tests at the nodes. \n\nA trie is, of course, a kind of tree, but there are cases where it pays to convert a trie \ninto a dag—di directed acyclic graph. A dag is a tree where some of the subtrees are \nshared. Imagine you have a spelUng corrector program with a list of some 50,000 or \nso words. You could put them into a trie, each word with the value t. But there would \nbe many subtrees repeated in this trie. For example, given a word list containing look, \nlooks, looked, and looking as well as show, shows, showed, and showing, there would \nbe repetition of the subtree containing -s, -ed and -ing. After the trie is built, we \ncould pass the whole trie to un i que, and it would collapse the shared subtrees, saving \nstorage. Of course, you can no longer add or delete keys from the dag without risking \nunintended side effects. \n\nThis process was carried out for a 56,000 word list. The trie took up 3.2Mbytes, \nwhile the dag was 1.1 Mbytes. This was still deemed unacceptable, so a more compact \nencoding of the dag was created, using a .2Mbytes vector. Encoding the same word \nlist in a hash table took twice this space, even with a special format for encoding \nsuffixes. \n\nTries work best when neither the indexing key nor the retrieval key contains \nvariables. They work reasonably well when the variables are near the end of the \nsequence. Consider looking up the pattern \"yel 1 o?\" in the dictionary, where the \" ?\" \ncharacter indicates a match of any letter. Following the branches for \"yel 1 o\" leads \nquickly to the only possible match, \"yel 1 ow\". In contrast, fetching with the pattern \n\" ??11 ow\" is much less efficient. The table lookup function would have to search all \n26 top-level branches, and for each of those consider all possible second letters, and \nfor each of those consider the path \" 11 ow\". Quite a bit of searching is required before \narriving at the complete set of matches: bellow, billow, fallow, fellow, follow, hallow, \nhollow, mallow, mellow, pillow, sallow, tallow, wallow, willow, and yellow. \n\nWe will return to the problem of discrimination nets with variables in section 14.8, \n[page 472](chapter14.md#page-472). \n\n\f\n<a id='page-346'></a>\n\n10.6 Exercises \n&#9635; Exercise 10.1 [h] Define tlie macro deftable, such that (def table person assoc) \nwill act much like a def struct—it will define a set of functions for manipulating a \ntable of people: get-person, put-person, cl ear-person, and map-person. The table \nshould be implemented as an association list. Later on, you can change the representation \nof the table simply by changing the form to (def tabl e person hash), without \nhaving to change anything else in your code. Other implementation options include \nproperty lists and vectors, def table should also take three keyword arguments: \ni nl i ne, si ze and test. Here is a possible macroexpansion: \n\n> (macroexpand '(deftableperson hash .-inline t :size 100)) = \n\n(progn \n(proclaim '(inline get-person put-person map-person)) \n(defparameter *person-table* \n\n(make-hash-table :test #'eql :size 100)) \n(defun get-person (x &optional default) \n(gethash . *person-table* default)) \n(defun put-person (x value) \n\n(setf (gethash . *person-table*) value)) \n(defun clear-person () (clrhash *person-table*)) \n(defun map-person (fn) (maphash fn *person-table*)) \n(defsetf get-person put-person) \n'person) \n\n&#9635; Exercise 10.2 [m] We can use the : type option to defstruct to define structures \nimplemented as lists. However, often we have a two-field structure that we would \nlike to implement as a cons cell rather than a two-element list, thereby cutting storage \nin half. Since defstruct does not allow this, define a new macro that does. \n\n&#9635; Exercise 10.3 [m] Use reuse - cons to write a version of f 1 atten (see [page 329](chapter10.md#page-329)) that \nshares as much of its input with its output as possible. \n\n&#9635; Exercise 10.4 [h] Consider the data type set. A set has two main operations: adjoin \nan element and test for membership. It is convenient to also add a map-over-elements \noperation. With these primitive operations it is possible to build up more complex \noperations like union and intersection. \nAs mentioned in section 3.9, Common Lisp provides several implementations \nof sets. The simplest uses lists as the underlying representation, and provides the \n\n\f\n<a id='page-347'></a>\n\nfunctions ad j oi ., member, uni on, i ntersecti on, and set-di f f erence. Another uses \nbit vectors, and a similar one uses integers viewed as bit sequences. Analyze the \ntime complexity of each implementation for each operation. \n\nNext, show how sorted lists can be used to implement sets, and compare the \noperations on sorted lists to their counterparts on unsorted lists. \n\n10.7 Answers \nAnswer 10.2 \n\n(defmacro def-cons-struct (cons car cdr &optional inline?) \n\"Define aliases for cons, car and cdr.\" \n'(progn (proclaim '(.(if inline? 'inline 'notinline) \n\n.car .cdr .cons)) \n(defun .car (x) (car x)) \n(defun .cdr (x) (cdr x)) \n(defsetf .car (x) (val) '(setf (car .x) .val)) \n(defsetf .cdr (x) (val) '(setf (cdr .x) .val)) \n(defun .cons (x y) (cons . y)))) \n\nAnswer 10.3 \n\n(defun flatten (exp &optional (so-far nil) last-cons) \n\"Return a flat list of the atoms in the input. \nEx: (flatten '((a) (b (c) d))) => (a b c d).\" \n(cond ((null exp) so-far) \n\n((atom exp) (reuse-cons exp so-far last-cons)) \n\n(t (flatten (first exp) \n(flatten (rest exp) so-far exp) \nexp)))) \n\n\f\n## Chapter 11\n<a id='page-348'></a>\n\nLogic Programming \n\nAlanguage that doesn't affect the way you think \nabout programming is not worth knowing. \n\n—Alan Perlis \n\nL\nL\nisp is the major language for AI work, but it is by no means the only one. The other \nstrong contender is Prolog, whose name derives from \"programming in logic.\"^ The idea \nbehind logic programming is that the programmer should state the relationships that \ndescribe a problem and its solution. These relationships act as constraints on the algorithms \nthat can solve the problem, but the system itself, rather than the programmer, is responsible for \nthe details of the algorithm. The tension between the \"programming\" and \"logic\" will be covered \nin chapter 14, but for now it is safe to say that Prolog is an approximation to the ideal goal of logic \nprogramming. Prolog has arrived at a comfortable niche between a traditional programming \nlanguage and a logical specification language. It relies on three important ideas: \n\n^Actually, programmation en logique, since it was invented bya French group (see [page 382](chapter11.md#page-382)). \n\n\f\n<a id='page-349'></a>\n\n* Prolog encourages the use of a single uniform data base. Good compilers provide \nefficient access to this data base, reducing the need for vectors, hash tables, \nproperty lists, and other data structures that the Lisp programmer must deal \nwith in detail. Because it is based on the idea of a data base, Prolog is relational, \nwhile Lisp (and most languages) are functional. In Prolog we would represent \na fact like \"the population of San Francisco is 750,000\" as a relation. In Lisp, \nwe would be inclined to write a function, population, which takes a city as \ninput and returns a number. Relations are more flexible; they can be used not \nonly to find the population of San Francisco but also, say, to find the cities with \npopulations over 500,000. \n* Prolog provides logic variables instead of \"normal\" variables. A logic variable is \nbound by unification rather than by assignment. Once bound, a logic variable \ncan never change. Thus, they are more like the variables of mathematics. The \nexistence of logic variables and unification allow the logic programmer to state \nequations that constrain the problem (as in mathematics), without having to \nstate an order of evaluation (as with assignment statements). \n* Prolog provides automatic backtracking. In Lisp each function call returns a single \nvalue (unless the programmer makes special arrangements to have it return \nmultiple values, or a list of values). In Prolog, each query leads to a search for \nrelations in the data base that satisfy the query. If there are several, they are \nconsidered one at a time. If a query involves multiple relations, as in \"what city \nhas a population over 500,000 and is a state capital?,\" Prolog will go through \nthe popul ati on relation to find a city with a population over 500,000. For each \none it finds, it then checks the capi tal relation to see if the city is a capital. If \nit is, Prolog prints the city; otherwise it backtracks, trying to find another city \nin the population relation. So Prolog frees the programmer from worrying \nabout both how data is stored and how it is searched. For some problems, the \nnaive automatic search will be too inefficient, and the programmer will have to \nrestate the problem. But the ideal is that Prolog programs state constraints on \nthe solution, without spelling out in detail how the solutions are achieved. \nThis chapter serves two purposes: it alerts the reader to the possibility of writing \ncertain programs in Prolog rather than Lisp, and it presents implementations of the \nthree important Prolog ideas, so that they may be used (independently or together) \nwithin Lisp programs. Prolog represents an interesting, different way of looking \nat the programming process. For that reason it is worth knowing. In subsequent \nchapters we will see several useful applications of the Prolog approach. \n\n\f\n<a id='page-350'></a>\n\n11.1 Idea 1: A Uniform Data Base \nThe first important Prolog idea should be familiar to readers of this book: manipulating \na stored data base of assertions. In Prolog the assertions are called clauses, \nand they can be divided into two types: facts, which state a relationship that holds \nbetween some objects, and rules, which are used to state contingent facts. Here \nare representations of two facts about the population of San Francisco and the capital \nof California. The relations are population and capital, and the objects that \nparticipate in these relations are SF, 750000, Sacramento, and CA: \n\n(population SF 750000) \n\n(capital Sacramento CA) \n\nWe are using Lisp syntax, because we want a Prolog interpreter that can be imbedded \nin Lisp. The actual Prolog notation would be popul ation(sf,750000). Here are \nsome facts pertaining to the 1 i kes relation: \n\n(likes Kim Robin) \n(likes Sandy Lee) \n(likes Sandy Kim) \n(likes Robin cats) \n\nThese facts could be interpreted as meaning that Kim likes Robin, Sandy likes both \nLee and Kim, and Robin likes cats. We need some way of telling Lisp that these are \nto be interpreted as Prolog facts, not a Lisp function call. We will use the macro <- to \nmark facts. Think of this as an assignment arrow which adds a fact to the data base: \n\n(<- (likes Kim Robin)) \n(<- (likes Sandy Lee)) \n(<- (likes Sandy Kim)) \n(<- (likes Robin cats)) \n\nOne of the major differences between Prolog and Lisp hinges on the difference \nbetween relations and functions. In Lisp, we would define a function 1 i kes, so \nthat (likes 'Sandy) would return the list (Lee Kim). If we wanted to access the \ninformation the other way, we would define another function, say, 1 i kers-of, so \nthat (1i ker s - of ' Lee) returns (Sandy). In Prolog, we have a single 1 i kes relation \ninstead of multiple functions. This single relation can be used as if it were multiple \nfunctions by posing different queries. For example, the query (1i kes Sandy ?who) \nsucceeds with ?who bound to Lee or Kim, and the query (1i kes ?who Lee) succeeds \nwith ?who bound to Sandy. \n\n\f\n<a id='page-351'></a>\n\nThe second type of clause in a Prolog data base is the rule. Rules state contingent \n\nfacts. For example, we can represent the rule that Sandy likes anyone who likes cats \n\nas follows: \n\n(<- (likes Sandy ?x) (likes ?x cats)) \n\nThis can be read in two ways. Viewed as a logical assertion, it is read, \"For any x, \nSandy likes . if . likes cats.\" This is a declarative interpretation. Viewed as a piece \nof a Prolog program, it is read, \"If you ever want to show that Sandy likes some x, \none way to do it is to show that . likes cats.\" This is a procedural interpretation. \nIt is called a backward-chaining interpretation, because one reasons backward from \nthe goal (Sandy likes x) to the premises (x likes cats). The symbol <- is appropriate \nfor both interpretations: it is an arrow indicating logical implication, and it points \nbackwards to indicate backward chaining. \n\nIt is possible to give more than one procedural interpretation to a declarative form. \n(We did that in chapter 1, where grammar rules were used to generate both strings \nof words and parse trees.) The rule above could have been interpreted procedurally \nas \"If you ever find out that some . likes cats, then conclude that Sandy likes x.\" This \nwould be forward chaining: reasoning from a premise to a conclusion. It turns out \nthat Prolog does backward chaining exclusively. Many expert systems use forward \nchaining exclusively, and some systems use a mixture of the two. \n\nThe leftmost expression in a clause is called the head, and the remaining ones are \ncalled the body. In this view, a fact is just a rule that has no body; that is, a fact is true \nno matter what. In general, then, the form of a clause is: \n\n(<-head body...) \n\nA clause asserts that the head is true only if all the goals in the body are true. For \nexample, the following clause says that Kim likes anyone who likes both Lee and \nKim: \n\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim)) \n\nThis can be read as: \n\nFor any X, deduce that Km likes . \nif it can be proved that X likes lee and . likes Kim. \n\n\f\n<a id='page-352'></a>\n\n11.2 Idea 2: Unification of Logic Variables \nUnification is a straightforward extension of the idea of pattern matching. The \npattern-matching functions we have seen so far have always matched a pattern \n(an expression containing variables) against a constant expression (one with no \nvariables). In unification, two patterns, each of which can contain variables, are \nmatched against each other. Here's an example of the difference between pattern \nmatching and unification: \n\n> (pat-match '(Tx + ?y) '(2 + D) ^ ((?Y . 1) (?X . 2)) \n\n> (unify '(?x + 1) '(2 + ?y)) => ((?Y . 1) (?X . 2)) \n\nWithin the unification framework, variables (such as ?x and ?y above) are called logic \nvariables. Like normal variables, a logic variable can be assigned a value, or it can \nbe unbound. The difference is that a logic variable can never be altered. Once it is \nassigned a value, it keeps that value. Any attempt to unify it with a different value \nleads to failure. It is possible to unify a variable with the same value more than once, \njust as it was possible to do a pattern match of (?x + ?x) with (2 + 2). \n\nThe difference between simple pattern matching and unification is that unification \nallows two variables to be matched against each other. The two variables remain \nunbound, but they become equivalent. If either variable is subsequently bound to \na value, then both variables adopt that value. The following example equates the \nvariables ?x and ?y by binding ?x to ?y: \n\n> (unify '(f ?x) '(f ?y)) => ((?X . ?Y)) \n\nUnification can be used to do some sophisticated reasoning. For example, if we have \ntwo equations, .-h. = 0 and . y = y, and if we know that these two equations \nunify, then we can conclude that a, x, and y are all 0. The version of uni fy we will \ndefine shows this result by binding ?y to 0, ?x to ?y, and ?a to ?x. We will also \ndefine the function unifier, which shows the structure that results from unifying \ntwo structures. \n\n> (unify '(?a + ?a = 0) '(?x + ?y = ?y)) => \n((?Y . 0) (?X . ?Y) (?A . ?X)) \n\n> (unifier '(?a + ?a = 0) '(?x + ?y = ?y)) => (0 + 0 = 0) \n\nTo avoid getting carried away by the power of unification, it is a good idea to take stock \nof exactly what unification provides. It does provide a way of stating that variables \nare equal to other variables or expressions. It does not provide a way of automatically \nsolving equations or applying constraints other than equality. The following example \n\n\f\n<a id='page-353'></a>\n\nmakes it clear that unification treats the symbol + only as an uninterpreted atom, not \nas the addition operator: \n\n> (unifier '(?a + ?a = 2) '(?x + ?y= ?y)) ^(2+2=2) \n\nBefore developing the code for unif y, we repeat here the code taken from the pattern-\nmatching utility (chapter 6): \n\n(defconstant fail nil \"Indicates pat-match failure\") \n\n(defconstant no-bindings *((t . t)) \n\"Indicates pat-match success, with no variables.\") \n\n(defun variable-p (x) \n\"Is X a variable (a symbol beginning with *?*)?\" \n(and (symbolp x) (equal (char (symbol-name x) 0) #\\?))) \n\n(defun get-binding (var bindings) \n\"Find a (variable . value) pair in a binding list. \" \n(assoc var bindings)) \n\n(defun binding-val (binding) \n\"Get the value part of a single binding.\" \n(cdr binding)) \n\n(defun lookup (var bindings) \n\"Get the value part (for var) from a binding list. \" \n(binding-val (get-binding var bindings))) \n\n(defun extend-bindings (var val bindings) \n\"Add a (var . value) pair to a binding list.\" \n(cons (cons var val) \n\nOnce we add a \"real\" binding, \nwe can get rid of the dummy no-bindings \n\n(if (and (eq bindings no-bindings)) \nnil \nbindings))) \n\n(defun match-variable (var input bindings) \n\"Does VAR match input? Uses (or updates) and returns bindings.\" \n(let ((binding (get-binding var bindings))) \n\n(cond ((not binding) (extend-bindings var input bindings)) \n((equal input (binding-val binding)) bindings) \n(t fail)))) \n\nThe unify function follows; it is identical to pat-match (as defined on [page 180](chapter6.md#page-180)) \nexcept for the addition of the line marked The function uni fy-vari abl e also \nfollows match -variable closely: \n\n\f\n<a id='page-354'></a>\n\n(defun unify (. y &optional (bindings no-bindings)) \n\"See if X and y match with given bindings.\" \n(cond ((eq bindings fail) fail) \n\n((variable-p x) (unify-variable . y bindings)) \n\n((variable-p y) (unify-variable y . bindings)) \n\n((eql X y) bindings) \n\n((and (consp x) (consp y)) \n\n(unify (rest x) (rest y) \n(unify (first x) (first y) bindings))) \n(t fail))) \n\n(defun unify-variable (var . bindings) \n\"Unify var with x. using (and maybe extending) bindings.\" \nWarning - buggy version \n\n(if (get-binding var bindings) \n(unify (lookup var bindings) . bindings) \n(extend-bindings var . bindings))) \n\nUnfortunately, this definition is not quite right. It handles simple examples: \n\n> (unify '(?x + 1) '(2 + ?y)) => ((?Y . 1) (?X . 2)) \n\n> (unify '?x '?y) ((?X . ?Y)) \n\n> (unify '(?x ?x) '(Ty ?y)) => ((?Y . ?Y) (?X . ?Y)) \n\nbut there are several pathological cases that it can't contend with: \n\n> (unify '(?x ?x ?x) '(?y ?y ?y)) \n\n>Trap #043622 (PDL-OVERFLOW REGULAR) \n\nThe regular push-down list has overflowed. \n\nWhile in the function GET-BINDING ^ UNIFY-VARIABLE .= UNIFY \n\nThe problem here is that once ?y gets bound to itself, the call to unify inside \n\nuni fy-vari abl e leads to an infinite loop. But matching ?y against itself must al\n\n\nways succeed, so we can move the equality test in uni fy before the variable test. This \n\nassumes that equal variables are eql, a valid assumption for variables implemented \n\nas symbols (but be careful if you ever decide to implement variables some other way). \n\n(defun unify (x y &optional (bindings no-bindings)) \n\"See if X and y match with given bindings.\" \n(cond ((eq bindings fail) fail) \n\n((eql X y) bindings) moved this line \n((variable-p x) (unify-variable . y bindings)) \n((variable-p y) (unify-variable y . bindings)) \n((and (consp x) (consp y)) \n\n(unify (rest x) (rest y) \n\n\f\n<a id='page-355'></a>\n\n(unify (first x) (first y) bindings))) \n(t fail))) \n\nHere are some test cases: \n\n> (unify '(?x ?x) '(?y ?y)) ((?X . ?Y)) \n\n> (unify '(?x ?x ?x) '(?y ?y ?y)) ((?X . ?Y)) \n\n> (unify '(?x ?y) '(?y ?x)) ^ ((?Y . ?X) (?X . ?Y)) \n\n> (unify '(?x ?y a) '(?y ?x ?x)) \n>Trap #043622 (PDL-OVERFLOW REGULAR) \nThe regular push-down list has overflowed. \nWhile in the function GET-BINDING ^ UNIFY-VARIABLE <= UNIFY \n\nWe have pushed off the problem but not solved it. Allowing both (?Y . ?X) and \n(?X . ?Y) in the same binding list is as bad as allowing (?Y . ?Y). To avoid the \nproblem, the policy should be never to deal with bound variables, but rather with \ntheir values, as specified in the binding list. The function uni fy-vari abl e fails to \nimplement this policy. It does have a check that gets the binding for va r when it is a \nbound variable, but it should also have a check that gets the value of x, when . is a \nbound variable: \n\n(defun unify-variable (var . bindings) \n\"Unify var with x, using (and maybe extending) bindings.\" \n(cond ((get-binding var bindings) \n\n(unify (lookup var bindings) . bindings)) \n((and (variable-p x) (get-binding . bindings)) \n(unify var (lookup . bindings) bindings)) \n(t (extend-bindings var . bindings)))) \n\nHere are some more test cases: \n\n> (unify '(?x ?y) *(?y ?x)) ((?X . ?Y)) \n\n> (unify '(?x ?y a) '(?y ?x ?x)) ^ ((?Y . A) (?X . ?Y)) \n\nIt seems the problem is solved. Now let's try a new problem: \n\n> (unify '?x '(f ?x)) => ((?X F ?X)) \n\nHere((?X F ?X)) really means ((?X . ((F ?X)))), so ?X is bound to (F ?X).This \nrepresents a circular, infinite unification. Some versions of Prolog, notably Prolog II \n(Giannesini et al. 1986), provide an interpretation for such structures, but it is tricky \nto define the semantics of infinite structures. \n\n\f\n<a id='page-356'></a>\n\nThe easiest way to deal with such infinite structures is just to ban them. This \nban can be realized by modifying the unifier so that it fails whenever there is an \nattempt to unify a variable with a structure containing that variable. This is known in \nunification circles as the occurs check. In practice the problem rarely shows up, and \nsince it can add a lot of computational complexity, most Prolog systems have ignored \nthe occurs check. This means that these systems can potentially produce unsound \nanswers. In the final version of uni fy following, a variable is provided to allow the \nuser to turn occurs checking on or off. \n\n(defparameter *occurs-check* t \"Should we do the occurs check?\") \n\n(defun unify (x y &optional (bindings no-bindings)) \n\"See if X and y match with given bindings.\" \n(cond ((eq bindings fail) fail) \n\n((eql X y) bindings) \n((variable-p x) (unify-variable . y bindings)) \n((variable-p y) (unify-variable y . bindings)) \n((and (consp x) (consp y)) \n\n(unify (rest x) (rest y) \n(unify (first x) (first y) bindings))) \n(t fail))) \n\n(defun unify-variable (var . bindings) \n\"Unify var with x. using (and maybe extending) bindings.\" \n(cond ((get-binding var bindings) \n\n(unify (lookup var bindings) . bindings)) \n((and (variable-p x) (get-binding . bindings)) \n(unify var (lookup . bindings) bindings)) \n((and *occurs-check* (occurs-check var . bindings)) \nfail) \n(t (extend-bindings var . bindings)))) \n\n(defun occurs-check (var . bindings) \n\"Does var occur anywhere inside x?\" \n(cond ((eq var x) t) \n\n((and (variable-p x) (get-binding . bindings)) \n(occurs-check var (lookup . bindings) bindings)) \n((consp x) (or (occurs-check var (first x) bindings) \n(occurs-check var (rest x) bindings))) \n(t nil))) \n\nNow we consider how unify will be used. In particular, one thing we want is a \nfunction for substituting a binding list into an expression. We originally chose \nassociation lists as the implementation of bindings because of the availability of the \nfunction subl is. Ironically, subl is won't work any more, because variables can \nbe bound to other variables, which are in turn bound to expressions. The function \nsubst-bi ndi ngs acts like subl i s, except that it substitutes recursive bindings. \n\n\f\n<a id='page-357'></a>\n\n(defun subst-bindings (bindings x) \n\"Substitute the value of variables in bindings into x, \ntaking recursively bound variables into account.\" \n(cond ((eq bindings fail) fail) \n\n((eq bindings no-bindings) x) \n((and (variable-p x) (get-binding . bindings)) \n\n(subst-bindings bindings (lookup . bindings))) \n\n((atom x) x) \n\n(t (reuse-cons (subst-bindings bindings (car x)) \n\n(subst-bindings bindings (cdr x)) \nx)))) \n\nNow let's try uni fy on some examples: \n\n> (unify '(?x ?y a) '(?y ?x ?x)) => ((?Y . A) (?X. ?Y)) \n\n> (unify .?. '(f ?x)) NIL \n\n> (unify '(?x ?y) '((f ?y) (f ?x))) ^ NIL \n\n> (unify '(?x ?y ?z) '((Ty ?z) (?x ?z) (?x ?y))) => NIL \n\n> (unify 'a 'a) ((T . T)) \n\nFinally, the function unifier calls unify and substitutes the resulting binding Ust \ninto one of the arguments. The choice of . is arbitrary; an equal result would come \nfrom substituting the binding list into y. \n\n(defun unifier (x y) \n\"Return something that unifies with both . and y (or fail).\" \n(subst-bindings (unify . y) .)) \n\nHere are some examples of uni f i er: \n\n> (unifier '(?. ?y a) '(?y ?x ?x)) (A A A) \n\n> (unifier '((?a * ?x ^ 2) + (?b* ?x) + ?c) \n'(?z + (4 * 5) + 3)) => \n((?A * 5 ^ 2) + (4 * 5) + 3) \n\n\f\n<a id='page-358'></a>\n\nWhen *occurs - check* is false, we get the following answers: \n\n> (unify '?x *(f ?x)) ^ ((?X F ?X)) \n\n> (unify '(?x ?y) '((f ?y) (f ?x))) => \n((?Y F ?X) (?X F ?Y)) \n\n> (unify '(?x ?y ?z) '((?y ?z) (?x ?z) (?x ?y))) \n((?Z ?X ?Y) (?Y ?X 11) (?X ?Y ?Z)) \n\nProgramming with Prolog \n\nThe amazing thing about Prolog clauses is that they can be used to express relations \nthat we would normally think of as \"programs,\" not \"data.\" For example, we can \ndefine the member relation, which holds between an item and a list that contains that \nitem. More precisely, an item is a member of a list if it is either the first element of the \nlist or a member of the rest of the list. This definition can be translated into Prolog \nalmost verbatim: \n\n(<- (member ?item (?item . ?rest))) \n(<- (member ?item (?x . ?rest)) (member ?item ?rest)) \n\nOf course, we can write a similar definition in Lisp. The most visible difference is that \nProlog allows us to put patterns in the head of a clause, so we don't need recognizers \nlike consp or accessors like first and rest. Otherwise, the Lisp definition is similar:^ \n\n(defun lisp-member (item list) \n(and (consp list) \n(or (eql item (first list)) \n(lisp-member item (rest list))))) \n\nIf we wrote the Prolog code without taking advantage of the pattern feature, it would \nlook more like the Lisp version: \n\n(<- (member ?item ?list) \n(= ?list (?item . ?rest))) \n\n^Actually, this is more like the Lisp f i nd than the Lisp member. In this chapter we have \nadopted the traditional Prolog definition of member. \n\n\f\n<a id='page-359'></a>\n\n(<- (member ?item ?list) \n(= ?list (?x . ?rest)) \n(member ?item ?rest)) \n\nIf we define or in Prolog, we would write a version that is clearly just a syntactic \nvariant of the Lisp version. \n\n(<- (member ?item ?list) \n(= ?list (?fir$t . ?rest)) \n(or (= ?item ?first) \n\n(member ?i tern ?rest))) \n\nLet's see how the Prolog version of member works. Imagine that we have a Prolog \ninterpreter that can be given a query using the macro ?-, and that the definition of \nmember has been entered. Then we would see: \n\n> (?- (member 2 (1 2 3))) \nYes; \n\n> (?- (member 2 (1 2 3 2 1))) \n\nYes; \n\nYes; \n\nThe answer to the first query is \"yes\" because 2 is a member of the rest of the list. In \nthe second query the answer is \"yes\" twice, because 2 appears in the list twice. This \nis a little surprising to Lisp programmers, but there still seems to be a fairly close \ncorrespondence between Prolog's and Lisp's member. However, there are things that \nthe Prolog member can do that Lisp cannot: \n\n> (?- (member ?x (1 2 3))) \n\n?X = 1; \n?X = 2 \n?X = 3 \n\nHere member is used not as a predicate but as a generator of elements in a Hst. \nWhile Lisp functions always map from a specified input (or inputs) to a specified \noutput, Prolog relations can be used in several ways. For member, we see that the \nfirst argument, ?x, can be either an input or an output, depending on the goal that \nis specified. This power to use a single specification as a function going in several \ndifferent directions is a very flexible feature of Prolog. (Unfortunately, while it works \nvery well for simple relations like member, in practice it does not work well for large \nprograms. It is very difficult to, say, design a compiler and automatically have it work \nas a disassembler as well.) \n\n\f\n<a id='page-360'></a>\n\nNow we turn to the implementation of the Prolog interpreter, as summarized in \nfigure 11.1. The first implementation choice is the representation of rules and facts. \nWe will build a single uniform data base of clauses, without distinguishing rules from \nfacts. The simplest representation of clauses is as a cons cell holding the head and \nthe body. For facts, the body will be empty. \n\n;; Clauses are represented as (head . body) cons cells \n(defun clause-head (clause) (first clause)) \n(defun clause-body (clause) (rest clause)) \n\nThe next question is how to index the clauses. Recall the procedural interpretation \nof a clause: when we want to prove the head, we can do it by proving the body. This \nsuggests that clauses should be indexed in terms of their heads. Each clause will be \nstored on the property list of the predicate of the head of the clause. Since the data \nbase is now distributed across the property list of various symbols, we represent the \nentire data base as a Hst of symbols stored as the value of *db-predi cates*. \n\nClauses are stored on the predicate's plist \n(defun get-clauses (pred) (get pred 'clauses)) \n(defun predicate (relation) (first relation)) \n\n(defvar *db-predicates* nil \n\"A list of all predicates stored in the database.\") \n\nNow we need a way of adding a new clause. The work is split up into the macro <-, \nwhich provides the user interface, and a function, add-cl a use, that does the work. \nIt is worth defining a macro to add clauses because in effect we are defining a new \nlanguage: Prolog-In-Lisp. This language has only two syntactic constructs: the <macro \nto add clauses, and the ? - macro to make queries. \n\n(defmacro <- (&rest clause) \n\"Add a clause to the data base.\" \n\n'(add-clause '.clause)) \n(defun add-clause (clause) \n\"Add a clause to the data base, indexed by head's predicate.\" \nThe predicate must be a non-variable symbol, \n\n(let ((pred (predicate (clause-head clause)))) \n(assert (and (symbolp pred) (not (variable-p pred)))) \n(pushnew pred *db-predicates*) \n(setf (get pred 'clauses) \n\n(nconc (get-clauses pred) (list clause))) \npred)) \n\nNow all we need is a way to remove clauses, and the data base will be complete. \n\n\f\n<a id='page-361'></a>\n<\n\n\n?\n\n\n*db-precli cates* \n*occurs -check* \n\nclause \n\nvariable \n\nadd-clause \nprove \nprove-all \ntop-level-prove \n\nget-clauses \npredicate \nclear-db \nclear-predicate \nrename-variables \nunique-find-anywhere-if \nshow-prolog-soluti ons \nshow-prolog-vars \nvariables-in \n\nfail \nno-bindings \n\nunify \nunify-variable \noccurs-check \nsubst-bindings \nget-binding \nlookup \nextend-bindings \nvariable-p \nreuse-cons \n\nTop-Level Macros \n\nAdd a clause to the data base. \nProve a query and print answer(s). \n\nSpecial Variables \n\nA list of all predicates. \nShould we check for circular unifications? \n\nData Types \n\nConsists of a head and a body. \nA symbol starting with a ?. \n\nMajor Functions \n\nAdd a clause to the data base. \nReturn a list of possible solutions to goal. \nReturn a list of solutions to the conjunction of goals. \nProve the goals, and print variables readably. \n\nAuxiliary F^mctions \n\nFind all the clauses for a predicate. \nPick out the predicate from a relation. \nRemove all clauses (for all predicates) from the data base. \nRemove the clauses for a single predicate. \nReplace all variables in . with new ones. \nFind all unique leaves satisfying predicate. \nPrint the variables in each of the solutions. \nPrint each variable with its binding. \nReturn a list of all the variables in an expression. \n\nPreviously Defined Constants \n\nAn indication that unification has failed. \nA succesful unification with no variables. \n\nPreviously Defined Functions \n\nReturn bindings that unify two expressions (section 11.2). \nUnify a variable against an expression. \nSee if a particular variable occurs inside an expression. \nSubstitute bindings into an expression. \nGet the (var . val) binding for a variable. \nGet the value for a variable. \nAdd a new variable/value pair to a binding list. \nIs the argument a variable? \nLike cons, except will reuse an old value if possible. \n\nFigure 11.1: Glossary for the Prolog Interpreter \n\n\f\n<a id='page-362'></a>\n\n(defun clear-db () \n\"Remove all clauses (for all predicates) from the data base.\" \n(mapc #'clear-predicate *db-predicates*)) \n\n(defun clear-predicate (predicate) \n\"Remove the clauses for a single predicate.\" \n(setf (get predicate 'clauses) nil)) \n\nA data base is useless without a way of getting data out, as well as putting it in. The \nfunction prove will be used to prove that a given goal either matches a fact that is in \nthe data base directly or can be derived from the rules. To prove a goal, first find all \nthe candidate clauses for that goal. For each candidate, check if the goal unifies with \nthe head of the clause. If it does, try to prove all the goals in the body of the clause. \nFor facts, there will be no goals in the body, so success will be immediate. For rules, \nthe goals in the body need to be proved one at a time, making sure that bindings from \nthe previous step are maintained. The implementation is straightforward: \n\n(defun prove (goal bindings) \n\"Return a list of possible solutions to goal.\" \n(mapcan #'(lambda (clause) \n\n(let ((new-clause (rename-variables clause))) \n(prove-all (clause-body new-clause) \n(unify goal (clause-head new-clause) bindings)))) \n(get-clauses (predicate goal)))) \n\n(defun prove-all (goals bindings) \n\"Return a list of solutions to the conjunction of goals.'\" \n(cond ((eq bindings fail) fail) \n\n((null goals) (list bindings)) \n(t (mapcan #*(lambda (goall-solution) \n(prove-all (rest goals) goall-solution)) \n(prove (first goals) bindings))))) \n\nThe tricky part is that we need some way of distinguishing a variable ?x in one \nclause from another variable ?x in another clause. Otherwise, a variable used in two \ndifferent clauses in the course of a proof would have to take on the same value in \neach clause, which would be a mistake. Just as arguments to a function can have \ndifferent values in different recursive calls to the function, so the variables in a clause \nare allowed to take on different values in different recursive uses. The easiest way to \nkeep variables distinct is just to rename all variables in each clause before it is used. \nThe function rename-vari abl es does this:^ \n\n^See exercise 11.12 for an alternative approach. \n\n\f\n<a id='page-363'></a>\n\n(defun rename-variables (x) \n\"Replace all variables in . with new ones.\" \n(sublis (mapcar #'(lambda (var) (cons var (gensym (string var)))) \n\n(variables-in x)) \n\nX)) \n\nRename - variables makes use of gensym, a function that generates a new symbol each \ntime it is called. The symbol is not interned in any package, which means that there \nis no danger of a programmer typing a symbol of the same name. The predicate \nvari abl es -i. and its auxiliary function are defined here: \n\n(defun variables-in (exp) \n\"Return a list of all the variables in EXP.\" \n(unique-find-anywhere-if #*variable-p exp)) \n\n(defun unique-find-anywhere-if (predicate tree \n\n&optional found-so-far) \n\"Return a list of leaves of tree satisfying predicate, \nwith duplicates removed.\" \n(if (atom tree) \n\n(if (funcall predicate tree) \n(adjoin tree found-so-far) \nfound-so-far) \n\n(unique-find-anywhere-if \npredicate \n(first tree) \n(unique-find-anywhere-if predicate (rest tree) \n\nfound-so-far)))) \n\nFinally, we need a nice interface to the proving functions. We will use ?- as a macro \nto introduce a query. The query might as well allow a conjunction of goals, so ?- will \ncall prove-all. Together,<- and?- def ine the complete syntax of our Prolog-In-Lisp \nlanguage. \n\n(defmacro ? - (&rest goals) '(prove-all '.goals no-bindings)) \n\nNow we can enter all the clauses given in the prior example: \n\n(<- (likes Kim Robin)) \n\n(<- (likes Sandy Lee)) \n\n(<- (likes Sandy Kim)) \n\n(<- (likes Robin cats)) \n\n(<- (likes Sandy ?x) (likes ?x cats)) \n\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim)) \n\n(<- (likes ?x ?x)) \n\n\f\n<a id='page-364'></a>\n\nTo ask whom Sandy Hkes, we would use: \n\n> (?- (likes Sandy ?who)) \n\n(((?WHO . LEE)) \n((?WHO . KIM)) \n((7X2856 . ROBIN) (?WHO . 7X2856)) \n((7X2860 . CATS) (7X2857 . CATS) (7X2856 . SANDY) (7WH0 . 7X2856)) \n((7X2865 . CATS) (7X2856 . 7X2865) (7WH0 . 7X2856)) \n((7WH0 . SANDY) (7X2867 . SANDY))) \n\nPerhaps surprisingly, there are six answers. The first two answers are Lee and Kim, \nbecause of the facts. The next three stem from the clause that Sandy likes everyone \nwho likes cats. First, Robin is an answer because of the fact that Robin likes cats. \nTo see that Robin is the answer, we have to unravel the bindings: ?who is bound to \n?x2856, which is in turn bound to Robin. \n\nNow we're in for some surprises: Sandy is listed, because of the following reasoning: \n(1) Sandy likes anyone/thing who likes cats, (2) cats like cats because everyone \nlikes themself, (3) therefore Sandy likes cats, and (4) therefore Sandy likes Sandy. \nCats is an answer because of step (2), and finally, Sandy is an answer again, because \nof the clause about liking oneself. Notice that the result of the query is a list of \nsolutions, where each solution corresponds to a different way of proving the query \ntrue. Sandy appears twice because there are two different ways of showing that \nSandy likes Sandy. The order in which solutions appear is determined by the order \nof the search. Prolog searches for solutions in a top-down, left-to-right fashion. The \nclauses are searched from the top down, so the first clauses entered are the first ones \ntried. Within a clause, the body is searched left to right. In using the (1 i kes Ki m ?x) \nclause, Prolog would first try to find an . who likes Lee, and then see if . likes Kim. \n\nThe output from prove-al 1 is not very pretty. We can fix that by defining a new \nfunction, top-level -prove, which calls prove-all as before, but then passes the \nlist of solutions to show-prolog-solutions, which prints them in a more readable \nformat Note thatshow-prolog-solutions returns no values: (values). This means \nthe read-eval-print loop will not print anything when (values) is the result of a \ntop-level call. \n\n(defmacro 7- (&rest goals) \n*(top-level-prove *,goals)) \n\n(defun top-level-prove (goals) \n\"Prove the goals, and print variables readably.\" \n(show-prolog-solutions \n\n(variables-in goals) \n(prove-all goals no-bindings))) \n\n\f\n<a id='page-365'></a>\n\n(defun show-prolog-solutions (vars solutions) \n\"Print the variables in each of the solutions.\" \n(if (null solutions) \n\n(format t \"-&No.\") \n(mapc #'(lambda (solution) (show-prolog-varssolutions)) \n(values)) \n\n(defun show-prolog-vars (vars bindings) \n\"Print each variable with its binding.\" \n\n vars solution)) \n\n(if (null vars) \n(format t \"~&Yes\") \n(dolist (var vars) \n\n(format t \"\"&^a = ~a\" var \n(subst-bindings bindings\n\n(princ \";\")) \n\nNow let's try some queries: \n\n> (?- (likes Sandy ?who)) \n\n?WHO = LEE; \n\n?WHO = KIM; \n\n?WHO = ROBIN; \n\n?WHO = SANDY; \n\n?WHO = CATS; \n\n?WHO = SANDY; \n\n> (?- (likes ?who Sandy)) \n?WHO = SANDY; \n?WHO = KIM; \n?WHO = SANDY; \n\n> (?- (likes Robin Lee)) \nNo. \n\n var)))) \n\nThe first query asks again whom Sandy likes, and the second asks who likes Sandy. \nThe third asks for confirmation of a fact. The answer is \"no,\" because there are no \nclauses or facts that say Robin likes Lee. Here's another example, a list of pairs of \npeople who are in a mutual liking relation. The last answer has an uninstantiated \nvariable, indicating that everyone likes themselves. \n\n\f\n<a id='page-366'></a>\n\n> (?- (likes ?x ?y) (likes ?y ?x)) \n\n?Y = KIM \n\n?X = SANDY; \n\n?Y = SANDY \n\n?X = SANDY; \n\n?Y = SANDY \n\n?X = SANDY; \n\n?Y = SANDY \n\n?X = KIM; \n\n?Y = SANDY \n\n?X = SANDY; \n\n?Y = 7X3251 \n\n?X = 7X3251; \n\nIt makes sense in Prolog to ask open-ended queries like \"what lists is 2 a member of?\" \nor even \"what items are elements of what lists?\" \n\n(7- (member 2 71ist)) \n(7- (member 7item 71ist)) \n\nThese queries are valid Prolog and will return solutions, but there will be an infinite \nnumber of them. Since our interpreter collects all the solutions into a single list \nbefore showing any of them, we will never get to see the solutions. The next section \nshows how to write a new interpreter that fixes this problem. \n\n&#9635; Exercise 11.1 [m] The representation of relations has been a list whose first element \nis a symbol. However, for relations with no arguments, some people prefer to write \n(<- . q r) rather than (<- (p) (q) (r)). Make changes so that either form is \nacceptable. \n\n&#9635; Exercise 11.2 [m] Some people find the < - notation difficult to read. Define macros \nrul e and fact so that we can write: \n\n(fact (likes Robin cats)) \n(rule (likes Sandy 7x) if (likes 7x cats)) \n\n\f\n<a id='page-367'></a>\n\n11.3 Idea 3: Automatic Backtracking \nThe Prolog interpreter implemented in the last section solves problems by returning a \nlist of all possible solutions. We'll call this a batch approach, because the answers are \nretrieved in one uninterrupted batch of processing. Sometimes that is just what you \nwant, but other times a single solution will do. In real Prolog, solutions are presented \none at a time, as they are found. After each solution is printed, the user has the \noption of asking for more solutions, or stopping. This is an incremental approach. \nThe incremental approach will be faster when the desired solution is one of the first \nout of many alternatives. The incremental approach will even work when there is an \ninfinite number of solutions. And if that is not enough, the incremental approach can \nbe implemented so that it searches depth-first. This means that at any point it will \nrequire less storage space than the batch approach, which must keep all solutions in \nmemory at once. \n\nIn this section we implement an incremental Prolog interpreter. One approach \nwould be to modify the interpreter of the last section to use pipes rather than lists. \nWith pipes, unnecessary computation is delayed, and even infinite lists can be \nexpressed in a finite amount of time and space. We could change to pipes simply by \nchanging the mapcan in prove and prove-a11 to mappend-pi pe ([page 286](chapter9.md#page-286)). The books \nby Winston and Horn (1988) and by Abelson and Sussman (1985) take this approach. \nWe take a different one. \n\nThe first step is a version of prove and prove-al 1 that return a single solution \nrather than a list of all possible solutions. This should be reminiscent of achi eve and \nachieve-a11 from gps (chapter 4). Unlike gps, recursive subgoals and clobbered \nsiblinggoals are not checked for. However, prove is required to search systematically \nthrough all solutions, so it is passed an additional parameter: a list of other goals to \nachieve after achieving the first goal. This is equivalent to passing a continuation to \nprove. The result is that if prove ever succeeds, it means the entire top-level goal has \nsucceeded. If it fails, it just means the program is backtracking and trying another \nsequence of choices. Note that prove relies on the fact that f ai 1 is ni 1, because of \nthe way it uses some. \n\n(defun prove-all (goals bindings) \n\"Find a solution to the conjunction of goals.\" \n(cond ((eq bindings fail) fail) \n\n((null goals) bindings) \n(t (prove (first goals) bindings (rest goals))))) \n\n(defun prove (goal bindings other-goals) \n\"Return a list of possible solutions to goal.\" \n(some #*(lambda (clause) \n\n(let ((new-clause (rename-variables clause))) \n(prove-all \n(append (clause-body new-clause) other-goals) \n\n\f\n<a id='page-368'></a>\n\n(unify goal (clause-head new-clause) bindings)))) \n(get-clauses (predicate goal)))) \n\nIf . rove does succeed, it means a solution has been found. If we want more solutions, \nwe need some way of making the process fail, so that it will backtrack and try again. \nOne way to do that is to extend every query with a goal that will print out the variables, \nand ask the user if the computation should be continued. If the user says yes, then \nthe goalfails, and backtracking starts. If the user says no, the goal succeeds, and since \nit is the final goal, the computation ends. This requires a brand new type of goal: one \nthat is not matched against the data base, but rather causes some procedure to take \naction. In Prolog, such procedures are called primitives, because they are built-in to \nthe language, and new ones may not be defined by the user. The user may, of course, \ndefine nonprimitive procedures that call upon the primitives. \n\nIn our implementation, primitives will be represented as Lisp functions. A \npredicate can be represented either as a list of clauses (as it has been so far) or as a \nsingle primitive. Here is a version of prove that calls primitives when appropriate: \n\n(defun prove (goal bindings other-goals) \n\"Return a list of possible solutions to goal.\" \n(let ((clauses (get-clauses (predicate goal)))) \n\n(if (listp clauses) \n(some \n#'(lambda (clause) \n(let ((new-clause (rename-variables clause))) \n\n(prove-al1 \n(append (clause-body new-clause) other-goals) \n(unify goal (clause-head new-clause) bindings)))) \n\nclauses) \n\nThe predicate's \"clauses\" can be an atom; \n;; a primitive function to call \n(funcall clauses (rest goal) bindings \n\nother-goals)))) \n\nHere is theversionof top-level -provethatadds the primitivegoalshow-prolog-vars \ntotheendofthelistofgoals. Note that this versionneednot call show-prolog-sol utions \nitself, since the printing will be handled by the primitive for show-prol og-vars. \n\n(defun top-level-prove (goals) \n(prove-all '(.goals (show-prolog-vars ,@(variables-in goals))) \n\nno-bindings) \n(format t \"~&No.\") \n(values)) \n\nHere we define the primitive show-prol og- vars. All primitives must be functions of \n\n\f\n<a id='page-369'></a>\n\nthree arguments: a Hst of arguments to the primitive relation (here a list of variables \nto show), a binding list for these arguments, and a list of pending goals. A primitive \nshould either return f ai 1 or call prove-al 1 to continue. \n\n(defun show-prolog-vars (vars bindings other-goals) \n\"Print each variable with its binding. \nThen ask the user if more solutions are desired.\" \n(if (null vars) \n\n(format t \"~&Yes\") \n(dolist (var vars) \n(format t \"\"&^a = ~a\" var \n(subst-bindings bindings var)))) \n\n(if (continue-.) \nfail \n(prove-all other-goals bindings))) \n\nSince primitives are represented as entries on the clauses property of predicate \nsymbols, we have to register show- prol og - va rs as a primitive like this: \n\n(setf (get 'show-prolog-vars 'clauses) 'show-prolog-vars) \n\nFinally, the Lisp predicate conti nue-p asks the user if he or she wants to see more \nsolutions: \n\n(defun continue-p () \n\"Ask user if we should continue looking for solutions.\" \n(case (read-char) \n\n(#\\; t) \n(#\\. nil) \n(#\\newline (continue-p)) \n(otherwise \n\n(format t \" Type ; to see more or . to stop\") \n(continue-p)))) \n\nThis version works just as well as the previous version on finite problems. The only \ndifference is that the user, not the system, types the semicolons. The advantage is \nthat we can now use the system on infinite problems as well. First, we'll ask what \nHsts 2 is a member of: \n\n\f\n<a id='page-370'></a>\n\n> (?- (member 2 ?list)) \n?LIST = (2 . 7REST3302); \n?LIST = (7X3303 2 . 7REST3307); \n7LIST = (7X3303 7X3308 2 . 7REST3312); \n7LIST = (7X3303 7X3308 7X3313 2 . 7REST3317). \nNo. \n\nThe answers mean that 2 is a member of any Ust that starts with 2, or whose second \nelement is 2, or whose third element is 2, and so on. The infinite computation was \nhalted when the user typed a period rather than a semicolon. The \"no\" now means \nthat there are no more answers to be printed; it will appear if there are no answers at \nall, if the user types a period, or if all the answers have been printed. \n\nWe can ask even more abstract queries. The answer to the next query says that \nan item is an element of a list when it is the the first element, or the second, or the \nthird, or the fourth, and so on, \n\n> (7- (member 7item 71ist)) \n7 ITEM = 7ITEM3318 \n7LIST = (7ITEM3318 . 7REST3319); \n7ITEM = 7ITEM3323 \n7LIST = (7X3320 7ITEM3323 . 7REST3324): \n7 ITEM = 7ITEM3328 \n7LIST = (7X3320 7X3325 7ITEM3328 . 7REST3329); \n7 ITEM = 7ITEM3333 \n7LIST = (7X3320 7X3325 7X3330 7ITEM3333 . 7REST3334). \nNo. \n\nNow let's add the definition of the relation length: \n\n(<- (length () 0)) \n(<- (length (?x . ?y) (1+ ?n)) (length ?y ?n)) \n\nHere are some queries showing that length can be used to find the second argument, \nthe first, or both: \n\n> (7- (length (abed) 7n)) \n7N = (1+ (1+ (1+ (1+ 0)))); \nNo. \n\n> (7- (length 71ist (1+ (1+ 0)))) \n7LIST = (7X3869 7X3872); \nNo. \n\n\f\n<a id='page-371'></a>\n\n> (?- (length ?list ?n)) \n\n?LIST = NIL \n\n?N = 0; \n\n?LIST = (?X3918) \n\n?N = (1+ 0); \n\n?LIST = (7X3918 7X3921) \n\n7N = (1+ (1+ 0)). \n\nNo. \n\nThe next two queries show the two lists of length two with a as a member. Both \n\nqueries give the correct answer, a two-element list that either starts or ends with a. \n\nHowever, the behavior after generating these two solutions is quite different. \n\n> (7- (length 71 (1+ (1+ 0))) (member a 71)) \n7L = (A 7X4057); \n7L = (7Y4061 A); \nNo. \n\n> (7- (member a 71) (length 71 (1+ (1+ 0)))) \n7L = (A 7X4081); \n7L = (7Y4085 A);[Abort] \n\nIn the first query, length only generates one possible solution, the list with two \nunbound elements, member takes this solution and instantiates either the first or the \nsecond element to a. \n\nIn the second query, member keeps generating potential solutions. The first two \npartial solutions, where a is the first or second member of a list of unknown length, \nare extended by length to yield the solutions where the list has length two. After \nthat, member keeps generating longer and longer lists, which length keeps rejecting. \nIt is implicit in the definition of member that subsequent solutions will be longer, but \nbecause that is not explicitly known, they are all generated anyway and then explicitly \ntested and rejected by length. \n\nThis example reveals the limitations of Prolog as a pure logic-programming language. \nIt turns out the user must be concerned not only about the logic of the problem \nbut also with the flow of control. Prolog is smart enough to backtrack and find all \nsolutions when the search space is small enough, but when it is infinite (or even \nvery large), the programmer still has a responsibility to guide the flow of control. \nIt is possible to devise languages that do much more in terms of automatic flow of \ncontrol.\"* Prolog is a convenient and efficient middle ground between imperative \nlanguages and pure logic. \n\n^See the MU-Prolog and NU-Prolog languages (Naish 1986). \n\n\f\n<a id='page-372'></a>\n\nApproaches to Backtracking \n\nSuppose you are asked to make a \"small\" change to an existing program. The \nproblem is that some function, f, which was thought to be single-valued, is now \nknown to return two or more vaUd answers in certain circumstances. In other words, \nf is nondeterministic. (Perhaps f is sqrt, and we now want to deal with negative \nnumbers). What are your alternatives as a programmer? Five possibiUties can be \nidentified: \n\n* Guess. Choose one possibility and discard the others. This requires a means \nof making the right guesses, or recovering from wrong guesses. \n* Know. Sometimes you can provide additional information that is enough to \ndecide what the right choice is. This means changing the calling function(s) to \nprovide the additional information. \n* Return a list. This means that the calling function(s) must be changed to expect \na list of replies. \n* Return a pipe, as defined in section 9.3. Again, the calling function(s) must be \nchanged to expect a pipe. \n* Guess and save. Choose one possibility and return it, but record enough \ninformation to allow computing the other possibilities later. This requires \nsaving the current state of the computation as well as some information on the \nremaining possibilities. \nThe last alternative is the most desirable. It is efficient, because it doesn't require \ncomputing answers that are never used. It is unobtrusive, because it doesn't require \nchanging the calling function (and the calling function's calling function) to expect a \nlist or pipe of answers. Unfortunately, it does have one major difficulty: there has \nto be a way of packaging up the current state of the computation and saving it away \nso that it can be returned to when the first choice does not work. For our Prolog \ninterpreter, the current state is succinctly represented as a list of goals. In other \nproblems, it is not so easy to summarize the entire state. \n\nWe will see in section 22.4 that the Scheme dialect of Lisp provides a function, \nca 11 - wi th - cu r rent - conti nua t i on, that does exactly what we want: it packages the \ncurrent state of the computation into a function, which can be stored away and \ninvoked later. Unfortunately, there is no corresponding function in Common Lisp. \n\nAnonymous Variables \n\nBefore moving on, it is useful to introduce the notion of an anonymous variable. \nThis is a variable that is distinct from all others in a clause or query, but which the \n\n\f\n<a id='page-373'></a>\n\nprogrammer does not want to bother to name. In real Prolog, the underscore is used \nfor anonymous variables, but we will use a single question mark. The definition of \nmember that follows uses anonymous variables for positions within terms that are not \nneeded within a clause: \n\n(<- (member ?item (?item . ?))) \n(<- (member ?item (? . ?rest)) (member ?item ?rest)) \n\nHowever, we also want to allow several anonymous variables in a clause but still be \nable to keep each anonymous variable distinct from all other variables. One way to \ndo that is to replace each anonymous variable with a unique variable. The function \nrepl ace - ? - va rs uses gensym to do just that. It is installed in the top-level macros <and \n? - so that all clauses and queries get the proper treatment. \n\n(defmacro <- (&rest clause) \n\"Add a clause to the data base.\" \n*(add-clause '.(replace-?-vars clause))) \n\n(defmacro ? - (&rest goals) \n\"Make a query and print answers.\" \n'(top-level-prove '.(replace-?-vars goals))) \n\n(defun replace-?-vars (exp) \n\"Replace any ? within exp with a var of the form ?123.\" \n(cond ((eq exp '?) (gensym \"?\")) \n\n((atom exp) exp) \n\n(t (reuse-cons (replace-?-vars (first exp)) \n(replace-?-vars (rest exp)) \nexp)))) \n\nA named variable that is used only once in a clause can also be considered an \nanonymous variable. This is addressed in a different way in section 12.3. \n\n11.4 The Zebra Puzzle \nHere is an example of something Prolog is very good at: a logic puzzle. There are \nfifteen facts, or constraints, in the puzzle: \n\n1. There are five houses in a line, each with an owner, a pet, a cigarette, a drink, \nand a color. \n2. The Englishman lives in the red house. \n3. The Spaniard owns the dog. \n\f\n<a id='page-374'></a>\n\n4. Coffee is drunk in the green house. \n5. The Ukrainian drinks tea. \n6. The green house is immediately to the right of the ivory house. \n7. The Winston smoker owns snails. \n8. Kools are smoked in the yellow house. \n9. Milk is drunk in the middle house. \n10. The Norwegian lives in the first house on the left. \n11. The man who smokes Chesterfields lives next to the man with the fox. \n12. Kools are smoked in the house next to the house with the horse. \n13. The Lucky Strike smoker drinks orange juice. \n14. The Japanese smokes Parliaments. \n15. The Norwegian lives next to the blue house. \nThe questions to be answered are: who drinks water and who owns the zebra? To \nsolve this puzzle, we first define the relations nextto (for \"next to\") and i ri ght (for \n\"immediately to the right of\"). They are closely related to member, which is repeated \nhere. \n\n(<- (member ?item (?item . ?rest))) \n(<- (member ?item (?x . ?rest)) (member ?item ?rest)) \n\n(<- (nextto ?x ?y ?list) (iright ?x ?y ?list)) \n(<- (nextto ?x ?y ?list) (iright ?y ?x ?list)) \n\n(<- (iright ?left ?right (?left ?right . ?rest))) \n(<- (iright Tieft ?right (?x . ?rest)) \n(iright ?left ?right ?rest)) \n\n(<- (= ?x ?x)) \n\nWe also defined the identity relation, =. It has a single clause that says that any . is \nequal to itself. One might think that this implements eq or equal. Actually, since \nProlog uses unification to see if the two arguments of a goal each unify with ?x, this \nmeans that = is unification. \n\nNow we are ready to define the zebra puzzle with a single (long) clause. The \nvariable ?h represents the list of five houses, and each house is represented by a term \nof the form (house nationality pet cigarette drink color). The variable ?w is the water \ndrinker, and ?z is the zebra owner. Each of the 15 constraints in the puzzle is listed \n\n\f\n<a id='page-375'></a>\n\nin the body of zebra, ahhough constraints 9 and 10 have been combined into the \nfirst one. Consider constraint 2, \"The EngUshman lives in the red house.\" This is \ninterpreted as \"there is a house whose nationality is Englishman and whose color is \nred, and which is a member of the list of houses\": in other words, (member (house \nenglishman ? ? ? red) ?h). The other constraints are similarly straightforward. \n\n(<- (zebra ?h ?w ?z) \nEach house is of the form: \n(house nationality pet cigarette drink house-color) \n\n(= ?h ((house norwegian ? ? ? ?) ;1,10 \n? \n\n(house ? ? ? milk ?) ? ?)) ; 9 \n(member (house englishman ? ? ? red) ?h) ; 2 \n(member (house Spaniard dog ? ? ?) ?h) ; 3 \n(member (house 111 coffee green) ?h) ; 4 \n(member (house Ukrainian ? ? tea ?) ?h) ; 5 \n(iright (house 1111 ivory) ; 6 \n\n(house 1111 green) ?h) \n(member (house ? snails winston ? ?) ?h) ; 7 \n(member (house ? ? kools ? yellow) ?h) ; 8 \n(nextto (house ? ? chesterfield ? ?) ;11 \n\n(house ? fox ? ? ?) ?h) \n(nextto (house ? ? kools ? ?) ;12 \n\n(house ? horse ? ? ?) ?h) \n(member (house ? ? luckystrike orange-juice ?) ?h);13 \n(member (house Japanese ? parliaments ? ?) ?h) ;14 \n(nextto (house norwegian 1111) ;15 \n\n(house 1111 blue) ?h) \n\nNow for the questions: \n(member (house ?w ? ? water ?) ?h) ;Q1 \n(member (house ?z zebra 111) ?h)) ;Q2 \n\nHere's the query and solution to the puzzle: \n\n> (?- (zebra ?houses ?water-drinker ?zebra-owner)) \n\n7H0USES = ((HOUSE NORWEGIAN FOX KOOLS WATER YELLOW) \n(HOUSE UKRAINIAN HORSE CHESTERFIELD TEA BLUE) \n(HOUSE ENGLISHMAN SNAILS WINSTON MILK RED) \n(HOUSE SPANIARD DOG LUCKYSTRIKE ORANGE-JUICE IVORY) \n(HOUSE JAPANESE ZEBRA PARLIAMENTS COFFEE GREEN)) \n\n7WATER-DRINKER = NORWEGIAN \n\n7ZEBRA-0WNER = JAPANESE. \n\nNo. \n\nThis took 278 seconds, and profiHng (see [page 288](chapter9.md#page-288)) reveals that the function prove was \ncalled 12,825 times. A call to prove has been termed a logical inference, so our system \n\n\f\n<a id='page-376'></a>\n\nis performing 12825/278 = 46 logical inferences per second, or LIPS. Good Prolog \nsystems perform at 10,000 to 100,000 LIPS or more, so this is barely Hmping along. \n\nSmall changes to the problem can greatly affect the search time. For example, \nthe relation nextto holds when the first house is immediately right of the second, or \nwhen the second is immediately right of the first. It is arbitrary in which order these \nclauses are listed, and one might think it would make no difference in which order \nthey were listed. In fact, if we reverse the order of these two clauses, the execution \ntime is roughly cut in half. \n\n11.5 The Synergy of Backtracking and \nUnification \nProlog's backward chaining with backtracking is a powerful technique for generating \nthe possible solutions to a problem. It makes it easy to implement a generate-and-test \nstrategy, where possible solutions are considered one at a time, and when a candidate \nsolution is rejected, the next is suggested. But generate-and-test is only feasible when \nthe space of possible solutions is small. \n\nIn the zebra puzzle, there are five attributes for each of the five houses. Thus \nthere are 5! ^, or over 24 billion candidate solutions, far too many to test one at a time. \nIt is the concept of unification (with the corresponding notion of a logic variable) that \nmakes generate-and-test feasible on this puzzle. Instead of enumerating complete \ncandidate solutions, unification allows us to specify partial candidates. We start out \nknowing that there are five houses, with the Norwegian living on the far left and \nthe milk drinker in the middle. Rather than generating all complete candidates that \nsatisfy these two constraints, we leave the remaining information vague, by unifying \nthe remaining houses and attributes with anonymous logic variables. The next \nconstraint (number 2) places the Englishman in the red house. Because of the way \nmember is written, this first tries to place the Englishman in the leftmost house. This \nis rejected, because Englishman and Norwegian fail to unify, so the next possibiUty is \nconsidered, and the Englishman is placed in the second house. But no other features \nof the second house are specified—we didn't have to make separate guesses for the \nEnglishman's house being green, yellow, and so forth. The search continues, filling \nin only as much as is necessary and backing up whenever a unification fails. \n\nFor this problem, unification serves the same purpose as the delay macro \n([page 281](chapter9.md#page-281)). It allows us to delay deciding the value of some attribute as long as \npossible, but to immediately reject a solution that tries to give two different values \nto the same attribute. That way, we save time if we end up backtracking before the \ncomputation is made, but we are still able to fill in the value later on. \n\nIt is possible to extend unification so that it is doing more work, and backtracking \nis doing less work. Consider the following computation: \n\n\f\n<a id='page-377'></a>\n\n(?- (length ?1 4) \n(member d ?1) (member a ?1) (member c ?1) (member b ?1) \n(= ?1 (a b c d))) \n\nThe first two Hnes generate permutations of the Hst (d a c b), and the third line \ntests for a permutation equal to (a b c d). Most of the work is done by backtracking. \nAn alternative is to extend unification to deal with lists, as well as constants and \nvariables. Predicates like length and member would be primitives that would have to \nknow about the representation of lists. Then the first two lines of the above program \nwould set ?1 to something like #s( list :length 4 :members (d a c d)). The \nthird line would be a call to the extended unification procedure, which would further \nspecify ?1 to be something like: \n\n#s(11st rlength 4 imembers (d a c d) :order (abc d)) \n\nBy making the unification procedure more complex, we eliminate the need for backtracking \nentirely. \n\n&#9635; Exercise 11.3 [s] Would a unification algorithm that delayed member tests be a good \nidea or a bad idea for the zebra puzzle? \n\n11.6 Destructive Unification \nAs we saw in section 11.2, keeping track of a binding list of variables is a little tricky. \nIt is also prone to inefficiency if the binding list grows large, because the list must \nbe searched linearly, and because space must be allocated to hold the binding list. \nAn alternative implementation is to change unify to a destructive operation. In \nthis approach, there are no binding lists. Instead, each variable is represented as \na structure that includes a field for its binding. When the variable is unified with \nanother expression, the variable's binding field is modified to point to the expression. \nSuch variables will be called vars to distinguish them from the implementation of \nvariables as symbols starting with a question mark, vars are defined with the \nfollowing code: \n\n(defconstant unbound \"Unbound\") \n\n(defstruct var name (binding unbound)) \n\n(defun bound-p (var) (not (eq (var-binding var) unbound))) \n\nThe macro de ref gets at the binding of a variable, returning its argument when it is an \n\n\f\n<a id='page-378'></a>\n\nunbound variable or a nonvariable expression. It includes a loop because a variable \ncan be bound to another variable, which in turn is bound to the ultimate value. \n\nNormally, it would be considered bad practice to implement de ref as a macro, \nsince it could be implemented as an inline function, provided the caller was willing \nto write (setf . (deref x)) instead of (de ref x). However, de ref will appear \nin code generated by some versions of the Prolog compiler that will be presented in \nthe next section. Therefore, to make the generated code look neater, I have allowed \nmyself the luxury of the deref macro. \n\n(defmacro deref (exp) \n\"Follow pointers for bound variables.\" \n'(progn (loop while (and (var-p ,exp) (bound-p ,exp)) \n\ndo (setf ,exp (var-binding ,exp))) \n,exp)) \n\nThe function unify! below is the destructive version of unify. It is a predicate \nthat returns true for success and false for failure, and has the side effect of altering \nvariable bindings. \n\n(defun unify! (x y) \n\"Destructively unify two expressions\" \n(cond ((eql (deref x) (deref y)) t) \n\n((var-p x) (set-binding! . y)) \n((var-p y) (set-binding! y .)) \n((and (consp .) (consp y)) \n\n(and (unify! (first x) (first y)) \n(unify! (rest x) (rest y)))) \n(t nil))) \n\n(defun set-binding! (var value) \n\"Set var's binding to value. Always succeeds (returns t).\" \n(setf (var-binding var) value) \nt) \n\nTo make vars easier to read, we can install a : pri nt-function: \n\n(defstruct (var (iprint-function print-var)) \nname (binding unbound)) \n(defun print-var (var stream depth) \n(if (or (and (numberp *print-level*) \n(>= depth *print-level*)) \n\n(var-p (deref var))) \n(format stream \"?~a\" (var-name var)) \n(write var :stream stream))) \n\n\f\n<a id='page-379'></a>\n\nThisis the first example of a carefully crafted : pri nt-function. There are three things \nto notice about it. First, it explicitly writes to the stream passed as the argument. \nIt does not write to a default stream. Second, it checks the variable depth against \n*pr i nt-1 evel *, and prints just the variable name when the depth is exceeded. Third, \nit uses wr i te to print the bindings. This is because wr i te pays attention to the current \nvalues of *pr int-escape*, *print-pretty*, and soon. Other printing functions such \nas pri nl or pri nt do not pay attention to these variables. \n\nNow, for backtracking purposes, we want to make set-bi nding! keep track of \nthe bindings that were made, so they can be undone later: \n\n(defvar *trail* (make-array 200 ifill-pointer 0 ladjustable t)) \n\n(defun set-binding! (var value) \n\"Set var's binding to value, after saving the variable \nin the trail. Always returns t.\" \n(unless (eq var value) \n\n(vector-push-extend var *trail*) \n(setf (var-binding var) value)) \nt) \n\n(defun undo-bindings! (old-trail) \n\"Undo all bindings back to a given point in the trail. \" \n(loop until (= (fill-pointer nrail*) old-trail) \n\ndo (setf (var-binding (vector-pop *trail*)) unbound))) \n\nNow we need a way of making new variables, where each one is distinct. That could \nbe done by gensym-ing a new name for each variable, but a quicker solution is just to \nincrement a counter. The constructor function ? is defined to generate a new variable \nwith a name that is a new integer. This is not strictly necessary; we could have just \nused the automatically provided constructor make-var. However, I thought that the \noperation of providing new anonymous variable was different enough from providing \na named variable that it deserved its own function. Besides, make-var may be less \nefficient, because it has to process the keyword arguments. The function ? has no \narguments; it just assigns the default values specified in the slots of the va r structure. \n\n(defvar *var-counter* 0) \n\n(defstruct (var (iconstructor ? ()) \n\n(:print-function print-var)) \n(name (incf *var-counter*)) \n(binding unbound)) \n\nA reasonable next step would be to use destructive unification to make a more \nefficient interpreter. This is left as an exercise, however, and instead we put the \ninterpreter aside, and in the next chapter develop a compiler. \n\n\f\n<a id='page-380'></a>\n\n11.7 Prolog in Prolog \nAs stated at the start of this chapter, Prolog has many of the same features that \nmake Lisp attractive for program development. Just as it is easy to write a Lisp \ninterpreter in Lisp, it is easy to write a Prolog interpreter in Prolog. The following \nProlog metainterpreter has three main relations. The relation c1 a use is used to store \nclauses that make up the rules and facts that are to be interpreted. The relation \nprove is used to prove a goal. It calls prove-al 1, which attempts to prove a list of \ngoals, prove-al 1 succeeds in two ways: (1) if the list is empty, or (2) if there is some \nclause whose head matches the first goal, and if we can prove the body of that clause, \nfollowed by the remaining goals: \n\n(<- (prove ?goal) (prove-all (?goal))) \n\n(<- (prove-all nil)) \n\n(<- (prove-all (?goal . ?goals)) \n(clause (<- ?goal . ?body)) \n(concat ?body ?goals ?new-goals) \n(prove-all ?new-goals)) \n\nNow we add two clauses to the data base to define the member relation: \n\n(<- (clause (<- (mem ?x (?x . ?y))))) \n(<- (clause (<- (mem ?x (? . ?z)) (mem ?x ?z)))) \n\nFinally, we can prove a goal using our interpreter: \n\n(?- (prove (mem ?x (1 2 3)))) \n?X = 1; \n?X = 2; \n?X = 3; \nNo. \n\n11.8 Prolog Compared to Lisp \nMany of the features that make Prolog a succesful language for AI (and for program \ndevelopment in general) are the same as Lisp's features. Let's reconsider the list of \nfeatures that make Lisp different from conventional languages (see [page 25](chapter1.md#page-25)) and see \nwhat Prolog has to offer: \n\n\f\n<a id='page-381'></a>\n\n* Built-in Support for Lists (and other data types). New data types can be created \neasily using lists or structures (structures are preferred). Support for reading, \nprinting, and accessing components is provided automatically. Numbers, \nsymbols, and characters are also supported. However, because logic variables \ncannot be altered, certain data structures and operations are not provided. For \nexample, there is no way to update an element of a vector in Prolog. \n* Automatic Storage Management. The programmer can allocate new objects without \nworrying about reclaiming them. Reclaiming is usually faster in Prolog than \nin Lisp, because most data can be stack-allocated instead of heap-allocated. \n* Dynamic Typing. Declarations are not required. Indeed, there is no standard \nway to make type declarations, although some implementations allow for them. \nSome Prolog systems provide only fixnums, so that eliminates the need for a \nlarge class of declarations. \n* First-Class Functions. Prolog has no equivalent of 1 ambda, but the built-in predicate \ncal 1 allows a term—a piece of data—to be called as a goal. Although \nbacktracking choice points are not first-class objects, they can be used in a way \nvery similar to continuations in Lisp. \n* Uniform Syntax. Like Lisp, Prolog has a uniform syntax for both programs and \ndata. This makes it easy to write interpreters and compilers in Prolog. While \nLisp's prefix-operator list notation is more uniform, Prolog allows infix and \npostfix operators, which may be more natural for some applications. \n* Interactive Environment. Expressions can be immediately evaluated. High-\nquality Prolog systems offer both a compiler and interpreter, along with a host \nof debugging tools. \n* Extensibility. Prolog syntax is extensible. Because programs and data share \nthe same format, it is possible to write the equivalent of macros in Prolog and \nto define embedded languages. However, it can be harder to ensure that the \nresulting code will be compiled efficiently. The details of Prolog compilation \nare implementation-dependent. \nTo put things in perspective, consider that Lisp is at once one of the highest-level \nlanguages available and a universal assembly language. It is a high-level language \nbecause it can easily capture data, functional, and control abstractions. It is a good \nassembly language because it is possible to write Lisp in a style that directly reflects \nthe operations available on modern computers. \n\nProlog is generally not as efficient as an assembly language, but it can be more \n\nconcise as a specification language, at least for some problems. The user writes \n\nspecifications: lists of axioms that describe the relationships that can hold in the \n\nproblem domain. If these specifications are in the right form, Prolog's automatic \n\n\f\n<a id='page-382'></a>\n\nbacktracking can find a solution, even though the programmer does not provide an \nexplicit algorithm. For other problems, the search space will be too large or infinite, \nor Prolog's simple depth-first search with backup will be too inflexible. In this case, \nProlog must be used as a programming language rather than a specification language. \nThe programmer must be aware of Prolog's search strategy, using it to implement an \nappropriate algorithm for the problem at hand. \n\nProlog, like Lisp, has suffered unfairly from some common myths. It has been \nthought to be an inefficient language because early implementations were interpreted, \nand because it has been used to write interpreters. But modern compiled \nProlog can be quite efficient (see Warren et al. 1977 and Van Roy 1990). There is a \ntemptation to see Prolog as a solution in itself rather than as a programming language. \nThose who take that view object that Prolog's depth-first search strategy and basis in \npredicate calculus is too inflexible. This objection is countered by Prolog programmers \nwho use the facilities provided by the language to build more powerful search \nstrategies and representations, just as one would do in Lisp or any other language. \n\n11.9 History and References \nCordell Green (1968) was the first to articulate the view that mathematical results \non theorem proving could be used to make deductions and thereby answer queries. \nHowever, the major technique in use at the time, resolution theorem proving (see \nRobinson 1965), did not adequately constrain search, and thus was not practical. \nThe idea of goal-directed computing was developed in Carl Hewitt's work (1971) on \nthe PLANNER language for robot problem solving. He suggested that the user provide \nexplicit hints on how to control deduction. \n\nAt about the same time and independently, Alain Colmerauer was developing \na system to perform natural language analysis. His approach was to weaken the \nlogical language so that computationally complex statements (such as logical disjunctions) \ncould not be made. Colmerauer and his group implemented the first \nProlog interpreter using Algol-W in the summer of 1972 (see Roussel 1975). It was \nRoussel's wife, Jacqueline, who came up with the name Prolog as an abbreviation \nfor \"programmation en logique.\" The first large Prolog program was their natural \nlanguage system, also completed that year (Colmerauer et al. 1973). For those who \nread English better than French, Colmerauer (1985) presents an overview of Prolog. \nRobert Kowalski is generally considered the coinventer of Prolog. His 1974 article \noutlines his approach, and his 1988 article is a historical review on the early logic \nprogramming work. \n\nThere are now dozens of text books on Prolog. In my mind, six of these stand \nout. Clocksin and Mellish's Programming in Prolog (1987) was the first and remains \none of the best. Sterling and Shapiro's The Art of Prolog (1986) has more substantial \nexamples but is not as complete as a reference. An excellent overview from a slightly \n\n\f\n<a id='page-383'></a>\n\nmore mathematical perspective is Pereira and Shieber's Prolog and Natural-Language \nAnalysis (1987). The book is worthwhile for its coverage of Prolog alone, and it also \nprovides a good introduction to the use of logic programming for language understanding \n(see part V for more on this subject). O'Keefe's The Craft of Prolog (1990) \nshows a number of advanced techinques. O'Keefe is certainly one of the most influential \nvoices in the Prolog community. He has definite views on what makes for good \nand bad coding style and is not shy about sharing his opinions. The reader is warned \nthat this book evolved from a set of notes on the Clocksin and Mellish book, and the \nlack of organization shows in places. However, it contains advanced material that \ncan be found nowhere else. Another collection of notes that has been organized into \na book is Coelho and Cotta's Prolog by Example. Published in 1988, this is an update \nof their 1980 book. How to Solve it in Prolog. The earlier book was an underground \nclassic in the field, serving to educate a generation of Prolog programmers. Both \nversions include a wealth of examples, unfortunately with little documentation and \nmany typos. Finally, Ivan Bratko's Prolog Programming for Artificial Intelligence (1990) \ncovers some introductory AI material from the Prolog perspective. \n\nMaier and Warren's Computing with Logic (1988) is the best reference for those \ninterested in implementing Prolog. It starts with a simple interpreter for a variable-\nfree version of Prolog, and then moves up to the full language, adding improvements \nto the interpreter along the way. (Note that the second author, David S. Warren of \nStonybrook, is different from David H. D. Warren, formerly at Edinburgh and now \nat Bristol. Both are experts on Prolog.) \n\nLloyd's Foundations of Logic Programming (1987) provides a theoretical explanation \nof the formal semantics of Prolog and related languages. Lassez et al. (1988) and \nKnight (1989) provide overviews of unification. \n\nThere have been many attempts to extend Prolog to be closer to the ideal of Logic \nProgramming. The language MU-Prolog and NU-Prolog (Naish 1986) and Prolog III \n(Colmerauer 1990) are particularly interesting. The latter includes a systematic \ntreatment of the ^ relation and an interpretation of infinite trees. \n\n11.10 Exercises \n&#9635; Exercise 11.4 [m] It is somewhat confusing to see \"no\" printed after one or more \nvalid answers have appeared. Modify the program to print \"no\" only when there are \nno answers at all, and \"no more\" in other cases. \n\n&#9635; Exercise 11.5 [h] At least six books (Abelson and Sussman 1985, Charniak and \nMcDermottl985, Charniaketal. 1986, Hennessey 1989, Wilensky 1986, and Winston \nand Horn 1988) present unification algorithms with a common error. They all have \nproblems unifying (?x ?y a) with (?y ?x ?x). Some of these texts assume that uni fy \n\n\f\n<a id='page-384'></a>\n\nwill be called in a context where no variables are shared between the two arguments. \nHowever, they are still suspect to the bug, as the following example points out: \n\n> (unify '(f (?x ?y a) (?y ?x ?x)) '(f ?z ?z)) \n((?Y . A) (?X . ?Y) (?Z ?X ?Y A)) \n\nDespite this subtle bug, I highly recommend each of the books to the reader. It is \ninteresting to compare different implementations of the same algorithm. It turns out \nthere are more similarities than differences. This indicates two things: (1) there is a \ngenerally agreed-upon style for writing these functions, and (2) good programmers \nsometimes take advantage of opportunities to look at other's code. \n\nThe question is: Can you give an informal proof of the correctness of the algorithm \npresented in this chapter? Start by making a clear statement of the specification. \nApply that to the other algorithms, and show where they go wrong. Then see if you \ncan prove that the unify function in this chapter is correct. Failing a complete proof, \ncan you at least prove that the algorithm will always terminate? See Norvig 1991 for \nmore on this problem. \n\n&#9635; Exercise 11.6 [h] Since logic variables are so basic to Prolog, we would like them \nto be efficient. In most implementations, structures are not the best choice for small \nobjects. Note that variables only have two slots: the name and the binding. The \nbinding is crucial, but the name is only needed for printing and is arbitrary for most \nvariables. This suggests an alternative implementation. Each variable will be a \ncons cell of the variable's binding and an arbitrary marker to indicate the type. This \nmarker would be checked by vari abl e-p. Variable names can be stored in a hash \ntable that is cleared before each query. Implement this representation for variables \nand compare it to the structure representation. \n\n&#9635; Exercise 11.7 [m] Consider the following alternative implementation for anonymous \nvariables: Leave the macros <- and ?- alone, so that anonymous variables \nare allowed in assertions and queries. Instead, change uni fy so that it lets anything \nmatch against an anonymous variable: \n\n(defun unify (x y &optional (bindings no-bindings)) \n\"See if . and y match with given bindings.\" \n(cond ((eq bindings fail) fail) \n\n((eql . y) bindings) \n((or (eq . *?) (eq y '?)) bindings) \n((variable-p x) (unify-variable . y bindings)) \n((variable-p y) (unify-variable y . bindings)) \n((and (consp x) (consp y)) \n\n(unify (rest x) (rest y) \n\n\f\n<a id='page-385'></a>\n(unify (first x) (first y) bindings))) \n(t fail))) \n\nIs this alternative correct? If so, give an informal proof. If not, give a counterexample. \n\n&#9635; Exercise 11.8 Pi] Write a version of the Prolog interpreter that uses destructive \nunification instead of binding lists. \n\n&#9635; Exercise 11.9 [m] Write Prolog rules to express the terms father, mother, son, \ndaughter, and grand- versions of each of them. Also define parent, child, wife, \nhusband, brother, sister, uncle, and aunt. You will need to decide which relations \nare primitive (stored in the Prolog data base) and which are derived by rules. \n\nFor example, here's a definition of grandfather that says that G is the grandfather \nof C if G is the father of some P, who is the parent of C: \n\n(<- (grandfather ?g ?c) \n(father ?g ?p) \n(parent ?p ?c)) \n\n&#9635; Exercise 11.10 [m] The following problem is presented in Wirth 1976: \n\nI married a widow (let's call her W) who has a grown-up daughter (call her \nD). My father (F), who visited us often, fell in love with my step-daughter and \nmarried her. Hence my father became my son-in-law and my step-daughter \nbecame my mother. Some months later, my wife gave birth to a son (Si), who \nbecame the brother-in-law of my father, as well as my uncle. The wife of my \nfather, that is, my step-daughter, also had a son (S2). \n\nRepresent this situation using the predicates defined in the previous exercise, \nverify its conclusions, and prove that the narrator of this tale is his own grandfather. \n\n&#9635; Exercise 11.11 [d] Recall the example: \n\n> (?- (length (abed) ?n)) \n?N = (1+ (1+ (1+ (1+ 0)))); \n\nIt is possible to produce 4 instead of (1+ (1+ (1+ (1+ 0)))) byextendingthenotion \nof unification. Ait-Kaci et al. 1987 might give you some ideas how to do this. \n\n\f\n<a id='page-386'></a>\n\n&#9635; Exercise 11.12 [h] The function rename-vari abl es was necessary to avoid confusion \nbetween the variables in the first argument to unify and those in the second \nargument. An alternative is to change the uni f y so that it takes two binding lists, one \nfor each argument, and keeps them separate. Implement this alternative. \n\n11.11 Answers \nAnswer 11.9 We will choose as primitives the unary predicates mal e and f emal e \nand the binary predicates chi 1 d and married. The former takes the child first; the \nlatter takes the husband first. Given these primitives, we can make the following \ndefinitions: \n\n(<- (father ?f ?c) (male ?f) (parent ?f ?c)) \n(<- (mother ?m ?c) (female ?m) (parent ?m ?c)) \n(<- (son ?s ?p) (male ?s) (parent ?p ?s)) \n(<- (daughter ?s ?p) (male ?s) (parent ?p ?s)) \n\n(<- (grandfather ?g ?c) (father ?g ?p) (parent ?p ?c)) \n(<- (grandmother ?g ?c) (mother ?g ?p) (parent ?p ?c)) \n(<- (grandson ?gs ?gp) (son ?gs ?p) (parent ?gp ?p)) \n(<- (granddaughter ?gd ?gp) (daughter ?gd ?p) (parent ?gp ?p)) \n\n(<- (parent ?p ?c) (child ?c ?p)) \n(<- (wife ?w ?h) (married ?h ?w)) \n(<- (husband ?h ?w) (married ?h ?w)) \n\n(<- (sibling ?x ?y) (parent ?p ?x) (parent ?p ?y)) \n(<- (brother ?b ?x) (male ?b) (sibling ?b ?x)) \n(<- (sister ?s ?x) (female ?s) (sibling ?s ?x)) \n(<- (uncle ?u ?n) (brother ?u ?p) (parent ?p ?n)) \n(<- (aunt ?a ?n) (sister ?a ?p) (parent ?p ?n)) \n\nNote that there is no way in Prolog to express a true definition. We would like to say \nthat \"P is the parent of C if and only if C is the child of P,\" but Prolog makes us express \nthe biconditional in one direction only. \n\n\f\n<a id='page-387'></a>\n\nAnswer 11.10 Because we haven't considered step-relations in the prior definitions, \nwe have to extend the notion of parent to include step-parents. The definitions \nhave to be written very carefully to avoid infinite loops. The strategy is to structure \nthe defined terms into a strict hierarchy: the four primitives are at the bottom, then \npa rent is defined in terms of the primitives, then the other terms are defined in terms \nof parent and the primitives. \n\nWe also provide a definition for son-in-law: \n\n(<- (parent ?p ?c) (married ?p ?w) (child ?c ?w)) \n(<- (parent ?p ?c) (married ?h ?p) (child ?c ?w)) \n(<- (son-in-law ?s ?p) (parent ?p ?w) (married ?s ?w)) \n\nNow we add the information from the story. Note that we only use the four primitives \nmale, female, married, and child: \n\n(<- (male I)) (<- (male F)) (<- (male SD) (<- (male S2)) \n(<- (female W)) (<- (female D)) \n(<- (married I W)) \n(<- (married F D)) \n(<- (child D W)) \n(<- (child I F)) \n(<- (child SI I)) \n(<- (child S2 F)) \n\nNow we are ready to make the queries: \n\n> (?- (son-in-law F I)) \nYes. \n\n> (?- (mother D I)) \nYes. \n\n> (?- (uncle SI I)) \nYes. \n\n> (?- (grandfather I I)) \nYes. \n\n\f\n## Chapter 12\n<a id='page-388'></a>\n\nCompiling Logic \nPrograms \n\nV I 1 he end of chapter 11 introduced a new, more efficient representation for logic variables. \n\nI It would be reasonable to build a new version of the Prolog interpreter incorporating \n\nJL this representation. However, chapter 9 has taught us that compilers run faster than \ninterpreters and are not that much harder to build. Thus, this chapter will present a Prolog \ncompiler that translates from Prolog to Lisp. \n\nEach Prolog predicate will be translated into a Lisp function, and we will adopt the convention \nthat a predicate called with a different number of arguments is a different predicate. If the symbol \n. can be called with either one or two arguments, we will need two Lisp functions to implement \nthe two predicates. Following Prolog tradition, these will be called p/1 and p/2. \n\nThe next step is to decide what the generated Lisp code should look like. It must unify \nthe head of each clause against the arguments, and if the unification succeeds, it must call the \npredicates in the body. The difficult part is that the choice points have to be remembered. If \na call to a predicate in the first clause fails, we must be able to return to the second clause and \ntry again. \n\n\f\n<a id='page-389'></a>\n\nThis can be done by passing in a success continuation as an extra argument to \nevery predicate. This continuation represents the goals that remain unsolved, the \nother-goal s argument of prove. For each clause in the predicate, if all the goals iri a \nclause succeed, then we should call the success continuation. If a goal fails, we don't \ndo anything special; we just go on to the next clause. There is one complication: after \nfailing we have to undo any bindings made by uni fy I. Consider an example. The \nclauses \n\n(<- (likes Robin cats)) \n\n(<- (likes Sandy ?x) (likes ?x cats)) \n\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim)) \n\ncould be compiled into this: \n\n(defun likes/2 (?argl ?arg2 cont) \nFirst clause: \n(if (and (unify! ?argl 'Robin) (unify! ?arg2 'cats)) \n(funcall cont)) \n(undo-bindings) \nSecond clause: \n(if (unify! ?argl 'Sandy) \n(likes/2 ?arg2 'cats cont)) \n(undo-bindings) \nThird clause: \n(if (unify! ?argl 'Kim) \n(likes/2 ?arg2 'Lee \n#'(lambda () (likes/2 ?arg2 'Kim cont)))))) \n\nIn the first clause, we just check the two arguments and, if the unifications succeed, \n\ncall the continuation directly, because the first clause has no body. In the second \n\nclause, 1 i kes/2 is called recursively, to see if ?arg2 likes cats. If this succeeds, then \n\nthe original goal succeeds, and the continuation cont is called. In the third clause, \n\nwe have to call1 i kes/2 recursively again, this time requesting that it check if ?arg2 \n\nlikes Lee. If this check succeeds, then the continuation will be called. In this case, \n\nthe continuation involves another call to 1 i kes/2, to check if ?arg2 likes Kim. If this \n\nsucceeds, then the original continuation, cont, will finally be called. \n\nRecall that in the Prolog interpreter, we had to append the list of pending goals, \nother-goal s, to the goals in the body of the clause. In the compiler, there is no need \nto do an append. Instead, the continuation cont represents the other-goals, and the \nbody of the clause is represented by explicit calls to functions. \n\n\f\n<a id='page-390'></a>\n\nNote that the code for 1 i kes/2 given before has eUminated some unnecessary \ncalls to uni fy!. The most obvious implementation would have one call to uni fy 1 for \neach argument. Thus, for the second clause, we would have the code: \n\n(if (and (unify! ?argl 'Sandy) (unifyl ?arg2 ?x)) \n(likes/2 ?x 'cats cont)) \n\nwhere we would need a suitable let binding for the variable ?x. \n\n12.1 A Prolog Compiler \nThis section presents the compiler summarized in figure 12.1. At the top level is \nthe function prol og-compi 1 e, which takes a symbol, looks at the clauses defined for \nthat symbol, and groups the clauses by arity. Each symbol/arity is compiled into a \nseparate Lisp function by compi 1 e-predi cate. \n\n(defun prolog-compile (symbol &optional \n\n(clauses (get-clauses symbol))) \n\"Compile a symbol; make a separate function for each arity.\" \n(unless (null clauses) \n\n(let ((arity (relation-arity (clause-head (first clauses))))) \n;; Compile the clauses with this arity \n(compile-predicate \n\nsymbol arity (clauses-with-arity clauses #'= arity)) \n;; Compile all the clauses with any other arity \n(prolog-compile \n\nsymbol (clauses-with-arity clauses #'/= arity))))) \n\nThree utility functions are included here: \n\n(defun clauses-with-arity (clauses test arity) \n\"Return all clauses whose head has given arity.\" \n(find-all arity clauses \n\n:key #'(lambda (clause) \n(relation-arity (clause-head clause))) \nrtest test)) \n\n(defun relation-arity (relation) \n\"The number of arguments to a relation. \nExample: (relation-arity '(p a b c)) => 3\" \n(length (args relation))) \n\n(defun args (x) \"The arguments of a relation\" (rest x)) \n\nThe next step is to compile the clauses for a given predicate with a fixed arity into a \n\n\f\n<a id='page-391'></a>\n?-\n\nnrail* \n\nvar \n\ntop-level-prove \nrun-prolog \n\nprOlog-compi1e-symbols \nprolog-compile \ncompile-predicate \ncompile-clause \ncompile-body \ncompile-call \ncompile-arg \ncompile-unify \n\nclauses-with-arity \nrelation-arity \nargs \nmake-parameters \nmake-predicate \nmake-= \ndef-prolog-compi1er-macro \nprolog-compi1er-macro \nhas-variable-p \nproper-listp \nmaybe-add-undo-bindings \nbind-unbound-vars \nmake-anonymous \nanonymous-variables-in \ncompile-if \ncompile-unify-vari able \nbind-variables-in \nfollow-binding \nbind-new-variables \nignore \n\nunify! \nundo-bindings! \nbinding-val \nsymbol \nnew-symbol \nfind-anywhere \n\nTop-Level Functions \n\nMake a query, but compile everything first. \n\nSpecial Variables \n\nA list of all bindings made so far. \n\nData Types \n\nA box for a variable; can be destructively modified. \n\nMajor Functions \n\nNew version compiles everything first. . \nCompile everything and call a Prolog function. \nCompile a list of Prolog symbols. \nCompile a symbol; make a separate function for each arity. \nCompile all the clauses for a given symbol/arity. \nTransform away the head and compile the resulting body. \nCompile the body of a clause. \nCompile a call to a Prolog predicate. \nGenerate code for an argument to a goal in the body. \nReturn code that tests if var and term unify. \n\nAuxiliary Functions \n\nReturn all clauses whose head has given arity. \nThe number of arguments to a relation. \nThe arguments of a relation. \nBuild a list of parameters. \nBuild a symbol of the form name/ari ty. \nBuild a unification relation. \nDefine a compiler macro for Prolog. \nFetch the compiler macro for a Prolog predicate. \nIs there a variable anywhere in the expression x? \nIsX a proper (non-dotted) list? \nUndo any bindings that need undoing. \nAdd a let if needed. \nReplace variables that are only used once with ?. \nA list of anonymous variables. \nCompile an IF form. No else-part allowed. \nCompile the unification of a var. \nBind all variables in exp to themselves. \nGet the ultimate binding of var according to bindings. \n\nExtend bindings to include any unbound variables. \nDo nothing—ignore the arguments. \n\nPreviously Defined Fimctions \n\nDestructive unification (see section 11.6). \n\nUse the trail to backtrack, undoing bindings. \nPick out the value part of a var/val binding. \nCreate or find an interned symbol. \nCreate a new uninterned symbol. \nDoes item occur anywhere in tree? \n\nFigure 12.1: Glossary for the Prolog Compiler \n\n\f\n<a id='page-392'></a>\n\nLisp function. For now, that will be done by compiling each clause indepently and \nwrapping them in a 1 ambda with the right parameter list. \n\n(defun compile-predicate (symbol arity clauses) \n\"Compile all the clauses for a given symbol/arity \ninto a single LISP function.\" \n(let ((predicate (make-predicate symbol arity)) \n\n(parameters (make-parameters arity))) \n(compile \n(eval \n'(defun .predicate (,parameters cont) \n..(mapcar #*(lambda (clause) \n(compile-clause parameters clause 'cont)) \nclauses)))))) \n\n(defun make-parameters (arity) \n\"Return the list (?argl ?arg2 ... ?arg-arity)\" \n(loop for i from 1 to arity \n\ncollect (new-symbol '?arg i))) \n\n(defun make-predicate (symbol arity) \n\"Return the symbol: symbol/arity\" \n(symbol symbol V arity)) \n\nNow for the hard part: we must actually generate the code for a clause. Here again \nis an example of the code desired for one clause. We'll start by setting as a target the \nsimple code: \n\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim)) \n\n(defun likes/2 (?argl ?arg2 cont) \n\n(if (and (unify! ?argl *Kim) (unify! ?arg2 ?x) \n(likes/2 ?arg2 'Lee \n#'(lambda () (likes/2 ?x 'Kim)))) \n\n...) \n\nbut we'll also consider the possibility of upgrading to the improved code: \n\n(defun likes/2 (?argl ?arg2 cont) \n\n(if (unify! ?argl 'Kim) \n(likes/2 ?arg2 'Lee \n#'(lambda () (likes/2 ?arg2 'Kim)))) \n\n...) \n\nOne approach would be to write two functions, compi 1 e-head and compi 1 e-body. \n\n\f\n<a id='page-393'></a>\nand then combine them into the code ( i f head body). This approach could easily \ngenerate the prior code. However, let's allow ourselves to think ahead a little. If we \neventually want to generate the improved code, we will need some communication \nbetween the head and the body. We will have to know that the head decided not \nto compile the unification of ?arg2 and ?x, but because of this, the body will have \nto substitute ?arg2 for ?x. That means that the compi 1 e - head function conceptually \nreturns two values: the code for the head, and an indication of substitutions to \nperform in the body. This could be handled by explicitly manipulating multiple \nvalues, but it seems complicated. \n\nAn alternate approach is to eliminate compi 1 e - head and just write compi 1 e - body. \nThis is possible if we in effect do a source-code transformation on the clause. Instead \nof treating the clause as: \n\n(<- (likes Kim ?x) \n(likes ?x Lee) (likes ?x Kim)) \n\nwe transform it to the equivalent: \n\n(<- (likes ?argl ?arg2) \n(= ?argl Kim) (= ?arg2 ?x) (likes ?x Lee) (likes ?x Kim)) \n\nNow the arguments in the head of the clause match the arguments in the function \n1 i kes/2, so there is no need to generate any code for the head. This makes things \nsimpler by eliminating compi 1 e-head, and it is a better decomposition for another \nreason: instead of adding optimizations to compi 1 e-head, we will add them to the \ncode in compi 1 e-body that handles =. That way, we can optimize calls that the user \nmakes to =, in addition to the calls introduced by the source-code transformation. \n\nTo get an overview, the calling sequence of functions will turn out to be as follows: \n\nprolog-compile \ncompile-predicate \ncompile-clause \n\ncompile-body \ncompile-call \ncompile-arg \ncompile-unify \n\ncompile-arg \n\nwhere each function calls the ones below it that are indented one level. We have already \ndefined the first two functions. Here thenisourfirstversionof compi 1 e-cl ause: \n\n\f\n<a id='page-394'></a>\n\n(defun compile-clause (parms clause cont) \n\"Transform away the head, and compile the resulting body.\" \n(compile-body \n\n(nconc \n(mapcar #'make-= parms (args (clause-head clause))) \n(clause-body clause)) \n\ncont)) \n\n(defun make-= (x y) *(= .x .y)) \n\nThe bulk of the work is in compi 1 e - body, which is a little more complicated. There are \nthree cases. If there is no body, we just call the continuation. If the body starts with \na call to =, we compile a call to uni fy!. Otherwise, we compile a call to a function, \npassing in the appropriate continuation. \n\nHowever, it is worthwhile to think ahead at this point. If we want to treat = \nspecially now, we will probably want to treat other goals specially later. So instead \nof explicitly checking for =, we will do a data-driven dispatch, looking for any predicate \nthat has a prol og-compi 1 er-macro property attached to it. Like Lisp compiler \nmacros, the macro can decline to handle the goal. We will adopt the convenhon that \nreturning .-pass means the macro decided not to handle it, and thus it should be \ncompiled as a normal goal. \n\n(defun compile-body (body cont) \n\"Compile the body of a clause.\" \n(if (null body) \n\nMfuncall .cont) \n\n(let* ((goal (first body)) \n(macro (prolog-compiler-macro (predicate goal))) \n(macro-val (if macro \n\n(funcall macro goal (rest body) cont)))) \n\n(if (and macro (not (eq macro-val :pass))) \nmacro-val \n(compile-cal 1 \n\n(make-predicate (predicate goal) \n(relation-arity goal)) \n(mapcar #'(lambda (arg) (compile-arg arg)) \n(args goal)) \n\n(if (null (rest body)) \ncont \n'#'(lambda () \n\n.(compile-body (rest body) cont)))))))) \n\n(defun compile-call (predicate args cont) \n\"Compile a call to a prolog predicate.\" \n'(.predicate .@args .cont)) \n\n\f\n<a id='page-395'></a>\n(defun prolog-compiler-macro (name) \n\"Fetch the compiler macro for a Prolog predicate.\" \nNote NAME is the raw name, not the name/arity \n(get name 'prolog-compiler-macro)) \n\n(defmacro def-prolog-compi1er-macro (name arglist &body body) \n\"Define a compiler macro for Prolog.\" \n'(setf (get ',name 'prolog-compiler-macro) \n\n#'(lambda .arglist ..body))) \n\n(def-prolog-compi1er-macro = (goal body cont) \n(let ((args (args goal))) \n(if (/= (length args) 2) \n.-pass \n\n'(if.(compile-unify (first args) (second args)) \n.(compile-body body cont))))) \n(defun compile-unify (x y) \n\"Return code that tests if var and term unify.\" \n'(unify! .(compile-arg x) .(compile-arg y))) \n\nAll that remains is compi1 e-arg, a function to compile the arguments to goals in the \nbody. There are three cases to consider, as shown in the compilation to the argument \nof q below: \n\n1 (<- (p ?x) (q ?x)) (q/1 ?x cont) \n\n2 (<- (p ?x) (q (f a b))) (q/1 '(f a b) cont) \n\n3 (<- (p ?x) (q (f ?x b))) (q/1 (list 'f ?x 'b) cont) \n\nIn case 1, the argument is a variable, and it is compiled as is. In case 2, the argument \nis a constant expression (one without any variables) that compiles into a quoted \nexpression. In case 3, the argument contains a variable, so we have to generate code \nthat builds up the expression. Case 3 is actually split into two in the list below: one \ncompiles into a call to 1 i st, and the other a call to cons. It is important to remember \nthat the goal (q (f ?x b)) does not involve a call to the function f. Rather, it involves \nthe term (f ?x b), which is just a list of three elements. \n\n(defun compile-arg (arg) \n\"Generate code for an argument to a goal in the body.\" \n(cond ((variable-p arg) arg) \n\n((not (has-variable-p arg)) \".arg) \n((proper-listp arg) \n'(list ..(mapcar #'compile-arg arg))) \n(t '(cons .(compile-arg (first arg)) \n.(compile-arg (rest arg)))))) \n\n\f\n<a id='page-396'></a>\n\n(defun has-variable-p (x) \n\"Is there a variable anywhere in the expression x?\" \n(find-if-anywhere #'variable-p x)) \n\n(defun proper-listp (x) \n\"Is X a proper (non-dotted) list? \" \n(or (null x) \n\n(and (consp x) (proper-listp (rest x))))) \n\nLet's see how it works. We will consider the following clauses: \n\n(<- (likes Robin cats)) \n(<- (likes Sandy ?x) (likes ?x cats)) \n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim)) \n\n(<- (member ?item (?item . ?rest))) \n(<- (member ?item (?x . ?rest)) (member Titem ?rest)) \n\nHere's what prol og-compi 1 e gives us: \n\n(DEFUN LIKES/2 (7ARG1 ?ARG2 CONT) \n(IF (UNIFY! ?ARG1 'ROBIN) \n(IF (UNIFY! 7ARG2 'CATS) \n(FUNCALL CONT))) \n(IF (UNIFY! ?ARG1 'SANDY) \n(IF (UNIFY! ?ARG2 ?X) \n(LIKES/2 ?X 'CATS CONT))) \n(IF (UNIFY! 7ARG1 'KIM) \n(IF (UNIFY! ?ARG2 ?X) \n(LIKES/2 ?X 'LEE (LAMBDA () \n(LIKES/2 ?X 'KIM CONT)))))) \n\n(DEFUN MEMBER/2 (7ARG1 7ARG2 CONT) \n(IF (UNIFY! 7ARG1 7ITEM) \n(IF (UNIFY! 7ARG2 (CONS 7ITEM 7REST)) \n(FUNCALL CONT))) \n(IF (UNIFY! 7ARG1 7ITEM) \n(IF (UNIFY! 7ARG2 (CONS 7X 7REST)) \n(MEMBER/2 7ITEM 7REST CONT)))) \n\n\f\n<a id='page-397'></a>\n12.2 Fixing the Errors in the Compiler \nThere are some problems in this version of the compiler: \n\n* We forgot to undo the bindings after each call to uni fy!. \n* The definition of undo-bi ndi ngs! defined previously requires as an argument \nan index into the *trai 1 * array. So we will have to save the current top of the \ntrail when we enter each function. \n* Local variables, such as ?x, were used without being introduced. They should \nbe bound to new variables. \nUndoing the bindings is simple: we add a single line to compile-predicate, \na call to the function maybe-add-undo-bindings. This function inserts a call to \nundo-bi ndi ngs! after every failure. If there is only one clause, no undoing is necessary, \nbecause the predicate higher up in the calling sequence will do it when it fails. \nIf there are multiple clauses, the function wraps the whole function body in a . et \nthat captures the initial value of the trail's fill pointer, so that the bindings can be \nundone to the right point. Similarly, we can handle the unbound-variable problem \nby wrapping a call to bind - unbound- va rs around each compiled clause: \n\n(defun compile-predicate (symbol arity clauses) \n\"Compile all the clauses for a given symbol/arity \ninto a single LISP function.\" \n(let ((predicate (make-predicate symbol arity)) \n\n(parameters (make-parameters arity))) \n(compile \n(eval \n'(defun .predicate (,parameters cont) \n(maybe-add-undo-bindings \n(mapcar #*(lambda (clause) \n(compile-clause parameters \nclause 'cont)) \nclauses))))))) \n\n(defun compile-clause (parms clause cont) \n\"Transform away the head, and compile the resulting body.\" \n(bind-unbound-vars \n\nparms \n(compi1e-body \n\n(nconc \n(mapcar #'make-= parms (args (clause-head clause))) \n(clause-body clause)) \n\ncont))) \n\n\f\n<a id='page-398'></a>\n\n(defun maybe-add-undo-bindings (compiled-exps) \n\"Undo any bindings that need undoing. \nIf there are any, bind the trail before we start.\" \n(if (length=1 compiled-exps) \n\ncompiled-exps \n\n'((let ((old-trail (fill-pointer nrail*))) \n,(first compiled-exps) \n,@(loop for exp in (rest compiled-exps) \ncollect '(undo-bindings! old-trail) \ncollect exp))))) \n\n(defun bind-unbound-vars (parameters exp) \n\"If there are any variables in exp (besides the parameters) \nthen bind them to new vars.\" \n(let ((exp-vars (set-difference (variables-in exp) \n\nparameters))) \n(if exp-vars \n'(let .(mapcar #'(lambda (var) *(.var (?))) \nexp-vars) \n,exp) \nexp))) \n\nWith these improvements, here's the code we get for 1 i kes and member: \n\n(DEFUN LIKES/2 (?ARG1 ?ARG2 CONT) \n(LET ((OLD-TRAIL (FILL-POINTER *TRAIL*))) \n(IF (UNIFY! ?ARG1 'ROBIN) \n(IF (UNIFY! ?ARG2 'CATS) \n\n(FUNCALL CONT))) \n(UNDO-BINDINGS! OLD-TRAIL) \n(LET ((?X (?))) \n\n(IF (UNIFY! ?ARG1 'SANDY) \n(IF (UNIFY! ?ARG2 ?X) \n\n(LIKES/2 ?X 'CATS CONT)))) \n(UNDO-BINDINGS! OLD-TRAIL) \n(LET ((?X (?))) \n\n(IF (UNIFY! ?ARG1 'KIM) \n(IF (UNIFY! ?ARG2 ?X) \n(LIKES/2 ?X 'LEE (LAMBDA () \n(LIKES/2 ?X 'KIM CONT)))))))) \n\n\f\n<a id='page-399'></a>\n\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT) \n(LET ((OLD-TRAIL (FILL-POINTER *TRAIL*))) \n(LET ((?ITEM (?)) \n(?RE$T (?))) \n(IF (UNIFY! ?ARG1 ?ITEM) \n(IF (UNIFY! ?ARG2 (CONS ?ITEM ?REST)) \n\n(FUNCALL CONT)))) \n(UNDO-BINDINGS! OLD-TRAIL) \n(LET ((?X (?)) \n\n(?ITEM (?)) \n(?REST (?))) \n(IF (UNIFY! ?ARG1 ?ITEM) \n(IF (UNIFY! ?ARG2 (CONS ?X ?REST)) \n(MEMBER/2 ?ITEM ?REST CONT)))))) \n\n12.3 Improving the Compiler \nThis is fairly good, although there is still room for improvement. One minor improvement \nis to eliminate unneeded variables. For example, ?rest in the first clause of \nmember and ?x in the second clause are bound to new variables—the result of the (?) \ncall—and then only used once. The generated code could be made a little tighter by \njust putting (?) inline, rather than binding it to a variable and then referencing that \nvariable. There are two parts to this change: updating compi 1 e-arg to compile an \nanonymous variable inline, and changing the < - macro so that it converts all variables \nthat only appear once in a clause into anonymous variables: \n\n(defmacro <- (&rest clause) \n\"Add a clause to the data base.\" \n'(add-clause '.(make-anonymous clause))) \n\n(defun compile-arg (arg) \n\"Generate code for an argument to a goal in the body.\" \n(cond ((eq arg '?) '(?)) \n\n((variable-p arg) arg) \n((not (has-variable-p arg)) \",arg) \n((proper-listp arg) \n\n'(list ..(mapcar #'compile-arg arg))) \n(t '(cons .(compile-arg (first arg)) \n.(compile-arg (rest arg)))))) \n(defun make-anonymous (exp &optional \n(anon-vars (anonymous-variables-in exp))) \n\"Replace variables that are only used once with ?. \" \n(cond ((consp exp) \n\n(reuse-cons (make-anonymous (first exp) anon-vars) \n\n\f\n<a id='page-400'></a>\n\n(make-anonymous (rest exp) anon-vars) \n\nexp)) \n((member exp anon-vars) *?) \n(t exp))) \n\nFinding anonymous variables is tricky. The following function keeps two lists: the \nvariables that have been seen once, and the variables that have been seen twice \nor more. The local function wal k is then used to walk over the tree, recursively \nconsidering the components of each cons cell and updating the two lists as each \nvariable is encountered. This use of local functions should be remembered, as well \nas an alternative discussed in exercise 12.23 on [page 428](chapter12.md#page-428). \n\n(defun anonymous-variables-in (tree) \n\"Return a list of all variables that occur only once in tree.\" \n(let ((seen-once nil) \n\n(seen-more nil)) \n(labels ((walk (x) \n(cond \n((variable-p x) \n\n(cond ((member . seen-once) \n(setf seen-once (delete . seen-once)) \n(push . seen-more)) \n\n((member . seen-more) nil) \n(t (push . seen-once)))) \n\n((consp x) \n(walk (first x)) \n(walk (rest x)))))) \n\n(walk tree) \nseen-once))) \n\nNow member compiles into this: \n\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT) \n(LET ((OLD-TRAIL (FILL-POINTER nRAIL*))) \n(LET ((?ITEM (?))) \n(IF (UNIFY! ?ARG1 ?ITEM) \n(IF (UNIFY! ?ARG2 (CONS ?ITEM (?))) \n\n(FUNCALL CONT)))) \n(UNDO-BINDINGS! OLD-TRAIL) \n(LET ((?ITEM (?)) \n\n(?REST (?))) \n(IF (UNIFY! ?ARG1 ?ITEM) \n(IF (UNIFY! ?ARG2 (CONS (?) ?REST)) \n(MEMBER/2 ?ITEM ?REST CONT)))))) \n\n\f\n<a id='page-401'></a>\n12.4 Improving the Compilation of Unification \nNow we turn to the improvement of compi1 e - un i f y. Recall that we want to eliminate \ncertain calls to uni fy ! so that, for example, the first clause of member: \n\n(<- (member ?item (?item . ?rest))) \n\ncompiles into: \n\n(LET ((?ITEM (?))) \n(IF (UNIFY! ?ARG1 ?ITEM) \n(IF (UNIFY! ?ARG2 (CONS ?ITEM (?))) \n(FUNCALL CONT)))) \n\nwhen it could compile to the more efficient: \n\n(IF (UNIFY! ?ARG2 (CONS ?ARG1 (?))) \n(FUNCALL CONT)) \n\nEliminating the unification in one goal has repercussions in other goals later on, so \nwe will need to keep track of expressions that have been unified together. We have \na design choice. Either compi1 e-unify can modify a global state variable, or it can \nreturn multiple values. On the grounds that global variables are messy, we make the \nsecond choice: compi 1 e- uni fy will take a binding list as an extra argument and will \nreturn two values, the actual code and an updated binding list. We will expect that \nother related functions will have to be modified to deal with these multiple values. \n\nWhen compi le -unify is first called in our example clause, it is asked to unify \n?argl and ?item. We want it to return no code (or more precisely, the trivially true \ntest, t). For the second value, it should return a new binding list, with ?i tem bound \nto ?argl. That binding will be used to replace ?i tem with ?argl in subsequent code. \n\nHow do we know to bind ?item to ?argl rather than the other way around? \nBecause ?argl is already bound to something—the value passed in to member. We \ndon't know what this value is, but we can't ignore it. Thus, the initial binding list will \nhave to indicate that the parameters are bound to something. A simple convention \nis to bind the parameters to themselves. Thus, the initial binding list will be: \n\n((?argl . ?argl) (?arg2 . ?arg2)) \n\nWe saw in the previous chapter ([page 354](chapter11.md#page-354)) that binding a variable to itself can lead to \nproblems; we will have to be careful. \nBesides eliminating unifications of new variables against parameters, there are \nquite a few other improvements that can be made. For example, unifications involv\n\n\n\f\n<a id='page-402'></a>\n\ning only constants can be done at compile time. The call (= (f a) (f a)) always \nsucceeds, while (=3 4) always fails. In addition, unification of two cons cells can \nbe broken into components at compile time: (= (f ?x) (f a)) reduces to (= ?x \n\na) and (= f f), where the latter trivially succeeds. We can even do some occm-s \nchecking at compile time: (= ?x (f ?x)) should fail. \nThe following table lists these improvements, along with a breakdown for the \ncases of unifying a bound (? a rg1) or unbound (?x) variable agains another expression. \nThe first column is the unification call, the second is the generated code, and the third \nis the bindings that will be added as a result of the call: \n\nUnification Code Bindings \n1 (= 3 3) t — \n2 (= 3 4) nil — \n3 (= (f ?x) (?p 3)) t (?x . 3) (?p . f) \n4 (= ?argl ?y) t (?y . ?argl) \n5 (= ?argl ?arg2) (unify! ?argl ?arg2) (?argl . ?arg2) \n6 (= ?argl 3) (unify! ?argl 3) (?argl . 3) \n7 (= ?argl (f ?y)) (unify! ?argl ...) (?y . ?y) \n8 (= ?x ?y) t (?x . ?y) \n9 (= ?x 3) t (?x . 3) \n\n10 (= ?x (f ?y)) (unify! ?x ...) (?y . ?y) \n11 (= ?x (f ?x)) nil — \n12 (= ?x ?) t \n\n-\n\nFrom this table we can craft our new version of compi1 e-uni fy. The first part \nis fairly easy. It takes care of the first three cases in this table and makes stue \nthat compi 1 e-uni fy-vari abl e is called with a variable as the first argument for the \nother cases. \n\n(defun compile-unify (x y bindings) \n\"Return 2 values: code to test if . and y unify, \nand a new binding list.\" \n(cond \n\nUnify constants and conses: ; Case \n((not (or (has-variable-p x) (has-variable-p y))) ; 1,2 \n(values (equal . y) bindings)) \n((and (consp x) (consp y)) : 3 \n(multiple-value-bind (codel bindingsl) \n(compile-unify (first x) (first y) bindings) \n(multiple-value-bind (code2 bindings2) \n(compile-unify (rest x) (rest y) bindingsl) \n(values (compile-if codel code2) bindings2)))) \n\nHere . or y is a variable. Pick the right one: \n((variable-p x) (compi1e-unify-variable . y bindings)) \n(t (compile-unify-variab1e y . bindings)))) \n\n\f\n<a id='page-403'></a>\n(defun compile-if (pred then-part) \n\"Compile a Lisp IF form. No else-part allowed.\" \n(case pred \n\n((t) then-part) \n((nil) nil) \n(otherwise *(if ,pred .then-part)))) \n\nThe function compi 1 e - uni fy - va r i abl e following is one of the most complex we have \n\nseen. For each argument, we see if it has a binding (the local variables xb and yb), \n\nand then use the bindings to get the value of each argument (xl and y 1). Note that for \n\neither an unbound variable or one bound to itself, . will equal xl (and the same for y \n\nandyl). If either of the pairs of values is not equal, we should use the new ones (xl or \n\ny 1), and the clause commented deref does that. After that point, we just go through \n\nthe cases, one at a time. It turns out that it was easier to change the order slightly from \n\nthe preceding table, but each clause is commented with the corresponding number: \n\n(defun compile-unify-vari able (x y bindings) \n\"X is a variable, and Y may be.\" \n(let* ((xb (follow-binding . bindings)) \n\n(xl (if xb (cdr xb) x)) \n(yb (if (variable-p y) (follow-binding y bindings))) \n(yl (if yb (cdr yb) y))) \n\n(cond ; Case: \n((or (eq . *?) (eq y *?)) (values t bindings)) ; 12 \n((not (and (equal . xl) (equal y yl))) ; deref \n\n(compile-unify xl yl bindings)) \n((find-anywhere xl yl) (values nil bindings)) ; 11 \n((consp yl) ; 7.10 \n\n(values '(unifyl .xl .(compile-arg yl bindings)) \n(bind-variables-in yl bindings))) \n\n((not (null xb)) \n;.. i.e. X is an ?arg variable \n(if (and (variable-p yl) (null yb)) \n\n(values 't (extend-bindings yl xl bindings)) ; 4 \n(values '(unify! .xl ,(compile-arg yl bindings)) \n(extend-bindings xl yl bindings)))) ; 5.6 \n((not (null yb)) \n(compile-unify-variable yl xl bindings)) \n(t (values 't (extend-bindings xl yl bindings)))))) ; 8.9 \n\nTake some time to understand just how this function works. Then go on to the \nfollowing auxiliary functions: \n\n\f\n<a id='page-404'></a>\n\n(defun bind-variables-in (exp bindings) \n\"Bind all variables in exp to themselves, and add that to \nbindings (except for variables already bound).\" \n(dolist (var (variables-in exp)) \n\n(unless (get-binding var bindings) \n(setf bindings (extend-bindings var var bindings)))) \nbindings) \n\n(defun follow-binding (var bindings) \n\"Get the ultimate binding of var according to bindings.\" \n(let ((b (get-binding var bindings))) \n\n(if (eq (car b) (cdr b)) \nb \n(or (follow-binding (cdr b) bindings) \n\nb)))) \n\nNow we need to integrate the new compi 1 e - uni f y into the rest of the compiler. The \nproblem is that the new version takes an extra argument and returns an extra value, \nso all the functions that call it need to be changed. Let's look again at the calling \nsequence: \n\nprolog-compile \ncompile-predicate \ncompile-clause \n\ncompile-body \ncompile-call \ncompile-arg \n\ncompile-unify \ncompile-arg \n\nFirst, going downward, we see that compi 1 e-arg needs to take a binding Ust as an \nargument, so that it can look up and substitute in the appropriate values. But it will \nnot alter the binding list, so it still returns one value: \n\n(defun compile-arg (arg bindings) \n\"Generate code for an argument to a goal in the body.\" \n(cond ((eq arg *?) '(?)) \n\n((variable-p arg) \n(let ((binding (get-binding arg bindings))) \n(if (and (not (null binding)) \n\n(not (eq arg (binding-val binding)))) \n(compile-arg (binding-val binding) bindings) \narg))) \n\n((not (find-if-anywhere #'variable-p arg)) \".arg) \n((proper-listp arg) \n\n'(list ..(mapcar #*(lambda (a) (compile-arg a bindings)) \n\f\n<a id='page-405'></a>\n\narg))) \n(t '(cons ,(compile-arg (first arg) bindings) \n.(compile-arg (rest arg) bindings))))) \n\nNow, going upward, compile-body needs to take a binding list and pass it on to \nvarious functions: \n\n(defun compile-body (body cont bindings) \n\"Compile the body of a clause.\" \n(cond \n\n((null body) \n'(funcall .cont)) \n\n(t (let* ((goal (first body)) \n(macro (prolog-compiler-macro (predicate goal))) \n(macro-val (if macro \n\n(funcall macro goal (rest body) \ncontbindings)))) \n\n(if (and macro (not (eq macro-val rpass))) \nmacro-val \n(compile-cal1 \n\n(make-predicate (predicate goal) \n(relation-arity goal)) \n(mapcar #*(lambda (arg) \n(compile-arg arg bindings)) \n(args goal)) \n\n(if (null (rest body)) \ncont \n'#'(lambda () \n\n.(compile-body \n(rest body) cont \n(bind-new-variables bindings goal)))))))))) \n\nThe function bind -new-variables takes any variables mentioned in the goal that \nhave not been bound yet and binds these variables to themselves. This is because \nthe goal, whatever it is, may bind its arguments. \n\n(defun bind-new-variables (bindings goal) \n\"Extend bindings to include any unbound variables in goal.\" \n(let ((variables (remove-if #'(lambda (v) (assoc . bindings)) \n\n(variables-in goal)))) \n(nconc (mapcar #*self-cons variables) bindings))) \n\n(defun self-cons (x) (cons . .)) \n\nOne of the functions that needs to be changed to accept a binding list is the compiler \nmacro for =: \n\n\f\n<a id='page-406'></a>\n\n(def-prolog-compiler-macro = (goal body cont bindings) \n\"Compile a goal which is a call to =. \" \n(let ((args (args goal))) \n\n(if (/= (length args) 2) \n:pass decline to handle this goal \n(multiple-value-bind (codel bindingsl) \n\n(compile-unify (first args) (second args) bindings) \n\n(compile-if \ncodel \n(compile-body body cont bindingsl)))))) \n\nThe last step upward is to change compi 1 e-cl ause so that it starts everything off by \npassingin to comp i 1 e - body a binding list with all the parameters bound to themselves: \n\n(defun compile-clause (parms clause cont) \n\"Transform away the head, and compile the resulting body.\" \n(bind-unbound-vars \n\nparms \n\n(compile-body \n\n(nconc \n(mapcar #*make-= parms (args (clause-head clause))) \n(clause-body clause)) \n\ncont \n\n(mapcar #'self-cons parms)))) \n\nFinally, we can see the fruits of our efforts: \n\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT) \n(LET ((OLD-TRAIL (FILL-POINTER *TRAIL*))) \n(IF (UNIFYl ?ARG2 (CONS ?ARG1 (?))) \n\n(FUNCALL CONT)) \n(UNDO-BINDINGS! OLD-TRAIL) \n(LET ((?REST (?))) \n\n(IF (UNIFY! ?ARG2 (CONS (?) ?REST)) \n(MEI^BER/2 ?ARG1 ?REST CONT))))) \n\n(DEFUN LIKES/2 (?ARG1 ?ARG2 CONT) \n(LET ((OLD-TRAIL (FILL-POINTER *TRAIL*))) \n(IF (UNIFY! ?ARG1 'ROBIN) \n(IF (UNIFY! ?ARG2 'CATS) \n\n(FUNCALL CONT))) \n(UNDO-BINDINGS! OLD-TRAIL) \n(IF (UNIFY! ?ARG1 'SANDY) \n\n(LIKES/2 ?ARG2 'CATS CONT)) \n(UNDO-BINDINGS! OLD-TRAIL) \n(IF (UNIFY! ?ARG1 'KIM) \n\n(LIKES/2 ?ARG2 'LEE (LAMBDA () \n(LIKES/2 ?ARG2 'KIM CONT)))))) \n\n\f\n<a id='page-407'></a>\n12.5 Further Improvements to Unification \nCould compile-unify be improved yet again? If we insist that it call unifyl, it \nseems that it can't be made much better. However, we could improve it by in effect \ncompiling unify!. This is a key idea in the Warren Abstract Machine, or WAM, \nwhich is the most commonly used model for Prolog compilers. \n\nWe call uni fy! in four cases (5, 6, 7, and 10), and in each case the first argument \nis a variable, and we know something about the second argument. But the first \nthing uni fy! does is redundantly test if the first argument is a variable. We could \neliminate unnecessary tests by calling more specialized functions rather than the \ngeneral-purpose function uni fy!. Consider this call: \n\n(unify! ?arg2 (cons ?argl (?))) \n\nIf ?arg2 is an unbound variable, this code is appropriate. But if ?arg2 is a constant \natom, we should fail immediately, without allowing cons and ? to generate garbage. \nWe could change the test to: \n\n(and (consp-or-variable-p ?arg2) \n(unify-first! ?arg2 ?argl) \n(unify-rest! ?arg2 (?))) \n\nwith suitable definitions for the functions referenced here. This change should \nspeed execution time and limit the amount of garbage generated. Of course, it makes \nthe generated code longer, so that could slow things down if the program ends up \nspending too much time bringing the code to the processor. \n\n&#9635; Exercise 12.1 [h] Write definitions for consp-or-variable-p, unify-firstl, and \nuni fy - rest!, and change the compiler to generate code like that outlined previously. \nYou might want to look at the function compile-rule in section 9.6, starting on \n[page 300](chapter9.md#page-300). This function compiled a call to pat-match into individual tests; now we \nwant to do the same thing to uni fy!. Run some benchmarks to compare the altered \ncompiler to the original version. \n\n&#9635; Exercise 12.2 [h] We can gain some more efficiency by keeping track of which \nvariables have been dereferenced and calling an appropriate unification function: \neither one that dereferences the argument or one that assumes the argument has \nalready been dereferenced. Implement this approach. \n\n&#9635; Exercise 12.3 [m] What code is generated for (= (f (g ?x) ?y) (f ?y (?p a)))? \n\n\f\n<a id='page-408'></a>\n\nWhat more efficient code represents the same unification? How easy is it to change \n\nthe compiler to get this more efficient result? \n\n&#9635; Exercise 12.4 [h] In retrospect, it seems that binding variables to themselves, as \nin (?argl . ?argl), was not such a good idea. It complicates the meaning of \nbindings, and prohibits us from using existing tools. For example, I had to use \nfind-anywhere instead of occur-check for case 11, because occur-check expects \na noncircular binding list. But find-anywhere does not do as complete a job as \noccur-check. Write a version of compi 1 e - uni fy that returns three values: the code, \na noncircular binding list, and a list of variables that are bound to unknown values. \n\n&#9635; Exercise 12.5 [h] An alternative to the previous exercise is not to use binding lists at \nall. Instead, we could pass in a list of equivalence classes—that is, a list of lists, where \neach sublist contains one or more elements that have been unified. In this approach, \nthe initial equivalence class Hst would be ((?argl) (?arg2)). After unifying ?argl \nwith ?x,?arg2 with ?y, and ?x with 4, the list would be ((4 ?argl ?x) (?arg2 ?y)). \nThis assumes the convention that the canonical member of an equivalence class (the \none that will be substituted for all others) comes first. Implement this approach. \nWhat advantages and disadvantages does it have? \n\n12.6 The User Interface to the Compiler \nThe compiler can translate Prolog to Lisp, but that does us no good unless we can \nconveniently arrange to compile the right Prolog relations and call the right Lisp \nfunctions. In other words, we have to integrate the compiler with the <- and ? \nmacros. Surprisingly, we don't need to change these macros at all. Rather, we \nwill change the functions these macros call. When a new clause is entered, we will \nenter the clause's predicate in the list *uncompi 1 ed*. This is a one-line addition to \nadd-clause: \n\n(defvar *uncompiled* nil \n\"Prolog symbols that have not been compiled.\") \n\n(defun add-clause (clause) \n\"Add a clause to the data base, indexed by head's predicate.\" \n;; The predicate must be a non-variable symbol, \n(let ((pred (predicate (clause-head clause)))) \n\n(assert (and (symbolp pred) (not (variable-p pred)))) \n(pushnew pred *db-predicates*) \n(pushnew pred *uncompiled*) \n(setf (get pred 'clauses) \n\n\f\n<a id='page-409'></a>\n\n(nconc (get-clauses pred) (list clause))) \npred)) \n\nNow when a query is made, the ?- macro expands into a call to top-level - prove. \nThe Hst of goals in the query, along with the show-prol og-vars goal, is added as the \nsole clause for the relation top -1 evel - query. Next, that query, along with any others \nthat are on the uncompiled list, are compiled. Finally, the newly compiled top-level \nquery function is called. \n\n(defun top-level-prove (goals) \n\"Prove the list of goals by compiling and calling it.\" \n\nFirst redefine top-level-query \n(clear-predicate 'top-level-query) \n(let ((vars (delete *? (variables-in goals)))) \n\n(add-clause *((top-level-query) \n,goals \n(show-prolog-vars ,(mapcar #'symbol-name vars) \n\n.vars)))) \n;; Now run it \n(run-prolog 'top-level-query/0 #'ignore) \n(format t \"~&No.\") \n(values)) \n\n(defun run-prolog (procedure cont) \n\"Run a O-ary prolog procedure with a given continuation.\" \n\nFirst compile anything else that needs it \n(prolog-compi1e-symbols) \n;; Reset the trail and the new variable counter \n(setf (fill-pointer nrail*) 0) \n(setf *var-counter* 0) \n;; Finally, call the query \n(catch 'top-level-prove \n\n(funcall procedure cont))) \n\n(defun prolog-compi1e-symbols (&optional (symbols *uncompiled*)) \n\"Compile a list of Prolog symbols. \nBy default, the list is all symbols that need it.\" \n(mapc #'prolog-compile symbols) \n(setf *uncompiled* (set-difference *uncompiled* symbols))) \n\n(defun ignore (&rest args) \n(declare (ignore args)) \nnil) \n\nNote that at the top level, we don't need the continuation to do anything. Arbitrarily, \nwe chose to pass in the function ignore, which is defined to ignore its arguments. \n\n\f\n<a id='page-410'></a>\n\nThis function is useful in a variety of places; some programmers will proclaim it \ninline and then use a call to i gnore in place of an ignore declaration: \n\n(defun third-arg (x y .) \n(ignore . y) \n.) \n\nThe compiler's calling convention is different from the interpreter, so the primitives \nneed to be redefined. The old definition of the primitive show-prol og- va rs had three \nparameters: the list of arguments to the goal, a binding list, and a list of pending \ngoals. The new definition ofshow-prolog-vars/2 also has three parameters, but that \nis just a coincidence. The first two parameters are the two separate arguments to the \ngoal: a list of variable names and a list of variable values. The last parameter is a \ncontinuation function. To continue, we call that function, but to fail, we throw to the \ncatch point set up in top-1 evel - prove. \n\n(defun show-prolog-vars/2 (var-names vars cont) \n\"Display the variables, and prompt the user to see \nif we should continue. If not, return to the top level.\" \n(if (null vars) \n\n(format t \"~&Yes\") \n\n(loop for name in var-names \nfor var in vars do \n(format t \"~&~a = '^a\" name (deref-exp var)))) \n\n(if (continue-p) \n(funcall cont) \n(throw 'top-level-prove nil))) \n\n(defun deref-exp (exp) \n\"Build something equivalent to EXP with variables dereferenced.\" \n(if (atom (deref exp)) \n\nexp \n\n(reuse-cons \n(deref-exp (first exp)) \n(deref-exp (rest exp)) \nexp))) \n\nWith these definitions in place, we can invoke the compiler automatically just by \nmaking a query with the ? - macro. \n\n&#9635; Exercise 12.6 [m] Suppose you define a predicate p, which calls q, and then define \n\nq.In some implementations of Lisp, when you make a query like (? - (. ?x)), you \nmay get a warning message like \"function q/1 undef i ned\" before getting the correct \n\f\n<a id='page-411'></a>\n\nanswer. The problem is that each function is compiled separately, so warnings detected \nduring the compilation of p/1 will be printed right away, even if the function \nq/1 will be defined later. In ANSI Common Lisp there is a way to delay the printing \nof warnings until a series of compilations are done: wrap the compilation with the \nmacro wi th - compi1 at i on - uni t. Even if your implementation does not provide this \nmacro, it may provide the same functionality under a different name. Find out if \nwith-compilation-unit is already defined in your implementation, or if it can be \ndefined. \n\n12.7 Benchmarking the Compiler \nOur compiled Prolog code runs the zebra puzzle in 17.4 seconds, a 16-fold speed-up \nover the interpreted version, for a rate of 740 LIPS. \nAnother popular benchmark is Lisp's reverse function, which we can code as \nthe rev relation: \n\n(<- (rev () ())) \n\n(<- (rev (?x . ?a) ?b) (rev ?a ?c) (concat ?c (?x) ?b)) \n\n(<- (concat () ?1 ?1)) \n\n(<- (concat (?x . ?a) ?b (?x . ?c)) (concat ?a ?b ?c)) \n\nrev uses the relation concat, which stands for concatenation, (concat ?a ?b ?c)is \ntrue when ?a concatenated to ?b yields ?c. This relationlike name is preferred over \nmore procedural names like append. But rev is very similar to the following Lisp \ndefinitions: \n\n(defun rev (1) \n\n(if (null 1) \nnil \n(app (rev (rest 1)) \n\n(list (first 1))))) \n\n(defun app (x y) \n\n(if (null X) \ny \n(cons (first x) \n\n(app (rest x) y)))) \n\nBoth versions are inefficient. It is possible to write an iterative version of reverse \nthat does no extra consing and is tail-recursive: \n\n\f\n<a id='page-412'></a>\n\n(<- (irev ?1 ?r) (irev3 ?1 () ?r)) \n\n(<- (irevS (?x . ?1) ?so-far ?r) (irevS ?1 (?x ?so-far) ?r)) \n(<- (irev3 () ?r ?r)) \n\nThe Prolog i rev is equivalent to this Lisp program: \n\n(defun irev (list) (irev2 list nil)) \n\n(defun irev2 (list so-far) \n\n(if (consp list) \n(irev2 (rest list) (cons (first list) so-far)) \nso-far)) \n\nThe following table shows times in seconds to execute these routines on lists of length \n20 and 100, for both Prolog and Lisp, both interpreted and compiled. (Only compiled \nLisp could execute rev on a 100-element list without running out of stack space.) \nTimes for the zebra puzzle are also included, although there is no Lisp version of \nthis program. \n\nInterp. Comp. Interp. Comp. \nProblem Prolog Prolog Speed-up Lisp Lisp \n\nzebra 278.000 17.241 16 — — \nrev 20 4.24 .208 20 .241 .0023 \nrev 100 — — — — .0614 \nirev 20 .22 .010 22 .028 .0005 \nirev 100 9.81 .054 181 .139 .0014 \n\nThis benchmark is too small to be conclusive, but on these examples the Prolog \ncompiler is 16 to 181 times faster than the Prolog interpreter, slightly faster than \ninterpreted Lisp, but still 17 to 90 times slower than compiled Lisp. This suggests \nthat the Prolog interpreter cannot be used as a practical programming tool, but the \nProlog compiler can. \n\nBefore moving on, it is interesting to note that Prolog provides for optional arguments \nautomatically. Although there is no special syntax for optional arguments, an \noften-used convention is to have two versions of a relation, one with . arguments \nand one with . - 1. A single clause for the . — 1 case provides the missing, and \ntherefore \"optional,\" argument. In the following example, i rev /2 can be considered \nas a version of i rev/3 where the missing optional argument is (). \n\n(<- (irev ?1 ?r) (irev ?1 () ?r)) \n(<- (irev (?x . ?1) ?so-far ?r) (irev ?1 (?x ?so-far) ?r)) \n(<- (irev () ?r ?r)) \n\nThis is roughly equivalent to the following Lisp verison: \n\n\f\n<a id='page-413'></a>\n\n(defun irev (list &optional (so-far nil)) \n\n(if (consp list) \n(irev (rest list) (cons (first list) so-far)) \nso-far)) \n\n12.8 Adding More Primitives \nJust as a Lisp compiler needs machine instructions to do input/output, arithmetic, \nand the like, so our Prolog system needs to be able to perform certain primitive actions. \nFor the Prolog interpreter, primitives were implemented by function symbols. When \nthe interpreter went to fetch a list of clauses, if it got a function instead, it called that \nfunction, passing it the arguments to the current relation, the current bindings, and \na list of unsatisfied goals. For the Prolog compiler, primitives can be installed simply \nby writing a Lisp function that respects the convention of taking a continuation as \nthe final argument and has a name of the form symbol/arity. For example, here's an \neasy way to handle input and output: \n\n(defun read/1 (exp cont) \n(if (unify! exp (read)) \n(funcall cont))) \n\n(defun write/1 (exp cont) \n(write (deref-exp exp) :pretty t) \n(funcall cont)) \n\nCalling (write ?x) will always succeed, so the continuation will always be called. \nSimilarly, one could use (read ?x) to read a value and unify it with ?x. If ?x is \nunbound, this is the same as assigning the value. However, it is also possible to make \na call like (read (?x + ?y)), which succeeds only if the input is a three-element list \nwith + in the middle. It is an easy extension to define read/2 and wr i te/2 as relations \nthat indicate what stream to use. To make this useful, one would need to define \nopen/2 as a relation that takes a pathname as one argument and gives a stream back \nas the other. Other optional arguments could also be supported, if desired. \n\nThe primitive nl outputs a newline: \n\n(defun nl/0 (cont) (terpri) (funcall cont)) \n\nWe provided special support for the unification predicate, =. However, we could \nhave simplified the compiler greatly by having a simple definition for =/2: \n\n\f\n<a id='page-414'></a>\n\n(defun =/2 (?argl ?arg2 cont) \n(if (unify! ?argl ?arg2) \n(funcall cont))) \n\nIn fact, if we give our compiler the single clause: \n\n(<- (= ?x ?x)) \n\nit produces just this code for the definition of =/ 2. There are other equaUty predicates \nto worry about. The predicate= =/2 is more like equal in Lisp. It does no unification, \nbut instead tests if two structures are equal with regard to their elements. A variable \nis considered equal only to itself. Here's an implementation: \n\n(defun =/2 (?argl ?arg2 cont) \n\"Are the two arguments EQUAL with no unification, \nbut with dereferencing? If so, succeed.\" \n(if (deref-equal ?argl ?arg2) \n\n(funcall cont))) \n\n(defun deref-equal (x y) \n\"Are the two arguments EQUAL with no unification, \nbut with dereferencing?\" \n(or (eql (deref x) (deref y)) \n\n(and (consp x) \n(consp y) \n(deref-equal (first x) (first y)) \n(deref-equal (rest x) (rest y))))) \n\nOne of the most important primitives is cal 1. Like funcall in Lisp, cal 1 allows us \nto build up a goal and then try to prove it. \n\n(defun cal 1/1 (goal cont) \n\"Try to prove goal by calling it.\" \n(deref goal) \n(apply (make-predicate (first goal) \n\n(length (args goal))) \n(append (args goal) (list cont)))) \n\nThis version of cal 1 will give a run-time error if the goal is not instantiated to a list \nwhose first element is a properly defined predicate; one might want to check for that, \nand fail silently if there is no defined predicate. Here's an example of call where the \ngoal is legal: \n\n\f\n<a id='page-415'></a>\n> (?- (= ?p member) (call (?p ?x (a b c)))) \n?P = MEMBER \n?X = A; \n?P = MEMBER \n?X = B; \n?P = MEMBER \n?X = C; \nNo. \n\nNow that we have ca 11, a lot of new things can be implemented. Here are the logical \nconnectives and and or: \n\n(<- (or ?a ?b) (call ?a)) \n\n(<- (or ?a ?b) (call ?b)) \n\n(<- (and ?a ?b) (call ?a) (call ?b)) \n\nNote that these are only binary connectives, not the n-ary special forms used in Lisp. \nAlso, this definition negates most of the advantage of compilation. The goals inside \nan and or or will be interpreted by cal 1, rather than being compiled. \n\nWe can also define not, or at least the normal Prolog not, which is quite distinct \nfrom the logical not. In fact, in some dialects, not is written \\+, which is supposed to \nbe reminiscent of the logical symbol I/, that is, \"can not be derived.\" The interpretation \nis that if goal G can not be proved, then (not G) is true. Logically, there is a difference \nbetween (not G) being true and being unknown, but ignoring that difference makes \nProlog a more practical programming language. See Lloyd 1987 for more on the \nformal semantics of negation in Prolog. \n\nHere's an implementation of not/L Since it has to manipulate the trail, and we \n\nmay have other predicates that will want to do the same, we'll package up what was \n\ndone in maybe-add-undo-bindings into the macro with-undo-bindings: \n\n(defmacro with-undo-bindings (&body body) \n\"Undo bindings after each expression in body except the last.\" \n(if (length=1 body) \n\n(first body) \n\n'(let ((old-trail (fill-pointer nrail*))) \n.(first body) \n.(loop for exp in (rest body) \n\ncollect *(undo-bindings! old-trail) \ncollect exp)))) \n\n(defun not/1 (relation cont) \n\"Negation by failure: If you can't prove G. then (not G) true.\" \n;; Either way. undo the bindings, \n(with-undo-bindings \n\n(call/1 relation #'(lambda () (return-from not/1 nil))) \n\n(funcall cont))) \n\n\f\n<a id='page-416'></a>\n\nHere's an example where not works fine: \n\n> (?- (member ?x (a b c)) (not (= ?x b))) \n?X = A; \n?X = C; \nNo. \n\nNow see what happens when we simply reverse the order of the two goals: \n\n> (?- (not (= ?x b)) (member ?x (a b c))) \nNo. \n\nThe first example succeeds unless ?x is bound to b. In the second example, ?x is \nunbound at the start, so (= ?x b) succeeds, the not fails, and the member goal is never \nreached. So our implementation of not has a consistent procedural interpretation, \nbut it is not equivalent to the declarative interpretation usually given to logical negation. \nNormally, one would expect that a and c would be valid solutions to the query, \nregardless of the order of the goals. \n\nOne of the fundamental differences between Prolog and Lisp is that Prolog is \nrelational: you can easily express individual relations. Lisp, on the other hand, is \ngood at expressing collections of things as lists. So far we don't have any way of \nforming a collection of objects that satisfy a relation in Prolog. We can easily iterate \nover the objects; we just can't gather them together. The primitive bagof is one way \nof doing the collection. In general, (bagof ?x (p ?x) ?bag) unifies ?bag with a list \nof all ?x's that satisfy (. ?x). If there are no such ?x's, then the call to bagof fails. A \nbagis an unordered collection with duplicates allowed. For example, the bag {a, 6, a} \nis the same as the bag {a, a, 6}, but different from {a, 6}. Bags stands in contrast to \nsets, which are unordered collections with no duplicates. The set {a, 6} is the same \nas the set {6, a}. Here is an implementation of bagof: \n\n(defun bagof/3 (exp goal result cont) \n\"Find all solutions to GOAL, and for each solution, \ncollect the value of EXP into the list RESULT.\" \n;; Ex: Assume (p 1) (p 2) (p 3). Then: \n;: (bagof ?x (p ?x) ?1) => ?1= (1 2 3) \n(let ((answers nil)) \n\n(call/1 goal #'(lambda () \n(push (deref-copy exp) answers))) \n(if (and (not (null answers)) \n(unify! result (nreverse answers))) \n(funcall cont)))) \n\n\f\n<a id='page-417'></a>\n(defun deref-copy (exp) \n\"Copy the expression, replacing variables with new ones. \nThe part without variables can be returned as is. \" \n(sublis (mapcar #'(lambda (var) (cons (deref var) (?)) \n\n(unique-find-anywhere-if #'var-p exp)) \nexp)) \n\nBelow we use bagof to collect a list of everyone Sandy likes. Note that the result is a \nbag, not a set: Sandy appears more than once. \n\n> (?- (bagof ?who (likes Sandy ?who) ?bag)) \n?WHO = SANDY \n\n?BAG = (LEE KIM ROBIN SANDY CATS SANDY); \n\nNo. \n\nIn the next example, we form the bag of every list of length three that has A and . as \nmembers: \n\n> (?- (bagof ?1 (and (length ?1 (1+ (1+ (1+ 0)))) \n(and (member a ?1) (member b ?1))) \n\n?bag)) \n?L = (?5 ?8 ?11 ?68 ?66) \n?BAG = ((A . ?17) (A ?21 B) (B A ?31) (?38 A B) (B ?48 A) (?52 . A)) \nNo. \n\nThose who are disappointed with a bag containing multiple versions of the same \nanswer may prefer the primitive setof, which does the same computation as bagof \nbut then discards the duplicates. \n\n(defun setof/3 (exp goal result cont) \n\"Find all unique solutions to GOAL, and for each solution, \ncollect the value of EXP into the list RESULT.\" \n;; Ex: Assume (p 1) (p 2) (p 3). Then: \n;; (setof ?x (p ?x) ?1) = > ?1 = (1 2 3) \n(let ((answers nil)) \n\n(call/1 goal #'(lambda () \n(push (deref-copy exp) answers))) \n(if (and (not (null answers)) \n\n(unify! result (delete-duplicates \nanswers \n:test #*deref-equal))) \n\n(funcall cont)))) \n\nProlog supports arithmetic with the operator is. For example, (Is ?x (+ ?y 1)) \nunifies ?x with the value of ?y plus one. This expression fails if ?y is unbound, and it \n\n\f\n<a id='page-418'></a>\n\ngives a run-time error if ?y is not a number. For our version of Prolog, we can support \nnot just arithmetic but any Lisp expression: \n\n(defun is/2 (var exp cont) \nExample: (is ?x (+ 3 (* ?y (+ ?z 4)))) \nOr even: (is (?x ?y ?x) (cons (first ?z) ?1)) \n\n(if (and (not (find-if-anywhere #*unbound-var-p exp)) \n(unify 1 var (eval (deref-exp exp)))) \n(funcall cont))) \n\n(defun unbound-var-p (exp) \n\"Is EXP an unbound var?\" \n(and (var-p exp) (not (bound-p exp)))) \n\nAs an aside, we might as well give the Prolog programmer access to the function \nunbound -var-p. The standard name for this predicate is va r/1: \n\n(defun var/1 (?argl cont) \n\"Succeeds if ?argl is an uninstantiated variable.\" \n(if (unbound-var-p ?argl) \n\n(funcall cont))) \n\nThe is primitive fails if any part of the second argument is unbound. However, there \nare expressions with variables that can be solved, although not with a direct call to \neval. For example, the following goal could be solved by binding ?x to 2: \n\n(solve (= 12 (* (+ ?x 1) 4))) \n\nWe might want to have more direct access to Lisp from Prolog. The problem with \nis is that it requires a check for unbound variables, and it calls eval to evaluate \narguments recursively. In some cases, we just want to get at Lisp's apply, without \ngoing through the safety net provided by i s. The primitive lisp does that. Needless \nto say,1 i sp is not a part of standard Prolog. \n\n(defun lisp/2 (?result exp cont) \n\"Apply (first exp) to (rest exp), and return the result.\" \n(if (and (consp (deref exp)) \n\n(unify! ?result (apply (first exp) (rest exp)))) \n(funcall cont))) \n\n&#9635; Exercise 12.7 [m] Define the primitive solve/1, which works like the function \nsol ve used in student ([page 225](chapter7.md#page-225)). Decide if it should take a single equation as \nargument or a list of equations. \n\n\f\n<a id='page-419'></a>\n&#9635; Exercise 12.8 [h] Assumewehadagoalof the form (solve (= 12 (* (+ ?x 1) \n4))). Rather than manipulate the equation when sol ve/1 is called at run time, we \nmight prefer to do part of the work at compile time, treating the call as if it were \n(solve (= ?x 2)). Write a Prolog compiler macro for sol ve. Notice that even when \nyou have defined a compiler macro, you still need the underlying primitive, because \nthe predicate might be invoked through a cal 1 / I. The same thing happens in Lisp: \neven when you supply a compiler macro, you still need the actual function, in case \nof a funcall or apply. \n\n&#9635; Exercise 12.9 [h] Which of the predicates call, and, or, not, or repeat could \nbenefit from compiler macros? Write compiler macros for those predicates that \ncould use one. \n\n&#9635; Exercise 12.10 [m] You might have noticed that ca 11 /1 is inefficient in two important \nways. First, it calls make-predi cate, which must build a symbol by appending \nstrings and then look the string up in the Lisp symbol table. Alter make-predi cate \nto store the predicate symbol the first time it is created, so it can do a faster lookup \non subsequent calls. The second inefficiency is the call to append. Change the whole \ncompiler so that the continuation argument comes first, not last, thus eliminating \nthe need for append in cal 1. \n\n&#9635; Exercise 12.11 [s] The primitive true/0 always succeeds, and f a i 1 /O always fails. \nDefine these primitives. Hint: the first corresponds to a Common Lisp function, and \nthe second is a function already defined in this chapter. \n\n&#9635; Exercise 12.12 [s] Would it be possible to write = =/ 2 as a list of clauses rather than \nas a primitive? \n\n&#9635; Exercise 12.13 [m] Write a version of deref - copy that traverses the argument expression \nonly once. \n\n\f\n<a id='page-420'></a>\n\n12.9 The Cut \nIn Lisp, it is possible to write programs that backtrack explicitly, although it can \nbe awkward when there are more than one or two backtrack points. In Prolog, \nbacktracking is automatic and implicit, but we don't yet know of any way to avoid \nbacktracking. There are two reasons why a Prolog programmer might want to disable \nbacktracking. First, keeping track of the backtrack points takes up time and space. \nA programmer who knows that a certain problem has only one solution should be \nable to speed up the computation by telling the program not to consider the other \npossible branches. Second, sometimes a simple logical specification of a problem \nwill yield redundant solutions, or even some unintended solutions. It may be that \nsimply pruning the search space to eliminate some backtracking will yield only \nthe desired answers, while restructuring the program to give all and only the right \nanswers would be more difficult. Here's an example. Suppose we wanted to define \na predicate, max/3, which holds when the third argument is the maximum of the \nfirst two arguments, where the first two arguments will always be instantiated to \nnumbers. The straightforward definition is: \n\n(<- (max ?x ?y ?x) (>= ?x ?y)) \n(<- (max ?x ?y ?y) ??x ?y)) \n\nDeclaratively, this is correct, but procedurally it is a waste of time to compute the < \nrelation if the >= has succeeded: in that case the < can never succeed. The cut symbol, \nwritten !, can be used to stop the wasteful computation. We could write: \n\n(<- (max ?x ?y ?x) (>= ?x ?y) !) \n(<- (max ?x ?y ?y)) \n\nThe cut in the first clause says that if the first clause succeeds, then no other clauses \nwill be considered. So now the second clause can not be interpreted on its own. \nRather, it is interpreted as \"if the first clause fails, then the max of two numbers is the \nsecond one.\" \n\nIn general, a cut can occur anywhere in the body of a clause, not just at the end. \nThere is no good declarative interpretation of a cut, but the procedural interpretation \nis two-fold. First, when a cut is \"executed\" as a goal, it always succeeds. But in \naddition to succeeding, it sets up a fence that cannot be crossed by subsequent \nbacktracking. The cut serves to cut off backtracking both from goals to the right of \nthe cut (in the same clause) and from clauses below the cut (in the same predicate). \nLet's look at a more abstract example: \n\n(<- (p) (q) (r) ! (s) (t)) \n(<- (p) (s)) \n\n\f\n<a id='page-421'></a>\n\nIn processing the first clause of p, backtracking can occur freely while attempting \nto solve q and r. Once r is solved, the cut is encountered. From that point on, \nbacktracking can occur freely while solving s and t, but Prolog will never backtrack \npast the cut into r, nor will the second clause be considered. On the other hand, if \nq or . failed (before the cut is encountered), then Prolog would go on to the second \nclause. \n\nNow that the intent of the cut is clear, let's think of how it should be implemented. \nWe'll look at a slightly more complex predicate, one with variables and multiple cuts: \n\n(<- (p ?x a) ! (q ?x)) \n\n(<- (p ?x b) (r ?x) ! (s ?x)) \n\nWe have to arrange it so that as soon as we backtrack into a cut, no more goals \nare considered. In the first clause, when q/1 fails, we want to return from p/2 \nimmediately, rather than considering the second clause. Similarly, the first time s /1 \nfails, we want to return from p/2, rather than going on to consider other solutions to \nr/1. Thus, we want code that looks something like this: \n\n(defun p/2 (argl arg2 cont) \n(let ((old-trail (fil 1-pointer nrail*))) \n(if (unify! arg2 'a) \n(progn (q/1 argl cont) \n\n(return-from p/2 nil))) \n(undo-bindings! old-trail) \n(if (unify! arg2 'b) \n\n(r/1 argl #'(lambda () \n(progn (s/1 argl cont) \n(return-from p/2 nil))))))) \n\nWe can get this code by making a single change to compi 1 e - body: when the first goal \n\nin a body (or what remains of the body) is the cut symbol, then we should generate a \n\nprogn that contains the code for the rest of the body, followed by a return-from the \n\npredicate being compiled. Unfortunately, the name of the predicate is not available \n\nto compi 1 e-body. We could change compile-clause and compi 1 e-body to take the \n\npredicate name as an extra argument, or we could bind the predicate as a special \n\nvariable in compi 1 e-predi cate. I choose the latter: \n\n(defvar ^predicate* nil \n\"The Prolog predicate currently being compiled\") \n\n\f\n<a id='page-422'></a>\n\n(defun compile-predicate (symbol arity clauses) \n\"Compile all the clauses for a given symbol/arity \ninto a single LISP function.\" \n(let ((^predicate* (make-predicate symbol arity)) \n\n(parameters (make-parameters arity))) \n(compile \n(eval \n'(defun ,*predicate* (.parameters cont) \n(maybe-add-undo-bindings \n(mapcar #*(lambda (clause) \n(compile-clause parameters \nclause *cont)) \nclauses))))))) \n\n(defun compile-body (body cont bindings) \n\"Compile the body of a clause.\" \n(cond \n\n((null body) \n'(funcall .cont)) \n((eq (first body) .) \n'(progn .(compile-body (rest body) cont bindings) \n(return-from .*predicate* nil))) \n\n(t (let* ((goal (first body)) \n(macro (prolog-compiler-macro (predicate goal))) \n(macro-val (if macro \n\n(funcall macro goal (rest body) \ncontbindings)))) \n\n(if (and macro (not (eq macro-val .-pass))) \nmacro-val \n'(.(make-predicate (predicate goal) \n\n(relation-arity goal)) \n.(mapcar #'(lambda (arg) \n(compile-arg arg bindings)) \n(args goal)) \n\n.(if (null (rest body)) \ncont \n'#*(lambda () \n\n.(compile-body \n(rest body) cont \n(bind-new-variables bindings goal)))))))))) \n\n&#9635; Exercise 12.14 [m] Given the definitions below, figure out what a call to test - cut \nwill do, and what it will write: \n\n(<- (test-cut) (p a) (p b) ! (p c) (p d)) \n(<- (test-cut) (p e)) \n\n\f\n<a id='page-423'></a>\n(<- (p ?x) (write (?x 1))) \n(<- (p ?x) (write (?x 2))) \n\nAnother way to use the cut is in a repeat/fail loop. The predicate repeat is defined \nwith the following two clauses: \n\n(<- (repeat)) \n(<- (repeat) (repeat)) \n\nAn alternate definition as a primitive is: \n\n(defun repeat/0 (cont) \n(loop (funcall cont))) \n\nUnfortunately, repeat is one of the most abused predicates. Several Prolog books \npresent programs like this: \n\n(<- (main) \n(write \"Hello.\") \n(repeat) \n(write \"Command: \") \n(read ?command) \n(process ?command) \n(= ?command exit) \n(write \"Good bye.\")) \n\nThe intent is that commands are read one at a time, and then processed. For each \ncommand except exit, process takes the appropriate action and then fails. This \ncauses a backtrack to the repeat goal, and a new command is read and processed. \nWhen the command is ex i t, the procedure returns. \n\nThere are two reasons why this is a poor program. First, it violates the principle of \nreferential transparency. Things that look alike are supposed to be alike, regardless \nof the context in which they are used. But here there is no way to tell that four of the six \ngoals in the body comprise a loop, and the other goals are outside the loop. Second, \nit violates the principle of abstraction. A predicate should be understandable as a \nseparate unit. But here the predicate process can only be understood by considering \nthe context in which it is called: a context that requires it to fail after processing each \ncommand. As Richard O'Keefe 1990 points out, the correct way to write this clause \nis as follows: \n\n\f\n<a id='page-424'></a>\n\n(<- (main) \n(write \"Hello.\") \n(repeat) \n\n(write \"Command: \") \n(read ?command) \n(process ?command) \n(or (= ?command exit) (fail)) \n\n(write \"Good bye.\")) \n\nThe indentation clearly indicates the limits of the repeat loop. The loop is terminated \nby an explicit test and is followed by a cut, so that a calling program won't accidently \nbacktrack into the loop after it has exited. Personally, I prefer a language like Lisp, \nwhere the parentheses make constructs like loops explicit and indentation can be \ndone automatically. But O'Keefe shows that well-structured readable programs can \nbe written in Prolog. \n\nThe if-then and if-then-else constructions can easily be written as clauses. Note \nthat the if-then-else uses a cut to commit to the then part if the test is satisfied. \n\n(<- (if ?test ?then) (if ?then ?else (fail))) \n\n(<- (if ?test ?then ?else) \n(call ?test) \n\n(call ?then)) \n\n(<- (if ?test ?then ?else) \n(call ?else)) \n\nThe cut can be used to implement the nonlogical not. The following two clauses are \noften given before as the definition of not. Our compiler succesfuUy turns these two \nclauses into exactly the same code as was given before for the primitive not/1: \n\n(<- (not ?p) (call ?p) I (fail)) \n(<- (not ?p)) \n\n12.10 '^ear Prolog \nThe Prolog-In-Lisp system developed in this chapter uses Lisp syntax because it is \nintended to be embedded in a Lisp system. Other Prolog implementations using \nLisp syntax include micro-Prolog, Symbolics Prolog, and LMI Prolog. \n\n\f\n<a id='page-425'></a>\nHowever, the majority of Prolog systems use a syntax closer to traditional mathematical \nnotation. The following table compares the syntax of \"standard\" Prolog to \nthe syntax of Prolog-In-Lisp. While there is currently an international committee \nworking on standardizing Prolog, the final report has not yet been released, so different \ndialects may have slightly different syntax. However, most implementations \nfollow the notation summarized here. They derive from the Prolog developed at the \nUniversity of Edinburgh for the DEC-10 by David H. D. Warren and his colleagues. \nThe names for the primitives in the last section are also taken from Edinburgh Prolog. \n\nProlog Prolog-In-Lisp \natom lower const \nvariable Upper ?var \nanonymous -? \ngoal p(Var,const) (p ?var const) \nrule p(X) q(X). (<- (p ?x) (q ?x)) \nfact p(a). (<- (p a)) \nquery ?- p(X). (?- (p ?x)) \nlist [a.b.c] (a b c) \ncons [a 1 Rest] (a . ?rest) \nnil [] () \nand p(X), q(X) (and (p ?x) (q ?x)) \nor p(X): q(X) (or (p ?x) (q ?x)) \nnot \\+ p(X) (not (p ?x)) \n\nWe have adopted Lisp's bias toward lists; terms are built out of atoms, variables, \nand conses of other terms. In real Prolog cons cells are provided, but terms are \nusually built out of structures, not lists. The Prolog term p(a,b) corresponds to the \nLisp vector #( p/2 a b), not the list (. a b). A minority of Prolog implementations \nuse structure sharing. In this approach, every non-atomic term is represented by \na skeleton that contains place holders for variables and a header that points to the \nskeleton and also contains the variables that will fill the place holders. With structure \nsharing, making a copy is easy: just copy the header, regardless of the size of the \nskeleton. However, manipulating terms is complicated by the need to keep track of \nboth skeleton and header. See Boyer and Moore 1972 for more on structure sharing. \n\nAnother major difference is that real Prolog uses the equivalent of failure contin\n\n\nuations, not success continuations. No actual continuation, in the sense of a closure, \n\nis built. Instead, when a choice is made, the address of the code for the next choice \n\nis pushed on a stack. Upon failure, the next choice is popped off the stack. This is \n\nreminiscent of the backtracking approach using Scheme's cal 1 /cc facility outlined \n\non [page 772](chapter22.md#page-772). \n\n\f\n<a id='page-426'></a>\n\n&#9635; Exercise 12.15 [m] Assuming an approach using a stack of failure continuations \ninstead of success continuations, show what the code for . and member would look \nlike. Note that you need not pass failure continuations around; you can just push \nthem onto a stack that top-1 evel - prove will invoke. How would the cut be implemented? \nDid we make the right choice in implementing our compiler with success \ncontinuations, or would failure continuations have been better? \n\n12.11 History and References \nAs described in chapter 11, the idea of logic programming was fairly well understood \nby the mid-1970s. But because the implementations of that time were slow, logic \nprogramming did not catch on. It was the Prolog compiler for the DEC-10 that made \nlogic programming a serious alternative to Lisp and other general-purpose languages. \nThe compiler was developed in 1977 by David H. D. Warren with Fernando Pereira \nand Luis Pereira. See the paper by Warren (1979) and by all three (1977). \n\nUnfortunately, David H. D. Warren's pioneering work on compiling Prolog has \nnever been published in a widely accessible form. His main contribution was the \ndescription of the Warren Abstract Machine (WAM), an instruction set for compiled \nProlog. Most existing compilers use this instruction set, or a slight modification \nof it. This can be done either through byte-code interpretation or through macro-\nexpansion to native machine instructions. Ait-Kaci 1991 provides a good tutorial on \nthe WAM, much less terse than the original (Warren 1983). The compiler presented in \nthis chapter does not use the WAM. Instead, it is modeled after Mark Stickel's (1988) \ntheorem prover. A similar compiler is briefly sketched by Jacques Cohen 1985. \n\n12.12 Exercises \n&#9635; Exercise 12.16 [m] Change the Prolog compiler to allow implicit calls. That is, if \na goal is not a cons cell headed by a predicate, compile it as if it were a cal 1. The \nclause: \n\n(<- (p ?x ?y) (?x c) ?y) \n\nshould be compiled as if it were: \n\n(<- (p ?x ?y) (call (?x c)) (call ?y)) \n\n\f\n<a id='page-427'></a>\n&#9635; Exercise 12.17 [h] Here are some standard Prolog primitives: \n\n* get/1 Read a single character and unify it with the argument. \n* put/1 Print a single character. \n* nonvar/1, /=, /==Theoppositesof var, = and==, respectively. \n* i nteger/1 True if the argument is an integer. \n* atom/1 True if the argument is a symbol (like Lisp's symbol p). \n* atomi c/1 True if the argument is a number or symbol (like Lisp's atom). \n.<,>,=<,> = Arithmetic comparison; succeeds when the arguments are both \ninstantiated to numbers and the comparison is true. \n\n* listing/0 Print out the clauses for all defined predicates. \n* 1 i sti ng/1 Print out the clauses for the argument predicate. \nImplement these predicates. In each case, decide if the predicate should be \nimplemented as a primitive or a list of clauses, and if it should have a compiler \nmacro. \n\nThere are some naming conflicts that need to be resolved. Terms like atom have \none meaning in Prolog and another in Lisp. Also, in Prolog the normal notation is \\ = \nand \\==, not / = and /==. For Prolog-In-Lisp, you need to decide which notations to \nuse: Prolog's or Lisp's. \n\n&#9635; Exercise 12.18 [s] In Lisp, we are used to writing n-ary calls like (< 1 . 10)or(= \n. y .). Write compiler macros that expand n-ary calls into a series of binary calls. \nForexample, (< 1 . 10) should expand into (and (< 1 n) (< . 10)). \n\n&#9635; Exercise 12.19 [m] One feature of Lisp that is absent in Prolog is the quote mechanism. \nIs there a use for quote? If so, implement it; if not, explain why it is not \nneeded. \n\n&#9635; Exercise 12.20 [h] Write a tracing mechanism for Prolog. Add procedures . -1 ra ce \nand p-untrace to trace and untrace Prolog predicates. Add code to the compiler to \ngenerate calls to a printing procedure for goals that are traced. In Lisp, we have to \ntrace procedures when they are called and when they return. In Prolog, there are \nfour cases to consider: the call, successful completion, backtrack into subsequent \nclauses, and failure with no more clauses. We will call these four cases cal 1, exi t. \n\n\f\n<a id='page-428'></a>\n\nredo, and f ai 1 , respectively. If we traced member, we would expect tracing output to \nlook something like this: \n\n> (? - (member ?x (a b c d)) (fail)) \nCALL MEMBER: ?1 (A . C D) \nEXIT MEMBER: A (A . C D) \nREDO MEMBER: ?1 (A . C D) \n\nCALL MEMBER: 11 (B C D) \n\nEXIT MEMBER: . (B C D) \n\nREDO MEMBER: ?1 (B C D) \n\nCALL MEMBER: 11 (C D) \nEXIT MEMBER: C (C D) \nREDO MEMBER: ?1 (C D) \n\nCALL MEMBER: 11 (D) \nEXIT MEMBER: D (D) \nREDO MEMBER: ?1 (D) \n\nCALL MEMBER: 11 NIL \nREDO MEMBER: 11 NIL \nFAIL MEMBER: 11 NIL \n\nFAIL MEMBER: 11 (D) \nFAIL MEMBER: 11 (C D) \nFAIL MEMBER: 11 (B C D) \nFAIL MEMBER: ?1 (A . C D) \nNo. \n\n&#9635; Exercise 12.21 [m] Some Lisp systems are very slow at compiling functions. KCL \nis an example; it compiles by translating to C and then calling the C compiler and \nassembler. In KCL it is best to compile only code that is completely debugged, and \nrun interpreted while developing a program. \nAlter the Prolog compiler so that calling the Lisp compiler is optional. In all cases, \nProlog functions are translated into Lisp, but they are only compiled to machine \nlanguage when a variable is set. \n\n&#9635; Exercise 12.22 [d] Some Prolog systems provide the predicate freeze to \"freeze\" a \ngoal until its variables are instantiated. For example, the goal (freeze . (> . 0)) \nis interpreted as follows: if x is instantiated, then just evaluate the goal (> . 0), and \nsucceed or fail depending on the result. However, if . is unbound, then succeed and \ncontinue the computation, but remember the goal (> . 0) and evaluate it as soon as \nX becomes instantiated. Implement freeze. \n\n&#9635; Exercise 12.23 [m] Write a recursive version of anonymous - va r i abl es -1. that does \nnot use a local function. \n\n\f\n<a id='page-429'></a>\n\n12.13 Answers \nAnswer 12.6 Here's a version that works for Texas Instruments and Lucid implementations: \n\n\n(defmacro with-compilation-unit (options &body body) \n\"Do the body, but delay compiler warnings until the end.\" \nThis is defined in Common Lisp the Language, 2nd ed. \n\n*(.(read-time-case \n#+TI * compi1 er:compi1er-warni ngs-context-bi nd \n#+Lucid *with-deferred-warnings \n\n'progn) \n..body)) \n\n(defun prolog-compile-symbols (&optional (symbols *uncompiled*)) \n\"Compile a list of Prolog symbols. \nBy default, the list is all symbols that need it.\" \n(with-compilation-unit () \n\n(mapc #*prolog-compile symbols) \n\n(setf *uncompiled* (set-difference *uncompiled* symbols)))) \n\nAnswer 12.9 Macros for and and or are very important, since these are commonly \nused. The macro for and is trivial: \n\n(def-prolog-compiler-macro and (goal body cont bindings) \n(compile-body (append (args goal) body) cont bindings)) \n\nThe macro for or is trickier: \n\n(def-prolog-compiler-macro or (goal body cont bindings) \n(let ((disjuncts (args goal))) \n\n(case (length disjuncts) \n(0 fail) \n(1 (compile-body (cons (first disjuncts) body) cont bindings)) \n(t (let ((fn (gensym \"F\"))) \n\n'(flet ((,fn () ,(compile-body body cont bindings))) \n.,(maybe-add-undo-bindings \n(loop for g in disjuncts collect \n(compile-body (list g) *#',fn \nbindings))))))))) \n\n\f\n<a id='page-430'></a>\n\nAnswer 12.11 true /0 is funcall: when a goal succeeds, we call the continuation, \nfai 1 /O is i gnore: when a goal fails, we ignore the continuation. We could also define \ncompiler macros for these primitives: \n\n(def-prolog-compi1er-macro true (goal body cont bindings) \n(compile-body body cont bindings)) \n\n(def-prolog-compiler-macro fail (goal body cont bindings) \n(declare (ignore goal body cont bindings)) \nnil) \n\nAnswer 12.13 \n\n(defun deref-copy (exp) \n\"Build a copy of the expression, which may have variables. \nThe part without variables can be returned as is. \" \n(let ((var-alist nil)) \n\n(labels \n\n((walk (exp) \n(deref exp) \n(cond ((consp exp) \n\n(reuse-cons (walk (first exp)) \n(walk (rest exp)) \nexp)) \n\n((var-p exp) \n(let ((entry (assoc exp var-alist))) \n\n(if (not (null entry)) \n(cdr entry) \n(let ((var-copy (?))) \n\n(push (cons exp var-copy) var-alist) \nvar-copy)))) \n(t exp)))) \n(walk exp)))) \n\n\f\n<a id='page-431'></a>\nAnswer 12.14 In the first clause of test - cut, all four calls to . will succeed via the \nfirst clause of p. Then backtracking will occur over the calls to (. c) and (. d). All \nfour combinations of 1 and 2 succeed. After that, backtracking would normally go \nback to the call to (p b). But the cut prevents this, and the whole (test-cut) goal \nfails, without ever considering the second clause. Here's the actual output: \n\n(?- (test-cut)) \n\n(A 1)(B 1)(C 1)(D 1) \n\nYes; \n\n(D 2) \n\nYes; \n\n(C 2)(D 1) \n\nYes; \n\n(D 2) \n\nYes; \n\nNo. \n\nAnswer 12.17 Forexample: \n\n(defun >/2 (x y cont) \n(if (and (numberp (deref x)) (numberp (deref y)) (> . y)) \n(funcall cont))) \n\n(defun numberp/1 (x cont) \n(if (numberp (deref x)) \n(funcall cont))) \n\nAnswer 12.19 Lisp uses quote in two ways: to distinguish a symbol from the value \nof the variable represented by that symbol, and to distinguish a literal list from the \nvalue that would be returned by evaluating a function call. The first distinction Prolog \nmakes by a lexical convention: variables begin with a question mark in our Prolog, \nand they are capitalized in real Prolog. The second distinction is not necessary \nbecause Prolog is relational rather than functional. An expression is a goal if it is a \nmember of the body of a clause, and is a literal if it is an argument to a goal. \n\n\f\n<a id='page-432'></a>\n\nAnswer 12.20 Hint: Here's how member could be augmented with calls to a procedure, \npro! og-trace, which will print information about the four kinds of tracing \nevents: \n\n(defun member/2 (?argl ?arg2 cont) \n(let ((old-trail (fill-pointer nrail*)) \n\n(exit-cont #*(lambda () \n(prolog-trace 'exit 'member ?argl ?arg2 ) \n(funcall cont)))) \n\n(prolog-trace 'call 'member ?argl ?arg2) \n(if (unify! ?arg2 (cons ?argl (?))) \n\n(funcall exit-cont)) \n(undo-bindings! old-trail) \n(prolog-trace 'redo 'member ?argl ?arg2) \n(let ((?rest (?))) \n\n(if (unify! ?arg2 (cons (?) ?rest)) \n(member/2 ?argl ?rest exit-cont))) \n(prolog-trace 'fail 'member ?argl ?arg2))) \n\nThe definition of prol og-trace is: \n\n(defvar *prolog-trace-indent* 0) \n\n(defun prolog-trace (kind predicate &rest args) \n(if (member kind '(call redo)) \n(incf *prolog-trace-indent* 3)) \n(format t \"~rvra ~a:~{ ~a~}\" \n*prolog-trace-indent* kind predicate args) \n(if (member kind '(fail exit)) \n(decf *prolog-trace-indent* 3))) \n\n\f\n<a id='page-433'></a>\nAnswer 12.23 \n\n(defun anonymous-variables-in (tree) \n\"Return a list of all variables that occur only once in tree.\" \n(values (anon-vars-in tree nil nil))) \n\n(defun anon-vars-in (tree seen-once seen-more) \n\"Walk the data structure TREE, returning a list of variables \nseen once, and a list of variables seen more than once.\" \n(cond \n((consp tree) \n(multiple-value-bind (new-seen-once new-seen-more) \n(anon-vars-in (first tree) seen-once seen-more) \n\n(anon-vars-in (rest tree) new-seen-once new-seen-more))) \n((not (variable-p tree)) (values seen-once seen-more)) \n((member tree seen-once) \n\n(values (delete tree seen-once) (cons tree seen-more))) \n((member tree seen-more) \n(values seen-once seen-more)) \n(t (values (cons tree seen-once) seen-more)))) \n\n\f\n## Chapter 13\n<a id='page-434'></a>\n\nObject-Oriented \nProgramming \n\nr I 1 he programs in this book cover a wide range of problems. It is only natural that a \n\nI wide range of programming styles have been introduced to attack these problems. One \n\nJL style not yet covered that has gained popularity in recent years is called object-oriented \nprogramming. To understand what object-oriented programming entails, we need to place it in \nthe context of other styles. \n\nHistorically, the first computer programs were written in an imperative programming style. A \nprogram was construed as a series of instructions, where each instruction performs some action: \nchanging the value of a memory location, printing a result, and so forth. Assembly language is \nan example of an imperative language. \n\nAs experience (and ambition) grew, programmers looked for ways of controlling the complexity \nof programs. The invention of subroutines marked the algorithmic or procedural programming \nstyle, a subclass of the imperative style. Subroutines are helpful for two reasons: breaking \nup the problem into small pieces makes each piece easier to understand, and it also makes it \npossible to reuse pieces. Examples of procedural languages are FORTRAN, C, Pascal, and Lisp \nwith setf. \n\n\f\n<a id='page-435'></a>\n\nSubroutines are still dependent on global state, so they are not completely separate \npieces. The use of a large number of global variables has been criticized as a \nfactor that makes it difficult to develop and maintain large programs. To eliminate \nthis problem, the functional programming style insists that functions access only the \nparameters that are passed to them, and always return the same result for the same \ninputs. Functional programs have the advantage of being mathematically clean—it \nis easy to prove properties about them. However, some applications are more naturally \nseen as taking action rather than calculating functional values, and are therefore \nunnatural to program in a functional style. Examples of functional languages are FP \nand Lisp without setf. \n\nIn contrast to imperative languages are declarative languages, which attempt to \nexpress \"what to do\" rather than \"how to do it.\" One type of declarative programming \nis rule-based programming, where a set of rules states how to transform a problem \ninto a solution. Examples of rule-based systems are ELIZA and STUDENT. \n\nAn important kind of declarative programming is logic programming, where axioms \nare used to describe constraints, and computation is done by a constructive proof of \na goal. An example of logic language is Prolog. \n\nObject-oriented programming is another way to tame the problem of global state. \nInstead of prohibiting global state (as functional programming does), object-oriented \nprogramming breaks up the unruly mass of global state and encapsulates it into small, \nmanageable pieces, or objects. This chapter covers the object-oriented approach. \n\n13,1 Object-Oriented Programming \n\nObject-oriented programming turns the world of computing on its side: instead \nof viewing a program primarily as a set of actions which manipulate objects, it is \nviewed as a set of objects that are manipulated by actions. The state of each object \nand the actions that manipulate that state are defined once and for all when the \nobject is created. This can lead to modular, robust systems that are easy to use and \nextend. It also can make systems correspond more closely to the \"real world,\" which \nwe humans perceive more easily as being made up of objects rather than actions. \nExamples of object-oriented languages are Simula, C++, and CLOS, the Common \nLisp Object System. This chapter will first introduce object-oriented programming \nin general, and then concentrate on the Common Lisp Object System. \n\nMany people are promoting object-oriented programming as the solution to the \nsoftware development problem, but it is hard to get people to agree on just what \nobject-orientation means. Peter Wegner 1987 proposes the following formula as a \ndefinition: \n\nObject-orientation = Objects + Classes + Inheritance \n\n\f\n<a id='page-436'></a>\n\nBriefly, objects are modules that encapsulate some data and operations on that data. \nThe idea of information /z/dm^—insulating the representation of that data from operations \noutside of the object—is an important part of this concept. Classes are groups \nof similar objects with identical behavior. Objects are said to be instances of classes. \nInheritance is a means of defining new classes as variants of existing classes. The new \nclass inherits the behavior of the parent class, and the programmer need only specify \nhow the new class is different. \n\nThe object-oriented style brings with it a new vocabulary, which is summarized in \nthe following glossary. Each term will be explained in more detail when it comes up. \n\nclass: A group of similar objects with identical behavior. \nclass variable: A variable shared by all members of a class. \ndelegation: Passing a message from an object to one of its components. \ngeneric function: A function that accepts different types or classes of \n\narguments. \ninheritance: A means of defining new classes as variants of existing \n\nclasses. \ninstance: An instance of a class is an object. \ninstance variable: A variable encapsulated within an object. \nmessage: A name for an action. Equivalent to generic function. \nmethod: A means of handling a message for a particular class. \nmultimethod: A method that depends on more than one argument. \nmultiple inheritance: Inheritance from more than one parent class. \nobject: An encapsulation of local state and behavior. \n\n13.2 Objects \nObject-oriented programming, by definition, is concerned with objects. Any datum \nthat can be stored in computer memory can be thought of as an object. Thus, the \nnumber 3, the atom x, and the string \"hel 1 o\" are all objects. Usually, however, the \nterm object is used to denote a more complex object, as we shall see. \n\nOf course, all programming is concerned with objects, and with procedures \noperating on those objects. Writing a program to solve a particular problem will \nnecessarily involve writing definitions for both objects and procedures. What distinguishes \nobject-oriented programming is that the primary way of decomposing the \nproblem into modules is based on the objects rather than on the procedures. The \ndifference can best be seen with an example. Here is a simple program to create bank \naccounts and keep track of withdrawals, deposits, and accumulation of interest. \nFirst, the program is written in traditional procedural style: \n\n(defstruct account \n(name \"\") (balance 0.00) (interest-rate .06)) \n\n\f\n<a id='page-437'></a>\n\n(defun account-withdraw (account amt) \n\"Make a withdrawal from this account.\" \n(if (<= amt (account-balance account)) \n\n(decf (account-balance account) amt) \n\n'insufficient-funds)) \n\n(defun account-deposit (account amt) \n\"Make a deposit to this account.\" \n(incf (account-balance account) amt)) \n\n(defun account-interest (account) \n\"Accumulate interest in this account.\" \n(incf (account-balance account) \n\n(* (account-interest-rate account) \n(account-balance account)))) \n\nWe can create new bank accounts with make-a ccount and modify them with \naccount-wi thdraw, account-deposi t, and account-i nterest. This is a simple problem, \nand this simple solution suffices. Problems appear when we change the specification \nof the problem, or when we envision ways that this implementation could \nbe inadvertently used in error. For example, suppose a programmer looks at the \naccount structure and decides to use (decf (account-balance account)) directly \ninstead of going through the account-wi thdraw function. This could lead to negative \naccount balances, which were not intended. Or suppose that we want to create a \nnew kind of account, where only a certain maximum amount can be withdrawn at \none time. There would be no way to ensure that account-withdraw would not be \napplied to this new, limited account. \n\nThe problem is that once we have created an account, we have no control over \n\nwhat actions are applied to it. The object-oriented style is designed to provide that \n\ncontrol. Here is the same program written in object-oriented style (using plain Lisp): \n\n(defun new-account (name &optional (balance 0.00) \n\n(interest-rate .06)) \n\"Create a new account that knows the following messages:\" \n#'(lambda (message) \n\n(case message \n(withdraw #*(lambda (amt) \n(if (<= amt balance) \n(decf balance amt) \n\n'insufficient-funds))) \n(deposit #'(lambda (amt) (incf balance amt))) \n(balance #'(lambda () balance)) \n(name #'(lambda () name)) \n(interest #*(lambda () \n(incf balance \n(* interest-rate balance))))))) \n\n\f\n<a id='page-438'></a>\n\nThe function new-account creates account objects, which are implemented as closures \nthat encapsulate three variables: the name, balance, and interest rate of the \naccount. An account object also encapsulates functions to handle the five messages \nto which the object can respond. An account object can do only one thing: receivea \nmessage and return the appropriate function to execute that message. For example, \nif you pass the message wi thdraw to an account object, it will return a function that, \nwhen applied to a single argument (the amount to withdraw), will perform the withdrawal \naction. This function is called the method that implements the message. The \nadvantage of this approach is that account objects are completely encapsulated; the \ninformation corresponding to the name, balance, and interest rate is only accessible \nthrough the five messages. We have a guarantee that no other code can manipulate \nthe information in the account in any other way.^ \n\nThe function get - method finds the method that implements a message for a given \nobject. The function send gets the method and applies it to a list of arguments. The \nname send comes from the Flavors object-oriented system, which is discussed in the \nhistory section ([page 456](chapter13.md#page-456)). \n\n(defun get-method (object message) \n\"Return the method that implements message for this object.\" \n(funcall object message)) \n\n(defun send (object message &rest args) \n\"Get the function to implement the message, \nand apply the function to the args.\" \n(apply (get-method object message) args)) \n\nHere is an example of the use of new- account and send: \n\n> (setf acct (new-account \"J. Random Customer\" 1000.00)) => \n#<CLOSURE 23652465> \n\n> (send acct 'withdraw 500.00) 500.0 \n\n> (send acct 'deposit 123.45) => 623.45 \n\n> (send acct 'name) ^ \"J. Random Customer\" \n\n> (send acct 'balance) => 623.45 \n\n^More accurately, we have a guarantee that there is no way to get at the inside of a closure \nusing portable Common Lisp code. Particular implementations may provide debugging tools \nfor getting at this hidden information, such as i .spect. So closures are not perfect at hiding \ninformation from these tools. Of course, no information-hiding method will be guaranteed \nagainst such covert channels—even with the most sophisticated software security measures, \nit is always possible to, say, wipe a magnet over the computer's disks and alter sensitive data. \n\n\f\n<a id='page-439'></a>\n13.3 Generic Functions \nThe send syntax is awkward, as it is different from the normal Lisp function-calling \nsyntax, and it doesn't fit in with the other Lisp tools. For example, we might like to \nsay (ma pea . ' ba 1 anee accounts), but with messages we would have to write that as: \n\n(mapcar #*(lambda (acct) (send acct 'balance)) accounts) \n\nWe can fix this problem by deiining generic functions that find the right method to \nexecute a message. For example, we could define: \n\n(defun withdraw (object &rest args) \n\"Define withdraw as a generic function on objects.\" \n(apply (get-method object 'withdraw) args)) \n\nand then write (withdraw acct .) instead of (send acct 'withdraw x). The \nfunction wi thdraw is generic because it not only works on account objects but also \nworks on any other class of object that handles the wi thdraw message. For example, \nwe might have a totally unrelated class, army, which also implements a withdraw \nmethod. Then we could say (send 5th-army 'withdraw) or (withdraw 5th-army) \nand have the correct method executed. So object-oriented programming eliminates \nmany problems with name clashes that arise in conventional programs. \n\nMany of the built-in Common Lisp functions can be considered generic functions, \nin that they operate on different types of data. For example, sqrt does one thing \nwhen passed an integer and quite another when passed an imaginary number. The \nsequence functions (like findordelete) operate on lists, vectors, or strings. These \nfunctions are not implemented like wi thd raw, but they still act like generic functions.^ \n\n13.4 Classes \nIt is possible to write macros to make the object-oriented style easier to read and \nwrite. The macro def i ne - cl ass defines a class with its associated message-handling \nmethods. It also defines a generic function for each message. Finally, it allows the \nprogrammer to make a distinction between variables that are associated with each \nobject and those that are associated with a class and are shared by all members of the \nclass. For example, you might want to have all instances of the class account share \nthe same interest rate, but you wouldn't want them to share the same balance. \n\n^There is a technical sense of \"generic function\" that is used within CLOS. These functions \nare not generic according to this technical sense. \n\n\f\n<a id='page-440'></a>\n\n(defmacro define-class (class inst-vars class-vars &body methods) \n\"Define a class for object-oriented programming.\" \nDefine constructor and generic functions for methods \n\n'(let ,class-vars \n(mapcar #'ensure-generic-fn \\(mapcar #'first methods)) \n(defun .class ,inst-vars \n\n#*(lambda (message) \n(case message \n,(mapcar #'make-clause methods)))))) \n\n(defun make-clause (clause) \n\"Translate a message from define-class into a case clause.\" \n'(.(first clause) #'(lambda .(second clause) ..(rest2 clause)))) \n\n(defun ensure-generic-fn (message) \n\"Define an object-oriented dispatch function for a message, \nunless it has already been defined as one.\" \n(unless (generic-fn-p message) \n\n(let ((fn #'(lambda (object &rest args) \n\n(apply (get-method object message) args)))) \n(setf (symbol-function message) fn) \n(setf (get message *generic-fn) fn)))) \n\n(defun generic-fn-p (fn-name) \n\"Is this a generic function?\" \n(and (fboundp fn-name) \n\n(eq (get fn-name 'generic-fn) (symbol-function fn-name)))) \n\nNow we define the class account with this macro. We make i nterest- rate a class \nvariable, one that is shared by all accounts: \n\n(define-class account (name &optional (balance 0.00)) \n((interest-rate .06)) \n\n(withdraw (amt) (if (<= amt balance) \n(decf balance amt) \n'insufficient-funds)) \n\n(deposit (amt) (incf balance amt)) \n(balance () balance) \n(name () name) \n\n(interest () (incf balance (* interest-rate balance)))) \n\nHere we use the generic functions defined by this macro: \n\n> (setf acct2 (account \"A. User\" 2000.00)) #<CL0SURE 24003064> \n\n> (deposit acct2 42.00) => 2042.0 \n\n> (interest acct2) 2164.52 \n\n\f\n<a id='page-441'></a>\n\n> (balance acct2) ^ 2164.52 \n\n> (balance acct) => 623.45 \n\nIn this last line, the generic function bal anee is applied to acct, an object that was \ncreated before we even defined the account class and the function balance. But \nbal anee still works properly on this object, because it obeys the message-passing \nprotocol. \n\n13.5 Delegation \nSuppose we want to create a new kind of account, one that requires a password for \neach action. We can define a new class, password-account, that has two message \nclauses. The first clause allows for changing the password (if you have the original \npassword), and the second is an otherwi se clause, which checks the password given \nand, if it is correct, passes the rest of the arguments on to the account that is being \nprotected by the password. \n\nThe definition of password-account takes advantage of the internal details of \ndefine-class in two ways: it makes use of the fact that otherwise can be used \nas a catch-all clause in a case form, and it makes use of the fact that the dispatch \nvariable is called message. Usually, it is not a good idea to rely on details about the \nimplementation of a macro, and soon we will see cleaner ways of defining classes. \nBut for now, this simple approach works: \n\n(define-class password-account (password acct) () \n(change-password (pass new-pass) \n\n(if (equal pass password) \n(setf password new-pass) \n'wrong-password)) \n\n(otherwise (pass &rest args) \n\n(if (equal pass password) \n(apply message acct args) \n'wrong-password))) \n\nNow we see how the class password-account can be used to provide protection for \nan existing account: \n\n(setf acct3 (password-account \"secret\" acct2)) => #<CLOSURE 33427277> \n> (balance acct3 \"secret\") => 2164.52 \n> (withdraw acct3 \"guess\" 2000.00) => WRONG-PASSWORD \n> (withdraw acct3 \"secret\" 2000.00) 164.52 \n\nNow let's try one more example. Suppose we want to have a new class of account \n\n\f\n<a id='page-442'></a>\n\nwhere only a limited amount of money can be withdrawn at any time. We could \ndefine the class 1 i mi ted - account: \n\n(define-class limited-account (limit acct) () \n(withdraw (amt) \n\n(if (> amt limit) \n'over-limit \n(withdraw acct amt))) \n\n(otherwise (&rest args) \n(apply message acct args))) \n\nThis definition redefines the wi t hd raw message to check if the limit is exceeded before \npassing on the message, and it uses the otherwi se clause simply to pass on all other \nmessages unchanged. In the following example, we set up an account with both a \npassword and a limit: \n\n> (setf acct4 (password-account \"pass\" \n(limited-account 100.00 \n(account \"A. Thrifty Spender\" 500.00)))) \n#<CLOSURE 34136775> \n\n> (withdraw acct4 \"pass\" 200.00) ^ OVER-LIMIT \n\n> (withdraw acct4 \"pass\" 20.00) => 480.0 \n\n> (withdraw acct4 \"guess\" 20.00) => WRONG-PASSWORD \n\nNote that functions like wi thdraw are still simple generic functions that just find the \nright method and apply it to the arguments. The trick is that each class defines a different \nway to handle the withdraw message. Calling wi thdraw with acct4 as argument \nresults in the following flow of control. First, the method in the password-account \nclass checks that the password is correct. If it is, it calls the method from the \n1i mi ted-account class. If the limit is not exceeded, we finally call the method from \nthe account class, which decrements the balance. Passing control to the method of \na component is called delegation. \n\nThe advantage of the object-oriented style is that we can introduce a new class \nby writing one definition that is localized and does not require changing any existing \ncode. If we had written this in traditional procedural style, we would end up with \nfunctions like the following: \n\n(defun withdraw (acct amt &optional pass) \n(cond ((and (typep acct 'password-account) \n(not (equal pass (account-password acct)))) \n'wrong-password) \n((and (typep acct 'limited-account) \n\n\f\n<a id='page-443'></a>\n(> amt (account-limit account))) \n'over-limit) \n((> amt balance) \n'insufficient-funds) \n(t (decf balance amt)))) \n\nThere is nothing wrong with this, as an individual function. The problem is that \nwhen the bank decides to offer a new kind of account, we will have to change this \nfunction, along with all the other functions that implement actions. The \"definition\" \nof the new account is scattered rather than localized, and altering a bunch of existing \nfunctions is usually more error prone than writing a new class definition. \n\n13.6 Inheritance \nIn the following table, data types (classes) are listed across the horizontal axis, and \nfunctions (messages) are listed up and down the vertical axis. A complete program \nneeds to fill in all the boxes, but the question is how to organize the process of filling \nthem in. In the traditional procedural style, we write function definitions that fill in \na row at a time. In the object-oriented style, we write class definitions that fill in a \ncolumn at a time. A third style, the data-dnven or generic style, fills in only one box at \na time. \n\naccount limited-password-\naccount account \nname object \ndeposit oriented \nwithdraw function oriented \nbalance \ninterest generic \n\nIn this table there is no particular organization to either axis; both messages and \nclasses are listed in random order. This ignores the fact that classes are organized hierarchically: \nboth Hmited-account and password-account are subclasses of account. \nThis was implicit in the definition of the classes, because both 1 i mi ted - account and \npassword-account contain accounts as components and delegate messages to those \ncomponents. But it would be cleaner to make this relationship explicit. \n\nThe defstruct mechanism does allow for just this kind of explicit inheritance. If \nwe had defined account as a structure, then we could define 1 i mi ted - account with: \n\n\f\n<a id='page-444'></a>\n\n(defstruct (limited-account (:include account)) limit) \n\nTwo things are needed to provide an inheritance facility for classes. First, we should \nmodify define-class so that it takes the name of the class to inherit from as the \nsecond argument. This will signal that the new class will inherit all the instance \nvariables, class variables, and methods from the parent class. The new class can, of \ncourse, define new variables and methods, or it can shadow the parent's variables and \nmethods. In the form below, we define 1 i ml ted - account to be a subclass of account \nthat adds a new instance variable, 11 mi t, and redefines the wi thdraw method so that \nit checks for amounts that are over the limit. If the amount is acceptable, then it uses \nthe function cal 1 -next-method (not yet defined) to get at the withdraw method for \nthe parent class, account. \n\n(define-class limited-account account (limit) () \n(withdraw (amt) \n\n(if (> amt limit) \nOver-limit \n(call-next-method)))) \n\nIf inheritance is a good thing, then multiple inheritance is an even better thing. For \nexample, assuming we have defined the classes 1 i mi ted - account and \npassword - account, it is very convenient to define the following class, which inherits \nfrom both of them: \n\n(define-class limited-account-with-password \n(password-account 1 i mi ted-account)) \n\nNotice that this new class adds no new variables or methods. All it does is combine \n\nthe functionality of two parent classes into one. \n\n&#9635; Exercise 13.1 [d] Define a version of def i ne-cl ass that handles inheritance and \ncall-next-method. \n\n&#9635; Exercise 13.2 [d] Define a version of def i ne-cl ass that handles multiple inheritance. \n\n\n\f\n<a id='page-445'></a>\n13.7 GLOS: The Common Lisp Object System \nSo far, we have developed an object-oriented programming system using a macro, \ndefine-class, and a protocol for implementing objects as closures. There have \nbeen many proposals for adding object-oriented features to Lisp, some similar to \nour approach, some quite different. Recently, one approach has been approved to \nbecome an official part of Common Lisp, so we will abandon our ad hoc approach \nand devote the rest of this chapter to CLOS, the Common Lisp Object System. The \ncorrespondence between our system and CLOS is summarized here: \n\nour system CLOS \ndefine-class defclass \nmethods defined in class defmethod \nclass-name make-instance \ncall-next-method call-next-method \nensure-generic-fn ensure-generic-function \n\nLike most object-oriented systems, CLOS is primarily concerned with defining \nclasses and methods for them, and in creating instances of the classes. In CLOS the \nmacro def class defines a class, defmethod defines a method, and make-instance \ncreates an instance of a class—an object. The general form of the macro def cl ass is: \n\n(def cl ass class-name (superclass...) (slot-specifier...) optional-class-option...) \n\nThe class-options are rarely used, def cl ass can be used to define the class account: \n\n(defclass account () \n\n((name :initarg -.name :reader name) \n\n(balance linitarg rbalance linitform 0.00 raccessor balance) \n\n(interest-rate :allocation :class :initform .06 \n\n:reader interest-rate))) \n\nIn the definition of account, we see that the Ust of superclasses is empty, because \naccount does not inherit from any classes. There are three slot specifiers, for the \nname, bal anee, and i nterest - rate slots. Each slot name can be followed by optional \nkeyword/value pairs defining how the slot is used. The name slot has an : i ni targ \noption, which says that the name can be specified when a new account is created \nwith make-instance. The :reader slot creates a method called name to get at the \ncurrent value of the slot. \n\nThe balance slot has three options: another :initarg, saying that the balance \ncan be specified when a new account is made; an rinitform, which says that if \nthe balance is not specified, it defaults to 0.00, and an raccessor, which creates a \n\n\f\n<a id='page-446'></a>\n\nmethod for getting at the slot's value just as : reader does, and also creates a method \nfor updating the slot with setf . \n\nThe i nterest- rate slot has an : i ni tf orm option to give it a defauh value and an \nrail ocati on option to say that this slot is part of the class, not of each instance of the \nclass. \n\nHere we see the creation of an object, and the application of the automatically \ndefined methods to it. \n\n> (setf al (make-instance 'account chalanee 5000.00 \n\n:name \"Fred\")) #<ACCOUNT 26726272> \n\n> (name al) ^ \"Fred\" \n\n> (balance al) 5000.0 \n\n> (interest-rate al) ^ 0.06 \n\nCLOS differs from most object-oriented systems in that methods are defined separately \nfrom classes. To define a method (besides the ones defined automatically by \n: reader, :writer, or :accessor options) we use the defmethod macro. It is similar \nto defun in form: \n\n(defmethod method-name (parameter..:) body...) \n\nRequired parameters to a defmethod can be of the form (var class), meaning that \nthis is a method that applies only to arguments of that class. Here is the method for \nwithdrawing from an account. Note that CLOS does not have a notion of instance \nvariable, only instance slot. So we have to use the method (bal ance acct) rather \nthan the instance variable bal anee: \n\n(defmethod withdraw ((acct account) amt) \n\n(if (< amt (balance acct)) \n(decf (balance acct) amt) \n'i nsuffi ci ent-funds)) \n\nWith CLOS it is easy to define a 1 imited-account as a subclass of account, and to \ndefine the wi thd raw method for 11 mi ted - accounts: \n\n(defclass limited-account (account) \n((limit :initarg ilimit -.reader limit))) \n\n(defmethod withdraw ((acct limited-account) amt) \n\n(if (> amt (limit acct)) \nOver-limit \n(call-next-method))) \n\n\f\n<a id='page-447'></a>\nNote the use of cal1 -next-method to invoke the withdraw method for the account \nclass. Also note that all the other methods for accounts automatically work on \ninstances of the class limited-account, because it is defined to inherit from account. In \nthe following example, we show that the name method is inherited, that the wi thdraw \nmethod for 1 i mi ted-account is invoked first, and that the withdraw method for \naccount is invoked by the cal1 -next-method function: \n\n> (setf a2 (make-instance 'limited-account \n:name \"A. Thrifty Spender\" \n:balance 500.00 :limit 100.00)) ^ \n\n#<LIMITED-ACCOUNT 24155343> \n\n> (name a2) ^ \"A. Thrifty Spender\" \n\n> (withdraw a2 200.00) ^ OVER-LIMIT \n\n> (withdraw a2 20.00) 480.0 \n\nIn general, there may be several methods appropriate to a given message. In that case, \nall the appropriate methods are gathered together and sorted, most specific first. The \nmost specific method is then called. That is why the method for 1 i mi ted - account is \ncalled first rather than the method for account. The function cal 1 -next-method can \nbe used within the body of a method to call the next most specific method. \n\nThe complete story is actually even more complicated than this. As one example \nof the complication, consider the class audi ted-a ccount, which prints and keeps \na trail of all deposits and withdrawals. It could be defined as follows using a new \nfeature of CLOS, : before and : after methods: \n\n(defclass audited-account (account) \n((audit-trail :initform nil :accessor audit-trail))) \n\n(defmethod withdraw ibefore ((acct audited-account) amt) \n(push (print '(withdrawing .amt)) \n(audit-trail acct))) \n\n(defmethod withdraw rafter ((acct audited-account) amt) \n(push (print '(withdrawal (.amt) done)) \n(audit-trail acct))) \n\nNow a call to withdraw with a audited-account as the first argument yields three \n\napplicable methods: the primary method from account and the : before and rafter \n\nmethods. In general, there might be several of each kind of method. In that case, \n\nall the : before methods are called in order, most specific first. Then the most \n\nspecific primary method is called. It may choose to invoke cal 1 - next-method to \n\nget at the other methods. (It is an error for a : before or : after method to use \n\ncal 1 -next-method.) Finally, all the rafter methods are called, least specific first. \n\n\f\n<a id='page-448'></a>\n\nThe values from the : before and : after methods are ignored, and the value from \nthe primary method is returned. Here is an example: \n\n> (setf a3 (make-instance 'audited-account .-balance 1000.00)) \n#<AUDITED-ACCOUNT 33555607> \n\n> (withdraw a3 100.00) \n\n(WITHDRAWING 100.0) \n\n(WITHDRAWAL (100.0) DONE) \n\n900.0 \n\n> (audit-trail a3) \n((WITHDRAWAL (100.0) DONE) (WITHDRAWING 100.0)) \n\n> (setf (audit-trail a3) nil) \nNIL \n\nThe last interaction shows the biggest flaw in CLOS: it fails to encapsulate information. \nIn order to make the audi t-trai 1 accessible to the wi thdraw methods, we had \nto give it accessor methods. We would like to encapsulate the writer function for \naudit-trail so that it can only be used with deposit and withdraw. But once the \nwriter function is defined it can be used anywhere, so an unscrupulous outsider can \ndestroy the audit trail, setting it to nil or anything else. \n\n13.8 A CLOS Example: Searching Tools \nCLOS is most appropriate whenever there are several types that share related behavior. \nA good example of an application that fits this description is the set of searching \ntools defined in section 6.4. There we defined functions for breadth-first, depth-\nfirst, and best-first search, as well as tree- and graph-based search. We also defined \nfunctions to search in particular domains, such as planning a route between cities. \n\nIf we had written the tools in a straightforward procedural style, we would have \nended up with dozens of similar functions. Instead, we used higher-order functions \nto control the complexity. In this section, we see how CLOS can be used to break up \nthe complexity in a slightly different fashion. \n\nWe begin by defining the class of search problems. Problems will be classified \naccording to their domain (route planning, etc.), their topology (tree or graph) and \ntheir search strategy (breadth-first or depth-first, etc.). Each combination of these \nfeatures results in a new class of problem. This makes it easy for the user to add a new \nclass to represent a new domain, or a new search strategy. The basic class, probl em, \ncontains a single-instance variable to hold the unexplored states of the problem. \n\n\f\n<a id='page-449'></a>\n(defclass problem () \n((states linitarg estates :accessor problem-states))) \n\nThe function searcher is similar to the function tree-search of section 6.4. The \nmain difference is that searcher uses generic functions instead of passing around \nfunctional arguments. \n\n(defmethod searcher ((prob problem)) \n\"Find a state that solves the search problem.\" \n(cond ((no-states-p prob) fail) \n\n((goal-p prob) (current-state prob)) \n(t (let ((current (pop-state prob))) \n(setf (problem-states prob) \n\n(problem-combiner \nprob \n(problem-successors prob current) \n(problem-states prob)))) \n\n(searcher prob)))) \n\nsearcher does not assume that the problem states are organized in a list; rather, it \nuses the generic function no-states-p to test if there are any states, pop-state to \nremove and return the first state, and current - state to access the first state. For the \nbasic probl em class, we will in fact implement the states as a list, but another class of \nproblem is free to use another representation. \n\n(defmethod current-state ((prob problem)) \n\"The current state is the first of the possible states.\" \n(first (problem-states prob))) \n\n(defmethod pop-state ((prob problem)) \n\"Remove and return the current state.\" \n(pop (problem-states prob))) \n\n(defmethod no-states-p ((prob problem)) \n\"Are there any more unexplored states?\" \n(null (problem-states prob))) \n\nIn tree - sea rch, we included a statement to print debugging information. We can do \nthat here, too, but we can hide it in a separate method so as not to clutter up the main \ndefinition of searcher. It is a :before method because we want to see the output \nbefore carrying out the operation. \n\n\f\n<a id='page-450'></a>\n\n(defmethod searcher .-before ((prob problem)) \n(dbg 'search \"~&;; Search: ~a\" (problem-states prob))) \n\nThe generic functions that remain to be defined are goal -p, probl em-combi ner, and \nprobl em-successors. We will address goal -p first, by recognizing that for many \nproblems we will be searching for a state that is eql to a specified goal state. We \ndefine the class eql -probl em to refer to such problems, and specify goal -p for that \nclass. Note that we make it possible to specify the goal when a problem is created, \nbut not to change the goal: \n\n(defclass eql-problem (problem) \n((goal :initarg :goal :reader problem-goal))) \n\n(defmethod goal-p ((prob eql-problem)) \n(eql (current-state prob) (problem-goal prob))) \n\nNow we are ready to specify two search strategies: depth-first search and \nbreadth-first search. We define problem classes for each strategy and specify the \nprobl em- combi ner function: \n\n(defclass dfs-problem (problem) () \n(:documentation \"Depth-first search problem.\")) \n\n(defclass bfs-problem (problem) () \n(:documentation \"Breadth-first search problem.\")) \n\n(defmethod problem-combiner ((prob dfs-problem) new old) \n\"Depth-first search looks at new states first.\" \n(append new old)) \n\n(defmethod problem-combiner ((prob bfs-problem) new old) \n\"Depth-first search looks at old states first.\" \n(append old new)) \n\nWhile this code will be sufficient for our purposes, it is less than ideal, because it \nbreaks an information-hiding barrier. It treats the set of old states as a list, which is the \ndefault for the . r obi em class but is not necessarily the implementation that every class \nwill use. It would have been cleaner to define generic functions add - sta tes - to - end \nand add-states-to-front and then define them with append in the default class. \nBut Lisp provides such nice list-manipulation primitives that it is difficult to avoid \nthe temptation of using them directly. \n\nOf course, the user who defines a new implementation for probl em-states \ncould just redefine probl em- combi ner for the offending classes, but this is precisely \nwhat object-oriented programming is designed to avoid: specializing one abstraction \n(states) should not force us to change anything in another abstraction (search \nstrategy). \n\n\f\n<a id='page-451'></a>\nThe last step is to define a class that represents a particular domain, and define \nproblem-successors for that domain. As the first example, consider the simple \nbinary tree search from section 6.4. Naturally, this gets represented as a class: \n\n(defclass binary-tree-problem (problem) ()) \n\n(defmethod problem-successors ((prob binary-tree-problem) state) \n(let ((n (* 2 state))) \n(list . (+ . 1)))) \n\nNow suppose we want to solve a binary-tree problem with breadth-first search, \nsearching for a particular goal. Simply create a class that mixes in \nbinary-tree-problem, eql-problem and bfs-problem, create an instance of that \nclass, and call searcher on that instance: \n\n(defclass binary-tree-eql-bfs-problem \n(binary-tree-problem eql-problem bfs-problem) ()) \n\n> (setf pi (make-instance 'binary-tree-eql-bfs-problem \nistates '(1) :goal 12)) \n#<BINARY-TREE-EQL-BFS-PROBLEM 26725536> \n\n> (searcher pi) \nSearch: (1) \nSearch: (2 3) \nSearch: (3 4 5) \nSearch: (4 5 6 7) \nSearch: (5 6 7 8 9) \nSearch: (6 7 8 9 10 11) \nSearch: (7 8 9 10 11 12 13) \nSearch: (8 9 10 11 12 13 14 15) \nSearch: (9 10 11 12 13 14 15 16 17) \nSearch: (10 11 12 13 14 15 16 17 18 19) \nSearch: (11 12 13 14 15 16 17 18 19 20 21) \nSearch: (12 13 14 15 16 17 18 19 20 21 22 23) \n\n12 \n\nBest-First Search \n\nIt should be clear how to proceed to define best-first search: define a class to represent \nbest-first search problems, and then define the necessary methods for that class. \nSince the search strategy only affects the order in which states are explored, the only \nmethod necessary will be for probl em- combi ner. \n\n\f\n<a id='page-452'></a>\n\n(defclass best-problem (problem) 0 \n(.'documentation \"A Best-first search problem.\")) \n\n(defmethod problem-combiner ((prob best-problem) new old) \n\"Best-first search sorts new and old according to cost-fn.\" \n(sort (append new old) #'< \n\n:key #'(lambda (state) (cost-fn prob state)))) \n\nThis introduces the new function cost -f n; naturally it will be a generic function. The \nfollowing is a cos t -f . that is reasonable for any eq 1 - . rob1 em dealing with numbers, \nbut it is expected that most domains will specialize this function. \n\n(defmethod cost-fn ((prob eql-problem) state) \n(abs (- state (problem-goal prob)))) \n\nBeam search is a modification of best-first search where all but the best b states are \nthrown away on each iteration. A beam search problem is represented by a class \nwhere the instance variable beam-width holds the parameter b. If this nil, then full \nbest-first search is done. Beam search is implemented by an : a round method on \nproblem-combiner. It calls the next method to get the list of states produced by \nbest-first search, and then extracts the first 6 elements. \n\n(defclass beam-problem (problem) \n((beam-width :initarg :beam-width :initform nil \n:reader problem-beam-width))) \n\n(defmethod problem-combiner raround ((prob beam-problem) new old) \n(let ((combined (call-next-method))) \n(subseq combined 0 (min (problem-beam-width prob) \n(length combined))))) \n\nNow we apply beam search to the binary-tree problem. As usual, we have to make \nup another class to represent this type of problem: \n\n(defclass binary-tree-eql-best-beam-problem \n(binary-tree-problem eql-problem best-problem beam-problem) \n()) \n\n> (setf p3 (make-instance 'binary-tree-eql-best-beam-problem \nrstates '(1) :goal 12 :beam-width 3)) \n#<BINARY-TREE-EQL-BEST-BEAM-PROBLEM 27523251> \n\n> (searcher p3) \nSearch: (1) \nSearch: (3 2) \nSearch: (7 6 2) \nSearch: (14 15 6) \nSearch: (15 6 28) \n\n\f\n<a id='page-453'></a>\nSearch: (6 28 30) \nSearch: (12 13 28) \n12 \n\nSo far the case for CLOS has not been compelling. The code in this section duplicates \nthe functionality of code in section 6.4, but the CLOS code tends to be more verbose, \nand it is somewhat disturbing that we had to make up so many long class names. \nHowever, this verbosity leads to flexibility, and it is easier to extend the CLOS code by \nadding new specialized classes. It is useful to make a distinction between the systems \nprogrammer and the applications programmer. The systems programmer would \nsupply a library of classes like dfs-problem and generic functions like searcher. \nThe applications programmer then just picks what is needed from the library. From \nthe following we see that it is not too difficult to pick out the right code to define a \ntrip-planning searcher. Compare this with the definition of tri . on [page 198](chapter6.md#page-198) to see \nif you prefer CLOS in this case. The main difference is that here we say that the cost \nfunction is a i r-di stance and the successors are the nei ghbors by defining methods; \nin tri . we did it by passing parameters. The latter is a little more succint, but the \nformer may be more clear, especially as the number of parameters grows. \n\n(defclass trip-problem (binary-tree-eql-best-beam-problem) \n((beam-width :initform 1))) \n\n(defmethod cost-fn ((prob trip-problem) city) \n(air-distance (problem-goal prob) city)) \n\n(defmethod problem-successors ((prob trip-problem) city) \n(neighbors city)) \n\nWith the definitions in place, it is easy to use the searching tool: \n\n> (setf p4 (make-instance 'trip-problem \nestates (list (city 'new-york)) \n:goal (city 'san-francisco))) \n\n#<TRIP-PROBLEM 31572426> \n\n> (searcher p4) \nSearch: ((NEW-YORK 73.58 40.47)) \nSearch: ((PITTSBURG 79.57 40.27)) \nSearch: ((CHICAGO 87.37 41.5)) \nSearch: ((KANSAS-CITY 94.35 39.06)) \nSearch: ((DENVER 105.0 39.45)) \n\n;; Search: ((FLAGSTAFF 111.41 35.13)) \n\nSearch: ((RENO 119.49 39.3)) \n;: Search: ((SAN-FRANCISCO 122.26 37.47)) \n(SAN-FRANCISCO 122.26 37.47) \n\n\f\n<a id='page-454'></a>\n\n13.9 Is CLOS Object-Oriented? \nThere is some argument whether CLOS is really object-oriented at all. The arguments \nare: \n\nCLOS IS an object-oriented system because it provides all three of the main criteria \nfor object-orientation: objects with internal state, classes of objects with specialized \nbehavior for each class, and inheritance between classes. \n\nCLOS is not an object-oriented system because it does not provide modular \nobjects with information-hiding. In the audi ted-account example, we would like to \nencapsulate the audit-trail instance variable so that only the withdraw methods \ncan change it. But because methods are written separately from class definitions, \nwe could not do that. Instead, we had to define an accessor for audi t-trai 1. That \nenabled us to write the withdraw methods, but it also made it possible for anyone \nelse to alter the audit trail as well. \n\nCLOS ismore general than an object-oriented system because it allows for methods \nthat specialize on more than one argument. In true object-oriented systems, methods \nare associated with objects of a particular class. This association is lexically obvious \n(and the message-passing metaphor is clear) when we write the methods inside the \ndefinition of the class, asinourdef i ne-cl ass macro. The message-passing metaphor \nis still apparent when we write generic functions that dispatch on the class of their \nfirst argument, which is how we've been using CLOS so far. \n\nBut CLOS methods can dispatch on the class of any required argument, or any \ncombination of them. Consider the following definition of cone, which is like append \nexcept that it works for vectors as well as lists. Rather than writing cone using \nconditional statements, we can use the multimethod dispatch capabilities of CLOS \nto define the four cases: (1) the first argument is nil, (2) the second argument is nil, \n\n(3) both arguments are lists, and (4) both arguments are vectors. Notice that if one of \nthe arguments is nil there will be two applicable methods, but the method for nul 1 \nwill be used because the class nul 1 is more specific than the class list. \n(defmethod cone ((x null) y) y) \n\n(defmethod cone (x (y null)) x) \n\n(defmethod cone ((x list) (y list)) \n(cons (first x) (cone (rest x) y))) \n\n(defmethod cone ((x vector) (y vector)) \n\n(let ((vect (make-array (+ (length x) (length y))))) \n\n(replace vect x) \n\n(replace vect y rstartl (length x)))) \n\n\f\n<a id='page-455'></a>\nHere we see that this definition works: \n\n> (cone nil '(a b c)) => (A . C) \n\n> (cone '(a b c) nil) => (A . C) \n\n> (cone '(a b c) '(d e f)) (A . C D . F) \n\n> (cone '#(a b e) '#(d e f)) => #(A . C D . F) \n\nIt works, but one might well ask: where are the objects? The metaphor of passing a \nmessage to an object does not apply here, unless we consider the object to be the list \nof arguments, rather than a single privileged argument. \n\nIt is striking that this style of method definition is very similar to the style used \nin Prolog. As another example, compare the following two definitions of 1 en, a \nrelation/function to compute the length of a list: \n\nCLOS %% Prolog \n(defmethod len ((x null)) 0) len(C].0). \n\n(defmethod len ((x eons)) len([XIL].N1) :(+ \n1 (len (rest x)))) len(L.N). Nl is N+1. \n\n13.10 Advantages of Object-Oriented \nProgramming \nBertrand Meyer, in his book on the object-oriented language Eiffel (1988), lists five \nqualities that contribute to software quality: \n\n* Correctness. Clearly, a correct program is of the upmost importance. \n* Robustness. Programs should continue to function in a reasonable manner even \nfor input that is beyond the original specifications. \n* Extendability. Programs should be easy to modify when the specifications \nchange. \n* Reusability. Program components should be easy to transport to new programs, \nthus amortizing the cost of software development over several projects. \n* Compatibility. Programs should interface well with other programs. For example, \na spreadsheet program should not only manipulate numbers correctly but \nalso be compatible with word processing programs, so that spreadsheets can \neasily be included in documents. \n\f\n<a id='page-456'></a>\n\nHere we list how the object-oriented approach in general and CLOS in particular \ncan effect these measures of quality: \n\n* Conectness. Correctness is usually achieved in two stages: correctness of \nindividual modules and correctness of the whole system. The object-oriented \napproach makes it easier to prove correctness for modules, since they are \nclearly defined, and it may make it easier to analyze interactions between \nmodules, since the interface is strictly limited. CLOS does not provide for \ninformation-hiding the way other systems do. \n* Robustness. Generic functions make it possible for a function to accept, at run \ntime, a class of argument that the programmer did not anticipate at compile \ntime. This is particularly true in CLOS, because multiple inheritance makes it \nfeasible to write default methods that can be used by a wide range of classes. \n* Extendability. Object-oriented systems with inheritance make it easy to define \nnew classes that are slight variants on existing ones. Again, CLOS's multiple \ninheritance makes extensions even easier than in single-inheritance systems. \n* Reusability. This is the area where the object-oriented style makes the biggest \ncontribution. Instead of writing each new program from scratch, object-\noriented programmers can look over a library of classes, and either reuse \nexisting classes as is, or specialize an existing class through inheritance. Large \nlibraries of CLOS classes have not emerged yet. Perhaps they will when the \nlanguage is more established. \n* Compatibility. The more programs use standard components, the more they will \nbe able to communicate with each other. Thus, an object-oriented program will \nprobably be compatible with other programs developed from the same library \nof classes. \n13.11 History and References \nThe first object-oriented language was Simula, which was designed by Ole-Johan \nDahl and Krysten Nygaard (1966, Nygaard and Dahl 1981) as an extension of Algol 60. \nIt is still in use today, mostly in Norway and Sweden. Simula provides the ability to \ndefine classes with single inheritance. Methods can be inherited from a superclass \nor overridden by a subclass. It also provides coroutines, class instances that execute \ncontinuously, saving local state in instance variables but periodically pausing to let \nother coroutines run. Although Simula is a general-purpose language, it provides \nspecial support for simulation, as the name implies. The built-in class simul ation \nallows a programmer to keep track of simulated time while running a set of processes \nas coroutines. \n\n\f\n<a id='page-457'></a>\nIn 1969 Alan Kay was a graduate student at the University of Utah. He became \naware of Simula and realized that the object-oriented style was well suited to his \nresearch in graphics (Kay 1969). A few years later, at Xerox, he joined with Adele \nGoldberg and Daniel Ingalls to develop the Smalltalk language (see Goldberg and \nRobinson 1983). While Simula can be viewed as an attempt to add object-oriented \nfeatures to strongly typed Algol 60, Smalltalk can be seen as an attempt to use the \ndynamic, loosely typed features of Lisp, but with methods and objects replacing \nfunctions and s-expressions. In Simula, objects existed alongside traditional data \ntypes like numbers and strings; in Smalltalk, every datum is an object. This gave \nSmalltalk the feel of an integrated Lisp environment, where the user can inspect, copy, \nor edit any part of the environment. In fact, it was not the object-oriented features of \nSmalltalk per se that have made a lasting impression but rather the then-innovative \nidea that every user would have a large graphical display and could interact with the \nsystem using a mouse and menus rather than by typing commands. \n\nGuy Steele's LAMBDA: The Ultimate Declarative (1976a and b) was perhaps the \nfirst paper to demonstrate how object-oriented programming can be done in Lisp. As \nthe title suggests, it was all done using 1 ambda, in a similar way to our def i ne-cl ass \nexample. Steele summarized the approach with the equation \"Actors = Closures \n(mod Syntax),\" refering to Carl Hewitt's \"Actors\" object-oriented formalism. \n\nIn 1979, the MIT Lisp Machine group developed the Flavors system based on this \napproach but offering considerable extensions (Cannon 1980, Weinreb 1980, Moon \net al. 1983). \"Flavor\" was a popular jargon word for \"type\" or \"kind\" at MIT, so it was \nnatural that it became the term for what we call classes. \n\nThe Flavor system was the first to support multiple inheritance. Other languages \nshunned multiple inheritance because it was too dynamic. With single inheritance, \neach instance variable and method could be assigned a unique offset number, and \nlooking up a variable or method was therefore trivial. But with multiple inheritance, \nthese computations had to be done at run time. The Lisp tradition enabled programmers \nto accept this dynamic computation, when other languages would not. \nOnce it was accepted, the MIT group soon came to embrace it. They developed \ncomplex protocols for combining different flavors into new ones. The concept of \nmix-ins was developed by programmers who frequented Steve's Ice Cream parlor in \nnearby Davis Square. Steve's offered a list of ice cream flavors every day but also \noffered to create new flavors—dynamically—by mixing in various cookies, candies, \nor fruit, at the request of the individual customer. For example, Steve's did not have \nchocolate-chip ice cream on the menu, but you could always order vanilla ice cream \nwith chocolate chips mixed in.^ \n\nThis kind of \"flavor hacking\" appealed to the MIT Lisp Machine group, who \n\n^Flavor fans will be happy to know that Steve's Ice Cream is now sold nationally in the \nUnited States. Alas, it is not possible to create flavors dynamically. Also, be warned that \nSteve's was bought out by his Teal Square rival, Joey's. The original Steve retired from the \nbusiness for years, then came back with a new line of stores under his last name, Harrell. \n\n\f\n<a id='page-458'></a>\n\nadopted the metaphor for their object-oriented programming system. All flavors \ninherited from the top-most flavor in the hierarchy: vanilla. In the window system, for \nexample, the flavor basi c-wi ndow was defined to support the minimal functionality \nof all windows, and then new flavors of window were defined by combining mix-in \nflavors such as scroll -bar-mixin, label -mixin, and border-mixin. These mix-in \nflavors were used only to define other flavors. Just as you couldn't go into Steve's and \norder \"crushed Heath bars, hold the ice cream,\" there was a mechanism to prohibit \ninstantiation of mix-ins. \n\nA complicated repetoire of method combinations was developed. The default \nmethod combination on Flavors was similar to CLOS: first do all the : before methods, \nthen the most specific primary method, then the : after methods. But it was \npossible to combine methods in other ways as well. For example, consider the \ni ns i de - wi dth method, which returns the width in pixels of the usuable portion of a \nwindow. A programmer could specify that the combined method for i nsi de-wi dth \nwas to be computed by calling all applicable methods and summing them. Then an \ninside-width method for the basic-window flavor would be defined to return the \nwidth of the full window, and each mix-in would have a simple method to say how \nmuch of the width it consumed. For example, if borders are 8 pixels wide and scroll \nbars are 12 pixels wide, then the i nsi de-wi dth method for border-mi xi . returns -8 \nandscroll -bar-mixinreturns -12. Thenany window, no matter how many mix-ins \nit is composed of, automatically computes the proper inside width. \n\nIn 1981, Symbolics came out with a more efficient implementation of Flavors. \nObjects were no longer just closures. They were still funcallable, but there was \nadditional hardware support that distinguished them from other functions. After a \nfew years Symbolics abandoned the (send object message) syntax in favor of a new \nsyntax based on generic functions. This system was known as New Flavors. It had a \nstrong influence on the eventual CLOS design. \n\nThe other strong influence on CLOS was the CommonLoops system developed \nat Xerox PARC. (See Bobrow 1982, Bobrow et al. 1986, Stefik and Bobrow 1986.) \nCommonLoops continued the New Flavors trend away from message passing by \nintroducing multimethods: methods that specialize on more than one argument. \n\nAs of summer 1991, CLOS itself is in a state of limbo. It was legitimitized by its \nappearance in Common Lisp the Language, 2d edition, but it is not yet official, and an \nimportant part, the metaobject protocol, is not yet complete. A tutorial on CLOS is \nKeenel989. \n\nWe have seen how easy it is to build an object-oriented system on top of Lisp, \nusing 1 ambda as the primary tool. An interesting alternative is to build Lisp on top of \nan object-oriented system. That is the approach taken in the Oaklisp system of Lang \nand Perlmutter (1988). Instead of defining methods using 1 ambda as the primitive, \nOakHsp has add-method as a primitive and defines 1 ambda as a macro that adds a \nmethod to an anonymous, empty operation. \n\nOf course, object-oriented systems are thriving outside the Lisp world. With the \n\n\f\n<a id='page-459'></a>\n\nsuccess of UNIX-based workstations, C has become one of the most widely available \nprogramming languages. C is a fairly low-level language, so there have been several \nattempts to use it as a kind of portable assembly language. The most succesful of \nthese attempts is C++, a language developed by Bjarne Stroustrup of AT&T Bell Labs \n(Stroustrup 1986). C++ provides a number of extensions, including the ability to \ndefine classes. However, as an add-on to an existing language, it does not provide as \nmany features as the other languages discussed here. Crucially, it does not provide \ngarbage collection, nor does it support fully generic functions. \n\nEiffel (Meyer 1988) is an attempt to define an object-oriented system from the \nground up rather than tacking it on to an existing language. Eiffel supports multiple \ninheritance and garbage collection and a limited amount of dynamic dispatching. \n\nSo-called modern languages like Ada and Modula support information-hiding \nthrough generic functions and classes, but they do not provide inheritance, and thus \ncan not be classified as true object-oriented languages. \n\nDespite these other languages, the Lisp-based object-oriented systems are the \nonly ones since Smalltalk to introduce important new concepts: multiple inheritance \nand method combination from Flavors, and multimethods from CommonLoops. \n\n13.12 Exercises \n&#9635; Exercise 13.3 [m] Implement deposit and interest methods for the account class \nusing CLOS. \n\n&#9635; Exercise 13.4 [m] Implement the password-account class using CLOS. Can it be \ndone as cleanly with inheritance as it was done with delegation? Or should you use \ndelegation within CLOS? \n\n&#9635; Exercise 13.5 [h] Implement graph searching, search paths, and A* searching as \nclasses in CLOS. \n\n&#9635; Exercise 13.6 [h] Implement a priority queue to hold the states of a problem. Instead \nof a list, the probl em-states will be a vector of lists, each initially null. Each \nnew state will have a priority (determined by the generic function priori ty) which \nmust be an integer between zero and the length of the vector, where zero indicates the \nhighest priority. A new state with priority . is pushed onto element . of the vector, \nand the state to be explored next is the first state in the first nonempty position. As \nstated in the text, some of the previously defined methods made the unwarranted \nassumption that probl em-states would always hold a Hst. Change these methods. \n\n\f\n## Chapter 14\n<a id='page-460'></a>\n\nKnowledge Representation \nand Reasoning \n\nKnowledge itself is power. \n\n-Francis Bacon (. 561-1626) \n\nThe power resides in the knowledge. \n\n—Edward Feigenbaum \nStanford University Heuristic Programming Project \n\nKnowledge is Knowledge, and vice versa. \n\n—Tee shirt \nStanford University Heuristic Programming Project \n\nI\nI\nn the 1960s, much of AI concentrated on search techniques. In particular, a lot of w^ork v^as \nconcerned with theorem proving: stating a problem as a small set of axioms and searching for \na proof of the problem. The implicit assumption was that the power resided in the inference \nmechanism-if we could just find the right search technique, then all our problems would be \nsolved, and all our theorems would be proved. \n\n\f\n<a id='page-461'></a>\n\nStarting in the 1970s, this began to change. The theorem-proving approach failed \nto live up to its promise. AI workers slowly began to realize that they were not going \nto solve NP-hard problems by conung up with a clever inference algorithm. The \ngeneral inferencing mechanisms that worked on toy examples just did not scale up \nwhen the problem size went into the thousands (or sometimes even into the dozens). \n\nThe expert-system approach offered an alternative. The key to solving hard problems \nwas seen to be the acquisition of special-case rules to break the problem into \neasier problems. According to Feigenbaum, the lesson learned from expert systems \nlike MYCIN (which we will see in chapter 16) is that the choice of inferencing mechanism \nis not as important as having the right knowledge. In this view it doesn't \nmatter very much if MYCIN uses forward- or backward-chaining, or if it uses certainty \nfactors, probabilities, or fuzzy set theory. What matters crucially is that we know \nPseudomonas is a gram-negative, rod-shaped organism that can infect patients with \ncompromised immune systems. In other words, the key problem is acquiring and \nrepresenting knowledge. \n\nWhile the expert system approach had some successes, it also had failiu-es, and \nresearchers were interested in learning the limits of this new technology and understanding \nexactly how it works. Many found it troublesome that the meaning of the \nknowledge used in some systems was never clearly defined. For example, does the \nassertion (color appl e red) mean that a particular apple is red, that all apples are \nred, or that some/most apples are red? The field of knowledge representation concentrated \non providing clear semantics for such representations, as well as providing \nalgorithms for manipulating the knowledge. Much of the emphasis was on finding a \ngood trade-off between expressiveness and efficiency. An efficient language is one for \nwhich all queries (or at least the average query) can be answered quickly. If we want \nto guarantee that queries will be answered quickly, then we have to limit what can \nbe expressed in the language. \n\nIn the late 1980s, a series of results shed doubt on the hopes of finding an efficient \nlanguage with any reasonable degree of expressiveness at all. Using mathematical \ntechniques based on worst-case analysis, it was shown that even seemingly trivial \nlanguages were intractable—in the worst case, it would take an exponential amount of \ntime to answer a simple query. \n\nThus, in the 1990s the emphasis has shifted to knowledge representation and reasoning, \na field that encompasses both the expressiveness and efficiency of languages but \nrecognizes that the average case is more important than the worst case. No amount \nof knowledge can help solve an intractable problem in the worse case, but in practice \nthe worst case rarely occurs. \n\n\f\n<a id='page-462'></a>\n\n14.1 A Taxonomy of Representation Languages \nAI researchers have investigated hundreds of knowledge representation languages, \ntrying to find languages that are convenient, expressive, and efficient. The languages \ncan be classified into four groups, depending on what the basic unit of representation \nis. Here are the four categories, with some examples: \n\n* Logical Formulae (Prolog) \n* Networks (semantic nets, conceptual graphs) \n* Objects (scripts, frames) \n* Procedures (Lisp, production systems) \nWe have already dealt with logic-based languages like Prolog. \n\nNetwork-based languages can be seen as a syntactic variation on logical languages. \nA link L between nodes A and . is just another way of expressing the logical relation \nB), The difference is that network-based languages take their links more \nseriously: they are intended to be implemented directly by pointers in the computer, \nand inference is done by traversing these pointers. So placing a link L between A \nand . not only asserts that L(A, B) is true, but it also says something about how the \nknowledge base is to be searched. \n\nObject-oriented languages can also be seen as syntactic variants of predicate calculus. \nHere is a statement in a typical slot-filler frame language: \n\n(a person \n\n(name = Jan) \n\n(age = 32)) \n\nThis is equivalent to the logical formula: \n\n3 p: person(p) . name(p,Jan) . age(p,32) \n\nThe frame notation has the advantage of being easier to read, in some people's \nopinion. However, the frame notation is less expressive. There is no way to say that \nthe person's name is either Jan or John, or that the person's age is not 34. In predicate \ncalculus, of course, such statements can be easily made. \n\nFinally, procedural languages are to be contrasted with representation languages: \nprocedural languages compute answers without explicit representation of knowledge. \n\n\nThere are also hybrid representation languages that use different methods to \nencode different kinds of knowledge. The KL-ONE family of languages uses both \nlogical formulae and objects arranged into a network, for example. Many frame \n\n\f\n<a id='page-463'></a>\nlanguages allow procedural attachment, a technique that uses arbitrary procedures to \ncompute values for expressions that are inconvenient or impossible to express in the \nframe language itself. \n\n14.2 Predicate Calculus and its Problems \nSo far, many of our representations have been based on predicate calculus, a notation \nwith a distinguished position in AI: it serves as the universal standard by which other \nrepresentations are defined and evaluated. The previous section gave an example \nexpression from a frame language. The frame language may have many merits in \nterms of the ease of use of its syntax or the efficiency of its internal representation of \ndata. However, to understand what expressions in the language mean, there must be \na clear definition. More often than not, that definition is given in terms of predicate \ncalculus. \n\nA predicate calculus representation assumes a universe of individuals, with relations \nand functions on those individuals, and sentences formed by combining \nrelations with the logical connectives and, or, and not. Philosophers and psychologists \nwill argue the question of how appropriate predicate calculus is as a model of \nhuman thought, but one point stands clear: predicate calculus is sufficient to represent \nanything that can be represented in a digital computer. This is easy to show: \nassuming the computer's memory has . bits, and the equation hi = 1 means that bit \ni is on, then the entire state of the computer is represented by a conjunction such as: \n\n(6o = 0) . (6i = 0) . (62 = 1) . ... . {bn = 0) \n\nOnce we can represent a state of the computer, it becomes possible to represent \nany computer program in predicate calculus as a set of axioms that map one state onto \nanother. Thus, predicate calculus is shown to be asufficientlangaage for representing \nanything that goes on inside a computer—it can be used as a tool for analyzing any \nprogram from the outside. \n\nThis does not prove that predicate calculus is an appropriate tool for all applications. \nThere are good reasons why we may want to represent knowledge in a form \nthat is quite different from predicate calculus, and manipulate the knowledge with \nprocedures that are quite different from logical inference. But we should still be able \nto describe our system in terms of predicate calculus axioms, and prove theorems \nabout it. To do any less is to be sloppy. For example, we may want to manipulate \nnumbers inside the computer by using the arithmetic instructions that are built into \nthe CPU rather than by manipulating predicate calculus axioms, but when we write \na square-root routine, it had better satisfy the axiom: \n\ny/x = y=^yxy = x \n\n\f\n<a id='page-464'></a>\n\nPredicate calculus also serves another purpose: as a tool that can be used by a \nprogram rather than on a program. All programs need to manipulate data, and some \nprograms will manipulate data that is considered to be in predicate calculus notation. \nIt is this use that we will be concerned with. \n\nPredicate calculus makes it easy to start writing down facts about a domain. But \nthe most straightforward version of predicate calculus suffers from a number of \nserious limitations: \n\n* Decidability—^ven a set of axioms and a goal, it may be that neither the goal nor \nits negation can be derived from the axioms. \n* Tractability—even when a goal is provable, it may take too long to find the proof \nusing the available inferencing mechanisms. \n* Uncertainty—it can be inconvenient to deal with relations that are probable to a \ndegree but not known to be definitely true or false. \n* Monotonicity—in pure predicate calculus, once a theorem is proved, it is true \nforever. But we would like a way to derive tentative theorems that rely on \nassumptions, and be able to retract them when the assumptions prove false. \n* Consistency—pure predicate calculus admits no contradictions. If by accident \nboth P and &not;P are derived, then any theorem can be proved. In effect, a single \ncontradiction corrupts the entire data base. \n* Omniscience—it can be difficult to distinguish what is provable from what should \nbe proved. This can lead to the unfounded assumption that an agent believes \nall the consequences of the facts it knows. \n* Expressiveness—the first-order predicate calculus makes it awkward to talk \nabout certain things, such as the relations and propositions of the language \nitself. \nThe view held predominantly today is that it is best to approach these problems \nwith a dual attack that is both within and outside of predicate calculus. It is considered \na good idea to invent new notations to address the problems—both for convenience \nand to facilitate special-purpose reasoners that are more efficient than a general-\npurpose theorem prover. However, it is also important to define scrupulously the \nmeaning of the new notation in terms of familiar predicate-calculus notation. As \nDrew McDermott put it, \"No notation without denotation!\" (1978). \n\nIn this chapter we show how new notations (and their corresponding meanings) \ncan be used to extend an existing representation and reasoning system. Prolog is \nchosen as the language to extend. This is not meant as an endorsement for Prolog as \nthe ultimate knowledge representation language. Rather, it is meant solely to give us \na clear and familiar foundation from which to build. \n\n\f\n<a id='page-465'></a>\n14.3 A Logical Language: Prolog \nProlog has been proposed as the answer to the problem of programming in logic. Why \nisn't it accepted as the universal representation language? Probably because Prolog \nis a compromise between a representation language and a programming language. \nGiven two specifications that are logically equivalent, one can be an efficient Prolog \nprogram, while the other is not. Kowalski's famous equation \"algonthm = logic + \ncontrol\" expresses the limits of logic alone: logic = algorithm -control Many problems \n(especially in AI) have large or infinite search spaces, and if Prolog is not given some \nadvice on how to search that space, it will not come up with the answer in any \nreasonable length of time. \n\nProlog's problems fall into three classes. First, in order to make the language \nefficient, its expressiveness was restricted. It is not possible to assert that a person's \nname is either Jan or John in Prolog (although it is possible to ask if the person's \nname is one of those). Similarly, it is not possible to assert that a fact is false; \nProlog does not distinguish between false and unknown. Second, Prolog's inference \nmechanism is neither sound nor complete. Because it does not check for circular \nunification, it can give incorrect answers, and because it searches depth-first it can \nmiss correct answers. Third, Prolog has no good way of adding control information \nto the underlying logic, making it inefficient on certain problems. \n\n14.4 Problems with Prolog's Expressiveness \nIf Prolog is programming in logic, it is not the full predicate logic we are familiar with. \nThe main problem is that Prolog can't express certain kinds of indefinite facts. It can \nrepresent definite facts: the capital of Rhode Island is Providence. It can represent \nconjunctions of facts: the capital of Rhode Island is Providence and the capital of \nCalifornia is Sacramento. But it can not represent disjunctions or negations: that the \ncapital of California is not Los Angeles, or that the capital of New York is either New \nYork City or Albany. We could try this: \n\n(<- (not (capital LA CA))) \n(<- (or (capital Albany NY) (capital NYC NY))) \n\nbut note that these last two facts concern the relation not and or, not the relation \ncapital. Thus, they will not be considered when we ask a query about capital. Fortunately, \nthe assertion \"Either NYC or Albany is the capital of NY\" can be rephrased \nas two assertions: \"Albany is the capital of NY if NYC is not\" and \"NYC is the capital \nof NY if Albany is not:\" \n\n\f\n<a id='page-466'></a>\n\n(<- (capital Albany NY) (not (capital NYC NY))) \n\n(<- (capital NYC NY) (not (capital Albany NY))) \n\nUnfortunately, Prolog's not is different from logic's not. When Prolog answers \"no\" \nto a query, it means the query cannot be proven from the known facts. If everything \nis known, then the query must be false, but if there are facts that are not known, the \nquery may in fact be true. This is hardly surprising; we can't expect a program to \ncome up with answers using knowledge it doesn't have. But in this case, it causes \nproblems. Given the previous two clauses and the query (capi tal ?c NY), Prolog \nwill go into an infinite loop. If we remove the first clause, Prolog would fail to prove \nthat Albany is the capital, and hence conclude that NYC is. If we remove the second \nclause, the opposite conclusion would be drawn. \n\nThe problem is that Prolog equates \"not proven\" with \"false.\" Prolog makes what \nis called the closed world assumption—it assumes that it knows everything that is true. \nThe closed world assumption is reasonable for most programs, because the programmer \ndoes know all the relevant information. But for knowledge representation in \ngeneral, we would like a system that does not make the closed world assumption \nand has three ways to answer a query: \"yes,\" \"no,\" or \"unknown.\" In this example, \nwe would not be able to conclude that the capital of NY is or is not NYC, hence we \nwould not be able to conclude anything about Albany. \n\nAs another example, consider the clauses: \n\n(<- (damned) (do)) \n\n(<- (damned) (not (do))) \n\nWith these rules, the query (? (damned)) should logically be answered \"yes.\" \nFurthermore, it should be possible to conclude (damned) without even investigating \nif (do) is provable or not. What Prolog does is first try to prove (do). If this succeeds, \nthen (damned) is proved. Either way, Prolog then tries again to prove (do), and this \ntime if the proof fails, then (damned) is proved. So Prolog is doing the same proof \ntwice, when it is unnecessary to do the proof at all. Introducing negation wrecks \nhavoc on the simple Prolog evaluation scheme. It is no longer sufficient to consider \na single clause at a time. Rather, multiple clauses must be considered together if we \nwant to derive all the right answers. \n\nRobert Moore 1982 gives a good example of the power of disjunctive reasoning. \nHis problem concerned three colored blocks, but we will update it to deal with three \ncountries. Suppose that a certain Eastern European country, E, has just decided if it \nwill remain under communist rule or become a democracy, but we do not know the \noutcome of the decision. . is situated between the democracy D and the communist \ncountry C: \n\nD E C \n\n\f\n<a id='page-467'></a>\n\nThe question is: Is there a communist country next to a democracy? Moore points \nout that the answer is \"yes,\" but discovering this requires reasoning by cases. If . is \na democracy then it is next to C and the answer is yes. But if . is communist then \nit is next toD and the answer is still yes. Since those are the only two possibilities, \nthe answer must be yes in any case. Logical reasoning gives us the right answer, but \nProlog can not. We can describe the problem with the following seven assertions \nand one query, but Prolog can not deal with the or in the final assertion. \n\n(<- (next-to D E)) (<- (next-to . D)) \n(<- (next-to . .) (<- (next-to C E)) \n(<- (democracy D)) (<- (communist O) \n(<- (or (democracy E) (communist E))) \n\n(?- (next-to ?A ?B) (democracy ?A) (communist ?B)) \n\nWe have seen that Prolog is not very good at representing disjunctions and negations. \nIt also has difficulty representing existentials. Consider the following statement in \nEnglish, logic, and Prolog: \n\nJan likes everyone. \n\nVX person(x) => likesQan,x) \n\n(<- (likes Jan ?x) (person ?x)) \n\nThe Prolog translation is faithful. But there is no good translation for \"Jan likes \nsomeone.\" The closest we can get is: \n\nJan likes someone. \n\n3 X person(x) => likesQan,x) \n\n(<- (likes Jan pD) \n(<- (person pD) \n\nHere we have invented a new symbol, pi, to represent the unknown person that Jan \nlikes, and have asserted that pi is a person. Notice that pi is a constant, not a variable. \nThis use of a constant to represent a specific but unknown entity is called a Skolem \nconstant, after the logician Thoralf Skolem (1887-1963). The intent is that pi may be \nequal to some other person that we know about. If we find out that Adrian is the \nperson Jan likes, then in logic we can just add the assertion pi = Adrian. But that does \nnot work in Prolog, because Prolog implicitly uses the unique name assumption—d\\\\ \natoms represent distinct individuals. \n\nA Skolem constant is really just a special case of a Skolem function - an unknown \n\nentity that depends on one or more variable. For example, to represent \"Everyone \n\nlikes someone\" we could use: \n\n\f\n<a id='page-468'></a>\n\nEveryone likes someone. \n\nV 2/ 3 X person(3:) => likes (y, x) \n\n(<- (likes ?y (p2 ?y))) \n(<- (person (p2 ?y))) \n\nHere .2 is a Skolem function that depends on the variable ?y. In other words, \neveryone likes some person, but not necessarily the same person. \n\n14.5 Problems with Predicate Calculus's \nExpressiveness \nIn the previous section we saw that Prolog has traded some expressiveness for \nefficiency. This section explores the limits of predicate calculus's expressiveness. \nSuppose we want to assert that lions, tigers, and bears are kinds of animals. In \npredicate calculus or in Prolog we could write an impHcation for each case: \n\n(<- (animal ?x) (lion ?x)) \n(<- (animal ?x) (tiger ?x)) \n(<- (animal ?x) (bear ?x)) \n\nThese implications allow us to prove that any known lion, tiger, or bear is in fact \nan animal. However, they do not allow us to answer the question \"What kinds of \nanimals are there?\" It is not hard to imagine extending Prolog so that the query \n\n(?- (<- (animal ?x) ?proposition)) \n\nwould be legal. However, this happens not to be valid Prolog, and it is not even \nvalid first-order predicate calculus (or FOPC). In FOPC the variables must range over \nconstants in the language, not over relations or propositions. Higher-order predicate \ncalculus removes this limitation, but it has a more complicated proof theory. \n\nIt is not even clear what the values of ?propos i ti on should be in the query above. \nSurely (1 ion ?x) would be a valid answer, but so would (animal ?x), (or (tiger \n?x) (bea r ?x)), and an infinite number of other propositions. Perhaps we should \nhave two types of queries, one that asks about \"kinds,\" and another that asks about \npropositions. \n\nThere are other questions that we might want to ask about relations. Just as it is \nuseful to declare the types of parameters to a Lisp function, it can be useful to declare \nthe types of the parameters of a relation, and later query those types. For example, \nwe might say that the 1 i kes relation holds between a person and an object. \n\nIn general, a sentence in the predicate calculus that uses a relation or sentence as \na term is called a higher-order sentence. There are some quite subtle problems that \n\n\f\n<a id='page-469'></a>\ncome into play when we start to allow higher-order expressions. Allowing sentences \nin the calculus to talk about the truth of other sentences can lead to a paradox: is the \nsentence \"This sentence is false\" true or false? \n\nPredicate calculus is defined in terms of a universe of individuals and their \nproperties and relations. Thus it is well suited for a model of the world that picks out \nindividuals and categorizes them - a person here, a building there, a sidewalk between \nthem. But how well does predicate calculus fare in a world of continuous substances? \nConsider a body of water consisting of an indefinite number of subconstituents that \nare all water, with some of the water evaporating into the air and rising to form clouds. \nIt is not at all obvious how to define the individuals here. However, Patrick Hayes \nhas shown that when the proper choices are made, predicate calculus can describe \nthis kind of situation quite well. The details are in Hayes 1985. \n\nThe need to define categories is a more difficult problem. Predicate calculus \nworks very well for crisp, mathematical categories: . is a triangle if and only if . is \na polygon with three sides. Unfortunately, most categories that humans deal with \nin everyday life are not defined so rigorously. The category friend refers to someone \nyou have mostly positive feelings for, whom you can usually trust, and so on. This \n\"definition\" is not a set of necessary and sufficient conditions but rather is an open-\nended list of ill-defined qualities that are highly correlated with the category friend. \nWe have a prototype for what an ideal friend should be, but no clear-cut boundaries \nthat separate friend from, say, acquaintance. Furthermore, the boundaries seem to \nvary from one situation to another: a person you describe as a good friend in your \nwork place might be only an acquaintance in the context of your home life. \n\nThere are versions of predicate calculus that admit quantifiers like \"most\" in \naddition to \"for all\" and \"there exists,\" and there have been attempts to define \nprototypes and measure distances from them. However, there is no consensus on \nthe way to approach this problem. \n\n14.6 Problems with Completeness \nBecause Prolog searches depth-first, it can get caught in one branch of the search \nspace and never examine the other branches. This problem can show up, for example, \nin trying to define a commutative relation, like si bl i ng: \n\n(<- (sibling lee kim)) \n(<- (sibling ?x ?y) (sibling ?y ?x)) \n\nWith these clauses, we expect to be able to conclude that Lee is Kim's sibling, and \nKim is Lee's. Let's see what happens: \n\n\f\n<a id='page-470'></a>\n\n> (?- (sibling ?x ?y)) \n?X = LEE \n?Y = KIM; \n?X = KIM \n?Y = LEE; \n?X = LEE \n?Y = KIM; \n?X = KIM \n?Y = LEE. \nNo. \n\nWe get the expected conclusions, but they are deduced repeatedly, because the \ncommutative clause for siblings is applied over and over again. This is annoying, but \nnot critical. Far worse is when we ask (? - (sibling fred ?x)). This query loops \nforever. Happily, this particular type of example has an easy fix: just introduce two \npredicates, one for data-base level facts, and one at the level of axioms and queries: \n\n(<- (sibling-fact lee kim)) \n(<- (sibling ?x ?y) (sibling-fact ?x ?y)) \n(<- (sibling ?x ?y) (sibling-fact ?y ?x)) \n\nAnother fix would be to change the interpreter to fail when a repeated goal was detected. \nThis was the approach taken in GPS. However, even if we eliminated repeated \ngoals, Prolog can still get stuck in one branch of a depth-first search. Consider the \nexample: \n\n(<- (natural 0)) \n(<- (natural (1-.- ?n)) (natural ?n)) \n\nThese rules define the natural numbers (the non-negative integers). We can use \nthe rules either to confirm queries like (natural (1+ (1->- (1-.- 0)))) or to generate \nthe natural numbers, as in the query (natural ?n). So far, everything is fine. But \nsuppose we wanted to define all the integers. One approach would be this: \n\n(<- (integer 0)) \n(<- (integer ?n) (integer (1+ ?n))) \n(<- (integer a+ ?n)) (integer ?n)) \n\nThese rules say that 0 is an integer, and any . is an integer if . -f 1 is, and . -h 1 is \nif . is. While these rules are correct in a logical sense, they don't work as a Prolog \nprogram. Asking (integer x) will result in an endless series of ever-increasing \nqueries: (integer (1+ x)), (integer (1+ (1+ and so on. Each goal is \ndifferent, so no check can stop the recursion. \n\n\f\n<a id='page-471'></a>\n\nThe occurs check may or may not introduce problems into Prolog, depending on \nyour interpretation of infinite trees. Most Prolog systems do not do the occurs check. \nThe reasoning is that unifying a variable with some value is the Prolog equivalent of \nassigning a value to a variable, and programmers expect such a basic operation to be \nfast. With the occurs check turned off, it will in fact be fast. With checking on, it \ntakes time proportional to the size of the value, which is deemed unacceptable. \n\nWith occurs checking off, the programmer gets the benefit of fast unification but \ncan run into problems with circular structures. Consider the following clauses: \n\n(<- (parent ?x (mother-of ?x))) \n\n(<- (parent ?x (father-of ?x))) \n\nThese clauses say that, for any person, the mother of that person and the father of \nthat person are parents of that person. Now let us ask if there is a person who is his \nor her own parent: \n\n> (? (parent ?y ?y)) \n?Y = [Abort] \n\nThe system has found an answer, where ?y = (mother-of ?y). The answer can't be \nprinted, though, because deref (or subst-bindings in the interpreter) goes into an \ninfinite loop trying to figure out what ?y is. Without the printing, there would be no \ninfinite loop: \n\n(<- (self-parent) (parent ?y ?y)) \n\n> (? (self-parent)) \n\nYes; \n\nYes; \n\nNo. \n\nThe sel f-parent query succeeds twice, once with the mother clause and once with \nthe father clause. Has Prolog done the right thing here? It depends on your interpretation \nof infinite circular trees. If you accept them as valid objects, then the answer \nis consistent. If you don't, then leaving out the occurs check makes Prolog unsound: \nit can come up with incorrect answers. \n\nThe same problem comes up if we ask if there are any sets that include themselves \n\nas members. The query (member ?set ?set) will succeed, but we will not be able to \n\nprint the value of ?set. \n\n\f\n<a id='page-472'></a>\n\n14.7 Problems with Efficiency: Indexing \nOur Prolog compiler is designed to handle \"programlike\" predicates - predicates \nwith a small number of rules, perhaps with complex bodies. The compiler does \nmuch worse on \"tablelike\" predicates-predicates with a large number of simple \nfacts. Consider the predicate pb, which encodes phone-book facts in the form: \n\n(pb (name Jan Doe) (num 415 555 1212)) \n\nSuppose we have a few thousand entries of this kind. A typical query for this data \nbase would be: \n\n(pb (name Jan Doe) ?num) \n\nIt would be inefficient to search through the facts linearly, matching each one against \nthe query. It would also be inefficient to recompile the whole pb/2 predicate every \ntime a new entry is added. But that is just what our compiler does. \n\nThe solutions to the three problems - expressiveness, completeness, and index-\ning-will be considered in reverse order, so that the most difficult one, expressiveness, \nwill come last. \n\n14.8 A Solution to the Indexing Problem \nA better solution to the phone-book problem is to index each phone-book entry in \nsome kind of table that makes it easy to add, delete, and retrieve entries. That is what \nwe will do in this section. We will develop an extension of the trie or discrimination \ntree data structure built in section 10.5 ([page 344](chapter10.md#page-344)). \n\nMaking a discrimination tree for Prolog facts is complicated by the presence of \nvariables in both the facts and the query. Either facts with variables in them will have \nto be indexed in several places, or queries with variables will have to look in several \nplaces, or both. We also have to decide if the discrimination tree itself will handle \nvariable binding, or if it will just return candidate matches which are then checked by \nsome other process. It is not clear what to store in the discrimination tree: copies of \nthe fact, functions that can be passed continuations, or something else. More design \nchoices will come up as we proceed. \n\nIt is difficult to make design choices when we don't know exactly how the system \nwill be used. We don't know what typical facts will look like, nor typical queries. \nTherefore, we will design a fairly abstract tool, forgetting for the moment that it will \nbe used to index Prolog facts. \n\n\f\n<a id='page-473'></a>\n\nWe will address the problem of a discrimination tree where both the keys and \nqueries are predicate structures with wild cards. A wild card is a variable, but with \nthe understanding thatjhere is no variable binding; each instance of a variable can \nmatch anything. A predicate structure is a list whose first element is a nonvariable \nsymbol. The discrimination tree supports three operations: \n\n* index &ndash; add a key/value pair to the tree \n* fetch &ndash; find all values that potentially match a given key \n* unindex &ndash; remove all key/value pairs that match a given key \nTo appreciate the problems, we need an example. Suppose we have the following \nsix keys to index. For simplicity, the value of each key will be the key itself: \n\n1 (p a b) \n\n2 (p a c) \n\n3 (p a ?x) \n\n4 (p b c) \n\n5 (p b (f c)) \n\n6 (p a (f . ?x)) \n\nNow assume the query (. ?y c). This should match keys 2, 3, and 4. How could \nwe efficiently arrive at this set? One idea is to list the key/value pairs under every \natom that they contain. Thus, all six would be listed under the atom p, while 2, \n4, and 5 would be listed under the atom c. A unification check could eliminate 5, \nbut we still would be missing 3. Key 3 (and every key with a variable in it) could \npotentially contain the atom c. So to get the right answers under this approach, \nwe will need to index every key that contains a variable under every atom - not an \nappealing situation. \n\nAn alternative is to create indices based on both atoms and their position. So now \nwe would be retrieving all the keys that have a c in the second argument position: 2 \nand 4, plus the keys that have a variable as the second argument: 3. This approach \nseems to work much better, at least for the example shown. To create the index, we \nessentially superimpose the list structure of all the keys on top of each other, to arrive \nat one big discrimination tree. At each position in the tree, we create an index of the \nkeys that have either an atom or a variable at that position. Figure 14.1 shows the \ndiscrimination tree for the six keys. \n\nConsider the query (. ?y c). Either the . or the c could be used as an index. \nThe . in the predicate position retrieves all six keys. But the c in the second argument \nposition retrieves only three keys: 2 and 4, which are indexed under c itself, and 3, \nwhich is indexed under the variable in that position. \n\nNow consider the query (. ?y (f ?z)). Again, the . serves as an index to all \nsix keys. The f serves as an index to only three keys: the 5 and 6, which are indexed \n\n\f\n<a id='page-474'></a>\n\n. A \n(.A .) (.A .) \n(PAC) (PAC) \n(PA?) (PA?) \n(PBC) (. A (F.?)) . \n(.8 (FC)) \n(. A (F.?)) \n. \n(PBC) \n(. A (F.?)) (. . (FC)) \n(. . (FC)) (. . (F C)) \n(PA(F.?) ) \n. \n(. . .) \nC \n(PAC) \n(PBC) \n? \n(PA?) \n\nFigure 14.1: Discrimination Tree with Six Keys \n\ndirectly under f in that position, and 3, which is indexed under the variable in a \nposition along the path that lead to f. In general, all the keys indexed under variables \nalong the path must be considered. \n\nThe retrieval mechanism can overretrieve. Given the query (. a (f ?x)),the \natom . will again retrieve all six keys, the atom a retrieves 1,2,3, and 6, and f again \nretrieves 5, 6, and 3. So f retrieves the shortest list, and hence it will be used to \ndetermine the final result. But key 5 is (. b (f c)), which does not match the query \n(pa (f?x)). \n\nWe could eliminate this problem by intersecting all the lists instead of just taking \nthe shortest list. It is perhaps feasible to do the intersection using bit vectors, but \nprobably too slow and wasteful of space to do it using lists. Even if we did intersect \nkeys, we would still overretrieve, for two reasons. First, we don't use . i 1 as an index, \nso we are ignoring the difference between (f ?x) and (f . ?x). Second, we are \nusing wild-card semantics, so the query (. ?x ?x) would retrieve all six keys, when \n\n\f\n<a id='page-475'></a>\nit should only retrieve three. Because of these problems, we make a design choice: \nwe will first build a data base retrieval function that retrieves potential matches, and \nlater worry about the unification process that will eliminate mismatches. \n\nWe are ready for a more complete specification of the indexing strategy: \n\n* The value will be indexed under each non-nil nonvariable atom in the key, with \na separate index for each position. For example, given the preceding data base, \nthe atom a in the first argument position would index values 1,2,3, and 6, while \nthe atom b in the second argument position would index value 4 and 5. The \natom . in the predicate position would index all six values. \nIn addition, we will maintain a separate index for variables at each position. For \nexample, value 3 would be stored under the index \"variable in second argument \nposition.\" \n\n* \"Position\" does not refer solely to the linear position in the top-level list. For \nexample, value 5 would be indexed under atom f in the caaddr position. \n* It follows that a key with . atoms will be indexed in. different ways. \nFor retrieval, the strategy is: \n\n* For each non-nil nonvariable atom in the retrieval key, generate a list of possible \nmatches. Choose the shortest such list. \n* Each list of possible matches will have to be augmented with the values indexed \nunder a variable at every position \"above.\" For example, f in the ca add r position \nretrieves value 5, but it also must retrieve value 3, because the third key has a \nvariable in the caddr position, and caddr is \"above\" caaddr. \n* The discrimination tree may return values that are not valid matches. The \npurpose of the discrimination tree is to reduce the number of values we will \nhave to unify against, not to determine the exact set of matches. \nIt is important that the retrieval function execute quickly. If it is slow, we might \njust as well match against every key in the table linearly. Therefore, we will take \ncare to implement each part efficiently. Note that we will have to compare the length \nof lists to choose the shortest possibility. Of course, it is trivial to compare lengths \nusing length, but length requires traversing the whole list. We can do better if we \nstore the length of the list explicitly. A list with its length will be called an nl1 st. \nIt will be implemented as a cons cell containing the number of elements and a list \nof the elements themselves. An alternative would be to use extensible vectors with \nfill pointers. \n\n\f\n<a id='page-476'></a>\n\nAn nlist is implemented as a (count . elements) pair: \n\n(defun make-empty-nlist () \n\"Create a new, empty nlist.\" \n(cons 0 nil)) \n\n(defun nlist-n (x) \"The number of elements in an nlist.\" (carx)) \n(defun nlist-list (x) \"The elements in an nlist.\" (cdr x)) \n\n(defun nlist-push (item nlist) \n\"Add a new element to an nlist.\" \n(incf (car nlist)) \n(push item (cdr nlist)) \nnlist) \n\nNow we need a place to store these nlists. We will build the data base out of \ndiscrimination tree nodes called dtree nodes. Each dtree node has a field to hold \nthe variable index, the atom indices, and pointers to two subnodes, one for the first \nand one for the rest. We implement dtrees as vectors for efficiency, and because we \nwill never need a dtree-. predicate. \n\n(defstruct (dtree (:type vector)) \n(first nil) (rest nil) (atoms nil) (var (make-empty-nlist))) \n\nA separate dtree will be stored for each predicate. Since the predicates must be \nsymbols, it is possible to store the dtrees on the predicate's property list. In most \nimplementations, this will be faster than alternatives such as hash tables. \n\n(let ((predicates nil)) \n\n(defun get-dtree (predicate) \n\"Fetch (or make) the dtree for this predicate.\" \n(cond ((get predicate 'dtree)) \n\n(t (push predicate predicates) \n(setf (get predicate 'dtree) (make-dtree))))) \n\n(defun clear-dtrees () \n\"Remove all the dtrees for all the predicates.\" \n(dolist (predicate predicates) \n\n(setf (get predicate 'dtree) nil)) \n(setf predicates nil))) \n\nThe function i ndex takes a relation as key and stores it in the dtree for the predicate \nof the relation. It calls dtree - i ndex to do all the work of storing a value under the \nproper indices for the key in the proper dtree node. \n\nThe atom indices are stored in an association Ust. Property lists would not \nwork, because they are searched using eq and atoms can be numbers, which are not \n\n\f\n<a id='page-477'></a>\nnecessarily eq. Association lists are searched using eql by default. An alternative \n\nwould be to use hash tables for the index, or even to use a scheme that starts with \n\nassociation lists and switches to a hash table when the number of entries gets large. I \n\nuse 1 ookup to look up the value of a key in a property list. This function, and its setf \n\nmethod, are defined on [page 896](chapter25.md#page-896). \n\n(defun index (key) \n\"Store key in a dtree node. Key must be (predicate . args); \nit is stored in the predicate's dtree.\" \n(dtree-index key key (get-dtree (predicate key)))) \n\n(defun dtree-index (key value dtree) \n\"Index value under all atoms of key in dtree.\" \n(cond \n\n((consp key) ; index on both first and rest \n(dtree-index (first key) value \n(or (dtree-first dtree) \n(setf (dtree-first dtree) (make-dtree)))) \n(dtree-index (rest key) value \n(or (dtree-rest dtree) \n\n(setf (dtree-rest dtree) (make-dtree))))) \n((null key)) ; don't index on nil \n((variable-p key) ; index a variable \n\n(nlist-push value (dtree-var dtree))) \n(t Make sure there is an nlist for this atom, and add to it \n(nlist-push value (lookup-atom key dtree))))) \n\n(defun lookup-atom (atom dtree) \n\"Return (or create) the nlist for this atom in dtree.\" \n(or (lookup atom (dtree-atoms dtree)) \n\n(let ((new (make-empty-nlist))) \n(push (cons atom new) (dtree-atoms dtree)) \nnew))) \n\nNow we define a function to test the indexing routine. Compare the output with \nfigure 14.1. \n\n(defun test-index () \n(let ((props '((p a b) (p a c) (p a ?x) (p b c) \n\n(p b (f c)) (p a (f . ?x))))) \n(clear-dtrees) \n(mapc #*index props) \n(write (list props (get-dtree '.)) \n\nicircle t rarray t :pretty t) \n(values))) \n\n\f\n<a id='page-478'></a>\n\n> (test-index) \n\n((#1=(P A B) \n#2=(P A C) \n#3=(P A ?X) \n#4=(P . C) \n#5=(P . (F O) \n#6=(P A (F . ?X))) \n\n#(#(NIL NIL (P (6 #6# #5# #4# #3# #2# #!#)) (0)) \n#(#(NIL NIL (B (2 #5# #4#) A (4 #6# #3# #2# #!#)) (0)) \n#(#(#(NIL NIL (F (2 #6# #5#)) (0)) \n#(#(NIL NIL (C (1 #5#)) (0)) \n\n#(NIL NIL NIL (0)) NIL (1 #6#)) \n(C (2 #4# #2#) . (1 #!#)) \n(1 #3#)) \n\n#(NIL NIL NIL (0)) \nNIL (0)) \nNIL (0)) \nNIL (0))) \n\nThe next step is to fetch matches from the dtree data base. The function fetch takes \na query, which must be a valid relation, as its argument, and returns a list of possible \nmatches. It calls dtree-fetch to do the work: \n\n(defun fetch (query) \n\"Return a list of buckets potentially matching the query, \nwhich must be a relation of form (predicate . args).\" \n(dtree-fetch query (get-dtree (predicate query)) \n\nnil 0 nil most-positive-fixnum)) \n\ndtree-fetch must be passed the query and the dtree, of course, but it is also passed \nfour additional arguments. First, we have to accumulate matches indexed under \nvariables as we are searching through the dtree. So two arguments are used to pass \nthe actual matches and a count of their total number. Second, we want dtree - fetch \nto return the shortest possible index, so we pass it the shortest answer found so far, \nand the size of the shortest answer. That way, as it is making its way down the tree, \naccumulating values indexed under variables, it can be continually comparing the \nsize of the evolving answer with the best answer found so far. \n\nWe could use nlists to pass around count/values pairs, but nlists only support a \npush operation, where one new item is added. We need to append together lists of \nvalues coming from the variable indices with values indexed under an atom. Append \nis expensive, so instead we make a list-of-lists and keep the count in a separate \nvariable. When we are done, dtree-fetch and hence fetch does a multiple-value \nreturn, yielding the list-of-lists and the total count. \n\n\f\n<a id='page-479'></a>\nThere are four cases to consider in dtree-fetch. If the dtree is null or the query \npattern is either null or a variable, then nothing will be indexed, so we should just \nreturn the best answer found so far. Otherwise, we bind var-. and var-1 ist to \nthe count and list-of-lists of variable matches found so far, including at the current \nnode. If the count var-. is greater than the best count so far, then there is no \nsense continuing, and we return the best answer found. Otherwise we look at the \nquery pattern. If it is an atom, we use dtree-atom-f etch to return either the current \nindex (along with the accumulated variable index) or the accumulated best answer, \nwhichever is shorter. If the query is a cons, then we use dtree-fetch on the first \npart of the cons, yielding a new best answer, which is passed along to the call of \ndtree-fetch on the rest of the cons. \n\n(defun dtree-fetch (pat dtree var-list-in var-n-in best-list best-n) \n\"Return two values: a list-of-lists of possible matches to pat. \nand the number of elements in the list-of-lists.\" \n(if (or (null dtree) (null pat) (variable-p pat)) \n\n(values best-list best-n) \n\n(let* ((var-nlist (dtree-var dtree)) \n(var-n (+ var-n-in (nlist-n var-nlist))) \n(var-list (if (null (nlist-list var-nlist)) \n\nvar-1 ist-i . \n(cons (nlist-list var-nlist) \nvar-list-in)))) \n\n(cond \n((>= var-n best-n) (values best-list best-n)) \n((atom pat) (dtree-atom-fetch pat dtree var-list var-n \n\nbest-list best-n)) \n(t (multiple-value-bind (listl nl) \n(dtree-fetch (first pat) (dtree-first dtree) \nvar-list var-n best-list best-n) \n(dtree-fetch (rest pat) (dtree-rest dtree) \nvar-list var-n listl nl))))))) \n\n(defun dtree-atom-fetch (atom dtree var-list var-n best-list best-n) \n\"Return the answers indexed at this atom (along with the vars), \nor return the previous best answer, if it is better.\" \n(let ((atom-nlist (lookup atom (dtree-atoms dtree)))) \n\n(cond \n((or (null atom-nlist) (null (nlist-list atom-nlist))) \n(values var-list var-n)) \n((and atom-nlist (< (incf var-n (nlist-n atom-nlist)) best-n)) \n(values (cons (nlist-list atom-nlist) var-list) var-n)) \n(t (values best-list best-n))))) \n\nHere we see a call to fetch on the data base created by test - i ndex. It returns two \nvalues: a list-of-lists of facts, and the total number of facts, three. \n\n\f\n<a id='page-480'></a>\n\n> (fetch '(. ? c)) \n(((. . . (. A .) \n((. . ?.))) \n3 \n\nNow let's stop and see what we have accomplished. The functions fetch and \ndtree-fetch fulfill their contract of returning potential matches. However, we still \nneed to integrate the dtree facility with Prolog. We need to go through the potential \nmatches and determine which candidates are actual matches. For simplicity we will \nuse the version of u.i f y with binding lists defined in section 11.2. (It is also possible to \nconstruct a more efficient version that uses the compiler and the destructive function \nunifyl.) \n\nThe function mapc- retri eve calls fetch to get a Ust-of-Usts of potential matches \nand then calls uni fy to see if the match is a true one. If the match is true, it calls \nthe supplied function with the binding list that represents the unification as the \nargument, mapc-retri eve is proclaimed inl ine so that functions passed to it can \nalso be compiled in place. \n\n(proclaim '(inline mapc-retrieve)) \n\n(defun mapc-retrieve (fn query) \n\"For every fact that matches the query, \napply the function to the binding list. \" \n(dolist (bucket (fetch query)) \n\n(dolist (answer bucket) \n(let ((bindings (unify query answer))) \n(unless (eq bindings fail) \n(funcall fn bindings)))))) \n\nThere are many ways to use this retriever. The function retri eve returns a list of the \nmatching binding hsts, and retri eve-matches substitutes each binding hst into the \noriginal query so that the result is a list of expressions that unify with the query. \n\n(defun retrieve (query) \n\"Find all facts that match query. Return a list of bindings.\" \n(let ((answers nil)) \n\n(mapc-retrieve #'(lambda (bindings) (push bindings answers)) \nquery) \nanswers)) \n\n(defun retrieve-matches (query) \n\"Find all facts that match query. \nReturn a list of expressions that match the query.\" \n(mapcar #'(lambda (bindings) (subst-bindings bindings query)) \n\n(retrieve query))) \n\n\f\n<a id='page-481'></a>\nThere is one further complication to consider. Recall that in our original Prolog \ninterpreter, the function prove had to rename the variables in each clause as it \nretrieved it from the data base. This was to insure that there was no conflict between \nthe variables in the query and the variables in the clause. We could do that in \nretrieve. However, if we assume that the expressions indexed in discrimination \ntrees are tablelike rather than rulelike and thus are not recursive, then we can get \naway with renaming the variables only once, when they are entered into the data \nbase. This is done by changing i ndex: \n\n(defun index (key) \n\"Store key in a dtree node. Key must be (predicate . args); \nit is stored in the predicate's dtree.\" \n(dtree-index key (rename-variables key) ; store unique vars \n\n(get-dtree (predicate key)))) \n\nWith the new i ndex in place, and after calling test - i ndex to rebuild the data base, \nwe are now ready to test the retrieval mechanism: \n\n> (fetch '(p ?x c)) \n(((P . C) (P A O) \n((PA 7X3408))) \n3 \n\n> (retrieve '(p ?x c)) \n\n(((7X3408 . C) (7X . A)) \n((7X . A)) \n((7X . B))) \n\n> (retrieve-matches '(p 7x c)) \n\n((P A C) (P A C) (P . .) \n\n> (retrieve-matches *(p 7x (7fn c))) \n\n((P A (7FN O) (P A (F O) (P . (F C))) \n\nActually, it is better to use mapc-retrieve when possible, since it doesn't cons up \n\nanswers the way retrieve and retrieve-matches do. The macro query-bind is \n\nprovided as a nice interface to mapc - ret r i eve. The macro takes as arguments a list of \n\nvariables to bind, a query, and one or more forms to apply to each retrieved answer. \n\nWithin this list of forms, the variables will be bound to the values that satisfy the \n\nquery. The syntax was chosen to be the same as mul ti pi e - va 1 ue - bi nd. Here we see \n\na typical use of query - bi nd, its result, and its macro-expansion: \n\n\f\n<a id='page-482'></a>\n\n> (query-bind (?x ?fn) '(p ?x (?fn c)) \n\n(format t \"~&P holds between ~a and ~a of c.\" ?x ?fn)) =. \n. holds between . and F of c. \n. holds between A and F of c. \n. holds between A and ?FN of c. \nNIL \n\n= (mapc-retrieve \n#'(lambda (#:bindings6369) \n(let ((?x (subst-bindings #:bindings6369 '?.)) \n(?fn (subst-bindings #:bindings6369 '?fn))) \n(format t \"~&P holds between ~a and ~a of c.\" ?x ?fn))) \n'(p ?x (?fn c))) \n\nHere is the implementation: \n\n(defmacro query-bind (variables query &body body) \n\"Execute the body for each match to the query. \nWithin the body, bind each variable.\" \n(let* ((bindings (gensym \"BINDINGS\")) \n\n(vars-and-vals \n(mapcar \n#'(lambda (var) \n(list var '(subst-bindings .bindings ',var))) \nvariables))) \n'(mapc-retrieve \n#'(lambda (.bindings) \n(let ,vars-and-vals \n.body)) \n.query))) \n\n14.9 A Solution to the Completeness Problem \nWe saw in chapter 6 that iterative deepening is an efficient way to cover a search \nspace without falling into an infinite loop. Iterative deepening can also be used to \nguide the search in Prolog. It will insiu-e that all valid answers are found eventually, \nbut it won't turn an infinite search space into a finite one. \n\nIn the interpreter, iterative deepening is implemented by passing an extra argument \nto prove and prove-a 11 to indicate the depth remaining to be searched. When \nthat argument is zero, the search is cut off, and the proof fails. On the next iteration \nthe bounds will be increased and the proof may succeed. If the search is never cut off \nby a depth bound, then there is no reason to go on to the next iteration, because all \n\n\f\n<a id='page-483'></a>\nproofs have already been found. The special variable *sea r ch - cut - off* keeps track \nof this. \n\n(defvar *search-cut-off* nil \"Has the search been stopped?\") \n\n(defun prove-all (goals bindings depth) \n\"Find a solution to the conjunction of goals.\" \nThis version just passes the depth on to PROVE, \n\n(cond ((eq bindings fail) fail) \n((null goals) bindings) \n(t (prove (first goals) bindings (rest goals) depth)))) \n\n(defun prove (goal bindings other-goals depth) \n\"Return a list of possible solutions to goal.\" \n:; Check if the depth bound has been exceeded \n(if (= depth 0) \n\n(progn (setf *search-cut-off* t) \nfail) \n(let ((clauses (get-clauses (predicate goal)))) \n(if (listp clauses) \n(some \n#'(lambda (clause) \n(let ((new-clause (rename-variables clause))) \n\n(prove-al1 \n(append (clause-body new-clause) other-goals) \n(unify goal (clause-head new-clause) bindings) \n(- depth 1)))) \n\nclauses) \n\nThe predicate's \"clauses\" can be an atom: \n;; a primitive function to call \n(funcall clauses (rest goal) bindings \n\nother-goals depth))))) \n\nprove and . rove - a 11 now implement search cutoff, but we need something to control \nthe iterative deepening of the search. First we define parameters to control the \niteration: one for the initial depth, one for the maximum depth, and one for the \nincrement between iterations. Setting the initial and increment values to one will \nmake the results come out in strict breadth-first order, but will duplicate more effort \nthan a slightly larger value. \n\n\f\n<a id='page-484'></a>\n\n(defparameter *depth-start* 5 \n\"The depth of the first round of iterative search.\") \n(defparameter *depth-incr* 5 \n\"Increase each iteration of the search by this amount.\") \n(defparameter *depth-max* most-positive-fixnum \n\"The deepest we will ever search.\") \n\nA new version of top-level - prove will be used to control the iteration. It calls \nprove-al 1 for all depths from the starting depth to the maximum depth, increasing \nby the increment. However, it only proceeds to the next iteration if the search was \ncut off at some point in the previous iteration. \n\n(defun top-level-prove (goals) \n(let ((all-goals \n*(,goals (show-prolog-vars ,@(variables-in goals))))) \n(loop for depth from *depth-start* to *depth-max* by *depth-incr* \n\nwhile (let ((*search-cut-off* nil)) \n(prove-all all-goals no-bindings depth) \n*search-cut-off*))) \n\n(format t \"~&No.\") \n(values)) \n\nThere is one final complication. When we increase the depth of search, we may \nfind some new proofs, but we will also find all the old proofs that were found on the \nprevious iteration. We can modify show-prol og-vars to only print proofs that are \nfound with a depth less than the increment - that is, those that were not found on the \nprevious iteration. \n\n(defun show-prolog-vars (vars bindings other-goals depth) \n\"Print each variable with its binding. \nThen ask the user if more solutions are desired.\" \n(if (> depth *depth-incr*) \n\nfail \n(progn \n\n(if (null vars) \n(format t \"~&Yes\") \n(dolist (var vars) \n\n(format t \"~&~a = ~a\" var \n(subst-bindings bindings var)))) \n\n(if (continue-p) \nfail \n(prove-all other-goals bindings depth))))) \n\nTo test that this works, try setting *depth-max* to 5 and running the following \nassertions and query. The infinite loop is avoided, and the first four solutions \nare found. \n\n\f\n<a id='page-485'></a>\n(<- (natural 0)) \n(<- (natural (1+ ?n)) (natural ?n)) \n\n> (?- (natural ?n)) \n\n?N = 0; \n\n?N = (1+ 0); \n\n?N = (1+ (1+ 0)); \n\n?N = (1+ (1+ (1+ 0))); \n\nNo. \n\n14.10 Solutions to the Expressiveness Problems \nIn this section we present solutions to three of the limitations described above: \n\n* Treatment of (limited) higher-order predications. \n* Introduction of a frame-based syntax. \n* Support for possible worlds, negation, and disjunction. \nWe also introduce a way to attach functions to predicates to do forward-chaining \n\nand error detection, and we discuss ways to extend unification to handle Skolem \n\nconstants and other problems. \n\nHigher-Order Predications \n\nFirst we will tackle the problem of answering questions like \"What kinds of animals \nare there?\" Paradoxically, the key to allowing more expressiveness in this case is to \ninvent a new, more limited language and insist that all assertions and queries are \nmade in that language. That way, queries that would have been higher-order in the \noriginal language become first-order in the restricted language. \n\nThe language admits three types of objects: categones, relations, and individuals. \nA category corresponds to a one-place predicate, a relation to a two-place predicate, \nand an individual to constant, or zero-place predicate. Statements in the language \nmusthaveoneof five primitive operators: sub, rel, ind. val , and and. They have \nthe following form: \n\n(sub subcategorysupercategory) \n(rel relation domain-category range-category) \n(i nd individual category) \n(val relation individual value) \n(and assertion...) \n\n\f\n<a id='page-486'></a>\n\nThe following table gives some examples, along with English translations: \n\n(sub dog animal) Dog is a kind of animal. \n(rel birthday animal date) The birthday relation holds between each animal \nand some date. \n(ind fido dog) The individual Fido is categorized as a dog. \n(val birthday fido july-1) The birthday of Fido is July-1. \n(and AB) Both A and Bare true. \nFor those who feel more comfortable with predicate calculus, the following table \ngives the formal definition of each primitive. The most complicated definition is for \nrel. The form (rel RAB) means that every R holds between an individual of A \nand an individual of B, and furthermore that every individual of A participates in at \n\nleast one R relation. \n(sub AB) Va:: A(x) D \n(rel RAB) \"rfx^y: R{x,y) D A{x) A B{y) \nA\\/xA{x) D 3y : R{x, y) \n(ind IC) C{I) \n(val RIV) R{I,V) \n(and PQ...) PAQ.,. \n\nQueries in the language, not surprisingly, have the same form as assertions, \nexcept that they may contain variables as well as constants. Thus, to find out what \nkinds of animals there are, use the query (sub ?kind animal). To find out what \nindividual animals there are, use the query (ind ?x animal). To find out what \nindividual animals of what kinds there are, use: \n\n(and (sub ?kind animal) (ind ?x ?kind)) \n\nThe implemention of this new language can be based directly on the previous implementation \nof dtrees. Each assertion is stored as a fact in a dtree, except that \nthe components of an and assertion are stored separately. The function add-fact \ndoes this: \n\n(defun add-fact (fact) \n\n\"Add the fact to the data base.\" \n\n(if (eq (predicate fact) 'and) \n\n(mapc #*add-fact (args fact)) \n(index fact))) \n\nQuerying this new data base consists of querying the dtree just as before, but with \na special case for conjunctive (and) queries. Conceptually, the function to do this, \nretri eve-fact, should be as simple as the following: \n\n\f\n<a id='page-487'></a>\n(defun retrieve-fact (query) \n\"Find all facts that match query. Return a list of bindings. \nWarning!! this version is incomplete.\" \n(if (eq (predicate query) 'and) \n\n(retrieve-conjunction (args query)) \n(retrieve query bindings))) \n\nUnfortunately, there are some complications. Think about what must be done in \nretrieve-conjunction. It is passed a list of conjuncts and must return a list of \nbinding lists, where each binding list satisfies the query. For example, to find out \nwhat people were born on July 1st, we could use the query: \n\n(and (val birthday ?p july-1) (ind ?p person)) \n\nretrieve-conjunction could solve this problem by first calling retrieve-fact on \n(val birthday ?p july-1). Once that is done, there is only one conjunct remaining, \nbut in general there could be several, so we need to call ret r i eve - conj uncti on recursively \nwith two arguments: theremainingconjuncts,andtheresultthat retrieve-fact \ngave for the first solution. Since retrieve-fact returns a list of binding lists, it will \nbe easiest if retri eve-conjunct i on accepts such a list as its second argument. Furthermore, \nwhen it comes time to call retri eve- fact on the second conjunct, we will \nwant to respect the bindings set up by the first conjunct. So retri eve -fact must \naccept a binding list as its second argument. Thus we have: \n\n(defun retrieve-fact (query &optional (bindings no-bindings)) \n\"Find all facts that match query. Return a list of bindings.\" \n(if (eq (predicate query) 'and) \n\n(retrieve-conjunction (args query) (list bindings)) \n(retrieve query bindings))) \n\n(defun retrieve-conjunction (conjuncts bindings-lists) \n\"Return a list of binding lists satisfying the conjuncts.\" \n(mapcan \n\n#'(lambda (bindings) \n\n(cond ((eq bindings fail) nil) \n((null conjuncts) (list bindings)) \n(t (retrieve-conjunction \n\n(rest conjuncts) \n\n(retrieve-fact \n(subst-bindings bindings (first conjuncts)) \nbindings))))) \n\nbindings-lists)) \n\nNotice that retrieve and therefore mapc-retrieve now also must accept a binding \nlist. The changes to them are shown in the following. In each case the extra argument \n\n\f\n<a id='page-488'></a>\n\nis made optional so that previously written functions that call these functions without \npassing in the extra argument will still work. \n\n(defun mapc-retrieve (fn query &optional (bindings no-bindings)) \n\"For every fact that matches the query, \napply the function to the binding list. \" \n(dolist (bucket (fetch query)) \n\n(dolist (answer bucket) \n(let ((new-bindings (unify query answer bindings))) \n(unless (eq new-bindings fail) \n(funcall fn new-bindings)))))) \n\n(defun retrieve (query &optional (bindings no-bindings)) \n\"Find all facts that match query. Return a list of bindings.\" \n(let ((answers nil)) \n\n(mapc-retrieve #'(lambda (bindings) (push bindings ansviers)) \nquery bindings) \nanswers)) \n\nNow add - fact and ret r i eve - fact comprise all we need to implement the language. \nHere is a short example where add-fact is used to add facts about bears and dogs, \nboth as individuals and as species: \n\n> (add-fact *(sub dog animal)) => . \n> (add-fact '(sub bear animal)) => . \n> (add-fact '(ind Fido dog)) => . \n> (add-fact '(ind Yogi bear)) . \n> (add-fact '(val color Yogi brown)) => . \n> (add-fact '(val color Fido golden)) . \n> (add-fact '(val latin-name bear ursidae)) => . \n> (add-fact '(val latin-name dog canis-familiaris)) => . \n\nNow retrieve -fact is used to answer three questions: What kinds of animals are \nthere? What are the Latin names of each kind of animal? and What are the colors of \neach individual bear? \n\n> (retrieve-fact '(sub ?kind animal)) \n(((?KIND . DOG)) \n((?KIND . BEAR))) \n\n> (retrieve-fact '(and (sub ?kind animal) \n(val latin-name ?kind ?latin))) \n(((7LATIN . CANIS-FAMILIARIS) (7KIND . DOG)) \n((7LATIN . URSIDAE) (7KIND . BEAR))) \n\n\f\n<a id='page-489'></a>\n> (retrieve-fact '(and (ind ?x bear) (val color ?x ?c))) \n\n(((?C . BROWN) (?X . YOGI))) \n\nImprovements \n\nThere are quite a few improvements that can be made to this system. One direction \nis to provide different kinds of answers to queries. The following two functions \nare similar to retri eve-matches in that they return lists of solutions that match the \nquery, rather than lists of possible bindings: \n\n(defun retrieve-bagof (query) \n\n\"Find all facts that match query. \n\nReturn a list of queries with bindings filled in.\" \n\n(mapcar #'(lambda (bindings) (subst-bindings bindings query)) \n\n(retrieve-fact query))) \n\n(defun retrieve-setof (query) \n\"Find all facts that match query. \nReturn a list of unique queries with bindings filled in. \" \n(remove-duplicates (retrieve-bagof query) :test #'equal)) \n\nAnother direction to take is to provide better error checking. The current system \ndoes not complain if a fact or query is ill-formed. It also relies on the user to input all \nfacts, even those that could be derived automatically from the semantics of existing \nfacts. Forexample, the semantics of sub imply that if (sub bear animal) and (sub \npolar-bear bear) are true, then (subpolar-bear animal) must also be true. This \nkind of implication can be handled in two ways. The typical Prolog approach would \nbe to write rules that derive the additional sub facts by backward-chaining. Then \nevery query would have to check if there were rules to run. The alternative is to use \naforward-chaining approach, which caches each new sub fact by adding it to the data \nbase. This latter alternative takes more storage, but because it avoids rederiving the \nsame facts over and over again, it tends to be faster. \n\nThe following version of add-fact does error checking, and it automatically \ncaches facts that can be derived from existing facts. Both of these things are done by \na set of functions that are attached to the primitive operators. It is done in a data-\ndriven style to make it easier to add new primitives, should that become necessary. \n\nThe function add-fact checks that each argument to a primitive relation is a \nnonvariable atom, and it also calls fact-present-p to check if the fact is already \npresent in the data base. If not, it indexes the fact and calls run-attached-f . to do \nadditional checking and caching: \n\n(defparameter ^primitives* '(and sub ind rel val)) \n\n\f\n<a id='page-490'></a>\n\n(defun add-fact (fact) \n\"Add the fact to the data base.\" \n(cond ((eq (predicate fact) *and) \n\n(mapc #*add-fact (args fact))) \n\n((or (not (every #*atom (args fact))) \n(some #'variable-p (args fact)) \n(not (member (predicate fact) *primitives*))) \n\n(error \"111-formed fact: ~a\" fact)) \n\n((not (fact-present-p fact)) \n(index fact) \n(run-attached-fn fact))) \n\nt) \n\n(defun fact-present-p (fact) \n\"Is this fact present in the data base?\" \n(retrieve fact)) \n\nThe attached functions are stored on the operator's property list under the indicator \n\nattached-fn: \n\n(defun run-attached-fn (fact) \n\"Run the function associated with the predicate of this fact.\" \n(apply (get (predicate fact) 'attached-fn) (args fact))) \n\n(defmacro def-attached-fn (pred args &body body) \n\"Define the attached function for a primitive.\" \n'(setf (get '.pred 'attached-fn) \n\n#'(lambda ,args ..body))) \n\nThe attached functions for ind and val are fairly simple. If we know (sub bear \nani mal), then when ( i nd Yogi bea r) is asserted, we have to also assert ( i nd Yogi \nanimal). Similarly, the values in a val assertion must be individuals of the categories \nin the relation's rel assertion. That is, if ( rel bi rthday animal date) is a fact and \n(val birthday Lee ju1y-l) is added, then we can conclude (ind Lee animal) and \n(ind july-1 date). The followingfunctions add the appropriate facts: \n\n(def-attached-fn ind (individual category) \nCache facts about inherited categories \n(query-bind (?super) '(sub .category ?super) \n(add-fact '(ind .individual .?super)))) \n\n\f\n<a id='page-491'></a>\n\n(def-attached-fn val (relation indi ind2) \nMake sure the individuals are the right kinds \n\n(query-bind (?catl ?cat2) '(rel .relation ?catl ?cat2) \n(add-fact *(ind ,indl .?catl)) \n(add-fact '(ind .ind2 .?cat2)))) \n\nThe attached function for rel simply runs the attached function for any individual of \nthe given relation. Normally one would make all rel assertions before i nd assertions, \nso this will have no effect at all. But we want to be sure the data base stays consistent \neven if facts are asserted in an unusual order. \n\n(def-attached-fn rel (relation catl cat2) \nRun attached function for any IND's of this relation \n(query-bind (?a ?b) '(ind .relation ?a ?b) \n(run-attached-fn '(ind .relation .?a .?b)))) \n\nThe most complicated attached function is for sub. Adding a fact such as (sub bear \nanimal) causes the following to happen: \n\n* All of animal's supercategories (such as 1 iving-thing) become supercategories \nof all of bea r's subcategories (such as pol ar - bea r). \n* animal itself becomes a supercategory all of bear's subcategories. \n* bear itself becomes a subcategory of all of animal's supercategories. \n* All of the individuals of bear become individuals of animal and its supercategories. \nThe following accomplishes these four tasks. It does it with four calls to \nindex-new-fact, which is used instead of add-fact because we don't need to run \nthe attached function on the new facts. We do, however, need to make sure that we \naren't indexing the same fact twice. \n\n(def-attached-fn sub (subcat supercat) \nCache SUB facts \n\n(query-bind (?super-super) '(sub .supercat ?super-super) \n(index-new-fact '(sub .subcat .?super-super)) \n(query-bind (?sub-sub) '(sub ?sub-sub .subcat) \n\n(index-new-fact '(sub .?sub-sub .?super-super)))) \n(query-bind (?sub-sub) '(sub ?sub-sub .subcat) \n(index-new-fact '(sub .?sub-sub .supercat))) \nCache IND facts \n(query-bind (?super-super) '(sub .subcat ?super-super) \n(query-bind (?sub-sub) '(sub ?sub-sub .supercat) \n(query-bind (?ind) '(ind ?ind .?sub-sub) \n(index-new-fact '(ind .?ind .?super-super)))))) \n\n\f\n<a id='page-492'></a>\n\n(defun index-new-fact (fact) \n\n\"Index the fact in the data base unless it is already there.\" \n\n(unless (fact-present-p fact) \n\n(index fact))) \n\nThe following function tests the attached functions. It shows that adding the single \nfact (sub bea r ani mal) to the given data base causes 18 new facts to be added. \n\n(defun test-bears () \n\n(clear-dtrees) \n\n(mapc #'add-fact \n\n'((sub animal living-thing) \n\n(sub living-thing thing) (sub polar-bear bear) \n\n(sub grizzly bear) (ind Yogi bear) (ind Lars polar-bear) \n\n(ind Helga grizzly))) \n\n(trace index) \n\n(add-fact '(sub bear animal)) \n\n(untrace index)) \n\n> (test-bears) \n\n(1 ENTER INDEX: (SUB BEAR ANIMAL)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB BEAR THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB GRIZZLY THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB POLAR-BEAR THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB BEAR LIVING-THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB GRIZZLY LIVING-THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB POLAR-BEAR LIVING-THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB GRIZZLY ANIMAL)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (SUB POLAR-BEAR ANIMAL)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (IND LARS LIVING-THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (IND HELGA LIVING-THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (IND YOGI LIVING-THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (IND LARS THING)) \n\n(1 EXIT INDEX: T) \n\n(1 ENTER INDEX: (IND HELGA THING)) \n\n\f\n<a id='page-493'></a>\n(1 EXIT INDEX: T) \n(1 ENTER INDEX: (IND YOGI THING)) \n(1 EXIT INDEX: T) \n(1 ENTER INDEX: (IND LARS ANIMAD) \n(1 EXIT INDEX: .) \n(1 ENTER INDEX: (IND HELGA ANIMAD) \n(1 EXIT INDEX: .) \n(1 ENTER INDEX: (IND YOGI ANIMAD) \n(1 EXIT INDEX: .) \n(INDEX) \n\nA Frame Language \n\nAnother direction we can take is to provide an alternative syntax that will be easier \nto read and write. Many representation languages are based on the idea of frames, \nand their syntax reflects this. A frame is an object with slots. We will continue to use \nthe same data base in the same format, but we will provide an alternative syntax that \nconsiders the individuals and categories as frames, and the relations as slots. \n\nHere is an example of the frame syntax for individuals, which uses the operator \n\na.Note that it is more compact than the equivalent notation using the primitives. \n(a person (name Joe) (age 27)) = \n\n(and (ind personl person) \n(val name personl Joe) \n(val age personl 27)) \n\nThe syntax also allows for nested expressions to appear as the values of slots. Notice \nthat the Skolem constant personl was generated automatically; an alternative is \nto supply a constant for the individual after the category name. For example, the \nfollowing says that Joe is a person of age 27 whose best friend is a person named Fran \nwho is 28 and whose best friend is Joe: \n\n(a person pi (name Joe) (age 27) \n(best-friend (a person (name Fran) (age 28) \n(best-friend pi)))) = \n\n(and (ind pi person) (val name pi joe) (val age pi 27) \n(ind person2 person) (val name person2 fran) \n(val age person2 28) (val best-friend person2 pi) \n(val best-friend pi person2)) \n\n\f\n<a id='page-494'></a>\n\nThe frame syntax for categories uses the operator each. For example: \n\n(each person (isa animal) (name person-name) (age integer)) = \n\n(and (sub person animal) \n(rel name person person-name) \n(rel age person integer)) \n\nThe syntax for queries is the same as for assertions, except that variables are used \ninstead of the Skolem constants. This is true even when the Skolem constants are \nautomatically generated, as in the following query: \n\n(a person (age 27)) = (AND (IND ?3 PERSON) (VAL AGE ?3 27)) \n\nTo support the frame notation, we define the macros a and each to make assertions \nand ?? to make queries. \n\n(defmacro a (&rest args) \n\"Define a new individual and assert facts about it in the data base.\" \n*(add-fact \\(translate-exp (cons *a args)))) \n\n(defmacro each (&rest args) \n\"Define a new category and assert facts about it in the data base.\" \n'(add-fact (translate-exp (cons 'each args)))) \n\n(defmacro ?? (&rest queries) \n\"Return a list of answers satisfying the query or queries.\" \n*(retrieve-setof \n\n'.(translate-exp (maybe-add 'and (replace-?-vars queries)) \nrquery))) \n\nAll three of these macros call on trans! ate - exp to translate from the frame syntax to \nthe primitive syntax. Note that an a or ea ch expression is computing a conjunction of \nprimitive relations, but it is also computing a term when it is used as the nested value \nof a slot. It would be possible to do this by returning multiple values, but it is easier to \nbuild translate - exp as a set of local functions that construct facts and push them on \nthe local variable conj uncts. At the end, the list of conj uncts is returned as the value \nof the translation. The local functions trans! ate-a and trans! ate-each return the \natom that represents the term they are translating. The local function translate \ntranslates any kind of expression, trans! ate -s! ot handles a slot, and co!! ect- f act \nis responsible for pushing a fact onto the list of conjuncts. The optional argument \nquery-mode-p tells what to do if the individual is not provided in an a expression. If \nquery-mode-p is true, the individual will be represented by a variable; otherwise it \nwill be a Skolem constant. \n\n\f\n<a id='page-495'></a>\n(defun translate-exp (exp &optional query-mode-p) \n\"Translate exp into a conjunction of the four primitives.\" \n(let ((conjuncts nil)) \n\n(labels \n((collect-fact (&rest terms) (push terms conjuncts)) \n\n(translate (exp) \nFigure out what kind of expression this is \n\n(cond \n((atom exp) exp) \n((eq (first exp) *a) (translate-a (rest exp))) \n((eq (first exp) 'each) (translate-each (rest exp))) \n(t (apply #'collect-fact exp) exp))) \n\n(translate-a (args) \ntranslate (A category Cind] (rel filler)*) \n(let* ((category (pop args)) \n(self (cond ((and args (atom (first args))) \n\n(pop args)) \n(query-mode-p (gentemp \"?\")) \n(t (gentemp (string category)))))) \n\n(collect-fact 'ind self category) \n(dolist (slot args) \n(translate-slot 'val self slot)) \nself)) \n\n(translate-each (args) \n;; translate (EACH category [(isa cat*)] (slot cat)*) \n(let* ((category (pop args))) \n\n(when (eq (predicate (first args)) 'isa) \n(dolist (super (rest (pop args))) \n(collect-fact 'sub category super))) \n(dolist (slot args) \n(translate-slot 'rel category slot)) \ncategory)) \n\n(translate-slot (primitive self slot) \n\ntranslate (relation value) into a REL or SUB \n(assert (= (length slot) 2)) \n(collect-fact primitive (first slot) self \n\n(translate (second slot))))) \n\nBody of translate-exp: \n(translate exp) Build up the list of conjuncts \n(maybe-add 'and (nreverse conjuncts))))) \n\n\f\n<a id='page-496'></a>\n\nThe auxiliary functions maybe - add and repl ace -? - va r s are shown in the following: \n\n(defun maybe-add (op exps &optional if-nil) \n\"For example, (maybe-add 'and exps t) returns \nt if exps is nil, (first exps) if there is only one. \nand (and expl exp2...) if there are several exps.\" \n(cond ((null exps) if-nil) \n\n((length=1 exps) (first exps)) \n(t (cons op exps)))) \n\n(defun length=1 (x) \n\"Is X a list of length 1?\" \n(and (consp x) (null (cdr x)))) \n\n(defun replace-?-vars (exp) \n\"Replace each ? in exp with a temporary var: 7123\" \n(cond ((eq exp '7) (gentemp \"7\")) \n\n((atom exp) exp) \n\n(t (reuse-cons (replace-7-vars (first exp)) \n(replace-7-vars (rest exp)) \nexp)))) \n\nPossible Worlds: Truth, Negation, and Disjunction \n\nIn this section we address four problems: distinguishing unknown from f al se, representing \nnegations, representing disjunctions, and representing multiple possible \nstates of affairs. It turns out that all four problems can be solved by introducing \ntwo new techniques: possible worlds and negated predicates. The solution is not \ncompletely general, but it is practical in a wide variety of applications. \n\nThere are two basic ways to distinguish unknown from false. The first possibility \nis to store a truth value - true or false - along with each proposition. The second \npossibility is to include the truth value as part of the proposition. There are several \nsyntactic variations on this theme. The following table shows the possibilities for \nthe propositions \"Jan likes Dean is true\" and \"Jan likes Ian is false:\" \n\nApproach True Prop. False Prop. \n(1) \n(2a) \n(likes(likes \nJan Dean) \ntrue Jan Dean) \n-true \n(likes(likes \nJan Ian) -false \nfalse Jan Ian) \n{2b) (likes Jan Dean) (not (likes Jan Dean)) \n(2c) (likes Jan Dean) (~likes Jan Dean) \n\nThe difference between (1) and (2) shows up when we want to make a query. \nWith (1), we make the single query (1 i kes JanDean) (or perhaps (1 i kes Jan ?x)), \nand the answers will tell us who Jan does and does not like. With (2), we make one \n\n\f\n<a id='page-497'></a>\nquery to find out what liking relationships are true, and another to find out which \nones are false. In either approach, if there are no responses then the answer is truly \nunknown. \n\nApproach (1) is better for applications where most queries are of the form \"Is \nthis sentence true or false?\" But applications that include backward-chaining rules \nare not like this. The typical backward-chaining rule says \"Conclude X is true ifY is \ntrue.\" Thus, most queries will be of the type \"Is Y true?\" Therefore, some version of \napproach (2) is preferred. \n\nRepresenting true and false opens the door to a host of possible extensions. First, \nwe could add multiple truth values beyond the simple \"true\" and \"false.\" These \ncould be symbolic values like \"probably-true\" or \"false-by-default\" or they could be \nnumeric values representing probabilities or certainty factors. \n\nSecond, we could introduce the idea of possible worlds. That is, the truth of a \nproposition could be unknown in the current world, but true if we assume p, and \nfalse if we assume q. In the possible world approach, this is handled by calling the \ncurrent world W, and then creating a new world VFi, which is just like W except \nthat . is true, and w2, which is just like W except that q is true. By doing reasoning \nin different worlds we can make predictions about the future, resolve ambiguitites \nabout the current state, and do reasoning by cases. \n\nFor example, possible worlds allow us to solve Moore's communism/democracy \nproblem ([page 466](chapter14.md#page-466)). We create two new possible worlds, one where is a democracy \nand one where it is communist. In each world it is easy to derive that there is \na democracy next to a communist country. The trick is to realize then that the \ntwo worlds form a partition, and that therefore the assertion holds in the original \n\"real\" world as well. This requires an interaction between the Prolog-based tactical \nreasoning going on within a world and the planning-based strategic reasoning that \ndecides which worlds to consider. \n\nWe could also add a truth maintenance system (or TMS) to keep track of the assumptions \nor justifications that lead to each fact being considered true. A truth \nmaintenance system can lessen the need to backtrack in a search for a global solution. \nAlthough truth maintenance systems are an important part of AI programming, \nthey will not be covered in this book. \n\nIn this section we extend the dtree facility (section 14.8) to handle truth values \nand possible worlds. With so many options, it is difficult to make design choices. We \nwill choose a fairly simple system, one that remains close to the simplicity and speed \nof Prolog but offers additional functionality when needed. We will adopt approach \n(2c) to truth values, using negated predicates. For example, the negated predicate of \n1 i kes is ~1 i kes, which is pronounced \"not likes.\" \n\nWe will also provide minimal support for possible worlds. Assume that there is \nalways a current world, W, and that there is a way to create alternative worlds and \nchange the current world to an alternative one. Assertions and queries will always be \nmade with respect to the current world. Each fact is indexed by the atoms it contains. \n\n\f\n<a id='page-498'></a>\n\njust as before. The difference is that the facts are also indexed by the current world. \nTo support this, we need to modify the notion of the numbered list, or nlist, to \ninclude a numbered association list, or nal i st. The following is an nal i st showing \nsix facts indexed under three different worlds: WO, Wl, and W2: \n\n(6 (WO #1# #2# #3#) (Wl #4#) (W2 #5# #6#)) \n\nThe fetching routine will remain unchanged, but the postfetch processing will have \nto sort through the nalists to find only the facts in the current world. It would also be \npossible for fetch to do this work, but the reasoning is that most facts will be indexed \nunder the \"real world,\" and only a few facts will exist in alternative, hypothetical \nworlds. Therefore, we should delay the effort of sorting through the answers to \neliminate those answers in the wrong world - it may be that the first answer fetched \nwill suffice, and then it would have been a waste to go through and eliminate other \nanswers. The following changes to i ndex and dtree -i ndex add support for worlds: \n\n(defvar *world* *W0 \"The current world used by index and fetch.\") \n\n(defun index (key &optional (world *world*)) \n\"Store key in a dtree node. Key must be (predicate . args); \nit is stored in the dtree, indexed by the world.\" \n(dtree-index key key world (get-dtree (predicate key)))) \n\n(defun dtree-index (key value world dtree) \n\"Index value under all atoms of key in dtree.\" \n(cond \n\n((consp key) ; index on both first and rest \n(dtree-index (first key) value world \n(or (dtree-first dtree) \n(setf (dtree-first dtree) (make-dtree)))) \n(dtree-index (rest key) value world \n(or (dtree-rest dtree) \n(setf (dtree-rest dtree) (make-dtree))))) \n((null key)) ; don't index on nil \n\n((variable-p key) ; index a variable \n(nalist-push world value (dtree-var dtree))) \n(t ;; Make sure there is an nlist for this atom, and add to it \n(nalist-push world value (lookup-atom key dtree))))) \n\nThe new function nalist-push adds a value to an nalist, either by inserting the value \nin an existing key's list or by adding a new key/value list: \n\n\f\n<a id='page-499'></a>\n(defun nalist-push (key val nalist) \n\"Index val under key in a numbered al ist. \" \n;; An nalist is of the form (count (key val*)*) \n\nEx: (6 (nums 1 2 3) (letters a b c)) \n(incf (car nalist)) \n(let ((pair (assoc key (cdr nalist)))) \n\n(if pair \n(push val (cdr pair)) \n(push (list key val) (cdr nalist))))) \n\nIn the following, fetch is used on the same data base created by tes t -i ndex, indexed \nunder the world WO. This time the result is a list-of-lists of world/values a-lists. The \ncount, 3, is the same as before. \n\n> (fetch '(p ?x c)) \n(((WO (P . C) (P A C))) \n((WO (P A ?X)))) \n3 \n\nSo far, worlds have been represented as symbols, with the implication that different \nsymbols represent completely distinct worlds. That doesn't make worlds very easy \nto use. We would like to be able to use worlds to explore alternatives - create a \nnew hypothetical world, make some assumptions (by asserting them as facts in the \nhypothetical world), and see what can be derived in that world. It would be tedious \nto have to copy all the facts from the real world into each hypothetical world. \n\nAn alternative is to establish an inheritance hierarchy among worlds. Then a fact \n\nis considered true if it is indexed in the current world or in any world that the current \n\nworld inherits from. \n\nTo support inheritance, we will implement worlds as structures with a name field \nand a field for the list of parents the world inherits from. Searching through the \ninheritance lattice could become costly, so we will do it only once each time the user \nchanges worlds, and mark all the current worlds by setting the current field on or \noff. Here is the definition for the world structure: \n\n(defstruct (world (:print-function print-world)) \nname parents current) \n\nWe will need a way to get from the name of a world to the world structure. Assuming \nnames are symbols, we can store the structure on the name's property list. The \nfunction get-worl d gets the structure for a name, or builds a new one and stores it. \nget - wor 1 d can also be passed a world instead of a name, in which case it just returns \nthe world. We also include a definition of the default initial world. \n\n\f\n<a id='page-500'></a>\n\n(defun get-world (name &optional current (parents (list *world*))) \n\"Look up or create the world with this name. \nIf the world is new, give it the list of parents.\" \n(cond ((world-p name) name) ; ok if it already is a world \n\n((get name 'world)) \n(t (setf (get name 'world) \n(make-world rname name .-parents parents \n.'current current))))) \n\n(defvar *world* (get-world 'WO nil nil) \n\"The current world used by index and fetch.\") \n\nThe function use-worl d is used to switch to a new world. It first makes the current \nworld and all its parents no longer current, and then makes the new chosen world and \nall its parents current. The function use-new-worl d is more efficient in the common \ncase where you want to create a new world that inherits from the current world. It \ndoesn't have to turn any worlds off; it j ust creates the new world and makes it current. \n\n(defun use-world (world) \n\"Make this world current.\" \n;; If passed a name, look up the world it names \n(setf world (get-world world)) \n(unless (eq world *world*) \n\nTurn the old world(s) off and the new one(s) on, \n;; unless we are already using the new world \n(set-world-current *world* nil) \n(set-world-current world t) \n(setf *world* world))) \n\n(defun use-new-world () \n\"Make up a new world and use it. \nThe world inherits from the current world.\" \n(setf *world* (get-world (gensym \"W\"))) \n(setf (world-current *world*) t) \n*world*) \n\n(defun set-world-current (world on/off) \n\"Set the current field of world and its parents on or off.\" \n\nnil is off, anything else is on. \n(setf (world-current world) on/off) \n(dolist (parent (world-parents world)) \n\n(set-world-current parent on/off))) \n\nWe also add a print function for worlds, which just prints the world's name. \n\n\f\n<a id='page-501'></a>\n(defun print-world (world &optional (stream t) depth) \n(declare (ignore depth)) \n(prinl (world-name world) stream)) \n\nThe format of the dtree data base has changed to include worlds, so we need \nnew retrieval functions to search through this new format. Here the functions \nmapc-retrieve, retrieve, and retrieve-bagof are modified to give new versions \nthat treat worlds. To reflect this change, the new functions all have names ending in \n\n-in-world: \n\n(defun mapc-retrieve-in-world (fn query) \n\"For every fact in the current world that matches the query, \napply the function to the binding list. \" \n(dolist (bucket (fetch query)) \n\n(dolist (world/entries bucket) \n(when (world-current (first world/entries)) \n(dolist (answer (rest world/entries)) \n(let ((bindings (unify query answer))) \n(unless (eq bindings fail) \n(funcall fn bindings)))))))) \n\n(defun retrieve-in-world (query) \n\"Find all facts that match query. Return a list of bindings.\" \n(let ((answers nil)) \n\n(mapc-retrieve-in-world \n#'(lambda (bindings) (push bindings answers)) \nquery) \n\nanswers)) \n\n(defun retrieve-bagof-in-world (query) \n\"Find all facts in the current world that match query. \nReturn a list of queries with bindings filled in. \" \n(mapcar #'(lambda (bindings) (subst-bindings bindings query)) \n\n(retrieve-in-world query))) \n\nNow let's see how these worlds work. First, in WO we see that the facts from \ntest -i ndex are still in the data base: \n\n> *world* ^ WO \n\n> (retrieve-bagof-in-world *(p ?z c)) ^ \n((P A C) (P A C) (P . .) \n\n\f\n<a id='page-502'></a>\n\nNow we create and use a new world that inherits from WO. Two new facts are added \nto this new world: \n\n> (use-new-world) W7031 \n> (index *(p new c)) => . \n> (index 'Cp b b)) => . \n\nWe see that the two new facts are accessible in this world: \n\n> (retrieve-bagof-in-world '(p ?z c)) \n((P A C) (P A C) (P . C) (P NEW O) \n\n> (retrieve-bagof-in-world '(^p ?x ?y)) ^ \n((~P . .)) \n\nNow we create another world as an alternative to the current one by first switching \nback to the original WO, then creating the new world, and then adding some facts: \n\n> (use-world *W0) WO \n\n> (use-new-world) W7173 \n\n> (index *(p newest c)) ^ . \n> (index '(~p c newest)) . \n\nHere we see that the facts entered in W7031 are not accessible, but the facts in the new \nworld and in WO are: \n\n> (retrieve-bagof-in-world '(p ?z c)) => \n((P A C) (P A C) (P . C) (P NEWEST O) \n\n> (retrieve-bagof-in-world '(^p ?x ?y)) \nir? C NEWEST)) \n\nUnification, Equality, Types, and Skolem Constants \n\nThe lesson of the zebra puzzle in section 11.4 was that unification can be used to \nlessen the need for backtracking, because an uninstantiated logic variable or partially \ninstantiated term can stand for a whole range of possible solutions. However, this \nadvantage can quickly disappear when the representation forces the problem solver \nto enumerate possible solutions rather than treating a whole range of solutions as one. \nFor example, consider the following query in the frame language and its expansion \ninto primitives: \n\n\f\n<a id='page-503'></a>\n(a person (name Fran)) \n= (and (ind ?p person) (val name ?p fran)) \n\nThe way to answer this query is to enumerate all individuals ?p of type person and \nthen check the name slot of each such person. It would be more efficient if (i nd ?p \nperson) did not act as an enumeration, but rather as a constraint on the possible \nvalues of ?p. This would be possible if we changed the definition of variables (and \nof the unification function) so that each variable had a type associated with it. In \nfact, there are at least three sources of information that have been implemented as \nconstraints on variables terms: \n\n* The type or category of the term. \n* The members or size of a term considered as a set or list. \n* Other terms this term is equal or not equal to. \nNote that with a good solution to the problem of equality, we can solve the problem \nof Skolem constants. The idea is that a regular constant unifies with itself but no \nother regular constant. On the other hand, a Skolem constant can potentially unify \nwith any other constant (regular or Skolem). The equality mechanism is used to keep \ntrack of each Skolem variable's possible bindings. \n\n14.11 History and References \nBrachman and Levesque (1985) collect thirty of the key papers in knowledge representation. \nIncluded are some early approaches to semantic network based (Quillian \n1967) and logic-based (McCarthy 1968) representation. Two thoughtful critiques \nof the ad hoc use of representations without defining their meaning are by Woods \n(1975) and McDermott (1978). It is interesting to contrast the latter with McDermott \n1987, which argues that logic by itself is not sufficient to solve the problems of AI. \nThis argument should not be surprising to those who remember the slogan logic = \nalgonthm -control. \n\nGenesereth and Nilsson's textbook (1987) cover the predicate-calculus-based approach \nto knowledge representation and AI in general. Ernest Davis (1990) presents \na good overview of the field that includes specialized representations for time, space, \nqualitative physics, propositional attitudes, and the interaction between agents. \n\nMany representation languages focus on the problem of defining descriptions for \ncategories of objects. These have come to be known as term-subsumption languages. \nExamples include KL-ONE (Schmolze and Lipkis 1983) and KRYPTON (Brachman, \nFikes, and Levesque 1983). See Lakoff 1987 for much more on the problem of \ncategories and prototypes. \n\n\f\n<a id='page-504'></a>\n\nHector Levesque (1986) points out that the areas Prolog has difficulty with - \ndisjunction, negation, and existentials - all involve a degree of vagueness. In his \nterm, they lack vividness. A vivid proposition is one that could be represented \ndirectly in a picture: the car is blue; she has a martini in her left hand; Albany is the \ncapital of New York. Nonvivid propositions cannot be so represented: the car is not \nblue; she has a martini in one hand; either Albany or New York City is the capital \nof New York. There is interest in separating vivid from nonvivid reasoning, but no \ncurrent systems are actually built this way. \n\nThe possible world approach of section 14.10 was used in the MRS system (Russell \n1985). More recent knowledge representation systems tend to use truth maintenance \nsystems instead of possible worlds. This approach was pioneered by Doyle (1979) \nand McAllester (1982). Doyle tried to change the name to \"reason maintenance,\" in \n(1983), but it was too late. The version in widest used today is the assumption-based \ntruth maintenance system, or ATMS, developed by de Kleer (1986a,b,c). Charniak \net al. (1987) present a complete Common Lisp implementation of a McAllesterstyleTMS. \n\n\nThere is little communication between the logic programming and knowledge \nrepresentation communities, even though they cover overlapping territory. Colmerauer \n(1990) and Cohen (1990) describe Logic Programming languages that address \nsome of the issues covered in this chapter. Key papers in equality reasoning include \nCaller and Fisher 1974, Kornfeld 1983,^ Jaffar, Lassez, and Maher 1984, and van \nEmden and Yukawa 1987. H&ouml;dobler's book (1987) includes an overview of the area. \nPapers on extending unification in ways other than equality include Ait-Kaci et al. \n1987 and Staples and Robinson 1988. Finally, papers on extending Prolog to cover \ndisjunction and negation (i.e., non-Horn clauses) include Loveland 1987, Plaisted \n1988, and Stickell988. \n\n14.12 Exercises \n&#9635; Exercise 14.1 [m] Arrange to store dtrees in a hash table rather than on the property \nlist of predicates. \n\n&#9635; Exercise 14.2 [m] Arrange to store the dtree-atoms in a hash table rather than in \nan association list. \n\n&#9635; Exercise 14.3 [m] Change the dtree code so that .i 1 is used as an atom index. Time \nthe performance on an application and see if the change helps or hurts. \n\n^ A commentary on this paper appears in Elcock and Hoddinott 1986. \n\n\f\n<a id='page-505'></a>\n&#9635; Exercise 14.4 [m] Consider the query (. a b c d e f g). If the index under a \nreturns only one or two keys, then it is probably a waste of time for dtree-fetc h \nto consider the other keys in the hope of finding a smaller bucket. It is certainly \na waste if there are no keys at all indexed under a. Make appropriate changes to \ndtree-fetch . \n\n&#9635; Exercise 14.5 [h] Arrange to delete elements from a dtree. \n\n&#9635; Exercise 14.6 [h] Implement iterative-deepening search in the Prolog compiler. \nYou will have to change each function to accept the depth as an extra argument, and \ncompile in checks for reaching the maximum depth. \n\n&#9635; Exercise 14.7 [d] Integrate the Prolog compiler with the dtree data base. Use \nthe dtrees for predicates with a large number of clauses, and make sure that each \npredicate that is implemented as a dtree has a Prolog primitive accessing the dtree. \n\n&#9635; Exercise 14.8 [d] Add support for possible worlds to the Prolog compiler with \ndtrees. This support has already been provided for dtrees, but you will have to \nprovide it for ordinary Prolog rules. \n\n&#9635; Exercise 14.9 [h] Integrate the language described in section 14.10 and the frame \nsyntax from section 14.10 with the extended Prolog compiler from the previous \nexercise. \n\n&#9635; Exercise 14.10 [d] Build a strategic reasoner that decides when to create a possible \nworld and does reasoning by cases over these worlds. Use it to solve Moore's problem \n([page 466](chapter14.md#page-466)). \n\n\f\n<a id='page-506'></a>\n\n14.13 Answers \nAnswer 14.1 \n\n(let ((dtrees (make-hash-table :test #'eq))) \n\n(defun get-dtree (predicate) \n\"Fetch (or make) the dtree for this predicate.\" \n(setf (gethash predicate dtrees) \n\n(or (gethash predicate dtrees) \n(make-dtree)))) \n\n(defun clear-dtrees () \n\"Remove all the dtrees for all the predicates.\" \n(clrhash dtrees))) \n\nAnswer 14.5 Hint: here is the code for nl i st - del ete. Now figure out how to find \nall the nlists that an item is indexed under. \n\n(defun nlist-delete (item nlist) \n\"Remove an element from an nlist . \nAssumes that item is present exactly once.\" \n(decf (car nlist)) \n(setf (cdr nlist) (delete item (cdr nlist) rcount D) \nnlist) \n\n\f\n## Chapter 15\n<a id='page-509'></a>\n\nSymbolic Mathematics \nwith Canonical Forms \n\nAnything simple always interests me. \n\n-David Hockney \n\nC\nC\nhapter 8 started with high hopes: to take an existing pattern matcher, copy down some \nmathematical identities out of a reference book, and come up with a usable symbolic \nalgebra system. The resulting system was usable for some purposes, and it showed \nthat the technique of rule-based translation is a powerful one. However, the problems of \nsection 8.5 show that not everything can be done easily and efficiently within the rule-based \npattern matching framework. \n\nThere are important mathematical transformations that are difficult to express in the rule-\nbased approach. For example, dividing two polynomials to obtain a quotient and remainder is \na task that is easier to express as an algorithm - a program - than as a rule or set of rules. \n\n\f\n<a id='page-510'></a>\n\nIn addition, there is a problem with efficiency. Pieces of the input expressions are \nsimplified over and over again, and much time is spent interpreting rules that do not \napply. Section 9.6 showed some techniques for speeding up the program by a factor \nof 100 on inputs of a dozen or so symbols, but for expressions with a hundred or so \nsymbols, the speed-up is not enough. We can do better by designing a specialized \nrepresentation from the ground up. \n\nSerious algebraic manipulation programs generally enforce a notion of canonical \nsimplification. That is, expressions are converted into a canonical internal format that \nmay be far removed from the input form. They are then manipulated, and translated \nback to external form for output. Of course, the simplifier we have already does this \nkind of translation, to some degree. It translates (3 + . + -3+ y) into (+ . y) \ninternally, and then outputs it as (. + y). But a canonical representation must have \nthe property that any two expressions that are equal have identical canonical forms. \nIn our system the expression (5 + y + x+ -5)is translated to the internal form (+ \ny .), which is not identical to (+ x y), even though the two expressions are equal. \nThus, our system is not canonical. Most of the problems of the previous section stem \nfrom the lack of a canonical form. \n\nAdhering to canonical form imposes grave restrictions on the representation. For \nexample, -1 and {x -l){x are equal, so they must be represented identically. \nOne way to insure this is to multiply out all factors and collect similar terms. So \n{x-l){x-\\-l)isx^ -x + x-l , which simplifies to x^ -1, in whatever the canonical \ninternal form is. This approach works fine for x^ - 1, but for an expression like \n{x -1 )1000^ multiplying out all factors would be quite time- (and space-) consuming. \nIt is hard to find a canonical form that is ideal for all problems. The best we can do is \nchoose one that works well for the problems we are most likely to encounter. \n\n15.1 A Canonical Form for Polynomials \nThis section will concentrate on a canonical form for polynomials. Mathematically \nspeaking, a polynomial is a function (of one or more variables) that can be computed \nusing only addition and multiplication. We will speak of a polynomial's main variable, \ncoefficents, and degree. In the polynomial: \n\n5xx^-\\-hxx^-\\-cxx-\\-l \n\nthe main variable isx, the degree is 3 (the highest power of x), and the coefficients \nare 5,6, c and 1. We can define an input format for polynomials as follows: \n\n1. Any Lisp number is a polynomial. \n2. Any Lisp symbol is a polynomial. \n\f\n<a id='page-511'></a>\n3. lip and q are polynomials, so are (p + ^) and (p* q). \n4. If . is a polynomial and . is a positive integer, then (p \" .) is a polynomial. \nHov^ever, the input format cannot be used as the canonical form, because it would \nadmit both (X + y)and(y + x), and both 4 and (2 + 2). \n\nBefore considering a canonical form for polynomials, let us see why polynomials \nwere chosen as the target domain. First, the volume of programming needed to support \ncanonical forms for a larger class of expressions grows substantially. To make \nthings easier, we have eliminated complications like log and trig functions. Polynomials \nare a good choice because they are closed under addition and multiplication: \nthe sum or product of any two polynomials is a polynomial. If we had allowed division, \nthe result would not be closed, because the quotient of two polynomials need \nnot be a polynomial. As a bonus, polynomials are also closed under differentiation \nand integration, so we can include those operators as well. \n\nSecond, for sufficiently large classes of expressions it becomes not just difficult \nbut impossible to define a canonical form. This may be surprising, and we don't \nhave space here to explain exactly why it is so, but here is an argument: Consider \nwhat would happen if we added enough functionality to duplicate all of Lisp. Then \n\"converting to canonical form\" would be the same as \"running a program.\" But it \nis an elementary result of computability theory that it is in general impossible to \ndetermine the result of running an arbitrary program (this is known as the halting \nproblem). Thus, it is not surprising that it is impossible to canonicalize complex \nexpressions. \n\nOur task is to convert a polynomial as previously defined into some canonical \nf orm.^ Much of the code and some of the commentary on this format and the routines \nto manipulate it was written by Richard Fateman, with some enhancements made \nby Peter Klier. \n\nThe first design decision is to assume that we will be dealing mostly with dense \npolynomials, rather than sparse ones. That is, we expect most of the polynomials \nto be like ax^ -f bx^ .-cx -\\-d, not like ax^^^ -|-bx^^ -h c. For dense polynomials, \nwe can save space by representing the main variable {x in these examples) and the \nindividual coefficients (a, 6, c, and d in these examples) explicitly, but representing \nthe exponents only implicitly, by position. Vectors will be used instead of Usts, to \nsave space and to allow fast access to any element. Thus, the representation of \n\n+ lOx^ + 20a: + 30 wiU be the vector: \n#(x 30 20 10 5) \n\n^ In fact, the algebraic properties of polynomial arithmetic and its generalizations fit so well \nwith ideas in data abstraction that an extended example (in Scheme) on this topic is provided \ninStructure and Interpretation of Computer Programs by Abelson and Sussman (see section 2.4.3, \npages 153-166). We'll pursue a slightly different approach here. \n\n\f\n<a id='page-512'></a>\n\nThe main variable, x, is in the 0th element of the vector, and the coefficient of the \nith power of x is in element i + 1 of the vector. A single variable is represented as a \nvector whose first coefficient is 1, and a number is represented as itself: \n\n#(x 30 20 10 5) represents5x^ + lOx^ + 20x + 30 \n\n#(x 0 1) representsX \n\n5 represents 5 \n\nThe fact that a number is represented as itself is a possible source of confusion. The \nnumber 5, for example, is a polynomial by our mathematical definition of polynomials. \nBut it is represented as 5, not as a vector, so (typep 5 ' pol ynomi al) will be \nfalse. The word \"polynomial\" is used ambiguously to refer to both the mathematical \nconcept and the Lisp type, but it should be clear from context which is meant. \n\nA glossary for the canonical simplifier program is given in figure 15.1. \n\nThe functions defining the type polynomial follow. Because we are concerned \nwith efficiency, we proclaim certain short functions to be compiled inline, use the \nspecific function svref (simple-vector reference) rather than the more general aref, \nand provide declarations for the polynomials using the special form the. More details \non efficiency issues are given in Chapter 9. \n\n(proclaim '(inline main-var degree coef \nvar= var> poly make-poly)) \n\n(deftype polynomial () 'simple-vector) \n\n(defun main-var (p) (svref (the polynomial p) 0)) \n\n(defun coef (p i) (svref (the polynomial p) (+ i 1))) \n\n(defun degree (p) (- (length (the polynomial p)) 2)) \n\nWe had to make another design decision in defining coef, the function to extract a \ncoefficient from a polynomial. As stated above, the zth coefficient of a polynomial is \nin element i + 1 of the vector. If we required the caller of coef to pass in . .-1 to get \n2, we might be able to save a few addition operations. The design decision was that \nthis would be too confusing and error prone. Thus, coef expects to be passed i and \ndoes the addition itself. \n\nFor our format, we will insist that main variables be symbols, while coefficients \ncan be numbers or other polynomials. A \"production\" version of the program might \nhave to account for main variables like (sin .), as well as other complications like + \nand * with more than two arguments, and noninteger powers. \n\nNow we can extract information from a polynomial, but we also need to build \nand modify polynomials. The function poly takes a variable and some coefficients \nand builds a vector representing the polynomial, make-pol y takes a variable and a \ndegree and produces a polynomial with all zero coefficients. \n\n\f\n<a id='page-513'></a>\ncanon-simplifier \ncanon \n\npolynomial \n\nprefix->canon \ncanon->prefix \npoly+poly \npoly*poly \npoly^n \nderiv-poly \n\npoly \nmake-poly \ncoef \nmain-var \ndegree \nvar= \nvar> \npoly-ipoly-\nk->-poly \nk*poly \npoly+same \npoly*same \nnormalize-poly \nexponent->prefix \nargs->prefix \nrat-numerator \nrat-denominator \nrat*rat \nrat->-rat \nrat/rat \n\nTop-Level Fimctions \nA read-canonicalize-print loop. \nCanonicalize argument and convert it back to infix. \nData Types \nA vector of main variable and coefficients. \nMajor Functions \nConvert a prefix expression to canonical polynomial. \nConvert a canonical polynomial to a prefix expression. \nAdd two polynomials. \nMultiply two polynomials. \nRaise polynomial . to the nth power, n>=0. \nReturn the derivative, dp/dx, of the polynomial p. \nAuxiliary Fimctions \nConstruct a polynomial with given coefficients. \nConstruct a polynomial of given degree. \nPick out the ith coefficient of a polynomial. \nThe main variable of a polynomial. \nThedegreeof a polynomial; (degree x^) = 2. \nAre two variables identical? \nIs one variable ordered before another? \nUnary or binary polynomial addition. \nUnary or binary polynomial subtraction. \nAdd a constant k to a polynomial p. \nMultiply a polynomial . by a constant k. \nAdd two polynomials with the same main variable. \nMultiply two polynomials with the same main variable. \nAlter a polynomial by dropping trailing zeros. \nUsed to convert to prefix. \nUsed to convert to prefix. \nSelect the numerator of a rational. \n\nSelect the denominator of a rational. \nMultiply two rationals. \nAdd two rationals. \nDivide two rationals. \n\nFigure 15.1: Glossary for the Symbolic Manipulation Program \n\n\f\n<a id='page-514'></a>\n\n(defun poly (x &rest coefs) \n\"Make a polynomial with main variable . \nand coefficients in increasing order.\" \n(apply #.vector . coefs)) \n\n(defun make-poly (x degree) \n\"Make the polynomial 0 + 0*x + 0*x''2 + ... 0*x\"degree\" \n(let ((p (make-array (+ degree 2) :initial-element 0))) \n\n(setf (main-var p) x) \n\nP)) \n\nA polynomial can be altered by setting its main variable or any one of its coefficients \nusing the following defsetf forms. \n\n(defsetf main-var (p) (val) \n*(setf (svref (the polynomial ,p) 0) ,val)) \n\n(defsetf coef (p i) (val) \n\n'(setf (svref (the polynomial ,p) (+ .i D) .val)) \nThe function pol y constructs polynomials in a fashion similar to 1 i st or vector: with \nan explicit list of the contents, make-poly, on the other hand, is like make-a may: it \nmakes a polynomial of a specified size. \n\nWe provide setf methods for modifying the main variable and coefficients. Since \nthis is the first use of defsetf, it deserves some explanation. A defsetf form takes \na function (or macro) name, an argument list, and a second argument list that must \nconsist of a single argument, the value to be assigned. The body of the form is an \nexpression that stores the value in the proper place. So the defsetf for ma 1 .- va r says \nthat (setf (main-var p) val) is equivalent to (setf (svref (the polynomial p) \n\n0) val). A defsetf is much like a defmacro, but there is a little less burden placed \non the writer of defsetf. Instead of passing . and val directly to the setf method. \nCommon Lisp binds local variables to these expressions, and passes those variables \nto the setf method. That way, the writer does not have to worry about evaluating \nthe expressions in the wrong order or the wrong number of times. It is also possible \nto gain finer control over the whole process with def i ne-setf-method, as explained \non [page 884](chapter25.md#page-884). \nThe functions poly+poly, poly*poly and poly'n perform addition, multiplication, \nand exponentiation of polynomials, respectively. They are defined with several \nhelping functions. k*poly multipHes a polynomial by a constant, k, which may \nbe a number or another polynomial that is free of polynomial p's main variable. \npoly*same is used to multiply two polynomials with the same main variable. For \naddition, the functions k+poly and poly+same serve analogous purposes. With that \nin mind, here's the function to convert from prefix to canonical form: \n\n\f\n<a id='page-515'></a>\n(defun prefix->canon (x) \n\"Convert a prefix Lisp expression to canonical form. \nExs; (+ X 2) (* 3 x)) => #(x 0 3 1) \n\n(- (* (-X 1) (+ X D) (- (^ X 2) D) => 0\" \n\n(cond ((numberp x) x) \n((symbolp x) (poly . 0 D) \n((and (exp-p x) (get (exp-op x) 'prefix->canon)) \n\n(apply (get (exp-op x) 'prefix->canon) \n(mapcar #'prefix->canon (exp-args x)))) \n(t (error \"Not a polynomial: ~a\" x)))) \n\nIt is data-driven, based on the pref ix->canon property of each operator. In the \nfollowing we install the appropriate functions. The existing functions poly*poly \nand poly'n can be used directly. But other operators need interface functions. The \noperators + and - need interface functions that handle both unary and binary. \n\n(dolist (item '((+ poly+) (- poly-) (* poly*poly) \n(\" poly^n) (D deriv-poly))) \n(setf (get (first item) *prefix->canon) (second item))) \n\n(defun poly+ (&rest args) \n\"Unary or binary polynomial addition.\" \n(ecase (length args) \n\n(1 (first args)) \n\n(2 (poly+poly (first args) (second args))))) \n\n(defun poly- (&rest args) \n\"Unary or binary polynomial subtraction.\" \n(ecase (length args) \n\n(1 (poly*poly -1 (first args))) \n(2 (poly+poly (first args) (poly*poly -1 (second args)))))) \n\nThe function pref ix->canon accepts inputs that were not part of our definition of \npolynomials: unary positive and negation operators and binary subtraction and \ndifferentiation operators. These are permissible because they can all be reduced to \nthe elementary + and * operations. \n\nRemember that our problems with canonical form all began with the inability to \ndecide which was simpler: (+ . y) or (+ y .). In this system, we define a canonical \nform by imposing an ordering on variables (we use alphabetic ordering as defined by \nstri ng>). The rule is that a polynomial . can have coefficients that are polynomials \nin a variable later in the alphabet than p's main variable, but no coefficients that \nare polynomials in variables earlier than p's main variable. Here's how to compare \nvariables: \n\n(defun var= (x y) (eq . y)) \n(defun var> (x y) (string> . y)) \n\n\f\n<a id='page-516'></a>\n\nThe canonical form of the variable . will be #(x 0 1), which is 0 x x<sup>0</sup> + 1 x x<sup>1</sup>. The \ncanonical form of (+ . y) is #(x #(y 0 1) 1). It couldn't be #(y #(x 0 1) 1), \nbecause then the resulting polynomial would have a coefficient with a lesser main \nvariable. The policy of ordering variables assures canonicality, by properly grouping \nlike variables together and by imposing a particular ordering on expressions that \nwould otherwise be commutative. \n\nHere, then, is the code for adding two polynomials: \n\n(defun poly+poly (p q) \n\"Add two polynomials.\" \n(normal ize-poly \n\n(cond \n((numberp p) (k+poly . q)) \n((numberp q) (k+poly q p)) \n((var= (main-var p) (main-var q)) (poly+same . q)) \n((var> (main-var q) (main-var p)) (k+poly q p)) \n(t (k+poly . q))))) \n\n(defun k+poly (k p) \n\"Add a constant k to a polynomial p.\" \n(cond ((eql k 0) p) 0 + . = . \n\n((and (numberp k)(numberp p)) \n(+ k p)) Add numbers \n\n(t (let ((r (copy-poly p))) Add k to x\"0 term of . \n(setf (coef r 0) (poly+poly (coef r 0) k)) \nr)))) \n\n(defun poly+same (p q) \n\"Add two polynomials with the same main variable.\" \nFirst assure that q is the higher degree polynomial \n\n(if (> (degree p) (degree q)) \n(poly+same q p) \n;; Add each element of . into r (which is a copy of q). \n(let ((r (copy-poly q))) \n\n(loop for i from 0 to (degree p) do \n(setf (coef r i) (poly+poly (coef r i) (coef . i)))) \nr))) \n\n(defun copy-poly (p) \n\"Make a copy a polynomial.\" \n(copy-seq p)) \n\n\f\n<a id='page-517'></a>\nand the code for multiplying polynomials: \n\n(defun poly*poly (p q) \n\"Multiply two polynomials.\" \n(normal ize-poly \n\n(cond \n((numberp p) (k*poly . q)) \n((numberp q) (k*poly q p)) \n((var= (main-var p) (main-var q)) (poly*same . q)) \n((var> (main-var q) (main-var p)) (k*poly q p)) \n(t (k*poly . q))))) \n\n(defun k*poly (k p) \n\"Multiply a polynomial . by a constant factor k.\" \n(cond \n\n((eql k 0) 0) ;; 0 * . = 0 \n((eql k 1) p) ;; 1 * . = . \n((and (numberp k) \n\n(numberp p)) (* k p)) Multiply numbers \n(t Multiply each coefficient \n(let ((r (make-poly (main-var p) (degree p)))) \nAccumulate result in r; rCi] = k*pCi] \n(loop for i from 0 to (degree p) do \n(setf (coef r i) (poly*poly k (coef . i)))) \nr)))) \n\nThe hard part is multiplying two polynomials with the same main variable. This \nis done by creating a new polynomial, r, whose degree is the sum of the two input \npolynomials . and q. Initially, all of r's coefficients are zero. A doubly nested \nloop multiplies each coefficient of . and q and adds the result into the appropriate \ncoefficient of r. \n\n(defun poly*same (p q) \n\"Multiply two polynomials with the same variable.\" \nrCi] = pCO]*qCi] + pCl]*qCi-l] + ... \n(let* ((r-degree (+ (degree p) (degree q))) \n(r (make-poly (main-var p) r-degree))) \n(loop for i from 0 to (degree p) do \n(unless (eql (coef . i) 0) \n(loop for j from 0 to (degree q) do \n(setf (coef r (+ i j)) \n(poly+poly (coef r (+ i j)) \n(poly*poly (coef . i) \n(coef q j))))))) \nr)) \n\n\f\n<a id='page-518'></a>\n\nBoth poly+poly and poly*poly make use of the function normal ize-poly to \"normalize\" \nthe result. The idea is that (- . 5) (\". 5)) should return O, not \n#(xOOOOOO). Note that normal ize-poly is a destructive operation: it calls \ndel ete, which can actually alter its argument. Normally this is a dangerous thing, \nbut since norma1 i ze - poly is replacing something with its conceptual equal, no harm \nis done. \n\n(defun normalize-poly (p) \n\"Alter a polynomial by dropping trailing zeros.\" \n(if (numberp p) \n\n. \n(let ((p-degree (- (position 0 . itest (complement #'eql) \n:from-end t) \n1))) \n(cond ((<= p-degree 0) (normalize-poly (coef . 0))) \n((< p-degree (degree p)) \n(delete 0 . .-start p-degree)) \n(t p))))) \n\nThere are a few loose ends to clean up. First, the exponentiation function: \n\n(defun poly'n (p n) \n\"Raise polynomial . to the nth power, n>=0.\" \n(check-type . (integer 0 *)) \n(cond ((= . 0) (assert (not (eql . 0))) 1) \n\n((integerp p) (expt . .)) \n(t (poly*poly . (poly^n . (-. 1)))))) \n\n15.2 Differentiating Polynomials \nThe differentiation routine is easy, mainly because there are only two operators (+ \nand *) to deal with: \n\n(defun deriv-poly (p x) \n\"Return the derivative, dp/dx, of the polynomial p.\" \n;; If . is a number or a polynomial with main-var > x, \n\nthen . is free of x, and the derivative is zero; \n;; otherwise do real work. \n;; But first, make sure X is a simple variable, \n;; of the form #(X 0 1). \n(assert (and (typep . 'polynomial) (= (degree x) 1) \n\n(eql (coef . 0) 0) (eql (coef . 1) 1))) \n\n\f\n<a id='page-519'></a>\n\n(cond \n((numberp p) 0) \n((var> (main-var p) (main-var x)) 0) \n((var= (main-var p) (main-var x)) \n\nd(a + bx + cx^2 + dx^3)/dx = b + 2cx + 3dx'^2 \n\nSo, shift the sequence . over by 1, then \n;; put . back in, and multiply by the exponents \n(let ((r (subseq . 1))) \n\n(setf (main-var r) (main-var x)) \n(loop for i from 1 to (degree r) do \n(setf (coef r i) (poly*poly (+ i 1) (coef r i)))) \n(normalize-poly r))) \n\n(t Otherwise some coefficient may contain x. Ex: \nd(z + 3x + 3zx^2 + z^2x^3)/dz \n= 1 + 0 + 3x'^2 + 2zx\"3 \nSo copy p, and differentiate the coefficients, \n\n(let ((r (copy-poly p))) \n(loop for i from 0 to (degree p) do \n(setf (coef r i) (deriv-poly (coef r i) x))) \n(normalize-poly r))))) \n\n&#9635; Exercise 15.1 [h] Integrating polynomials is not much harder than differentiating \nthem. For example: \n\n&int; ax<sup>2</sup> + bx dx = ax<sup>3</sup>/3 + bx<sup>2</sup>/2 + c.\n\nWrite a function to integrate polynomials and install it in pref ix->canon. \n\n&#9635; Exercise 15.2 [m] Add support for definite integrals, such as y dx. You will \nneed to make up a suitable notation and properly install it in both infix->prefix \nand prefix->canon. A full implementation of this feature would have to consider \ninfinity as a bound, as well as the problem of integrating over singularities. You need \nnot address these problems. \n\n15.3 Converting between Infix and Prefix \nAll that remains is converting from canonical form back to prefix form, and from \nthere back to infix form. This is a good point to extend the prefix form to allow \nexpressions with more than two arguments. First we show an updated version of \npref i x->i nf i . that handles multiple arguments: \n\n\f\n<a id='page-520'></a>\n\n(defun prefix->infix (exp) \n\"Translate prefix to infix expressions. \nHandles operators with any number of args.\" \n(if (atom exp) \n\nexp \n\n(intersperse \n(exp-op exp) \n(mapcar #'prefix->infix (exp-args exp))))) \n\n(defun intersperse (op args) \n\"Place op between each element of args. \nEx: (intersperse '+ '(a b c)) => '(a + b + c)\" \n(if (length=1 args) \n\n(first args) \n\n(rest (loop for arg in args \ncollect op \ncollect arg)))) \n\nNow we need only convert from canonical form to prefix: \n\n(defun canon->prefix (p) \n\"Convert a canonical polynomial to a lisp expression.\" \n(if (numberp p) \n\n. \n\n(args->prefix \n'+ 0 \n(loop for i from (degree p) downto 0 \n\ncollect (args->prefix \n'* 1 \n(list (canon->prefix (coef pi)) \n\n(exponent->prefix \n(main-var p) i))))))) \n\n(defun exponent->prefix (base exponent) \n\"Convert canonical base^exponent to prefix form.\" \n(case exponent \n\n(0 1) \n(1 base) \n(t *(\" .base .exponent)))) \n\n(defun args->prefix (op identity args) \n\"Convert argl op arg2 op ... to prefix form.\" \n(let ((useful-args (remove identity args))) \n\n(cond ((null useful-args) identity) \n((and (eq op '*) (member 0 args)) 0) \n((length=1 args) (first useful-args)) \n(t (cons op (mappend \n\n#*(lambda (exp) \n\n\f\n<a id='page-521'></a>\n(if (starts-with exp op) \n(exp-args exp) \n(list exp))) \n\nuseful-args)))))) \n\nFinally, here's a top level to make use of all this: \n\n(defun canon (infix-exp) \n\"Canonicalize argument and convert it back to infix\" \n(prefix->infix \n\n(canon->prefix \n(prefix->canon \n(infix->prefix infix-exp))))) \n\n(defun canon-simplifier () \n\"Read an expression, canonicalize it. and print the result.\" \n(loop \n\n(print 'canon>) \n(print (canon (read))))) \n\nand an example of it in use: \n\n> (canon-simplifier) \nCANON> (3 + X + 4 - X) \n7 \nCANON> (X + y + y + X) \n((2 * .) + (2 * Y)) \nCANON> (3 * X + 4 * X) \n(7 * X) \nCANON> (3*x + y + x + 4*x) \n((8 * X) + Y) \nCANON> (3*x + y + z + x + 4*x) \n((8 * X) + (Y + Z)) \nCANON> ((X + 1) ^ 10) \n((X ^ 10) + (10 * (X ^ 9)) + (45 * (X ^ 8)) + (120 * (X ^ 7)) \n\n+ (210 * (X ^ 6)) + (252 * (X ^ 5)) + (210 * (X ^ 4)) \n+ (120 * (X 3)) + (45 * (X ^ 2)) + (10 * X) + 1) \nCAN0N> ((X + 1) 10 + (X - 1) ^ 10) \n((2 * (X ^ 10)) + (90 * (X ^ 8)) + (420 * (X ^ 6)) \n+ (420 * (X ^ 4)) + (90 * (X ^ 2)) + 2) \nCAN0N> ((X + 1) ^ 10 - (X - 1) ^ 10) \n((20 * (X ^ 8)) + (240 * (X ^ 7)) + (504 * (X ^ 5)) \n+ (240 * (X ^ 3)) + (20 * X)) \nCAN0N> (3 * X ^ 3 + 4 * X * y * (X - 1) + X ^ 2 * (X + y)) \n((4 * (X ^ 3)) + ((5 * Y) * (X ^ 2)) + ((-4 * Y) * X)) \nCAN0N> (3*x^3 + 4*x*w*(x-l)+x^2*( x + w)) \n((((5 * (X ^ 2)) + (-4 * X)) * W) + (4 * (X ^ 3))) \n\f\n<a id='page-522'></a>\n\nCANON> (d (3 * X ^ 2 + 2 * X + 1) / d X) \n((6 * X) + 2) \nCANON> (d(z +3*x+3*z*x^2+z^2*x^3)/dz) \n(((2 * Z) * (X ^ 3)) + (3 * (X ^ 2)) + 1) \nCANON> [Abort] \n\n15.4 Benchmarking the Polynomial Simplifier \nUnlike the rule-based program, this version gets all the answers right. Not only is the \nprogram correct (at least as far as these examples go), it is also fast. We can compare \nit to the canonical simplifier originally written for MACSYMA by William Martin (circa \n1968), and modified by Richard Fateman. The modified version was used by Richard \nGabriel in his suite of Common Lisp benchmarks (1985). The benchmark program \nis called f rpo1y, because it deals with polynomials and was originally written in \nthe dialect Franz Lisp. The f rpoly benchmark encodes polynomials as lists rather \nthan vectors, and goes to great lengths to be efficient. Otherwise, it is similar to the \nalgorithms used here (although the code itself is quite different, using progs and gos \nand other features that have fallen into disfavor in the intervening decades). The \nparticular benchmark we will use here is raising 1-\\- . -\\-y -\\-ziothe 15th power: \n\n(defun rl5-test () \n\n(let ((r (prefix->canon *(+ 1 (+ . (+ y .)))))) \n\n(time (poly^n r 15)) \n\nnil)) \n\nThis takes .97 seconds on our system. The equivalent test with the original f rpoly \ncode takes about the same time: .98 seconds. Thus, our program is as fast as \nproduction-quaUty code. In terms of storage space, vectors use about half as much \nstorage as lists, because half of each cons cell is a pointer, while vectors are all useful \ndata.2 \n\nHow much faster is the polynomial-based code than the rule-based version? \nUnfortunately, we can't answer that question directly. We can time (simp ' ((1 \n\n+ x+ y + z) \" 15))). This takes only a tenth of a second, but that is because \nit is doing no work at all - the answer is the same as the input! Alternately, we \ncan take the expression computed by (poly^n r 15), convert it to prefix, and pass \nthat to simpli fy. simpl i fy takes 27.8 seconds on this, so the rule-based version is \n^Note: systems that use ''cdr-coding\" take about the same space for lists that are allocated \nall at once as for vectors. But cdr-coding is losing favor as RISC chips replace microcoded \nprocessors. \n\n\f\n<a id='page-523'></a>\nmuch slower. Section 9.6 describes ways to speed up the rule-based program, and a \ncomparison of timing data appears on [page 525](chapter15.md#page-525). \n\nThere are always surprises when it comes down to measuring timing data. For \nexample, the alert reader may have noticed that the version of pol y defined above \nrequires . multiplications. Usually, exponentiation is done by squaring a value when \nthe exponent is even. Such an algorithm takes only log. multiplications instead of \n\nn. We can add a line to the definition of poly to get an 0(log n) algorithm: \n(defun poly^n (p n) \n\"Raise polynomial . to the nth power. n>=0.\" \n(check-type . (integer 0 *)) \n(cond ((= . 0) (assert (not (eql . 0))) 1) \n\n((integerp p) (expt . n)) \n((evenp n) (poly^2 (poly^n . (/ . 2)))) \n(t (poly*poly . (poly^n . (-. 1)))))) \n\n(defun poly\"2 (p) (poly*poly . .)) \n\nThe surprise is that this takes longer to raise *r* to the 15th power. Even though it \ndoes fewer pol y*pol y operations, it is doing them on more complex arguments, and \nthere is more work altogether. If we use this version of poly'n, then rl5-test takes \n\n1.6seconds instead of .98 seconds. \nBy the way, this is a perfect example of the conceptual power of recursive functions. \nWe took an existing function, poly \"n, added a single cond clause, and changed \nit from an 0(n) to O(logn) algorithm. (This turned out to be a bad idea, but that's \nbeside the point. It would be a good idea for raising integers to powers.) The reasoning \nthat allows the change is simple: First, is certainly equal to (p^^^^)^ when \n. is even, so the change can't introduce any wrong answers. Second, the change \ncontinues the policy of decrementing . on every recursive call, so the function must \neventually terminate (when . = 0). If it gives no wrong answers, and it terminates, \nthen it must give the right answer. \n\nIn contrast, making the change for an iterative algorithm is more complex. The \ninitial algorithm is simple: \n\n(defun poly^n (p n) \n\n(let ((result D) \n(loop repeat . do (setf result (poly*poly . result))) \nresult)) \n\nBut to change it, we have to change the repeat loop to a whi 1 e loop, explicitly put in \nthe decrement of n, and insert a test for the even case: \n\n\f\n<a id='page-524'></a>\n\n(defun poly^n (p n) \n(let ((result D) \n(loop while (> . 0) \ndo (if (evenp n) \n(setf . (poly^2 p) \n. (/ . 2)) \n(setf result (poly*poly . result) \n. (- . 1)))) \nresult)) \n\nFor this problem, it is clear that thinking recursively leads to a simpler function that \nis easier to modify. \n\nIt turns out that this is not the final word. Exponentiation of polynomials can be \ndone even faster, with a little more mathematical sophistication. Richard Fateman's \n1974 paper on Polynomial Multiplication analyzes the complexity of a variety of \nexponentiation algorithms. Instead of the usual asymptotic analysis (e.g. 0(n) \nor (9(n^)), he uses a fine-grained analysis that computes the constant factors (e.g. \n1000 X . or 2 X n^). Such analysis is crucial for small values of n. It turns out that for a \nvariety of polynomials, an exponentiation algorithm based on the binomial theorem \nis best. The binomial theorem states that \n\n(a + b)<sup>n = &Sigma; TK\n\n\ni=0 \n\nfor example. \n\n(a + b)<sup>3</sup> = b<sup>3</sup> + 3ab<sup>2</sup> + 3a<sup>2</sup> + a<sup>3</sup>\n\nWe can use this theorem to compute a power of a polynomial all at once, instead \nof computing it by repeated multiplication or squaring. Of course, a polynomial will \nin general be a sum of more than two components, so we have to decide how to split it \ninto the a and b pieces. There are two obvious ways: either cut the polynomial in half, \nso that a and 6 will be of equal size, or split off one component at a time. Fateman \nshows that the latter method is more efficient in most cases. In other words, a \npolynomial k^x'^ -fk2x'^~~^ +k^x^''^ -h . . will be treated as the sum a + b where \na = k\\x'^ and b is the rest of the polynomial. \n\nFollowing is the code for binomial exponentiation. It is somewhat messy, because \nthe emphasis is on efficiency. This means reusing some data and using . - add - i nto 1 \ninstead of the more general poly+poly. \n\n(defun poly'^n (p n) \n\n\"Raise polynomial . to the nth power, n>=0.\" \n\n;; Uses the binomial theorem \n\n(check-type . (integer 0 *)) \n\n(cond \n\n((= . 0) 1) \n\n\f\n<a id='page-525'></a>\n((integerp p) (expt . .)) \n(t ;; First: split the polynomial . = a + b, where \na = k*x^d and b is the rest of . \n(let ((a (make-poly (main-var p) (degree p))) \n(b (normalize-poly (subseq . 0 (- (length p) 1)))) \n\nAllocate arrays of powers of a and b: \n(a^n (make-array (+ . 1))) \n(b^n (make-array {+ . 1))) \n\nInitialize the result: \n\n(result (make-poly (main-var p) (* (degree p) n)))) \n(setf (coef a (degree p)) (coef . (degree p))) \n;; Second: Compute powers of a^i and b^i for i up to . \n(setf (aref a^n 0) 1) \n(setf (aref b^n 0) 1) \n(loop for i from 1 to . do \n\n(setf (aref a^n i) (poly*poly a (aref a^n (- i 1)))) \n(setf (aref b^n i) (poly*poly b (aref b^n (-i 1))))) \n;; Third: add the products into the result. \nso that resultCi] = (n choose i) * a'^i * b\"(n-i) \n(let ((c 1)) c helps compute (n choose i) incrementally \n(loop for i from 0 to . do \n(p-add-into! result c \n(poly*poly (aref a'^n i) \n(aref b^n (- . i)))) \n(setf c (/ (* c (- . i)) (+ i 1))))) \n(normalize-poly result))))) \n\n(defun p-add-into! (result c p) \n\"Destructively add c*p into result.\" \n(if (or (numberp p) \n\n(not (var= (main-var p) (main-var result)))) \n(setf (coef result 0) \n(poly+poly (coef result 0) (poly*poly c p))) \n(loop for i from 0 to (degree p) do \n(setf (coef result i) \n(poly+poly (coef result i) (poly*poly c (coef . i)))))) \nresult) \n\nUsing this version of pol y \"n, rl5 - test takes only .23 seconds, four times faster than \nthe previous version. The following table compares the times for rl5 -test with \nthe three versions of poly'n, along with the times for applying simply to the rl5 \npolynomial, for various versions of s i mpl i f y: \n\n\f\n<a id='page-526'></a>\n\nprogram sees speed-up \nrule-based versions \n1 original 27.8 -2 memoization 7.7 4 \n3 memo+index 4.0 7 \n4 compilation only 2.5 11 \n5 memo+compilation 1.9 15 \ncanonical versions \n6 squaring pol y'n 1.6 17 \n7 iterative poly' n .98 28 \n8 binomial poly' n .23 120 \n\nAs we remarked earlier, the general techniques of memoization, indexing, and \ncompilation provide for dramatic speed-ups. However, in the end, they do not lead \nto the fastest program. Instead, the fastest version was achieved by throwing out the \noriginal rule-based program, replacing it with a canonical-form-based program, and \nfine-tuning the algorithms within that program, using mathematical analysis. \n\nNow that we have achieved a sufficiently fast system, the next two sections \nconcentrate on making it more powerful. \n\n15.5 A Canonical Form for Rational Expressions \nA rational number is defined as a fraction: the quotient of two integers. A rational \nexpression is hereby defined as the quotient of two polynomials. This section presents \na canonical form for rational expressions. \n\nFirst, a number or polynomial will continue to be represented as before. The \nquotient of two polynomials will be represented as a cons cells of numerator and \ndenominator pairs. However, just as Lisp automatically reduces rational numbers \nto simplest form (6/8 is represented as 3/4), we must reduce rational expressions. \nSo, for example, {x^ -l)/{x -1) must be reduced to . + 1, not left as a quotient of \ntwo polynomials. \n\nThe following functions build and access rational expressions but do not reduce \nto simplest form, except in the case where the denominator isa number. Building up \nthe rest of the functionality for full rational expressions is left to a series of exercises: \n\n(defun make-rat (numerator denominator) \n\n\"Build a rational: a quotient of two polynomials.\" \n\n(if (numberp denominator) \n\n(k*poly (/ 1 denominator) numerator) \n\n(cons numerator denominator))) \n\n\f\n<a id='page-527'></a>\n(defun rat-numerator (rat) \n\"The numerator of a rational expression.\" \n(typecase rat \n\n(cons (car rat)) \n(number (numerator rat)) \n(t rat))) \n\n(defun rat-denominator (rat) \n\"The denominator of a rational expression.' \n(typecase rat \n\n(cons (cdr rat)) \n(number (denominator rat)) \n(t 1))) \n\n&#9635; Exercise 15.3 [s] Modify pref i x->canon to accept input of the form . / y and to \nreturn rational expressions instead of polynomials. Also allow for input of the form \n. \" - n. \n\n&#9635; Exercise 15.4 [m] Add arithmetic routines for multiplication, addition, and division \nof rational expressions. Call them rat*rat, rat+rat, and rat/rat respectively. \nThey will call upon poly*poly. poly+poly and a new function, pol y/poly, which is \ndefined in the next exercise. \n\n&#9635; Exercise 15.5 [h] Define poly-gcd, which computes the greatest common divisor \nof two polynomials. \n\n&#9635; Exercise 15.6 [h] Using poly-gcd, define the function pol y/poly, which will implement \ndivision for polynomials. Polynomials are closed under addition and multiplication, \nso poly+poly and poly*poly both returned polynomials. Polynomials are \nnot closed under division, so pol y /pol y will return a rational expression. \n\n15.6 Extending Rational Expressions \nNow that we can divide polynomials, the final step is to reinstate the logarithmic, \nexponential, and trigonometric functions. The problem is that if we allow all these \nfunctions, we get into problems with canonical form again. For example, the following \nthree expressions are all equivalent: \n\n\f\n<a id='page-528'></a>\n\nsin(x) \n\ncos (x- ^) \n\n2i \n\nIf we are interested in assuring we have a canonical form, the safest thing is to \nallow only and log(x). All the other functions can be defined in terms of these two. \nWith this extension, the set of expressions we can form is closed under differentiation, \nand it is possible to canonicalize expressions. The result is a mathematically sound \nconstruction known as a differentiable field. This is precisely the construct that is \nassumed by the Risch integration algorithm (Risch 1969,1979). \n\nThe disadvantage of this minimal extension is that answers may be expressed in \nunfamiliar terms. The user asks for d sin(x^)/dx, expecting a simple answer in terms \nof cos, and is surprised to see a complex answer involving e*^. Because of this problem, \nmost computer algebra systems have made more radical extensions, allowing \nsin, cos, and other functions. These systems are treading on thin mathematical ice. \nAlgorithms that would be guaranteed to work over a simple differentiable field may \nfail when the domain is extended this way. In general, the result will not be a wrong \nanswer but rather the failure to find an answer at all. \n\n15.7 History and References \nA brief history of symbolic algebra systems is given in chapter 8. Fateman (1979), \nMartin and Fateman (1971), and Davenport et al. (1988) give more details on the MACSYMA \nsystem, on which this chapter is loosely based. Fateman (1991) discusses the \nfrpoly benchmark and introduces the vector implementation used in this chapter. \n\n15.8 Exercises \n&#9635; Exercise 15.7 [h] Implement an extension of the rationals to include logarithmic, \nexponential, and trigonometric functions. \n\n&#9635; Exercise 15.8 [m] Modify deri . to handle the extended rational expressions. \n\n&#9635; Exercise 15.9 [d] Adapt the integration routine from section 8.6 ([page 252](chapter8.md#page-252)) to the \nrational expression representation. Davenport et al. 1988 may be useful. \n\n\f\n<a id='page-529'></a>\n\n&#9635; Exercise 15.10 [s] Give several reasons why constant polynomials, like 3, are represented \nas integers rather than as vectors. \n\n15.9 Answers \nAnswer 15.4 \n\n(defun rat*rat (x y) \n\"Multiply rationals: a/b * c/d= a*c/b*d\" \n(poly/poly (poly*poly (rat-numerator x) \n\n(rat-numerator y)) \n(poly*poly (rat-denominator x) \n(rat-denominator y)))) \n\n(defun rat+rat (x y) \n\"Add rationals: a/b + c/d= (a*d + c*b)/b*d\" \n(let ((a (rat-numerator x)) \n\n(b (rat-denominator x)) \n(c (rat-numerator y)) \n(d (rat-denominator y))) \n\n(poly/poly (poly+poly (poly*poly a d) (poly*poly c b)) \n(poly*poly b d)))) \n\n(defun rat/rat (x y) \n\"Divide rationals: a/b / c/d= a*d/b*c\" \n(rat*rat . (make-rat (rat-denominator y) (rat-numerator y)))) \n\nAnswer 15.6 \n\n(defun poly/poly (p q) \n\"Divide . by q: if d is the greatest common divisor of . and q \nthen p/q = (p/d) / (q/d). Note if q=l. then p/q = p.\" \n(if (eql q 1) \n\n. \n(let ((d (poly-gcd . q))) \n(make-rat (poly/poly . d) \n(poly/poly q d))))) \n\nAnswer 15.10 (1) An integer takes less time and space to process. (2) Representing \nnumbers as a polynomial would cause an infinite regress, because the coefficients \nwould be numbers. (3) Unless a policy was decided upon, the representation would \nnot be canonical, since #(. 3) and #(y 3) both represent 3. \n\n\f\n## Chapter 16\n<a id='page-530'></a>\n\nExpert Systems \n\nAn expert is one who knows more and more \nabout less and less. \n\n-Nicholas Murray Butler (1862-1947) \n\nI\nI\nn the 1970s there was terrific interest in the area of knowledge-based expert systems. An expert \nsystem or knowledge-based system is one that solves problems by applying knowledge \nthat has been garnered from one or more experts in a field. Since these experts will not in \ngeneral be programmers, they will very probably express their expertise in terms that cannot \nimmediately be translated into a program. It is the goal of expert-system research to come up \nwith a representation that is flexible enough to handle expert knowledge, but still capable of \nbeing manipulated by a computer program to come up with solutions. \n\n\f\n<a id='page-531'></a>\n\nA plausible candidate for this representation is as logical facts and rules, as in \nProlog. However, there are three areas where Prolog provides poor support for a \ngeneral knowledge-based system: \n\n* Reasoning with uncertainty. Prolog only deals with the black-and-white world \nof facts that are clearly true or false (and it doesn't even handle false very well). \nOften experts will express rules of thumb that are \"likely\" or \"90% certain.\" \n* Explanation. Prolog gives solutions to queries but no indication of how those \nsolutions were derived. A system that can explain its solutions to the user in \nunderstandable terms will be trusted more. \n* Flexible flow of control. Prolog works by backward-chaining from the goal. In \nsome cases, we may need more varied control strategy. For example, in medical \ndiagnosis, there is a prescribed order for acquiring certain information about \nthe patient. A medical system must follow this order, even if it doesn't fit in \nwith the backward-chaining strategy. \nThe early expert systems used a wide variety of techniques to attack these problems. \nEventually, it became clear that certain techniques were being used frequently, \nand they were captured in expert-system shells: specialized programming environments \nthat helped acquire knowledge from the expert and use it to solve problems \nand provide explanations. The idea was that these shells would provide a higher \nlevel of abstraction than just Lisp or Prolog and would make it easy to write new \nexpert systems. \n\nThe MYCIN expert system was one of the earliest and remains one of the best \nknown. It was written by Dr. Edward Shortliffe in 1974 as an experiment in medical \ndiagnosis. MYCIN was designed to prescribe antibiotic therapy for bacterial blood \ninfections, and when completed it was judged to perform this task as well as experts \nin the field. Its name comes from the common suffix in drugs it prescribes: erythromycin, \nclindamycin, and so on. The following is a slightly modified version of \none of MYCIN'S rules, along with an English paraphrase generated by the system: \n\n(defrule 52 \n\nif (site culture is blood) \n(gram organism is neg) \n(morphology organism is rod) \n(burn patient is serious) \n\nthen .4 \n(identity organism is Pseudomonas)) \n\n\f\n<a id='page-532'></a>\n\nRule 52: \nIf \n\n1) THE SITE OF THE CULTURE IS BLOOD \n2) THE GRAM OF THE ORGANISM IS NEG \n3) THE MORPHOLOGY OF THE ORGANISM IS ROD \n4) THE BURN OF THE PATIENT IS SERIOUS \nThen there is weakly suggestive evidence (0.4) that \n1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS \nMYCIN lead to the development of the EMYCIN expert-system shell. EMYCIN stands \nfor \"essential MYCIN,\" although it is often mispresented as \"empty MYCIN.\" Either \nway, the name refers to the shell for acquiring knowledge, reasoning with it, and \nexplaining the results, without the specific medical knowledge. \n\nEMYCIN is a backward-chaining rule interpreter that has much in common with \nProlog. However, there are four important differences. First, and most importantly, \nEMYCIN deals with uncertainty. Instead of insisting that all predications be true or \nfalse, EMYCIN associates a certainty factor with each predication. Second, EMYCIN \ncaches the results of its computations so that they need not be duplicated. Third, \nEMYCIN provides an easy way for the system to ask the user for information. Fourth, \nit provides explanations of its behavior. This can be summed up in the equation: \n\nEMYCIN = Prolog -h uncertainty + caching + questions -h explanations \n\nWe will first cover the ways EMYCIN is different from Prolog. After that we will \nreturn to the main core of EMYCIN, the backward-chaining rule interpreter. Finally, \nwe will show how to add some medical knowledge to EMYCIN to reconstruct MYCIN. \nA glossary of the program is in figure 16.1. \n\n16.1 Dealing with Uncertainty \nEMYCIN deals with uncertainty by replacing the two boolean values, true and false, \nwith a range of values called certainty factors. These are numbers from -1 (false) to \n+1 (true), with 0 representing a complete unknown. In Lisp: \n\n(defconstant true +1.0) \n(defconstant false -1.0) \n(defconstant unknown 0.0) \n\nTo define the logic of certainty factors, we need to define the logical operations, \nsuch as and, or, and not. The first operation to consider is the combination of two \ndistinct pieces of evidence expressed as certainty factors. Suppose we are trying to \n\n\f\n<a id='page-533'></a>\nemycin \nmycin \n\ndefcontext \ndefparm \ndefrule \n\ntrue \nfalse \nunknown \ncf-cut-off \n\ncontext \nparm \nrule \nyes/no \n\nget-context-data \nfind-out \nget-db \nuse-rules \nuse-rule \nnew-instance \nreport-findings \n\ncf-or \ncf-and \ntrue-p \nfalse-p \ncf-p \nput-db \nclear-db \nget-vals \nget-cf \nupdate-cf \nask-vals \nprompt-and-read-vals \ninst-name \ncheck-reply \nparse-reply \nparm-type \nget-parm \nput-rule \nget-rules \nclear-rules \nsatisfy-premises \neval-condition \nreject-premise \nconclude \nis \ncheck-conditions \nprint-rule \nprint-conditions \nprint-condition \ncf->english \nprint-why \n\nTop-Level Functions for the Client \nRun the shell on a list of contexts representing a problem. \nRun the shell on the microbial infection domain. \nTop-Level Fimctions for the Expert \nDefine a context. \nDefine a parameter. \nDefine a rule. \nConstants \nA certainty factor of +1. \nA certainty factor of -1. \nA certainty factor of 0. \nBelow this certainty we cut off search. \nData Types \nA subdomain concerning a particular problem. \nA parameter. \nA backward-chaining rule with certainty factors. \nThe type with members yes and no. \nMajor Functions within Emycin \nCollect data and draw conclusions. \nDetermine values by knowing, asking, or using rules. \nRetrieve a fact from the data base. \n\nApply all rules relevent to a parameter. \n\nApply one rule. \nCreate a new instance of a context. \nPrint the results. \nAuxiliary Functions \nCombine certainty factors (CPs) with OR. \n\nCombine certainty factors (CPs) with AND. \nIs this CP true for purposes of search? \nIs this CP false for purposes of search? \nIs this a certainty factor? \nPlace a fact in the data base. \nClear all facts from the data base. \nGet value and CP for a parameter/instance. \nGet CP for a parameter/instance/value triplet. \nChange CP for a parameter/instance/value triplet. \nAsk the user for value/CP for a parameter/instance. \nPrint a prompt and read a reply. \nThe name of an instance. \nSee if reply is valid list of CP/values. \nConvert reply into list of CP/values. \nValues of this parameter must be of this type. \nFind or make a parameter structure for this name. \nAdd a new rule, indexed under each conclusion. \nRetrieve rules that help determine a parameter. \nRemove all rules. \nCalculate the combined CP for the premises. \nDetermine the CP for a condition. \nRule out a premise if it is clearly false. \nAdd a parameter/instance/value/CP to the data base. \nAn alias for equal. \nMake sure a rule is valid. \nPrint a rule. \nPrint a list of conditions. \nPrint a single condition. \nConvert .7 to \"suggestive evidence,\" etc. \nSay why a rule is being used. \n\nFigure 16.1: Glossary for the EMYCIN Program \n\n\f\n<a id='page-534'></a>\n\ndetermine the chances of a patient having disease X. Assume we have a population \nof prior patients that have been given two lab tests. One test says that 60% of the \npatients have the disease and the other says that 40% have it. How should we \ncombine these two pieces of evidence into one? Unfortunately, there is no way to \nanswer that question correctly without knowing more about the dependence of the two \nsources on each other. Suppose the first test says that 60% of the patients (who all \nhappen to be male) have the disease, and the second says that 40% (who all happen \nto be female) have it. Then we should conclude that 100% have it, because the two \ntests cover the entire population. On the other hand, if the first test is positive only \nfor patients that are 70 years old or older, and the second is positive only for patients \nthat are 80 or older, then the second is just a subset of the first. This adds no new \ninformation, so the correct answer is 60% in this case. \n\nIn section 16.9 we will consider ways to take this kind of reasoning into account. \nFor now, we will present the combination method actually used in EMYCIN. It is \ndefined by the formula: \n\ncombine (A, B) = \n\nA + B-AB; A,B>0 \n\nA-^B-\\-AB; A,B <0 \n\nA-\\-B \n\n; otherwise \n\nl-min{\\Al\\B\\) \n\nAccording to this formula, combine(.60,.40) = .76, which is a compromise between \nthe extremes of .60 and 1.00. It is the same as the probability p(A or B), assuming that \nA and . are independent. \n\nHowever, it should be clear that certainty factors are not the same thing as \nprobabilities. Certainty factors attempt to deal with disbelief as well as belief, but \nthey do not deal with dependence and independence. The EMYCIN combination \nfunction has a number of desirable properties: \n\n* It always computes a number between -1 and +1. \n* Combining unknown (zero) with anything leaves it unchanged. \n* Combining true with anything (except false) gives true. \n* Combining true and false is an error, \n* Combining two opposites gives unknown. \n* Combining two positives (except true) gives a larger positive. \n* Combining a positive and a negative gives something in between. \n\f\n<a id='page-535'></a>\nSo far we have seen how to combine two separate pieces of evidence for the same \nhypothesis. In other words, if we have the two rules: \n\nand we know A with certainty factor (cf) .6 and . with cf .4, then we can conclude C \nwith cf .76. But consider a rule with a conjunction in the premise: \n\nAandB=>C \n\nCombining A and . in this case is quite different from combining them when they are \nin separate rules. EMYCIN chooses to combine conjunctions by taking the minimum of \neach conjunct's certainty factor. If certainty factors were probabilities, this would be \nequivalent to assumming dependence between conjuncts in a rule. (If the conjuncts \nwere independent, then the product of the probabilities would be the correct answer.) \nSo EMYCIN is making the quite reasonable (but sometimes incorrect) assumption that \nconditions that are tied together in a single rule will be dependent on one another, \nwhile conditions in separate rules are independent. \n\nThe final complication is that rules themselves may be uncertain. That is, MYCIN \naccommodates rules that look like: \n\nAandB=^.9C \n\nto say that A and . imply C with .9 certainty. EMYCIN simply multiplies the rule's cf \nby the combined cf of the premise. So if A has cf .6 and . has cf .4, then the premise \nas a whole has cf .4 (the minimum of A and B), which is multiplied by .9 to get .36. \nThe .36 is then combined with any exisiting cf for C. If C is previously unknown, then \ncombining .36 with 0 will give .36. If C had a prior cf of .76, then the new cf would be \n.36 -h .76 - (.36 X .76) = .8464. \n\nHere are the EMYCIN certainty factor combination functions in Lisp: \n\n(defun cf-or (a b) \n\"Combine the certainty factors for the formula (A or B). \nThis is used when two rules support the same conclusion.\" \n(cond ((and (> a 0) (> b 0)) \n\n(+ a b (* -1 a b))) \n((and (<a 0) (<b 0)) \n(+ a b (* a b))) \n(t (/ (+ a b) \n(- 1 (min (abs a) (abs b))))))) \n\n(defun cf-and (a b) \n\"Combine the certainty factors for the formula (A and B). \" \n(min a b)) \n\nCertainty factors can be seen as a generalization of truth values. EMYCIN is a \n\n\f\n<a id='page-536'></a>\n\nbackward-chaining rule system that combines certainty factors according to the \nfunctions laid out above. But if we only used the certainty factors true and f al se, \nthen EMYCIN would behave exactly like Prolog, returning only answers that are definitely \ntrue. It is only when we provide fractional certainty factors that the additional \nEMYCIN mechanism makes a difference. \n\nTruth values actually serve two purposes in Prolog. They determine the final \nanswer, yes, but they also determine when to cut off search: if any one of the \npremises of a rule is false, then there is no sense looking at the other premises. If \nin EMYCIN we only cut off the search when one of the premises was absolutely false, \nthen we might have to search through a lot of rules, only to yield answers with very \nlow certainty factors. Instead, EMYCIN arbitrarily cuts off the search and considers a \npremise false when it has a certainty factor below .2. The following functions support \nthis arbitrary cutoff point: \n\n(defconstant cf-cut-off 0.2 \n\"Below this certainty we cut off search.\") \n\n(defun true-p (cf) \n\"Is this certainty factor considered true?\" \n(and (cf-p cf) (> cf cf-cut-off))) \n\n(defun false-p (cf) \n\"Is this certainty factor considered false?\" \n(and (cf-p cf) (< cf (- cf-cut-off 1.0)))) \n\n(defun cf-p (x) \n\"Is X a valid numeric certainty factor?\" \n(and (numberp x) (<= false . true))) \n\n&#9635; Exercise 16.1 [m] Suppose you read the headline \"Elvis Alive in Kalamazoo\" in a \ntabloid newspaper to which you attribute a certainty factor of .01. If you combine certainties \nusing EMYCIN'S combination rule, how many more copies of the newspaper \nwould you need to see before you were .95 certain Elvis is alive? \n\n16.2 Caching Derived Facts \nThe second thing that makes EMYCIN different from Prolog is that EMYCIN caches all \nthe facts it derives in a data base. When Prolog is asked to prove the same goal twice, \nit performs the same computation twice, no matter how laborious. EMYCIN performs \nthe computation the first time and just fetches it the second time. \n\n\f\n<a id='page-537'></a>\nWe can implement a simple data base by providing three functions: put - db to add \nan association between a key and a value, get-db to retrieve a value, and cl ear-db \nto empty the data base and start over: \n\n(let ((db (make-hash-table :test #'equal))) \n(defun get-db (key) (gethash key db)) \n(defun put-db (key val) (setf (gethash key db) val)) \n(defun clear-db () (clrhash db))) \n\nThis data base is general enough to hold any association between key and value. \nHowever, most of the information we will want to store is more specific. EMYCIN \nis designed to deal with objects (or instances) and attributes (or parameters) of those \nobjects. For example, each patient has a name parameter. Presumably, the value of \nthis parameter will be known exactly. On the other hand, each microscopic organism \nhas an i denti ty parameter that is normally not known at the start of the consultation. \nApplying the rules will lead to several possible values for this parameter, each \nwith its own certainty factor. In general, then, the data base will have keys of the \nform (parameter instance) with values of the form ((vah cf\\) (vah c/2)...). In the \nfollowing code, get - va1 s returns the Ust of value/cf pairs for a given parameter and \ninstance, get-cf returns the certainty factor for a parameter/instance/value triplet, \nand upda te - cf changes the certainty factor by combining the old one with a new one. \nNote that the first time update-cf is called on a given parameter/instance/value \ntriplet, get-cf will return un known (zero). Combining that with the given cf yields cf \nitself. Also note that the data base has to be an equal hash table, because the keys \nmay include freshly consed lists. \n\n(defun get-vals (parm inst) \n\"Return a list of (val cf) pairs for this (parm inst).\" \n(get-db (list parm inst))) \n\n(defun get-cf (parm inst val) \n\"Look up the certainty factor or return unknown.\" \n(or (second (assoc val (get-vals parm inst))) \n\nunknown)) \n\n(defun update-cf (parm inst val cf) \n\"Change the certainty factor for (parm inst is val), \nby combining the given cf with the old. \" \n(let ((new-cf (cf-or cf (get-cf parm inst val)))) \n\n(put-db (list parm inst) \n(cons (list val new-cf) \n(remove val (get-db (list parm inst)) \n:key #*first))))) \n\nThe data base holds all information related to an instance of a problem. For example. \n\n\f\n<a id='page-538'></a>\n\nin the medical domain, the data base would hold all information about the current \npatient. When we want to consider a new patient, the data base is cleared. \n\nThere are three other sources of information that cannot be stored in this data \nbase, because they have to be maintained from one problem to the next. First, the \nrule base holds all the rules defined by the expert. Second, there is a structure to \ndefine each parameter; these are indexed under the name of each parameter. Third, \nwe shall see that the flow of control is managed in part by a list ofcontexts to consider. \nThese are structures that will be passed to the myci . function. \n\n16.3 Asking Questions \nThe third way that EMYCIN differs from Prolog is in providing an automatic means of \nasking the user questions when answers cannot be derived from the rules. This is not \na fundamental difference; after all, it is not too hard to write Prolog rules that print \na query and read a reply. EMYCIN lets the knowledge-base designer write a simple \ndeclaration instead of a rule, and will even assume a default declaration if none is \nprovided. The system also makes sure that the same question is never asked twice. \n\nThe following function ask-val s prints a query that asks for the parameter of an \ninstance, and reads from the user the value or a list of values with associated certainty \nfactors. The function first looks at the data base to make sure the question has not \nbeen asked before. It then checks each value and certainty factor to see if each is of \nthe correct type, and it also allows the user to ask certain questions. A ? reply will \nshow what type answer is expected. Rul e will show the current rule that the system \nis working on. Why also shows the current rule, but it explains in more detail what the \nsystem knows and is trying to find out. Finally, hel . prints the following summary: \n\n(defconstant help-string \n\n\"~&Type one of the following: \n\n? - to see possible answers for this parameter \n\nrule - to show the current rule \n\nwhy - to see why this question is asked \n\nhelp - to see this list \n\nxxx - (for some specific xxx) if there is a definite answer \n\n(XXX .5 yyy .4) - If there are several answers with \ndifferent certainty factors.\") \nHere is a s k - va 1 s. Note that the why and rule options assume that the current rule has \nbeen stored in the data base. The functions pri nt-why, parm-type, and check- repl y \nwill be defined shortly. \n\n\f\n<a id='page-539'></a>\n(defun ask-vals (parm inst) \n\"Ask the user for the value(s) of inst's parm parameter, \nunless this has already been asked. Keep asking until the \nuser types UNKNOWN (return nil) or a valid reply (return t).\" \n(unless (get-db '(asked ,parm .inst)) \n\n(put-db '(asked .parm .inst) t) \n(loop \n(let ((ans (prompt-and-read-vals parm inst))) \n\n(case ans \n(help (format t help-string)) \n(why (print-why (get-db 'current-rule) parm)) \n(rule (princ (get-db 'current-rule))) \n((unk unknown) (RETURN nil)) \n(? (format t \"~&A ~a must be of type ~a\" \n\nparm (parm-type parm)) nil) \n\n(t (if (check-reply ans parm inst) \n(RETURN t) \n(format t \"~&I1legal reply. ~ \n\nType ? to see legal ones.\")))))))) \n\nThe following is prompt - and - read- va 1 s, the function that actually asks the query and \n\nreads the reply. It basically calls format to print a prompt and read to get the reply, but \n\nthere are a few subtleties. First, it calls finish- output. Some Lisp implementations \n\nbuffer output on a line-by-line basis. Since the prompt may not end in a newline, \n\nf i ni sh - output makes sure the output is printed before the reply is read. \n\nSo far, all the code that refers to a parm is really referring to the name of a \nparameter - a symbol. The actual parameters themselves will be implemented as \nstructures. We use get-parm to look up the structure associated with a symbol, and \nthe selector functions parm-prompt to pick out the prompt for each parameter and \npa rm- reader to pick out the reader function. Normally this will be the function read, \nbut read -1 i ne is appropriate for reading string-valued parameters. \n\nThe macro def parm (shown here) provides a way to define prompts and readers \nfor parameters. \n\n(defun prompt-and-read-vals (parm inst) \n\"Print the prompt for this parameter (or make one up) and \nread the reply.\" \n(fresh-line) \n(format t (parm-prompt (get-parm parm)) (inst-name inst) parm) \n(princ \" \") \n(finish-output) \n(funcall (parm-reader (get-parm parm)))) \n\n\f\n<a id='page-540'></a>\n\n(defun inst-name (inst) \n\"The name of this instance.\" \nThe stored name is either like ((\"Jan Doe\" 1.0)) or nil \n(or (first (first (get-vals 'name inst))) \ninst)) \n\nThe function check- repl y uses parse - repl y to convert the user's reply into a canonical \nform, and then checks that each value is of the right type, and that each certainty \nfactor is valid. If so, the data base is updated to reflect the new certainty factors. \n\n(defun check-reply (reply parm inst) \n\"If reply is valid for this parm, update the DB. \nReply should be a val or (vail cfl val2 cf2 ...) . \nEach val must be of the right type for this parm.\" \n(let ((answers (parse-reply reply))) \n\n(when (every #'(lambda (pair) \n(and (typep (first pair) (parm-type parm)) \n(cf-p (second pair)))) \nanswers) \nAdd replies to the data base \n(dolist (pair answers) \n(update-cf parm inst (first pair) (second pair))) \nanswers))) \n\n(defun parse-reply (reply) \n\"Convert the reply into a list of (value cf) pairs.\" \n(cond ((null reply) nil) \n\n((atom reply) *((,reply .true))) \n(t (cons (list (first reply) (second reply)) \n(parse-reply (rest2 reply)))))) \n\nParameters are implemented as structures with six slots: the name (a symbol), the \ncontext the parameter is for, the prompt used to ask for the parameter's value, \na Boolean that tells if we should ask the user before or after using rules, a type \nrestriction describing the legal values, and finally, the function used to read the \nvalue of the parameter. \n\nParameters are stored on the property list of their names under the pa rm property, \nso getting the pa rm- type of a name requires first getting the parm structure, and then \nselecting the type restriction field. By default, a parameter is given type t, meaning \nthat any value is valid for that type. We also define the type yes/no, which comes in \nhandy for Boolean parameters. \n\nWe want the default prompt to be \"What is the PARM of the INST?\" But most \nuser-defined prompts will want to print the inst, and not the parm. To make it easy \nto write user-defined prompts, prompt-and-read-vals makes the instance be the \nfirst argument to the format string, with the parm second. Therefore, in the default \n\n\f\n<a id='page-541'></a>\nprompt we need to use the format directive \" ~*\" to skip the instance argument, and \n\"'^2:*\" to back up two arguments to get back to the instance. (These directives are \ncommon in cerror calls, where one list of arguments is passed to two format strings.) \n\ndefparm is a macro that calls new-parm, the constructor function defined in the \nparm structure, and stores the resulting structure under the parm property of the \nparameter's name. \n\n(defstruct (parm (.-constructor \nnew-parm (name &optional context type-restrict!on \n\nprompt ask-first reader))) \nname (context nil) (prompt \"~&What is the ~*~a of ~2:*~a?\") \n(ask-first nil) (type-restriction t) (reader 'read)) \n\n(defmacro defparm (parm &rest args) \n\"Define a parameter.\" \n'(setf (get *,parm *parm) (apply #*new-parm *,parm *.args))) \n\n(defun parm-type (parm-name) \n\"What type is expected for a value of this parameter?\" \n(parm-type-restriction (get-parm parm-name))) \n\n(defun get-parm (parm-name) \n\"Look up the parameter structure with this name.\" \nIf there is none, make one \n(or (get parm-name 'parm) \n(setf (get parm-name 'parm) (new-parm parm-name)))) \n\n(deftype yes/no () '(member yes no)) \n\n16.4 Contexts Instead of Variables \nEarlier we gave an equation relating EMYCIN to Prolog. That equation was not quite \ncorrect, because EMYCIN lacks one of Prolog's most important features: the logic \nvariable. Instead, EMYCIN uses contexts. So the complete equation is: \n\nEMYCIN = Prolog + uncertainty -f caching -f questions + explanations \n-f contexts - variables \n\nA context is defined by the designers of MYCIN as a situation within which the \nprogram reasons. But it makes more sense to think of a context simply as a data \ntype. So the list of contexts supplied to the program will determine what types of \nobjects can be reasoned about. The program keeps track of the most recent instance \nof each type, and the rules can refer to those instances only, using the name of the \n\n\f\n<a id='page-542'></a>\n\ntype. In our version of MYCIN, there are three types or contexts: patients, cultures, \nand organisms. Here is an example of a rule that references all three contexts: \n\n(defrule 52 \n\nif (site culture is blood) \n(gram organism is neg) \n(morphology organism is rod) \n(burn patient is serious) \n\nthen .4 \n(identity organism is Pseudomonas)) \n\nIgnoring certainty factors for the moment, this MYCIN rule is equivalent to a Prolog \nrule of the form: \n\n(<- (identity ?o ?pseudomonas) \n\n(and (culture ?c) (site ?c blood) \n(organism ?o) (gram ?o neg) (morphology ?o rod) \n(patient ?p) (burn ?p serious))) \n\nThe context mechanism provides sufficient flexibility to handle many of the cases \nthat would otherwise be handled by variables. One important thing that cannot \nbe done is to refer to more than one instance of the same context. Only the most \nrecent instance can be referred to. Contexts are implemented as structures with the \nfollowing definition: \n\n(defstruct context \n\"A context is a sub-domain, a type.\" \nname (number 0) initial-data goals) \n\n(defmacro defcontext (name &optional initial-data goals) \n\"Define a context.\" \n\n'(make-context :name '.name :initial-data *.initial-data \nigoals '.goals)) \nThe name field is something like patient or organism. Instances of contexts are \nnumbered; the number field holds the number of the most recent instance. Each \ncontext also has two lists of parameters. The i ni ti al -data parameters are asked for \nwhen each instance is created. Initial data parameters are normally known by the \nuser. For example, a doctor will normally know the patient's name, age, and sex, and \nas a matter of training expects to be asked these questions first, even if they don't \nfactor into every case. The goal parameters, on the other hand, are usually unknown \nto the user. They are determined through the backward-chaining process. \n\nThe following function creates a new instance of a context, writes a message, and \nstores the instance in two places in the data base: under the key current -i nstance. \n\n\f\n<a id='page-543'></a>\nand also under the name of the context. The contexts form a tree. In our example, \nthe pa ti ent context is the root of the tree, and the current patient is stored in the data \nbase under the key pati ent. The next level of the tree is for cultures taken from the \npatient; the current culture is stored under the cul ture key. Finally, there is a level \nfor organisms found in each culture. The current organism is stored under both the \norgani sm and current -i nstance keys. The context tree is shown in figure 16.2. \n\n(defun new-instance (context) \n\"Create a new instance of this context.\" \n(let ((instance (format nil \"~a-~d\" \n\n(context-name context) \n(incf (context-number context))))) \n\n(format t \"~& ~a ~&\" instance) \n(put-db (context-name context) instance) \n(put-db 'current-instance instance))) \n\nPatient: Sylvia Fischer \n\nCULTURE-1 CULTURE-2 \n\nORGANISM-1 ORGANISM-2 \n\nFigure 16.2: A Context Tree \n\n16.5 Backward-Chaining Revisited \nNow that we have seen how EMYCIN is different from Prolog, we are ready to tackle \nthe way in which it is the same: the backward-chaining rule interpreter. Like Prolog, \nEMYCIN is given a goal and applies rules that are appropriate to the goal. Applying a \nrule means treating each premise of the rule as a goal and recursively applying rules \nthat are appropriate to each premise. \n\n\f\n<a id='page-544'></a>\n\nThere are still some remaining differences. In Prolog, a goal can be any expression, \nand appropriate rules are those whose heads unify with the goal. If any appropriate \nrule succeeds, then the goal is known to be true. In EMYCIN, a rule might give a goal \na certainty of .99, but we still have to consider all the other rules that are appropriate \nto the goal, because they might bring the certainty down below the cutoff threshold. \nThus, EMYCIN always gathers all evidence relating to a parameter/instance pair first, \nand only evaluates the goal after all the evidence is in. For example, if the goal was \n(temp pa ti ent > 98.6), EMYCIN would first evaluate all rules with conclusions about \nthe current patient's temperature, and only then compare the temperature to 98.6. \n\nAnother way of looking at it is that Prolog has the luxury of searching depth-first, \nbecause the semantics of Prolog rules is such that if any rule says a goal is true, then it \nis true. EMYCIN must search breadth-first, because a goal with certainty of .99 might \nturn out to be false when more evidence is considered. \n\nWe are now ready to sketch out the design of the EMYCIN rule interpreter: To \nfi nd-out a parameter of an instance: If the value is already stored in the data base, \nuse the known value. Otherwise, the two choices are using the rules or asking the \nuser. Do these in the order specified for this parameter, and if the first one succeeds, \ndon't bother with the second. Note that ask-val s (defined above) will not ask the \nsame question twice. \n\nTo use - rul es, find all the rules that concern the given parameter and evaluate \nthem with use - rul e. After each rule has been tried, if any of them evaluate to true, \nthen succeed. \n\nTo use - rul e a rule, first check if any of the premises can be rejected outright. If \nwe did not have this check, then the system could start asking the user questions that \nwere obviously irrelevant. So we waste some of the program's time (checking each \npremise twice) to save the more valuable user time. (The function eval -condi ti on \ntakes an optional argument specifying if we should recursively ask questions in trying \nto accept or reject a condition.) \n\nIf no premise can be rejected, then evaluate each premise in turn with \neval uate- condi ti on, keeping track of the accumulated certainty factor with cf - and \n(which is currently just mi n), and cutting off evaluation when the certainty factor \ndrops below threshold. If the premises evaluate true, then add the conclusions to \nthe data base. The calling sequence looks like this. Note that the recursive call to \nf i nd - out is what enables chaining to occur: \n\nf i nd - out ; To find out a parameter for an instance: \n\nget- db ; See if it is cached in the data base \na s k-V a 1 s ; See if the user knows the answer \nuse - rul es ; See if there is a rule for it: \nreject-premise ; See if the rule is outright false \nsatisfy-premises ; Or see if each condition is true: \neval-condition ; Evaluate each condition \nf i nd - out ; By finding the parameter's values \n\n\f\n<a id='page-545'></a>\nBefore showing the interpreter, here is the structure definition for rules, along with \nthe functions to maintain a data base of rules: \n\n(defstruct (rule (:print-function print-rule)) \nnumber premises conclusions cf) \n\n(let ((rules (make-hash-table))) \n\n(defun put-rule (rule) \n\"Put the rule in a table, indexed under each \nparm in the conclusion.\" \n(dolist (concl (rule-conclusions rule)) \n\n(push rule (gethash (first concl) rules))) \nrule) \n\n(defun get-rules (parm) \n\"A list of rules that help determine this parameter.\" \n(gethash parm rules)) \n\n(defun clear-rules () (clrhash rules))) \n\nHere, then, is the interpreter, f i nd-out. It can find out the value(s) of a parameter \nthree ways. First, it looks to see if the value is already stored in the data base. Next, \nit tries asking the user or using the rules. The order in which these two options are \ntried depends on the parm-ask-first property of the parameter. Either way, if an \nanswer is determined, it is stored in the data base. \n\n(defun find-out (parm &optional (inst (get-db 'current-instance))) \n\"Find the value(s) of this parameter for this instance, \nunless the values are already known. \nSome parameters we ask first; others we use rules first.\" \n(or (get-db '(known .parm .inst)) \n\n(put-db '(known .parm .inst) \n\n(if (parm-ask-first (get-parm parm)) \n(or (ask-vals parm inst) (use-rules parm)) \n(or (use-rules parm) (ask-vals parm inst)))))) \n\n(defun use-rules (parm) \n\"Try every rule associated with this parameter. \nReturn true if one of the rules returns true.\" \n(some #'true-p (mapcar #'use-rule (get-rules parm)))) \n\n\f\n<a id='page-546'></a>\n\n(defun use-rule (rule) \n\"Apply a rule to the current situation.\" \n;; Keep track of the rule for the explanation system: \n(put-db 'current-rule rule) \n;; If any premise is known false, give up. \n;; If every premise can be proved true, then \n\ndraw conclusions (weighted with the certainty factor), \n(unless (some #'reject-premise (rule-premises rule)) \n(let ((cf (satisfy-premises (rule-premises rule) true))) \n(when (true-p cf) \n(dolist (conclusion (rule-conclusions rule)) \n(conclude conclusion (* cf (rule-cf rule)))) \ncf)))) \n\n(defun satisfy-premises (premises cf-so-far) \n\"A list of premises is satisfied if they are all true. \nA combined cf is returned.\" \n;; cf-so-far is an accumulator of certainty factors \n(cond ((null premises) cf-so-far) \n\n((not (true-p cf-so-far)) false) \n\n(t (satisfy-premises \n(rest premises) \n(cf-and cf-so-far \n\n(eval-condition (first premises))))))) \n\nThe function eval - condition evaluates a single condition, returning its certainty \nfactor. If f i nd - out - . is true, it first calls f i nd - out, which may either query the user \nor apply appropriate rules. If f i nd-out-p is false, it evaluates the condition using \nthe current state of the data base. It does this by looking at each stored value for \nthe parameter/instance pair and evaluating the operator on it. For example, if the \ncondition is (temp patient > 98.6) and the values for temp for the current patient \nare((98 .3) (99 .6) (100 .1)), then eval-condition will test each of the values \n98,99, and 100 against 98.6 using the > operator. This test will succeed twice, so the \nresulting certainty factor is .6 -h .1 = .7. \n\nThe function reject -premi se is designed as a quick test to eliminate a rule. As \nsuch, it calls eva 1- condi 11 on with f 1 nd - out - . nil, so it will reject a premise only if it \nis clearly false without seeking additional information. \n\nIf a rule's premises are true, then the conclusions are added to the data base by \nconcl ude. Note that is is the only operator allowed in conclusions, is is just an alias \nfor equal. \n\n(defun eval-condition (condition &optional (find-out-p t)) \n\"See if this condition is true, optionally using FIND-OUT \nto determine unknown parameters.\" \n(multiple-value-bind (parm inst op val) \n\n(parse-condition condition) \n\n\f\n<a id='page-547'></a>\n(when find-out-p \n(find-out parm inst)) \nAdd up all the (val cf) pairs that satisfy the test \n\n(loop for pair in (get-vals parm inst) \nwhen (funcall op (first pair) val) \nsum (second pair)))) \n\n(defun reject-premise (premise) \n\"A premise is rejected if it is known false, without \nneeding to call find-out recursively.\" \n(false-p (eval-condition premise nil))) \n\n(defun conclude (conclusion cf) \n\"Add a conclusion (with specified certainty factor) to DB.\" \n(multiple-value-bind (parm inst op val) \n\n(parse-condition conclusion) \n(update-cf parm inst val cf))) \n\n(defun is (a b) (equal a b)) \n\nAll conditions are of the form: (parameter instance operator value). For example: \n(morphology organism is rod). Thefunctionparse-conditionturnsalistofthis \nform into four values. The trick is that it uses the data base to return the current \ninstance of the context, rather than the context name itself: \n\n(defun parse-condition (condition) \n\"A condition is of the form (parm inst op val). \nSo for (age patient is 21), we would return 4 values: \n(age patient-1 is 21), where patient-1 is the current patient.\" \n(values (first condition) \n\n(get-db (second condition)) \n(third condition) \n(fourth condition))) \n\nAt this point a call like (find-out 'identity Organism-1) would do the right \nthing only if we had somehow entered the proper information on the current patient, \nculture, and organism. The function get - context - da ta makes sure that each context \nis treated in order. First an instance is created, then f i nd-out is used to determine \nboth the initial data parameters and the goals. The findings for each goal are printed, \nand the program asks if there is another instance of this context. Finally, we also \nneed a top-level function, emycin, which just clears the data base before calling \nget-context-data. \n\n\f\n<a id='page-548'></a>\n\n(defun emycin (contexts) \n\"An Expert-System Shell. Accumulate data for instances of each \ncontext, and solve for goals. Then report the findings.\" \n(clear-db) \n(get-context-data contexts)) \n\n(defun get-context-data (contexts) \n\"For each context, create an instance and try to find out \nrequired data. Then go on to other contexts, depth first, \nand finally ask if there are other instances of this context.\" \n(unless (null contexts) \n\n(let* ((context (first contexts)) \n\n(inst (new-instance context))) \n(put-db 'current-rule 'initial) \n(mapc #'find-out (context-initial-data context)) \n(put-db 'current-rule 'goal) \n(mapc #'find-out (context-goals context)) \n(report-findings context inst) \n(get-context-data (rest contexts)) \n(when (y-or-n-p \"Is there another ~a?\" \n\n(context-name context)) \n(get-context-data contexts))))) \n\n16.6 Interacting with the Expert \nAt this point all the serious computational work is done: we have defined a backward-\nchaining rule mechanism that deals with uncertainty, caching, questions, and contexts. \nBut there is still quite a bit of work to do in terms of input/output interaction. A \nprogramming language needs only to interface with programmers, so it is acceptable \nto make the programmer do all the work. But an expert-system shell is supposed to \nalleviate (if not abolish) the need for programmers. Expert-system shells really have \ntwo classes of users: the experts use the shell when they are developing the system, \nand the end users or clients use the resulting expert system when it is completed. \nSometimes the expert can enter knowledge directly into the shell, but more often \nit is assumed the expert will have the help of a knowledge engineer - someone who is \ntrained in the use of the shell and in eliciting knowledge, but who need not be either \nan expert in the domain or an expert programmer. \n\nIn our version of EMYCIN, we provide only the simplest tools for making the \nexpert's job easier. The macros defcontext and defparm, defined above, are a little \neasier than calling make - context and make - pa rm explicitly, but not much. The macro \ndef rul e defines a rule and checks for some obvious errors: \n\n\f\n<a id='page-549'></a>\n\n(defmacro defrule (number &body body) \n\"Define a rule with conditions, a certainty factor, and \nconclusions. Example: (defrule ROOl if ... then .9 ...) \" \n(assert (eq (first body) 'if)) \n(let* ((then-part (member 'then body)) \n\n(premises (Idiff (rest body) then-part)) \n(conclusions (rest2 then-part)) \n(cf (second then-part))) \n\nDo some error checking: \n(check-conditions number premises 'premise) \n(check-conditions number conclusions 'conclusion) \n(when (not (cf-p cf)) \n\n(warn \"Rule \"a: Illegal certainty factor: \"a\" number cf)) \nNow build the rule: \n*(put-rule \n(make-rule :number ',number :cf ,cf:premises ',premises \n:conclusions ',conclusions)))) \n\nThe function check-condi ti ons makes sure that each rule has at least one premise \nand conclusion, that each condition is of the right form, and that the value of the \ncondition is of the right type for the parameter. It also checks that conclusions use \nonly the operator i s: \n\n(defun check-conditions (rule-num conditions kind) \n\"Warn if any conditions are invalid.\" \n(when (null conditions) \n\n(warn \"Rule \"a: Missing \"a\" rule-num kind)) \n(dolist (condition conditions) \n(when (not (consp condition)) \n(warn \"Rule ~a: Illegal '\"a: ''a\" rule-num kind condition)) \n(multiple-value-bind (parm inst op val) \n\n(parse-condition condition) \n(declare (ignore inst)) \n(when (and (eq kind 'conclusion) (not (eq op 'is))) \n\n(warn \"Rule ~a: Illegal operator (~a) in conclusion: \"a\" \nrule-num op condition)) \n(when (not (typep val (parm-type parm))) \n(warn \"Rule ~a: Illegal value (~a) in ~a: ~a\" \nrule-num val kind condition))))) \n\nThe real EMYCIN had an interactive environment that prompted the expert for each \ncontext, parameter, and rule. Randall Davis (1977, 1979, Davis and Lenat 1982) \ndescribes the TEIRESIAS program, which helped experts enter and debug rules. \n\n\f\n<a id='page-550'></a>\n\n16.7 Interacting with the Client \nOnce the knowledge is in, we need some way to get it out. The client wants to run \nthe system on his or her own problem and see two things: a solution to the problem, \nand an explanation of why the solution is reasonable. EMYCIN provides primitive \nfacilities for both of these. The function report-f i ndi ngs prints information on all \nthe goal parameters for a given instance: \n\n(defun report-findings (context inst) \n\"Print findings on each goal for this instance.\" \n(when (context-goals context) \n\n(format t \"~&Findings for ~a;\" (inst-name inst)) \n(dolist (goal (context-goals context)) \n\n(let ((values (get-vals goal inst))) \n;; If there are any values for this goal, \n;; print them sorted by certainty factor, \n(if values \n\n(format t \"~& ~a:~{~{ ~a (~,3f) \"}\"}\" goal \n(sort (copy-list values) #'> :key #'second)) \n(format t \"~& ~a: unknown\" goal)))))) \n\nThe only explanation facility our version of EMYCIN offers is a way to see the current \nrule. If the user types rul e in response to a query, a pseudo-EngUsh translation of \nthe current rule is printed. Here is a sample rule and its translation: \n\n(defrule 52 \n\nif (site culture is blood) \n(gram organism is neg) \n(morphology organism is rod) \n(burn patient is serious) \n\nthen .4 \n(identity organism is Pseudomonas)) \n\nRule 52: \nIf \n\n1) THE SITE OF THE CULTURE IS BLOOD \n2) THE GRAM OF THE ORGANISM IS NEG \n3) THE MORPHOLOGY OF THE ORGANISM IS ROD \n4) THE BURN OF THE PATIENT IS SERIOUS \nThen there is weakly suggestive evidence (0.4) that \n1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS \nThe function pri nt - rul e generates this translation: \n\n\f\n<a id='page-551'></a>\n(defun print-rule (rule &optional (stream t) depth) \n(declare (ignore depth)) \n(format stream \"~&Rule ~a:~& If\" (rule-number rule)) \n(print-conditions (rule-premises rule) stream) \n(format stream \"~& Then \"a (~a) that\" \n\n(cf->english (rule-cf rule)) (rule-cf rule)) \n(print-conditions (rule-conclusions rule) stream)) \n\n(defun print-conditions (conditions &optional \n\n(stream t) (num 1)) \n\"Print a list of numbered conditions.\" \n(dolist (condition conditions) \n\n(print-condition condition stream num))) \n\n(defun print-condition (condition stream number) \n\"Print a single condition in pseudo-English.\" \n(format stream \"~& ~d)~{ ~a~}\" number \n\n(let ((parm (first condition)) \n(inst (second condition)) \n(op (third condition)) \n(val (fourth condition))) \n\n(case val \n(YES '(the ,inst ,op .parm)) \n(NO '(the .inst .op not .parm)) \n(T '(the .parm of the .inst .op .val)))))) \n\n(defun cf->english (cf) \n\"Convert a certainy factor to an English phrase.\" \n(cond ((= cf 1.0) \"there is certain evidence\") \n\n((> cf .8) \"there is strongly suggestive evidence\") \n((> cf .5) \"there is suggestive evidence\") \n((> cf 0.0) \"there is weakly suggestive evidence\") \n((= cf 0.0) \"there is NO evidence either way\") \n((< cf 0.0) (concatenate 'string (cf->english (- cf)) \n\n\" AGAINST the conclusion\")))) \n\nIf the user types why in response to a query, a more detailed account of the same \nrule is printed. First, the premises that are already known are displayed, followed \nby the remainder of the rule. The parameter being asked for will always be the first \nprennse in the remainder of the rule. The current - rul e is stored in the data base by \nuse-rul e whenever a rule is applied, but it is also set by get-context -data to the \natom i ni ti al or goal when the system is prompting for parameters, pri nt-why \nchecks for this case as well. Note the use of the pa rt it i on - i f function from [page 256](chapter8.md#page-256). \n\n\f\n<a id='page-552'></a>\n\n(defun print-why (rule parm) \n\"Tell why this rule is being used. Print what is known, \nwhat we are trying to find out, and what we can conclude.\" \n(format t \"~&CWhy is the value of '\"a being asked for?]\" parm) \n(if (member rule '(initial goal)) \n\n(format t \"~&~a is one of the ~a parameters.\" \nparm rule) \n(multiple-value-bind (knowns unknowns) \n(partition-if #'(lambda (premise) \n(true-p (eval-condition premise nil))) \n(rule-premises rule)) \n\n(when knowns \n(format t \"\"\"Alt is known that:\") \n(print-conditions knowns) \n(format t \"~&Therefore,\")) \n\n(let ((new-rule (copy-rule rule))) \n(setf (rule-premises new-rule) unknowns) \n(print new-rule))))) \n\nThat completes the definition of emyci n. We are now ready to apply the shell to a \nspecific domain, yielding the beginnings of an expert system. \n\n16.8 MYCIN, A Medical Expert System \nThis section applies emycin to MYCIN'S original domain: infectious blood disease. \nIn our version of MYCIN, there are three contexts: first we consider a patient, then \nany cultures that have been grown from samples taken from the patient, and finally \nany infectious organisms in the cultures. The goal is to determine the identity of \neach organism. The real MYCIN was more complex, taking into account any drugs \nor operations the patient may previously have had. It also went on to decide the \nreal question: what therapy to prescribe. However, much of this was done by \nspecial-purpose procedures to compute optimal dosages and the like, so it is not \nincluded here. The original MYCIN also made a distinction between current versus \nprior cultures, organisms, and drugs. All together, it had ten contexts to consider, \nwhile our version only has three: \n\n(defun mycin () \n\"Determine what organism is infecting a patient.\" \n(emycin \n\n(list (defcontext patient (name sex age) ()) \n(defcontext culture (site days-old) ()) \n(defcontext organism () (identity))))) \n\n\f\n<a id='page-553'></a>\nThese contexts declare that we will first ask each patient's name, sex, and age, and \neach culture's site and the number of days ago it was isolated. Organisms have no \ninitial questions, but they do have a goal: to determine the identity of the organism. \n\nThe next step is to declare parameters for the contexts. Each parameter is given \na type, and most are given prompts to improve the naturalness of the dialogue: \n\nParameters for patient: \n(defparm name patient t \"Patient's name: \" t read-line) \n(defparm sex patient (member male female) \"Sex:\" t) \n(defparm age patient number \"Age:\" t) \n(defparm burn patient (member no mild serious) \n\n\"Is ~a a burn patient? If so, mild or serious?\" t) \n(defparm compromised-host patient yes/no \n\"Is ~a a compromised host?\") \n\n;;; Parameters for culture: \n(defparm site culture (member blood) \n\"From what site was the specimen for ~a taken?\" t) \n(defparm days-old culture number \n\"How many days ago was this culture (~a) obtained?\" t) \n\n;;; Parameters for organism: \n(defparm identity organism \n(member Pseudomonas klebsiel la enterobacteriaceae \nstaphylococcus bacteroides streptococcus) \n\"Enter the identity (genus) of ~a:\" t) \n(defparm gram organism (member acid-fast pos neg) \n\"The gram stain of ~a:\" t) \n(defparm morphology organism (member rod coccus) \n\n\"Is ~a a rod or coccus (etc.):\") \n(defparm aerobicity organism (member aerobic anaerobic)) \n(defparm growth-conformation organism \n\n(member chains pairs clumps)) \n\nNow we need some rules to help determine the identity of the organisms. The \nfollowing rules are taken from Shortliffe 1976. The rule numbers refer to the pages \non which they are listed. The real MYCIN had about 400 rules, dealing with a much \nwider variety of premises and conclusions. \n\n(clear-rules) \n\n(defrule 52 \n\nif (site culture is blood) \n(gram organism is neg) \n(morphology organism is rod) \n(burn patient is serious) \n\nthen .4 \n(identity organism is Pseudomonas)) \n\n\f\n<a id='page-554'></a>\n\n(defrule 71 \n\nif (gram organism is pos) \n(morphology organism is coccus) \n(growth-conformation organism is clumps) \n\nthen .7 \n(identity organism is staphylococcus)) \n\n(defrule 73 \n\nif (site culture is blood) \n(gram organism is neg) \n(morphology organism is rod) \n(aerobicity organism is anaerobic) \n\nthen .9 \n(identity organism is bacteroides)) \n\n(defrule 75 \n\nif (gram organism is neg) \n(morphology organism is rod) \n(compromised-host patient is yes) \n\nthen .6 \n(identity organism is Pseudomonas)) \n\n(defrule 107 \n\nif (gram organism is neg) \n(morphology organism is rod) \n(aerobicity organism is aerobic) \n\nthen .8 \n(identity organism is enterobacteriaceae)) \n\n(defrule 165 \n\nif (gram organism is pos) \n(morphology organism is coccus) \n(growth-conformation organism is chains) \n\nthen .7 \n\n(identity organism is streptococcus)) \n\nHere is an example of the program in use: \n\n> (mycin) \nPATIENT-1 \nPatient's name: Sylvia Fischer \nSex: female \nAge: 27 \nCULTURE-1 \nFrom what site was the specimen for CULTURE-1 taken? blood \nHow many days ago was this culture (CULTURE-1) obtained? 3 \n- ORGANISM-1 \nEnter the identity (genus) of ORGANISM-1: unknown \nThe gram stain of ORGANISM-1: ? \n\n\f\n<a id='page-555'></a>\n\nA GRAM must be of type (MEMBER ACID-FAST POS NEG) \nThe gram stain of ORGANISM-1: neg \n\nThe user typed ? to see the list of valid responses. The dialog continues: \n\nIs ORGANISM-1 a rod or coccus (etc.): rod \nWhat is the AEROBICITY of ORGANISM-1? why \n[Why is the value of AEROBICITY being asked for?] \nIt is known that: \n\n1) THE GRAM OF THE ORGANISM IS NEG \n2) THE MORPHOLOGY OF THE ORGANISM IS ROD \nTherefore, \nRule 107: \nIf \n\n1) THE AEROBICITY OF THE ORGANISM IS AEROBIC \nThen there is suggestive evidence (0.8) that \n1) THE IDENTITY OF THE ORGANISM IS ENTEROBACTERIACEAE \nThe user wants to know why the system is asking about the organism's aerobicity. \nThe reply shows the current rule, what is already known about the rule, and the fact \nthat if the organism is aerobic, then we can conclude something about its identity. In \nthis hypothetical case, the organism is in fact aerobic: \n\nWhat is the AEROBICITY of ORGANISM-1? aerobic \nIs Sylvia Fischer a compromised host? yes \nIs Sylvia Fischer a burn patient? If so. mild or serious? why \n[Why is the value of BURN being asked for?] \nIt is known that: \n\n1) THE SITE OF THE CULTURE IS BLOOD \n2) THE GRAM OF THE ORGANISM IS NEG \n3) THE MORPHOLOGY OF THE ORGANISM IS ROD \nTherefore, \nRule 52: \nIf \n\n1) THE BURN OF THE PATIENT IS SERIOUS \nThen there is weakly suggestive evidence (0.4) that \n1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS \nIs Sylvia Fischer a burn patient? If so, mild or serious? serious \nFindings for ORGANISM-1: \nIDENTITY: ENTEROBACTERIACEAE (0.800) PSEUDOMONAS (0.760) \n\nThe system used rule 107 to conclude the identity might be enterobacteriaceae. \nThe certainty is .8, the certainty for the rule itself, because all the conditions were \nknown to be true with certainty. Rules 52 and 75 both support the hypothesis of \nPseudomonas. The certainty factors of the two rules, .6 and .4, are combined by the \n\n\f\n<a id='page-556'></a>\n\nformula .6 + .4 - (.6 . .4) = .76. After printing the findings for the first organism, \nthe system asks if another organism was obtained from this culture: \n\nIs there another ORGANISM? (Y or N) Y \n\nORGANISM-2 \n\nEnter the identity (genus) of ORGANISM-2: unknown \n\nThe gram stain of ORGANISM-2: (neg .8 pos .2) \n\nIs ORGANISM-2 a rod or coccus (etc.): rod \n\nWhat is the AEROBICITY of ORGANISM-2? anaerobic \n\nFor the second organism, the lab test was inconclusive, so the user entered a qualified \nanswer indicating that it is probably gram-negative, but perhaps gram-positive. This \norganism was also a rod but was anaerobic. Note that the system does not repeat \nquestions that it already knows the answers to. In considering rules 75 and 52 \nit already knows that the culture came from the blood, and that the patient is a \ncompromised host and a serious burn patient. In the end, rule 73 contributes to the \nbacteroides conclusion, and rules 75 and 52 again combine to suggest Pseudomonas, \nalthough with a lower certainty factor, because the neg finding had a lower certainty \nfactor: \n\nFindings for ORGANISM-2: \nIDENTITY: BACTEROIDES (0.720) PSEUDOMONAS (0.646) \n\nFinally, the program gives the user the opportunity to extend the context tree with \nnew organisms, cultures, or patients: \n\nIs there another ORGANISM? (Y or N) . \nIs there another CULTURE? (Y or N) . \nIs there another PATIENT? (Y or N) . \n\nThe set of rules listed above do not demonstrate two important features of the \nsystem: the ability to backward-chain, and the ability to use operators other than i s \nin premises. \n\nIf we add the following three rules and repeat the case shown above, then evaluating \nrule 75 will back-chain to rule 1, 2, and finally 3 trying to determine if the \npatient is a compromised host. Note that the question asked will be \"What is Sylvia \nFischer's white blood cell count?\" and not \"Is the white blood cell count of Sylvia \nFischer < 2.5?\" The latter question would suffice for the premise at hand, but it \nwould not be as useful for other rules that might refer to the WBC. \n\n(defparm wbc patient number \n\"What is ~a's white blood cell count?\") \n\n\f\n<a id='page-557'></a>\n(defrule 1 \n\nif (immunosuppressed patient is yes) \n\nthen 1.0 (compromised-host patient is yes)) \n\n(defrule 2 \n\nif (leukopenia patient is yes) \n\nthen 1.0 (immunosuppressed patient is yes)) \n\n(defrule 3 \n\nif (wbc patient < 2.5) \n\nthen .9 (leukopenia patient is yes)) \n\n16.9 Alternatives to Certainty Factors \nCertainty factors are a compromise. The good news is that a system based on rules \nwith certainty factors requires the expert to come up with only a small set of numbers \n(one for each rule) and will allow fast computation of answers. The bad news is that \nthe answer computed may lead to irrational decisions. \n\nCertainty factors have been justified by their performance (MYCIN performed as \nwell or better than expert doctors) and by intuitive appeal (they satisfy the criteria \nlisted on [page 534](chapter16.md#page-534)). However, they are subject to paradoxes where they compute \nbizarre results (as in Exercise 16.1, [page 536](chapter16.md#page-536)). If the rules that make up the knowledge \nbase are designed in a modular fashion, then problems usually do not arise, but it is \ncertainly worrisome that the answers may be untrustworthy. \n\nBefore MYCIN, most reasoning with uncertainty was done using probability theory. \nThe laws of probability - in particular, Bayes's law - provide a well-founded \nmathematical formalism that is not subject to the inconsistencies of certainty factors. \nIndeed, probability theory can be shown to be the only formalism that leads \nto rational behavior, in the sense that if you have to make a series of bets on some \nuncertain events, combining information with probability theory will give you the \nhighest expected value for your bets. Despite this, probability theory was largely set \naside in the mid-1970s. The argument made by Shortliffe and Buchanan (1975) was \nthat probability theory required too many conditional probabilities, and that people \nwere not good at estimating these. They argued that certainty factors were intuitively \neasier to deal with. Other researchers of the time shared this view. Shaf er, with later \nrefinements by Dempster, created a theory of belief functions that, like certainty \nfactors, represented a combination of the belief for and against an event. Instead of \nrepresenting an event by a single probability or certainty, Dempster-Shafer theory \nmaintains two numbers, which are analagous to the lower and upper bound on the \nprobability. Instead of a single number like .5, Dempster-Shafer theory would have \nan interval like [.4,.6] to represent a range of probabilities, A complete lack of knowledge \nwould be represented by the range [0,1]. A great deal of effort in the late 1970s \n\n\f\n<a id='page-558'></a>\n\nand early 1980s was invested in these and other nonprobabilistic theories. Another \nexample is Zadeh's fuzzy set theory, which is also based on intervals. \n\nThere is ample evidence that people have difficulty with problems involving \nprobability. In a very entertaining and thought-provoking series of articles, Tversky \nand Kahneman (1974, 1983, 1986) show how people make irrational choices when \nfaced with problems that are quite simple from a mathematical viewpoint. They \nliken these errors in choice to errors in visual perception caused by optical illusions. \nEven trained doctors and statisticians are subject to these errors. \n\nAs an example, consider the following scenario. Adrian and Dominique are to be \nmarried. Adrian goes for a routine blood test and is told that the results are positive \nfor a rare genetic disorder, one that strikes only 1 in 10,000 people. The doctor \nsays that the test is 99% accurate - it gives a false positive reading in only 1 in 100 \ncases. Adrian is despondent, being convinced that the probability of actually having \nthe disease is 99%. Fortunately, Dominique happens to be a Bayesian, and quickly \nreassures Adrian that the chance is more like 1 %. The reasoning is as follows: Take \n10,001 people at random. Of these, only 1 is expected to have the disease. That \nperson could certainly expect to test positive for the disease. But if the other 10,000 \npeople all took the blood test, then 1 % of them, or 100 people would also test positive. \nThus, the chance of actually having the disease given that one tests positive is 1/101. \nDoctors are trained in this kind of analysis, but unfortunately many of them continue \nto reason more like Adrian than Dominique. \n\nIn the late 1980s, the tide started to turn back to subjective Bayesian probability \ntheory. Cheeseman (1985) showed that, while Dempster-Shafer theory looks like \nit can, in fact it cannot help you make better decisions than probability theory. \nHeckerman (1986) re-examined MYCIN'S certainty factors, showing how they could \nbe interpreted as probabilities. Judea Pearl's 1988 book is an eloquent defense of \nprobability theory. He shows that there are efficient algorithms for combining and \npropagating probabilities, as long as the network of interdependencies does not \ncontain loops. It seems likely that uncertain reasoning in the 1990s will be based \nincreasingly on Bayesian probability theory. \n\n16.10 History and References \nThe MYCIN project is well documented in Buchanan and Shortliffe 1984. An earlier \nbook, Shortliffe 1976, is interesting mainly for historical purposes. Good introductions \nto expert systems in general include Weiss and Kulikowski 1984, Waterman \n1986, Luger and Shibblefield 1989, and Jackson 1990. \n\nDempster-Shafer evidence theory is presented enthusiastically in Gordon and \nShortliffe 1984 and in a critical light in Pearl 1989/1978. Fuzzy set theory is presented \nin Zadeh 1979 and Dubois and Prade 1988. \n\n\f\n<a id='page-559'></a>\nPearl (1988) captures most of the important points that lead to the renaissance \nof probability theory. Shafer and Pearl 1990 is a balanced collection of papers on all \nkinds of uncertain reasoning. \n16.11 Exercises \n&#9635; Exercise 16.2 [s] Suppose the rule writer wanted to be able to use symbolic certainty \nfactors instead of numbers. What would you need to change to support rules like \nthis: \n(defrule(defrule \n100 if \n101 if \n.. . \n.. . \nthen true ... ) \nthen probably ... ) \n\n&#9635; Exercise 16.3 [m] Change prompt-and-read-va l s so that it gives a better prompt \nfor parameters of type yes/no. \n\n&#9635; Exercise 16.4 [m] Currently, the rule writer can introduce a new parameter without \ndefining it first. That is handy for rapid testing, but it means that the user of the system \nwon't be able to see a nice English prompt, nor ask for the type of the parameter. In \naddition, if the rule writer simply misspells a parameter, it will be treated as a new \none. Make a simple change to fix these problems. \n\n&#9635; Exercise 16.5 [d] Write rules in a domain you are an expert in, or find and interview \nan expert in some domain, and write down rules coaxed from the expert. Evaluate \nyour resulting system. Was it easier to develop your system with EMYCI N than it \nwould have been without it? \n\n&#9635; Exercise 16.6 [s] It is said that an early version of MYCI N asked if the patient was \npregnant, even though the patient was male. Write a rule that would fix this problem. \n\n&#9635; Exercise 16.7 [m] To a yes/no question, what is the difference between yes and (no \n-1) ? What does this suggest? \n\n&#9635; Exercise 16.8 [m] What happens if the user types why to the prompt about the \npatient's name? What happens if the expert wants to have more than one context \nwith a name parameter? If there is a problem, fix it. \n\n\f\n<a id='page-560'></a>\n\nThe remaining exercises discuss extensions that were in the original EMYCIN, but \nwere not implemented in our version. Implementing all the extensions will result in a \nsystem that is very close to the full power of EMYCIN. These extensions are discussed \nin chapter 3 of Buchanan and Shortliffe 1984. \n\n&#9635; Exercise 16.9[h] Add a spelling corrector to ask-vals. If the user enters an invalid \nreply, and the parameter type is a member expression, check if the reply is \"close\" in \nspelling to one of the valid values, and if so, use that value. That way, the user can type \njust entero instead of enterobacter i aceae. You may experiment with the definition \nof \"close,\" but you should certainly allow for prefixes and at least one instance of a \nchanged, missing, inserted, or transposed letter. \n\n&#9635; Exercise 16.10 [m] Indent the output for each new branch in the context tree. In \nother words, have the prompts and findings printed like this: \n\nRATIENT-1 \nPatient's name: Sylvia Fischer \nSex: female \nAge: 27 \n\nCULTURE-1 \nFrom what site was the specimen for CULTURE-1 taken? blood \nHow many days ago was this culture (CULTURE-1) obtained? 3 \n\nORGANISM-1 \nEnter the identity (genus) of ORGANISM-1: unknown \nThe gram stain of ORGANISM-1: neg \n\nFindings for ORGANISM-1: \nIDENTITY: ENTEROBACTERIACEAE (0.800) PSEUDOMONAS (0.760) \nIs there another ORGANISM? (Y or N) . \nIs there another CULTURE? (Y or N) . \nIs there another PATIENT? (Y or N) . \n\n&#9635; Exercise 16.11 [h] We said that our emycin looks at all possible rules for each \nparameter, because there is no telling how a later rule may affect the certainty factor. \nActually, that is not quite true. If there is a rule that leads to a conclusion with \ncertainty 1, then no other rules need be considered. This was called a unity path. \nModify the program to look for unity paths first. \n\n&#9635; Exercise 16.12 [m] Depending on whether a parameter is in i ni ti al -data or not, \nall the relevant rules are run either before or after asking the user for the value \nof the parameter. But there are some cases when not all initial data parameters \n\n\f\n<a id='page-561'></a>\n\nshould be asked for. As an example, suppose that identity and gram were initial \ndata parameters of organi sm. If the user gave a positive answer for i denti ty, then it \nwould be wasteful to ask for the gram parameter, since it could be determined directly \nfrom rules. After receiving complaints about this problem, a system of antecedent \nrules was developed. These rules were always run first, before asking questions. \nImplement antecedent rules. \n\n&#9635; Exercise 16.13 [h] It is useful to be able to write default rules that fill in a value after \nall other rules have failed to determine one. A default rule looks like this: \n\n(defrule . if (parm inst unknown) then (parm inst is default)) \n\nIt may also have other conjuncts in the premise. Beside details like writing the \nunknown operator, the difficult part is in making sure that these rules get run at the \nright time (after other rules have had a chance to fill in the parameter), and that \ninfinite loops are avoided. \n\n&#9635; Exercise 16.14 [h] The context tree proved to be a limitation. Eventually, the need \narose for a rule that said, 'Tf any of the organisms in a culture has property X, then the \nculture has property Y.\" Implement a means of checking for some or every instance \nof a context. \n\n&#9635; Exercise 16.15 [m] As the rule base grew, it became increasingly hard to remember \nthe justification for previous rules. Implement a mechanism that keeps track of the \nauthor and date of creation of each rule, and allows the author to add documentation \nexplaining the rationale for the rule. \n\n&#9635; Exercise 16.16 [m] It is difficult to come up with the perfect prompt for each parameter. \nOne solution is not to insist that one prompt fits all users, but rather to allow \nthe expert to supply three different prompts: a normal prompt, a verbose prompt (or \nreprompt) for when the user replies with a ?, and a terse prompt for the experienced \nuser. Modify defparm to accommodate this concept, add a command for the user to \nask for the terse prompts, and change ask-val s to use the proper prompt. \n\nThe remaining exercises cover three additional replies the user can make: how, \nstop, and change. \n\n&#9635; Exercise 16.17 [d] In addition to why replies, EMYCIN also allowed for how questions. \nThe user can ask how the value of a particular parameter/instance pair was determined, \nand the system will reply with a list of rules and the evidence they supplied for \n\n\f\n<a id='page-562'></a>\n\nor against each value. Implement this mechanism. It will require storing additional \ninformation in the data base. \n\n&#9635; Exercise 16.18 [m] There was also a stop command that immediately halted the \nsession. Implement it. \n\n&#9635; Exercise 16.19 [d] The original EMYCIN also had a change command to allow the \nuser to change the answer to certain questions without starting all over. Each question \nwas assigned a number, which was printed before the prompt. The command change, \nfollowed by a list of numbers, causes the system to look up the questions associated \nwith each number and delete the answer to these questions. The system also throws \naway the entire context tree and all derived parameter values. At that point the \nentire consultation is restarted, using only the data obtained from the unchanged \nquestions. Although it may seem wasteful to start over from the beginning, it will \nnot be wasteful of the user's time, since correct answers will not be asked again. \nIdentify what needs to be altered to implement change and make the alterations. \n\n&#9635; Exercise 16.20 [h] Change the definition of cf - a nd and cf -or to use fuzzy set theory \ninstead of certainty factors. Do the same for Dempster-Shafer theory. \n\n16.12 Answers \nAnswer 16.1 Because EMYCIN assumes independence, each reading of the same \nheadline would increase the certainty factor. The following computation shows \nthat 298 more copies would be needed to reach .95 certainty. A more sophisticated \nreasoner would realize that multiple copies of a newspaper are completely dependent \non one another, and would not change the certainty with each new copy. \n\n> (loop for cf = .01 then (cf-or .01 cf) \nuntil (> cf .95) \ncount t) \n\n298 \n\nAnswer 16.2 Thedef rule expands to (make-rule rnumber .01 :cf true ...); \nthat is, the certainty factor is unquoted, so it is already legal to use true as a certainty \nfactor! To support probabl y and other hedges, just define new constants. \n\n\f\n<a id='page-563'></a>\nAnswer 16.4 Just make the defauh parameter type be ni 1 (by changing t to ni1 \nin parm-type). Then any rule that uses an undefined parameter will automatically \ngenerate a warning. \n\nAnswer 16.6 \n\n(defrule 4 \nif (sex patient is male) \nthen -1 (pregnant patient is yes)) \n\nAnswer 16.7 Logically, there should be no difference, but to EMYCIN there is a big \ndifference. EMYCIN wouldnotcomplainif you answered (yes 1 no 1). This suggests \nthat the system should have some way of dealing with mutually exclusive answers. \nOne way would be to accept only yes responses for Boolean parameters, but have the \ninput routine translate no to (yes -1) and (no cf) to (yes 1-cf). Another possibility \nwould be to have u pd a t e -cf check to see if any certainty factor on a mutually exclusive \nvalue is 1, and if so, change the other values to -1. \n\nAnswer 16.18 Add the clause (stop (throw 'stop nil)) to the case statement \nin ask-vals and wrap a (catch 'stop ...) around the code in emycin. \n\n\f\n## Chapter 17\n<a id='page-564'></a>\n\nLine-Diagram \nLabeling by Constraint \nSatisfaction \n\nIt is wrong to think of Waltz's work only as a \nstatement of the epistemology of line drawings of \npolyhedra. Instead I think it is an elegant case study \nof a paradigm we can expect to see again and again. \n\n- Patrick Winston \n\nThe Psychology of Computer Vision (1975) \n\nI I 1 his book touches only the areas of AI that deal with abstract reasoning. There is another \n\nI side of AI, the field of robotics, that deals with interfacing abstract reasoning with the real \n\nJL world through sensors and motors. A robot receives input from cameras, microphones, \nsonar, and touch-sensitive devices, and produces \"ouput\" by moving its appendages or generating \nsounds. The real world is a messier place than the abstract worlds we have been covering. \nA robot must deal with noisy data, faulty components, and other agents and events in the world \nthat can affect changes in the environment. \n\n\f\n<a id='page-565'></a>\n\nComputer vision is the subfield of robotics that deals with interpreting visual \ninformation. Low-level vision takes its input directly from a camera and detects \nlines, regions and textures. We will not be concerned with this. High-level vision \nuses the findings of the low-level component to build a three-dimensional model of \nthe objects depicted in the scene. This chapter covers one small aspect of high-level \nvision. \n\n17.1 The Line-Labeling Problem \nIn this chapter we look at the line-diagram labeling problem: Given a list of lines and \nthe Vertexes at which they intersect, how can we determine what the lines represent? \nFor example, given the nine lines in figure 17.1, how can we interpret the diagram as \na cube? \n\nFigure 17.1: A Cube \n\nBefore we can arrive at an interpretation, we have to agree on what the candidates \nare. After all, figure 17.1 could be just a hexagon with three lines in the middle. For \nthe purposes of this chapter, we will consider only diagrams that depict one or more \npo/y/zedra - three-dimensional solid figures whose surfaces are flat faces bounded by \nstraight lines. In addition, we will only allow trihedral VERTEXES. That is, each vertex \nmust be formed by the intersection of three faces, as in the corner of a cube, where \nthe top, front, and side of the cube come together. A third restriction on diagrams is \nthat no so-called accidental Vertexes are allowed. For example, figure 17.1 might be \na picture of three different cubes hanging in space, which just happen to line up so \nthat the edge of one is aligned with the edge of another from our viewpoint. We will \nassume that this is not the case. \n\n\f\n<a id='page-566'></a>\n\nGiven a diagram that fits these three restrictions, our goal is to identify each line, \nplacing it in one of three classes: \n\n1. A convex line separates two visible faces of a polyhedron such that a line from \none face to the other would lie inside the polyhedron. It will be marked with a \nplus sign: -h. \n2. A concave line separates two faces of two polyhedra such that a line between \nthe two spaces would pass through empty space. It will be marked with a \nminus sign: -. \n3. A boundary line denotes the same physical situation as a convex line, but the \ndiagram is oriented in such a way that only one of the two faces of the polyhedron \nis visible. Thus, the line marks the boundary between the polyhedron \nand the background. It will be marked with an arrow: - Traveling along the \nline from the tail to the point of the arrow, the polyhedron is on the right, and \nthe background is on the left. \nFigure 17.2 shows a labeling of the cube using these conventions. Vertex A is \nthe near corner of the cube, and the three lines coming out of it are all convex lines. \nLines GD and DF are concave lines, indicating the junction between the cube and \nthe surface on which it is resting. The remaining lines are boundary lines, indicating \nthat there is no physical connection between the cube and the background there, but \nthat there are other sides of the cube that cannot be seen. \n\nFigure 17.2: A Line-labeled Cube \n\nThe line-labeling technique developed in this chapter is based on a simple idea. \nFirst we enumerate all the possible Vertexes, and all the possible labelings for each \n\n\f\n<a id='page-567'></a>\n\nvertex. It turns out there are only four different vertex types in the trihedral polygon \nworld. We call them L, Y, W, and . Vertexes, because of their shape. The Y and W \nVertexes are also known as forks and arrows, respectively. The Vertexes are listed in \nfigure 17.3. Each vertex imposes some constraints on the lines that compose it. For \nexample, in a W vertex, the middle line can be labeled with a + or - but not with \nan arrow. \n\nNX ./ \\y \n\n\\ \n\\ \n1 . 2 \n1 \n\n3 \n\n3 \n\n3 \nV 2 \n\n\\ V \n\n(V L 1 2) (V Y 1 2 3) (V . 1 2 3) (VWL 23) \n\nFigure 17.3: The Possible Vertexes and Labels \n\nEach line connects two Vertexes, so it must satisfy both constraints. This suggests \na simple algorithm for labeling a diagram based on constraint propagation: First, \nlabel each vertex with all the possible labelings for the vertex type. An L vertex has \nsix possibilities, Y has five, . has four, and W has three. Next, pick a vertex, V. \nConsider a neighboring vertex, . (that is, . and V are connected by a line). . will \nalso have a set of possible labelings. If . and V agree on the possible labelings for the \nline between them, then we have gained nothing. But if the intersection of the two \npossibility sets is smaller than V's possibility set, then we have found a constraint on \n\n\f\n<a id='page-568'></a>\n\nthe diagram. We adjust . and V's possible labehngs accordingly. Every time we add \na constraint at a vertex, we repeat the whole process for all the neighboring Vertexes, \nto give the constraint a chance to propagate as far as possible. When every vertex \nhas been visited at least once and there are no more constraints to propagate, then \nwe are done. \n\nFigure 17.4 illustrates this process. On the left we start with a cube. All Vertexes \nhave all possible labelings, except that we know line GD is concave (-), indicating that \nthe cube is resting on a surface. This constrains vertex D in such a way that line DA \nmust be convex (+). In the middle picture the constraint on vertex D has propagated \nto vertex A, and in the right-hand picture it propagates to vertex B. Soon, the whole \ncube will be uniquely labeled. \n\nFigure 17.4: Propagating Constraints \n\nMany diagrams will be labeled uniquely by this constraint propagation process. \nSome diagrams, however, are ambiguous. They will still have multiple labelings \nafter constraint propagation has finished. In this case, we can search for a solution. \nSimply choose an ambiguous vertex, choose one of the possible labelings for that \nvertex, and repeat the constraint propagation/search process. Keep going until the \ndiagram is either unambiguous or inconsistent. \n\nThat completes the sketch of the line-labeling algorithm. We are now ready to \nimplement a labeling program. It's glossary is in figure 17.5. \n\nThe two main data structures are the di agram and the vertex. It would have been \npossible to implement a data type for 1 i nes, but it is not necessary: lines are defined \nimplicitly by the two Vertexes at their end points. \n\nA diagram is completely specified by its list of Vertexes, so the structure di agram \nneeds only one slot. A vertex, on the other hand, is a more complex structure. Each \nvertex has an identifying name (usually a single letter), a vertex type (L, Y, W, or T), a \n\n\f\n<a id='page-569'></a>\n\nTop-Level Functions \nprint-labelings Label the diagram by propagating constraints and then searching. \n\nData Types \ndiagram A diagram is a list of VERTEXES. \nvertex A vertex has a name, type, and list of neighbors and labelings. \n\nMajor Functions \nfind-labelings Do the same constraint propagation, but don't print anything. \npropagate-constraints Reduce the number of labelings on vertex by considering neighbors. \nconsistent-labelings Return the set of labelings that are consistent with neighbors. \nsearch-solutions Try all labelings for one ambiguous vertex, and propagate. \ndefdiagram (macro) Define a diagram. \ndiagram Retrieve a diagram stored by name. \nground Attach the line between the two VERTEXES to the ground. \n\nAuxiliary Functions \nlabels-for Return all the labels for the line going to vertex. \nreverse -label Reverse left and right on arrow labels. \nambiguous-vertex -p A vertex is ambiguous if it has more than one labeling. \nnumber-of-labelings Number of labels on a vertex. \nfind-vertex Find the vertex with the given name. \nmatrix-transpose Turn a matrix on its side. \npossible-labelings The list of possible labelings for a given vertex type. \nprint-vertex Print a vertex in the short form. \nshow-vertex Print a vertex in a long form, on a new line. \nshow-diagram Print a diagram in a long form. Include a title. \nconstruct-diagram Build a new diagram from a set of vertex descriptions. \nconstruct-vertex Build a new vertex from a vertex description. \nmake-copy-diagram Make a copy of a diagram, preserving connectivity. \ncheck-diagram Check if the description appears consistent. \n\nFigure 17.5: Glossary for the Line-Labeling Program \n\nlist of neighboring Vertexes, and a list of possible labelings. A labeling is a list of line \nlabels. For example, a Y vertex will initially have a list of five possible labelings. If it \nis discovered that the vertex is the interior of a concave corner, then it will have the \nsingle labeling ( -- -). We give type information on the slots of vertex because it \nis a compUcated data type. The syntax of defstruct is such that you cannot specify \n\na : type without first specifying a default value. We chose L as the default value for \nthe type slot at random, but note that it would have been an error to give nil as the \ndefault value, because ni1 is not of the right type. \n(defstruct diagram \"A diagram is a list of Vertexes.\" Vertexes) \n\n(defstruct (vertex (:print-function print-vertex)) \n(name nil :type atom) \n(type 'L :type (member L Y W T)) \n(neighbors nil :type list) ; of vertex \n(labelings nil :type list)) ; of lists of (member + -L R))))) \n\n\f\n<a id='page-570'></a>\n\nAn ambiguous vertex will have several labelings, while an unambiguous vertex has \nexactly one, and a vertex with no labelings indicates an impossible diagram. Initially \nwe don't know which Vertexes are what, so they all start with several possible labelings. \nNote that a labeling is a list, not a set: the order of the labels is significant and \nmatches the order of the neighboring Vertexes. The function possi bl e-1 abel i ngs \ngives a list of all possible labelings for each vertex type. We use R and L instead of \narrows as labels, because the orientation of the arrows is significant. An R means \nthat as you travel from the vertex to its neighbor, the polyhedron is on the right and \nthe background object is on the left. Thus, an R is equivalent to an arrow pointing \naway from the vertex. The L is just the reverse. \n\n(defun ambiguous-vertex-p (vertex) \n\"A vertex is ambiguous if it has more than one labeling.\" \n(> (number-of-labelings vertex) D) \n\n(defun number-of-labelings (vertex) \n(length (vertex-labelings vertex))) \n\n(defun impossible-vertex-p (vertex) \n\"A vertex is impossible if it has no labeling.\" \n(null (vertex-labelings vertex))) \n\n(defun impossible-diagram-p (diagram) \n\"An impossible diagram is one with an impossible vertex.\" \n(some #*impossible-vertex-p (diagram-Vertexes diagram))) \n\n(defun possible-labelings (vertex-type) \n\"The list of possible labelings for a given vertex type.\" \n;; In these labelings, R means an arrow pointing away from \n\nthe vertex, L means an arrow pointing towards it. \n\n(case vertex-type \n((L) '((R L) (L R) (+ R) (L +) (- L) (R -))) \n((Y) '((+ + +) ( ) (L R -) (- L R) (R - L))) \n((T) '((R L -H) (R L -) (R L L) (R L R))) \n((W) '((L R +) (-- +) (+ + -))))) \n\n17.2 Combining Constraints and Searching \nThe main function print-1 abel ings takes a diagram as input, reduces the number \nof labelings on each vertex by constraint propagation, and then searches for all \nconsistent interpretations. Output is printed before and after each step. \n\n\f\n<a id='page-571'></a>\n\n(defun print-labelings (diagram) \n\"Label the diagram by propagating constraints and then \nsearching for solutions if necessary. Print results.\" \n(show-diagram diagram \"~&The initial diagram is:\") \n(every #*propagate-constraints (diagram-vertexes diagram)) \n(show-diagram diagram \n\n\"~2&After constraint propagation the diagram is:\") \n\n(let* ((solutions (if (impossible-diagram-p diagram) \nnil \n(search-solutions diagram))) \n\n(n (length solutions))) \n\n(unless (= . 1) \n(format t \"~2&There are ~r solution~:p:\" n) \n(mapc #'show-diagram solutions))) \n\n(values)) \nThe function propagate-constraints takes a vertex and considers the constraints \nimposed by neighboring Vertexes to get a list of all the cons i stent -1 abel i ngs for the \nvertex. If the number of consistent labelings is less than the number before we started, \nthen the neighbors' constraints have had an effect on this vertex, so we propagate the \nnew-found constraints on this vertex back to each neighbor. The function returns \nnil and thus immediately stops the propagation if there is an impossible vertex. \nOtherwise, propagation continues until there are no more changes to the labelings. \nThe whole propagation algorithm is started by a call to every in pri nt -1 abel i ngs, \nwhich propagates constraints from each vertex in the diagram. But it is not obvious \nthat this is all that is required. After propagating from each vertex once, couldn't \nthere be another vertex that needs relabeling? The only vertex that could possibly \nneed relabeling would be one that had a neighbor changed since its last update. \nBut any such vertex would have been visited by propagate-constraint, since we \npropagate to all neighbors. Thus, a single pass through the Vertexes, compounded \nwith recursive calls, will find and apply all possible constraints. \nThe next question worth asking is if the algorithm is guaranteed to terminate. \nClearly, it is, because propagate-constra i nts can only produce recursive calls when \nit removes a labeling. But since there are a finite number of labelings initially (no more \nthan six per vertex), there must be a finite number of calls topropagate-constraints. \n(defun propagate-constraints (vertex) \n\"Reduce the labelings on vertex by considering neighbors. \nIf we can reduce, propagate the constraints to each neighbor.\" \nReturn nil only when the constraints lead to an impossibility \n(let ((old-num (number-of-labelings vertex))) \n(setf (vertex-labelings vertex) (consistent-labelings vertex)) \n(unless (impossible-vertex-p vertex) \n(when (< (number-of-labelings vertex) old-num) \n(every #'propagate-constraints (vertex-neighbors vertex))) \nt))) \n\n\f\n<a id='page-572'></a>\n\nThe function consi stent -1 abel i ngs is passed a vertex. It gets all the labels for this \nvertex from the neighboring Vertexes, collecting them in nei ghbor-1 abel s. It then \nchecks all the labels on the current vertex, keeping only the ones that are consistent \nwith all the neighbors' constraints. The auxiliary function labels-for finds the \nlabels for a particular neighbor at a vertex, and reverse -1 abel accounts for the fact \nthat L and R labels are interpreted with respect to the vertex they point at. \n\n(defun consistent-labelings (vertex) \n\"Return the set of labelings that are consistent with neighbors.\" \n(let ((neighbor-labels \n\n(mapcar #'(lambda (neighbor) (labels-for neighbor vertex)) \n(vertex-neighbors vertex)))) \nEliminate labelings that don't have all lines consistent \n;; with the corresponding line's label from the neighbor. \nAccount for the L-R mismatch with reverse -label, \n(find-all-if \n#'(lambda (labeling) \n(every #'member (mapcar #'reverse-1abel labeling) \nneighbor-labels)) \n(vertex-labelings vertex)))) \n\nConstraint propagation is often sufficient to yield a unique interpretation. But sometimes \nthe diagram is still underconstrained, and we will have to search for solutions. \nThe function search-sol utions first checks to see if the diagram is ambiguous, by \nseeing if it has an ambiguous vertex, v. If the diagram is unambiguous, then it is a \nsolution, and we return it (in a hst, since sea rch - sol ut i ons is designed to return a \nlist of all solutions). Otherwise, for each of the possible labelings for the ambiguous \nvertex, we create a brand new copy of the diagram and set v's labeling in the copy to \none of the possible labelings. In effect, we are guessing that a labeling is a correct one. \nWe call propagate - const ra i nts; if it fails, then we have guessed wrong, so there are \nno solutions with this labeling. But if it succeeds, then we call sea rch-sol utions \nrecursively to give us the list of solutions generated by this labeling. \n\n(defun search-solutions (diagram) \n\"Try all labelings for one ambiguous vertex, and propagate.\" \n\nIf there is no ambiguous vertex, return the diagram. \n;; If there is one, make copies of the diagram trying each of \n;; the possible labelings. Propagate constraints and append \n;; all the solutions together, \n(let ((v (find-if #'ambiguous-vertex-p \n\n(diagram-Vertexes diagram)))) \n\n(if (null V) \n(list diagram) \n(mapcan \n\n#'(lambda (v-labeling) \n\n\f\n<a id='page-573'></a>\n\n(let* ((diagram2 (make-copy-diagram diagram)) \n\n(v2 (find-vertex (vertex-name v) diagram2))) \n(setf (vertex-labelings v2) (list v-labeling)) \n(if (propagate-constraints v2) \n\n(search-solutions diagram2) \nnil))) \n(vertex-labelings v))))) \n\nThat's all there is to the algorithm; all that remains are some auxiliary functions. \nHere are three of them: \n\n(defun labels-for (vertex from) \n\"Return all the labels for the line going to vertex.\" \n(let ((pos (position from (vertex-neighbors vertex)))) \n\n(mapcar #*(lambda (labeling) (nth pos labeling)) \n(vertex-labelings vertex)))) \n\n(defun reverse-label (label) \n\"Account for the fact that one vertex's right is another's left.\" \n(case label (L 'R) (R 'D (otherwise label))) \n\n(defun find-vertex (name diagram) \n\"Find the vertex in the given diagram with the given name.\" \n(find name (diagram-vertexes diagram) :key #'vertex-name)) \n\nHere are the printing functions, print - vertex prints a vertex in short form. It obeys \nthe .r i .t convention of returning the first argument. The functions s how - ve r t ex and \nshow-di agramprintmoredetailedforms. They obey theconventionfordescri be-like \nfunctions of returning no values at all. \n\n(defun print-vertex (vertex stream depth) \n\"Print a vertex in the short form.\" \n(declare (ignore depth)) \n(format stream \"~a/~d\" (vertex-name vertex) \n\n(number-of-labelings vertex)) \nvertex) \n\n(defun show-vertex (vertex &optional (stream t)) \n\"Print a vertex in a long form, on a new line.\" \n(format stream \"~& \"a \"d:\" vertex (vertex-type vertex)) \n(mapc #'(lambda (neighbor labels) \n\n(format stream \" '\"a~a=[''{~a''}]\" (vertex-name vertex) \n\n(vertex-name neighbor) labels)) \n(vertex-neighbors vertex) \n(matrix-transpose (vertex-labelings vertex))) \n\n(values)) \n\n\f\n<a id='page-574'></a>\n\n(defun show-diagram (diagram &optional (title \"~2&Diagram:\") \n\n(stream t)) \n\"Print a diagram in a long form. Include a title. \" \n(format stream title) \n(mapc #*show-vertex (diagram-vertexes diagram)) \n(let ((n (reduce #'* (mapcar #'number-of-labelings \n\n(diagram-vertexes diagram))))) \n(when (> . 1) \n(format stream \"~&For \"RD interpretation~:p.\" n)) \n(values))) \n\nNote that matri x-transpose is called by show-vertex to turn the matrix of labelings \non its side. It works like this: \n\n> (possible-labelings *Y) \n\nii+ + +) \n\n( ) \n\n(L R -) \n(- L R) \n(R - D) \n\n> (matrix-transpose (possible-labelings .)) \n\n((+ - L - R) \n(-^' - R L -) \n(-H -- R D) \n\nThe implementation of matrix-transpose is surprisingly concise. It is an old Lisp \ntrick, and well worth understanding: \n\n(defun matrix-transpose (matrix) \n\"Turn a matrix on its side.\" \n(if matrix (apply #'mapcar #'list matrix))) \n\nThe remaining code has to do with creating diagrams. We need some handy way of \nspecifying diagrams. One way would be with a line-recognizing program operating \non digitized input from a camera or bitmap display. Another possibility is an interactive \ndrawing program using a mouse and bitmap display. But since there is not yet a \nCommon Lisp standard for interacting with such devices, we will have to settle for a \ntextual description. The macro def di agram defines and names a diagram. The name \nis followed by a list of vertex descriptions. Each description is a list consisting of \nthe name of a vertex, the vertex type (Y, A, L, or T), and the names of the neighboring \nVertexes. Here again is the def di agram description for the cube shown in figure 17.6. \n\n\f\n<a id='page-575'></a>\n\n(defdiagram cube \n(a Y b c d) \n\n(bW e a) \n(c W f a) \n(dW g a) \n(eL b) \n(f L c) \n(gL d)) \n\nFigure 17.6: A Cube \n\nTiie macro def diagram calls construct -diagram to do the real work. It would \nbe feasible to have defdi agram expand into a defvar, making the names be special \nvariables. But then it would be the user's responsibility to make copies of such a \nvariable before passing it to a destructive function. Instead, I use put-di agram and \ndi agram to put and get diagrams in a table, di agram retrieves the named diagram \nand makes a copy of it. Thus, the user cannot corrupt the original diagrams stored in \nthe table. Another possibility would be to have def di agram expand into a function \ndefinition for name that returns a copy of the diagram. I chose to keep the diagram \nname space separate from the function name space, since names like cube make \nsense in both spaces. \n\n(defmacro defdiagram (name &rest vertex-descriptors) \n\"Define a diagram. A copy can be gotten by (diagram name).\" \n'(put-diagram '.name (construct-diagram '.vertex-descriptors))) \n\n(let ((diagrams (make-hash-table))) \n\n\f\n<a id='page-576'></a>\n\n(defun diagram (name) \n\"Get a fresh copy of the diagram with this name.\" \n(make-copy-diagram (gethash name diagrams))) \n\n(defun put-diagram (name diagram) \n\"Store a diagram under a name.\" \n(setf (gethash name diagrams) diagram) \nname)) \n\nThe function construct-di agram translates each vertex description, using \nconstruct - vertex, and then fills in the neighbors of each vertex. \n\n(defun construct-diagram (vertex-descriptors) \n\"Build a new diagram from a set of vertex descriptor.\" \n(let ((diagram (make-diagram))) \n\nPut in the Vertexes \n(setf (diagram-vertexes diagram) \n\n(mapcar #'construct-vertex vertex-descriptors)) \n;; Put in the neighbors for each vertex \n(dolist (v-d vertex-descriptors) \n\n(setf (vertex-neighbors (find-vertex (first v-d) diagram)) \n(mapcar #'(lambda (neighbor) \n(find-vertex neighbor diagram)) \n(v-d-neighbors v-d)))) \ndiagram)) \n\n(defun construct-vertex (vertex-descriptor) \n\"Build the vertex corresponding to the descriptor.\" \n;; Descriptors are like: (x L y z) \n(make-vertex \n\n:name (first vertex-descriptor) \n:type (second vertex-descriptor) \n:labelings (possible-labelings (second vertex-descriptor)))) \n\n(defun v-d-neighbors (vertex-descriptor) \n\"The neighboring vertex names in a vertex descriptor.\" \n(rest (rest vertex-descriptor))) \n\nThe defstruct for di agram automatically creates the function copy-di agram, but it \njust copies each field, without copying the contents of each field. Thus we need \nmake - copy -di ag ram to create a copy that shares no structure with the original. \n\n\f\n<a id='page-577'></a>\n\n(defun make-copy-diagram (diagram) \n\"Make a copy of a diagram, preserving connectivity.\" \n(let* ((new (make-diagram \n\n'.Vertexes (mapcar #*copy-vertex \n(diagram-vertexes diagram))))) \nPut in the neighbors for each vertex \n(dolist (v (diagram-vertexes new)) \n(setf (vertex-neighbors v) \n(mapcar #*(lambda (neighbor) \n(find-vertex (vertex-name neighbor) new)) \n(vertex-neighbors v)))) \nnew)) \n\n17.3 Labeling Diagrams \nWe are now ready to try labeling diagrams. First the cube: \n\n> (print-labelings (diagram 'cube)) \n\nThe initial diagram is: \nA/5 Y: AB=C+-L-R] AC=[+-RL-] AD=[+--RL] \nB/3 W: BG=[L-+] BE=[R-+] BA=[++-] \nC/3 W: CE=[L-+] CF=[R-+] CA=C++-] \nD/3 W: DF=[L-+] DG=[R-+] DA=C++-] \nE/6 L: EC=[RL+L-R] EB=[LRR+L-] \nF/6 L: FD=[RL+L-R] FC=CLRR+L-] \nG/6 L: GB=[RL+L-R] GD=[LRR+L-] \n\nFor 29,160 interpretations. \n\nAfter constraint propagation the diagram is: \nA/1 Y: AB=[+] AC=[+] AD=[+] \nB/2 W: BG=CL-] BE=[R-] BA=C++] \nC/2 W: CE=[L-] CF=[R-] CA=C++] \nD/2 W: DF=[L-] DG=[R-] DA=C++] \nE/3 L: EC=[R-R] EB=[LL-] \nF/3 L: FD=[R-R] FC=CLL-] \nG/3 L: GB=[R-R] GD=[LL-] \n\nFor 216 interpretations. \n\nThere are four solutions: \n\n\f\n<a id='page-578'></a>\n\nDiagram: \nA/1 Y: AB=[+] AC=C+] AD=C+] \nB/1 W: BG=[L] BE=[R] BA=[+] \nC/1 W: CE=CL] CF=CR] CA=[+] \nD/1 W: DF=CL] DG=[R] DA=[+] \nE/1 L: EC=[R] EB=[L] \nF/1 L: FD=CR] FC=CL] \nG/1 L: GB=[R] GD=[L] \n\nDiagram: \nA/1 Y: AB=[+] AC=[+] AD=[+] \nB/1 W: BG=[L] BE=[R] BA=[+] \nC/1 W: CE=[L] CF=[R] CA=C+] \nD/1 W: DF=C-] DG=[-] DA=C+] \nE/1 L: EC=CR] EB=CL] \nF/1 L: FD=C-] FC=[L] \nG/1 L: GB=CR] GD=[-] \n\nDiagram: \nA/1 Y: AB=C+] AC=C+] AD=C+] \nB/1 W: BG=[L] BE=[R] BA=C+] \nC/1 W: CE=[-] CF=C-] CA=C+] \nD/1 W: DF=CL] DG=CR] DA=[-H] \nE/1 L: EC=C-] EB=[L] \nF/1 L: FD=[R] FC=[-] \nG/1 L: GB=[R] GD=[L] \n\nDiagram: \nA/1 Y: AB=[+] AC=[+] AD=C+] \nB/1 W: BGK-] BE=C-] BA=C+] \nC/1 W: CE=[L] CF=[R] CA=[+] \nD/1 W: DF=[L] DG=CR] DA=C+] \nE/1 L: EC=CR] EB=C-] \nF/1 L: FD=[R] FC=CL] \nG/1 L: GB=C-] GD=[L] \n\nThe four interpretations correspond, respectively, to the cases where the cube is free \nfloating, attached to the floor (GD and DF = -), attached to a wall on the right (EC \nand CF = -), or attached to a wall on the left (BG and BE = -). These are shown in \nfigure 17.7. It would be nice if we could supply information about where the cube is \nattached, and see if we can get a unique interpretation. The function ground takes a \ndiagram and modifies it by making one or more lines be grounded lines - lines that \nhave a concave (-) label, corresponding to a junction with the ground. \n\n\f\n<a id='page-579'></a>\n\nFigure 17.7: Four Interpretations of the Cube \n\n(defun ground (diagram vertex-a vertex-b) \n\"Attach the line between the two Vertexes to the ground. \nThat is. label the line with a -\" \n(let* ((A (find-vertex vertex-a diagram)) \n\n(B (find-vertex vertex-b diagram)) \n\n(i (position . (vertex-neighbors A)))) \n(assert (not (null i))) \n(setf (vertex-labelings A) \n\n(find-all-if #'(lambda (1) (eq (nth i 1) '-)) \n(vertex-labelings A))) \ndiagram)) \n\n\f\n<a id='page-580'></a>\n\nWe can see how this works on the cube: \n\nFigure 17.8: Cube on a Plate \n\n> (print-labelings (ground (diagram 'cube) 'g *d)) \n\nThe initial diagram is: \nA/5 Y: AB=[+-L-R] AC=C+-RL-] AD=[+--RL] \nB/3 W: BG=[L-+] BE=[R-+] BA=C++-] \nC/3 W: CE=CL-+] CF=CR-+] CA=C-H-] \nD/3 W: DF=[L-+] DG=[R-+] DA=[-M-] \nE/6 L: EC=[RL+L-R] EB=[LRR+L-] \nF/6 L: FD=[RL+L-R] FCKLRR+L-] \nG/1 L: GB=[R] GD=[-] \nFor 4,860 interpretations. \n\nAfter constraint propagation the diagram is: \nA/1 Y: AB=C+] AC=C+] AD=C+] \nB/1 W: BG=[L] BE=[R] BA=[+] \nC/1 W: CE=[L] CF=CR] CA=[+] \nD/1 W: DF=[-] DG=C-] DA=C+] \nE/1 L: EC=[R] EB=CL] \nF/1 L: FD=[-] FC=CL] \nG/1 L: GB=CR] GD=C-] \n\n\f\n<a id='page-581'></a>\nNote that the user only had to specify one of the two ground lines, GD. The program \nfound that DF is also grounded. Similarly, in programming ground-1 ine, we only \nhad to update one of the Vertexes. The rest is done by constraint propagation. \n\nThe next example yields the same four interpretations, in the same order (free \nfloating, attached at bottom, attached at right, and attached at left) when interpreted \nungrounded. The grounded version yields the unique solution shown in the following \noutput and in figure 17.9. \n\nFigure 17.9: Labeled Cube on a Plate \n\n(defdiagram cube-on-plate \n(a Y b c d) \n(b W e a) \n(c W f a) \n(d W g a) \n\n(eL b) \n(f Y c i) \n(gY d h) \n\n(h W 1 g j) \n(i W f m j) \n(j Y hi k) \n(k Wm 1 j) \n(1 L h k) \n\n\f\n<a id='page-582'></a>\n\n(m L k i)) \n\n> (print-labelings (ground (diagram 'cube-on-plate) 'k 'm)) \n\nThe initial diagram is: \nA/5 Y: AB=C+-L-R] AC=C+-RL-] A[)=[+--RL] \nB/3 W: BG=CL-+] BE=[R-+] BA=C++-] \nC/3 W: CE=CL-+] CF=CR-+] CA=C++-] \nD/3 W: DF=CL-+] DG=CR-+] DA=C++-] \nE/6 L: EC=CRL+L-R] EB=CLRR+L-] \nF/5 Y: FD=C+-L-R] FC=C+-RL-] FI=[+--RL] \nG/5 Y: GB=C+-L-R] GD=C+-RL-] GH=[+--RL] \nH/3 W: HL=CL-+] HG=[R-+] HJ=[+-h-] \n1/3 W: IF=CL-+] IM=[R-+] IJ=[++-] \nJ/5 Y: JH=C+-L-R] JI=C+-RL-] JK=[+--RL] \nK/1 W: KM=[-] KL=C-] KJ=[+] \nL/6 L: LH=CRL+L-R] LK=CLRR+L-] \nM/6 L: MK=[RL+L-R] MI=CLRR+L-] \n\nFor 32.805.000 interpretations. \n\nAfter constraint propagation the diagram is: \nA/1 Y: AB=C+] AC=C+] AD=C+] \nB/1 W: BG=CL] BE=[R] BA=C+] \nC/1 W: CE=[L] CF=CR] CA=[+] \nD/1 W: DF=C-] DG=C-] DA=[+] \nE/1 L: EC=CR] EB=CL] \nF/1 Y: FD=C-] FC=CL] FI=[R] \nG/1 Y: GB=[R] GD=C-] GH=CL] \nH/1 W: HL=[L] HG=CR] HJ=M \nI/l W: IF=CL] IM=[R] IJ=C+] \nJ/1 Y: JH=[+] JI=C+] JK=[+] \nK/1 W: KM=[-] KL=[-] KJ=[+] \nL/1 L: LH=CR] LK=C-] \nM/1 L: MK=[-] MI=[L] \n\nIt is interesting to try the algorithm on an \"impossible\" diagram. It turns out the \nalgorithm correctly finds no interpretation for this well-known illusion: \n\n(defdiagram poiuyt \n(a L b g) \n(b L j a) \n(c L d 1) \n(d L h c) \n(e L f i) \n(f L k e) \n(g L a 1) \n(h L 1 d) \n(i L e k) \n(j L k b) \n\n\f\n<a id='page-583'></a>\n\nFigure 17.10: An Impossible Figure (A Poiuyt) \n\n(k W j i f) \n(1 W h g c)) \n\n> (print-labelings (diagram 'poiuyt)) \n\nThe initial diagram is: \nA/6 AB=CRL+L-R] AG=[LRR+L-] \nB/6 BJ=[RL+L-R] BA=[LRR+L-] \nC/6 CD=CRL+L-R] CL=[LRR+L-] \nD/6 DH=[RL+L-R] DC=CLRR+L-] \nE/6 EF=[RL+L-R] EI=[LRR+L-] \nF/6 FK=[RL+L-R] FE=CLRR+L-] \nG/6 GA=[RL+L-R] GL=[LRR+L-] \nH/6 HL=[RL+L-R] HD=CLRR+L-] \n1/6 IE=[RL+L-R] IK=CLRR+L-] \nJ/6 JK=[RL+L-R] JB=CLRR+L-] \nK/3 W KJ=[L-+] KI=CR-+] KF=[++-] \nL/3 W LH=[L-+] LG=[R-+] LC=C++-] \n\nFor 544.195.584 interpretations. \n\nAfter constraint propagation the diagram is: \nA/5 AB=CRL+-R] AG=[LRRL-] \nB/5 BJ=CRLL-R] BA=[LR+L-] \nC/2 CD=[LR] CL=[+-] \nD/3 DH=[RL-] DC=[LRL3 \nE/3 EF=[RLR] EI=[LR-] \nF/2 FK=C+-] FE=[RL] \n\n\f\n<a id='page-584'></a>\n\nG/4 L: GA=[RL-R] GL=[L+L-] \nH/4 L: HL=[R+-R] HD=[LRL-] \n1/4 L: IE=CRL-R] IK=[L+L-] \nJ/4 L: JK=[R+-R] JB=CLRL-] \nK/3 W: KJ=[L-+] KI=CR-+] KF=C++-3 \nL/3 W: LH=CL-+] LG=[R-+] LC=C++-] \n\nFor 2.073,600 interpretations. \n\nThere are zero solutions: \n\nNow we try a more complex diagram: \n\n(defdiagram tower\n\n(a Y b c d) (n L q 0) \n(b W g e a) (0 W y j n) \n(c W e f a) (P L r i) \n(d W f g a) (q W . s w) \n(e L c b) (r W s . .) \n(f Y d c i) (s L r q) \n(g Y b d h) (t W w . .) \n(h W 1 g j) (u W . y .) \n(i W f m p) (V W y w .) \n(j Y h 0 k) (w Y t . q) \n(k W m 1 j) (x Y r u t) \n(1 L h k) (y Y V u o) \n(m L k i) (z Y t U V)) \n\n> (print-labelings (ground (diagram 'tower) . 'k)) \n\nThe initial diagram is: \nA/5 Y: =[+-L-R3 AC=[+-RL-] AD=C+--RL] \nB/3 W: \nC/3 W: \nD/3 W: \nE/6 L: \nF/5 Y: FD=C+-L-R] FC=C+-RL-] FI=C+--RL] \nG/5 Y: GB=[+-L-R] GD=C+-RL-] GH=C+--RL] \nH/3 W: HL=CL-+] HG=CR-+] HJ=C-h-] \n1/3 W: IF=[L-+] IM=[R-+] IP=C++-] \nJ/5 Y: ^--RL] \nK/3 W: KM=[L-+] KL=CR-+] KJ=C++-] \nL/1 L: \nM/6 L: \nN/6 L: \n0/3 W: \nP/6 L: \n0/3 W: QN=[L-+] QS=CR-+] QW=C++-] \nR/3 W: RS=CL-+] RP=[R-+3 RX=C-H-] \nS/\nS/S/6\n66 L\nLL:\n:: SR=CRL+L-R] SQ=CLRR+L-] \n\n\f\n<a id='page-585'></a>\n\nT/3 W: TW=CL-+] TX=CR-+] TZ=C++-] \nU/3 W: UX=[L-+] UY=[R-+] UZ=[++-] \nV/3 W: VY=CL-+] VW=CR-+] VZ=[++-] \nW/5 Y: WT=C+-L-R] WV=C+-RL-] WQ=C+--RL] \nX/5 Y: XR=[+-L-R] XU=C+-RL-] XT=[+--RL] \nY/5 Y: YV=[+-L-R] YU=[+-RL-] YO=C+--RL] \nZ/5 Y: ZT=C+-L-R] ZU=C+-RL-] ZV=[+--RL] \n\nFor 1,614,252,037,500,000 interpretations. \n\nFigure 17.11: A Tower \n\nAfter constraint propagation the diagram is: \nA/1 Y: AB=[+] AC=[+] AI>[+] \nB/1 W: BG=[L] BE=[R] BA=[+] \nC/1W: CE=[L] CF=[R] CA=[+] \nD/1W: DF=[-] DG=[-] DA=[+] \nE/1L: EC=[R]EB=[L] \nF/1YFD=[-] FC=[L] FI=[R] \nG/1Y GB=[R] GD=[-] GH=[L] \nH/1W: HL=[L] HG=[R] HJ=[+] \nI/l W: IF=[L]IM=[R] IP=[+] \nJ/lYJH=[+]JO=MJK=[+] \n\n\f\n<a id='page-586'></a>\n\nK/1 W: KM=[-] KL=[-] KJ=[+] \nL/1 L: LH=[R] LK=[-] \nM/1L: MK=[-] MI=[L] \nN/1 L: NQ=[R] NO=[-] \nO/l W:OY=M OJ=M ON=[-] \nP/1 L: PR=[L] PI=[+] \nQ/1 W: QN=[L] QS=[R] QW=[+] \nR/1 W: RS=[L] RP=[R] RX=M \nS/1 L: SR=[R] SQ=[L] \nT/1 W: TW=[+] TX=[+] TZ=[-] \nU/1 W: UX=[+] UY=[+] UZ=[-] \nV/1 W: VY=[+] VW=[+] VZ=[-] \nW/1.: WT=[+] WV=M WQ=[+] \nX/1.: XR=[+] XU=[+] XT=[+] \n./1.: YV=[+] YU=[+] Y0=[+] \nZ/1Y: ZT=[-] ZU=[-] ZV=[-] \n\nWe see that the algorithm was able to arrive at a single interpretation. Moreover, even \nthough there were a large number of possibilities - over a quadrillion - the computation \nis quite fast. Most of the time is spent printing, so to get a good measurement, \nwe define a function to find solutions without printing anything: \n\n(defun find-labelings (diagram) \n\"Return a list of all consistent labelings of the diagram.\" \n(every #'propagate-constraints (diagram-vertexes diagram)) \n(search-solutions diagram)) \n\nWhen we time the application of find-label ings to the grounded tower and the \npoiuyt, we find the tower takes 0.11 seconds, and the poiuyt 21 seconds. This is over \n180 times longer, even though the poiuyt has only half as many Vertexes and only \nabout half a million interpretations, compared to the tower's quadrillion. The poiuyt \ntakes a long time to process because there are few local constraints, so violations are \ndiscovered only by considering several widely separated parts of the figure all at the \nsame time. It is interesting that the same fact that makes the processing of the poiuyt \ntake longer is also responsible for its interest as an illusion. \n\n17.4 Checking Diagrams for Errors \nThis section considers one more example, and considers what to do when there are \napparent errors in the input. The example is taken from Charniak and McDermott's \nIntroduction to Artificial Intelligence, page 138, and shown in figure 17.12. \n\n\f\n<a id='page-587'></a>\nFigure 17.12: Diagram of an arch \n\n(defdiagram arch \n(a W e b c) (P L 0 q) \n(b L d a) (q . . i .) \n(c Y a d g) (. .3 s q) \n(d Y c b m) (s L . t) \n(e L a f) (t W. s k) \n(f . e g n) (u L t 1) \n(g wh f c) (V L 2 4) \n(h . g i 0) (w W X 1 y) \n(i . h j q) (X Lw z) \n(j . i k r) (y Yw 2 z) \n(k . j 1 t) (z W 3X y) \n(1 . k m v) (1 . . 0 w) \n(m L 1 d) (2 W V3 y) \n(n L f 1) (3 L . 2) \n(0 W . 1 h) (4 . u 1 V)) \n\nUnfortunately, running this example results in no consistent interpretations after \nconstraint propagation. This seems wrong. Worse, when we try to ground the \ndiagram on the line XZ and call pri nt -1 abel i ngs on that, we get the following error: \n\n\f\n<a id='page-588'></a>\n\n>>ERROR: The first argument to NTH was of the wrong type. \nThe function expected a fixnum >= zero. \nWhile in the function LABELS-FOR ^ CONSISTENT-LABELINGS \n\nDebugger entered while in the following function: \n\nLABELS-FOR (P.C. = 23) \nArg 0 (VERTEX): U/6 \nArg 1 (FROM): 4/4 \n\nWhat has gone wrong? A good guess is that the diagram is somehow inconsistent - \nsomewhere an error was made in transcribing the diagram. It could be that the \ndiagram is in fact impossible, like the poiuyt. But that is unlikely, as it is easy for us \nto provide an intuitive interpretation. We need to debug the diagram, and it would \nalso be a good idea to handle the error more gracefully. \n\nOne property of the diagram that is easy to check for is that every line should be \nmentioned twice. If there is a line between Vertexes A and B, there should be two \nentries in the vertex descriptors of the following form: \n\n(A ? ... . ...) \n(. ? ... A ...) \n\nHere the symbolmeans we aren't concerned about the type of the Vertexes, only \nwith the presence of the line in two places. The following code makes this check \nwhen a diagram is defined. It also checks that each vertex is one of the four legal \ntypes, and has the right number of neighbors. \n\n(defmacro defdiagram (name &rest vertex-descriptors) \n\"Define a diagram. A copy can be gotten by (diagram name).\" \n'(put-diagram '.name (construct-diagram \n\n(check-diagram '.vertex-descriptors)))) \n\n(defun check-diagram (vertex-descriptors) \n\"Check if the diagram description appears consistent.\" \n(let ((errors 0)) \n\n(dolist (v-d vertex-descriptors) \nv-d is like: (a Y b c d) \n(let ((A (first v-d)) \n\n(v-type (second v-d))) \nCheck that the number of neighbors is right for \nthe vertex type (and that the vertex type is legal) \n\n(when (/= (length (v-d-neighbors v-d)) \n\n(case v-type ((W Y .) 3) ((L) 2) (t -1))) \n(warn \"Illegal type/neighbor combo: '^a\" v-d) \n(incf errors)) \n\n;; Check that each neighbor . is connected to \n\n\f\n<a id='page-589'></a>\n\nthis vertex. A. exactly once \n(dolist (B (v-d-neighbors v-d)) \n(when (/= 1 (count-if \n#'(lambda (v-d2) \n(and (eql (first v-d2) B) \n(member A (v-d-neighbors v-d2)))) \n\nvertex-descriptors)) \n(warn \"Inconsistent vertex: \"a-^a\" A B) \n(incf errors))))) \n\n(when (> errors 0) \n(error \"Inconsistent diagram. ~d total error~:p.\" \nerrors))) \nvertex-descriptors) \n\nNow let's try the arch again: \n\n(defdiagram arch \n(a W eb c) (PL 0 q) \n(b L d a) (q. . i r) \n(c Y a d g) (r . j s q) \n(d Y c b m) (s L r t) \n(e L a f) (t W V s k) \n(f . e g n) (u L t 1) \n(g W hf c) (V L 2 4) \n(h . g i 0) (wW X 1 y) \n(i . h j q) (X L w z) \n(j . i k r) (yY w 2 z) \n(k . j 1 t) (.W 3 X y) \n(1 . k m v) (1. . 0 w) \n(m L 1 d) (2W V 3 y) \n(n L f 1) (3 L . 2) \n(0 W .1 h) (4. u 1 V)) \n\nWarning: Inconsistent vertex: T-'V \nWarning: Inconsistent vertex: U-'T \nWarning: Inconsistent vertex: U--L \nWarning: Inconsistent vertex: L--V \nWarning: Inconsistent vertex: 4\n\n--u \n\nWarning: Inconsistent vertex: 4-'L \n\n>ERROR: Inconsistent diagram, 6 total errors. \n\nThe def d i a g ram was transcribed from a hand-labeled diagram, and it appears that the \ntranscription has fallen prey to one of the oldest problems in mathematical notation: \nconfusing a \"u\" with a \"v.\" The other problem was in seeing the line U-L as a single \nline, when in fact it is broken up into two segments, U-4 and 4-L. Repairing these \nbugs gives the diagram: \n\n\f\n<a id='page-590'></a>\n\n(defdiagram arch \n\n(a W e b c) (P L 0 q ) \n( b L d a) (q . . i . ) \n(c Y a d g ) ( . . J s q ) \n(d Y c b m) (s L . t ) \n(e L a f) ( t W u s k) ; t-u not t-v \n(f . e g n) (u L t 4) ; w4 \nnot u-l \n( g W h f c) (V L 2 4) \n(h . g i 0 ) (w W X 1 y ) \n( i \n(j \n(k \n. h \n. \n. i \nJ q ) \nk r) \n1 t ) \n( X L w z) \n( y Y w 2 z) \n(z W 3 X y ) \n(1 . k m 4) (1 . . 0 w) ;1-4 not l-v \n(m L 1 d ) \n(n L f 1) \n( 0 W . 1 h ) \n(2 \n(3 \n(4 \nwV 3 y ) \nL . 2) \n. u 1 V) ) \n\nThis time there are noerrors detected by check-di agram, butrunningprint-label ings \n\nagain still does not give a solution. To get more information about which constraints \n\nare applied, I modified propagate-constrai nts to print out some information: \n\n(defun propagate-constraints (vertex) \n\"Reduce the number of labelings on vertex by considering neighbors. \nIf we can reduce, propagate the new constraint to each neighbor.\" \n\nReturn nil only when the constraints lead to an impossibility \n\n(let ((old-num (number-of-labelings vertex))) \n(setf (vertex-labelings vertex) (consistent-labelings vertex)) \n(unless (impossible-vertex-. vertex) \n\n(when (< (number-of-labelings vertex) old-num) \n\n(format t \"-&; ~a: \"Ua ~a\" vertex \n(vertex-neighbors vertex) \n(vertex-labelings vertex)) \n(every #'propagate-constraints (vertex-neighbors vertex))) \n\nvertex))) \n\nRunning the problem again gives the following trace: \n\n> (print-labelings (ground (diagram 'arch) *x '.)) \n\nThe initial diagram is: \nA/3 W: AE=[L-+] AB=[R-+] AC=[++-] \nP/6 L: PO=[RL+L-R] PQ=CLRR+L-] \nB/6 L: BD=[RL-HL-R] BA=CLRR+L-] \nQ/4 T: QP=[RRRR] QI=[LLLL] QR=[+-LR] \nC/5 Y: CA=C+-L-R] CD=C+-RL-] CG=[+--RL] \nR/4 T: RJ=[RRRR] RS=[LLLL] RQ=[+-LR] \nD/5 Y: DC=C+-L-R] DB=C+-RL-] DM=C+--RL] \n\n\f\n<a id='page-591'></a>\nS/6 L: SR=[RL+L-R] ST=CLRR+L-] \nE/6 L: EA=CRL+L-R] EF=[LRR+L-] \nT/3 W: TU=[L-+] TS=[R-+] TK=C++-] \nF/4 T: FE=[RRRR] FG=CLLLL] FN=C+-LR] \nU/6 L: UT=CRL+L-R] U4=CLRR+L-] \nG/3 W: GH=[L-+] GF=CR-+] GCK-H-] \nV/6 L: V2=[RL+L-R] V4=[LRR+L-] \nH/4 T: HG=CRRRR] HI=CLLLL] HO=[+-LR] \nW/3 W: WX=CL-+] W1=[R-+] WY=C++-] \n1/4 T: IH=[RRRR] IJ=CLLLL] IQ=C+-LR] \nX/1 L: XW=[R] XZ=[-] \nJ/4 T: JI=CRRRR] JK=CLLLL] JR=[-h-LR] \nY/5 Y: YW=[+-L-R] Y2=[+-RL-] YZ=C+--RL] \nK/4 T: KJ=[RRRR] KL=[LLLL] KT=C+-LR] \nZ/3 W: Z3=CL-+] ZX=CR-+] ZY=C++-] \nL/4 T: LK=[RRRR] LM=[LLLL] L4=C+-LR] \n1/4 T: 1N=[RRRR] 10=CLLLL] 1W=[+-LR] \nM/6 L: ML=CRL+L-R] MD=[LRR+L-] \n2/3 W: 2V=[L-+] 23=[R-+] 2Y=[++-] \nN/6 L: NF=CRL+L-R] N1=CLRR+L-] \n3/6 L: 3Z=[RL+L-R] 32=CLRR+L-] \n0/3 W: OP=[L-+] 01=CR-+] OH=C++-] \n4/4 T: 4U=[RRRR] 4L=[LLLL] 4V=C+-LR] \n\nFor 2,888 ,816,545,234,944,000 i nterpretati ons. \nP/2 (0/3 0/4) ((R L) (- D) \n0/1 (P/2 1/4 H/4) ((L R +)) \nP/1 (0/1 Q/4) ((R D) \n1/3 (N/6 0/1 W/3) ((R L +) (R L -) (R L D) \nN/2 (F/4 1/3) ((R L) (- D) \nF/2 (E/6 G/3 N/2) ((R L -) (R L D) \nE/2 (A/3 F/2) ((R L) (- D) \nA/2 (E/2 B/6 C/5) ((L R +) (-- +)) \nB/3 (D/5 A/2) ((R L) (- L) (R -)) \nD/3 (C/5 B/3 M/6) ((---) (- L R) (R - D) \nW/1 (X/1 1/3 Y/5) ((L R +)) \n1/1 (N/2 0/1 W/1) ((R L D ) \nY/1 (W/1 2/3 Z/3) ((+ + +)) \n2/2 (V/6 3/6 Y/1) ((L R +) (-- +)) \nV/3 (2/2 4/4) ((R L) (- L) (R -)) \n4/2 (U/6 L/4 V/3) ((R L -) (R L R)) \nU/2 : (T/3 4/2) ((R L) (- D) \nT/2 (U/2 S/6 K/4) ((L R +) (-- +)) \nS/2 (R/4 T/2) ((R L) (R -)) \nK/1 (J/4 L/4 T/2) ((R L +)) \nJ/1 (1/4 K/1 R/4) ((R L D ) \nI/l (H/4 J/1 0/4) ((R L R)) \nL/1 (K/1 M/6 4/2) ((R L R)) \nM/2 (L/1 D/3) ((R L) (R -)) \n\n\f\n<a id='page-592'></a>\n\n3/3: (Z/3 2/2) ((R L) (- L) (R -)) \n1/1: (3/3 X/1 Y/1) (( - - +)) \n3/1: (Z/1 2/2) (( - D) \n2/1: (V/3 3/1 Y/1) ((L R +)) \nV/2: (2/1 4/2) ((R L) (R -)) \n\nAfter constraint propagation the diagram is: \nA/0 W: \nP/1 L: PO=[R] PQ=CL] \nB/0 L: \nQ/4 T: QP=[RRRR] QI=[LLLL] QR=[+-LR] \nC/0 Y: \nR/4 T: RJ=[RRRR] RS=[LLLL] RQ=C+-LR] \nD/0 Y: \nS/2 L: SR=CRR] ST=[L-] \nE/2 L: EA=[R-] EF=CLL] \nT/2 W: TU=[L-] TS=CR-] TK=[++] \nF/2 T: FE=CRR] FG=[LL] FN=C-L] \nU/2 L: UT=[R-] U4=[LL] \nG/0 W: \nV/2 L: V2=[RR] V4=CL-] \nH/0 T: \nW/1 W: WX=[L] W1=[R] WY=C+] \n\nI/l T: IH=[R3 IJ=[L] IQ=[R] \nX/1 L: XW=[R] XZ=[-] \nJ/1 T: JI=[R] JK=[L] JR=[L] \nY/1 Y: YW=C+] Y2=[+] YZ=[+] \nK/1 T: KJ=CR] KL=[L] KT=[+] \nZ/1 W: Z3=C-] ZX=[-] ZY=[H-] \nL/1 T: LK=[R] LM=[L] L4=[R] \n1/1 T: 1N=[R] 10=[L] 1W=[L] \nM/2 L: ML=[RR] MD=CL-] \n2/1 W: 2V=CL] 23=CR] 2Y=[+] \nN/2 L: NF=[R-] N1=[LL] \n3/1 L: 3Z=[-] 32=[L] \n0/1 W: OP=[L] 01=CR] OH=C+] \n4/2 T: 4U=[RR] 4L=[LL] 4V=[-R] \n\nFrom the diagram after constraint propagation we can see that the Vertexes A,B,C,D,G, \nand . have no interpretations, so they are a good place to look first for an error. From \nthe trace generated by propagate-constraints (the lines beginning with a semicolon), \nwe see that constraint propagation started at . and after seven propagations \nreached some of the suspect Vertexes: \n\n\f\n<a id='page-593'></a>\n\nA/2: (E/2 B/6 C/5) ((L R +) (-- +)) \n8/3: (D/5 A/2) ((R L) (- L) (R -)) \nD/3: (C/5 B/3 M/6) (( ) (- L R) (R - D) \n\nA and . look acceptable, but look at the entry for vertex D. It shows three interpretations, \nand it shows that the neighbors are C, B, and M. Note that line DC, the first \nentry in each of the interpretations, must be either -, - or R. But this is an error, \nbecause the \"correct\" interpretation has DC as a + line. Looking more closely, we \nnotice that D is in fact a W-type vertex, not a Y vertex as written in the definition. We \nshould have: \n\n(defdiagram arch \n(a W e b c) (p L 0 q) \n(b L d a) (q . . i r) \n(cY a d g) (r . j s q) \n(d W b m c) (s L r t) ;disaW,notY \n\n(e L a f) (t W u s k) \n(f . e g n) (u L t 4) \n(gW h f c) (V L 2 4) \n(h . g i 0) (w W . 1 y) \n(i . h j q) (x L w z) \n(j . i k r) (y Y w 2 z) \n(k . j 1 t) (z W 3 X y) \n(1 . k m 4) (1 . . 0 w) \n(m L 1 d) (2 WV 3 y) \n(. L f 1) (3 L . 2) \n(0 W . 1 h) (4 . u 1 V)) \n\nBy running the problem again and inspecting the trace output, we soon discover the \nreal root of the problem: the most natural interpretation of the diagram is beyond the \nscope of the program! There are many interpretations that involve blocks floating in \nair, but if we ground lines OP, TU and XZ, we run into trouble. Remember, we said \nthat we were considering trihedral Vertexes only. But vertex 1 would be a quad-hedral \nvertex, formed by the intersection of four planes: the top and back of the base, and \nthe bottom and left-hand side of the left pillar. The intuitively correct labeling for the \ndiagram would have Ol be a concave (-) line and Al be an occluding line, but our \nrepertoire of labelings for . Vertexes does not allow this. Hence, the diagram cannot \nbe labeled consistently. \n\nLet's go back and consider the error that came up in the first version of the \ndiagram. Even though the error no longer occurs on this diagram, we want to make \nsure that it won't show up in another case. Here's the error: \n\n\f\n<a id='page-594'></a>\n\n>>ERROR: The first argument to NTH was of the wrong type. \nThe function expected a fixnum >= zero. \nWhile in the function LABELS-FOR <i= CONSISTENT-LABELINGS \n\nDebugger entered while in the following function: \n\nLABELS-FOR (P.C. = 23) \nArg 0 (VERTEX): U/6 \nArg 1 (FROM): 4/4 \n\nLooking at the definition of 1 abel s - for, we see that it is looking for the from vertex, \nwhich in this case is 4, among the neighbors of U. It was not found, so pos became nil, \nand the function nth complained that it was not given an integer as an argument. So \nthis error, if we had pursued it earlier, would have pointed out that 4 was not listed \nas a neighbor of U, when it should have been. Of course, we found that out by other \nmeans. In any case, there is no bug here to fix - as long as a diagram is guaranteed to \nbe consistent, the 1 abel s - for bug will not appear again. \n\nThis section has made two points: First, write code that checks the input as \nthoroughly as possible. Second, even when input checking is done, it is still up to \nthe user to understand the limitations of the program. \n\n17.5 History and References \nGuzman (1968) was one of the first to consider the problem of interpreting line \ndiagrams. He classified Vertexes, and defined some heuristics for combining information \nfrom adjacent Vertexes. Huffman (1971) and Clowes (1971) independently \ncame up with more formal and complete analyses, and David Waltz (1975) extended \nthe analysis to handle shadows, and introduced the constraint propagation algorithm \nto cut down on the need for search. The algorithm is sometimes called \"Waltz \nfiltering\" in his honor. With shadows and nontrihedral angles, there are thousands \nof vertex labelings instead of 18, but there are also more constraints, so the constraint \npropagation actually does better than it does in our limited world. Waltz's approach \nand the Huffman-Clowes labels are covered in most introductory AI books, including \nRich and Knight 1990, Charniak and McDermott 1985, and Winston 1984, Waltz's \noriginal paper appears in The Psychology of Computer Vision (Winston 1975), an influential \nvolume collecting early work done at MIT. He also contributed a summary \narticle on Waltz filtering (Waltz 1990). \n\nMany introductory AI texts give vision short coverage, but Charniak and McDermott \n(1985) and Tanimoto (1990) provide good overviews of the field. Zucker (1990) \nprovides an overview of low-level vision. \n\nRamsey and Barrett (1987) give an implementation of a line-recognition program. \nIt would make a good project to connect their program to the one presented in this \nchapter, and thereby go all the way from pixels to 3-D descriptions. \n\n\f\n<a id='page-595'></a>\n\n17.6 Exercises \nThis chapter has solved the problem of line-labeling for polyhedra made of trihedral \nVertexes. The following exercises extend this solution. \n\n&#9635; Exercise 17.1 [h] Use the line-labeling to produce a face labeling. Write a function \nthat takes a labeled diagram as input and produces a list of the faces (planes) that \ncomprise the diagram. \n\n&#9635; Exercise 17.2 [h] Use the face labeling to produce a polyhedron labeling. Write \na function that takes a hst of faces and a diagram and produces a list of polyhedra \n(blocks) that comprise the diagram. \n\n&#9635; Exercise 17.3 [d] Extend the system to include quad-hedral Vertexes and/or shadows. \nThere is no conceptual difficulty in this, but it is a very demanding task to find \nall the possible vertex types and labelings for them. Consult Waltz 1975. \n\n&#9635; Exercise 17.4 [d] Implement a program to recognize lines from pixels. \n\n&#9635; Exercise 17.5 [d] If you have access to a workstation with a graphical interface, \nimplement a program to allow a user to draw diagrams with a mouse. Have the \nprogram generate output in the form expected by construct-di agram. \n\n\f\n## Chapter 18\n<a id='page-596'></a>\n\nSearch and the \nGame of Othello \n\nIn the beginner's mind there are \nendless possibilities; \nin the expert's there are few. \n\n-Suzuki Roshi, Zen Master \n\nG\nG\name playing has been the target of much early work in AI for three reasons. First, \nthe rules of most games are formalized, and they can be implemented in a computer \nprogram rather easily. Second, in many games the interface requirements are trivial. \nThe computer need only print out its moves and read in the opponent's moves. This is true for \ngames like chess and checkers, but not for ping-pong and basketball, where vision and motor \nskills are crucial. Third, playing a good game of chess is considered by many an intellectual \nachievement. Newell, Shaw, and Simon say, \"Chess is the intellectual game par excellence \" and \nDonald Michie called chess the \"Drosophila melanogaster of machine intelligence,\" meaning that \nchess is a relatively simple yet interesting domain that can lead to advances in AI, just as study \nof the fruit fly served to advance biology. \n\n\f\n<a id='page-597'></a>\nToday there is less emphasis on game playing in AI. It has been realized that \ntechniques that work well in the limited domain of a board game do not necessarily \nlead to intelligent behavior in other domains. Also, as it turns out, the techniques \nthat allow computers to play well are not the same as the techniques that good \nhuman players use. Humans are capable of recognizing abstract patterns learned \nfrom previous games, and formulating plans of attack and defense. While some \ncomputer programs try to emulate this approach, the more succesful programs \nwork by rapidly searching thousands of possible sequences of moves, making fairly \nsuperficial evaluations of the worth of each sequence. \n\nWhile much previous work on game playing has concentrated on chess and \ncheckers, this chapter demonstrates a program to play the game of Othello.^ Othello \nis a variation on the nineteenth-century game Reversi. It is an easy game to program \nbecause the rules are simpler than chess. Othello is also a rewarding game to \nprogram, because a simple search technique can yield an excellent player. There \nare two reasons for this. First, the number of legal moves per turn is low, so the \nsearch is not too explosive. Second, a single Othello move can flip a dozen or more \nopponent pieces. This makes it difficult for human players to visualize the long-range \nconsequences of a move. Search-based programs are not confused, and thus do well \nrelative to humans. \n\nThe very name \"Othello\" derives from the fact that the game is so unpredictable, \nlike the Moor of Venice. The name may also be an allusion to the line, \"Your daughter \nand the Moor are now making the beast with two backs,\"^ since the game pieces \ndo indeed have two backs, one white and one black. In any case, the association \nbetween the game and the play carries over to the name of several programs: Cassio, \nlago, and Bill. The last two will be discussed in this chapter. They are equal to or \nbetter than even champion human players. We will be able to develop a simplified \nversion that is not quite a champion but is much better than beginning players. \n\n18.1 The Rules of the Game \nOthello is played on a 8-by-8 board, which is initially set up with four pieces in the \ncenter, as shown in figure 18.1. The two players, black and white, alternate turns, \nwith black playing first. On each turn, a player places a single piece of his own color \non the board. No piece can be moved once it is placed, but subsequent moves may \nflip a piece from one color to another. Each piece must be placed so that it brackets \none or more opponent pieces. That is, when black plays a piece there must be a \nline (horizontal, vertical, or diagonal) that goes through the piece just played, then \nthrough one or more white pieces, and then to another black piece. The intervening \n\n^Othello is a registered trademark of CBS Inc. Gameboard design © 1974 CBS Inc. \n\n^Othelh [I. i. 117] WiUiam Shakespeare. \n\n\f\n<a id='page-598'></a>\n\nwhite pieces are flipped over to black. If there are bracketed white pieces in more \nthan one direction, they are all flipped. Figure 18.2 (a) indicates the legal moves for \nblack with small dots. Figure 18.2 (b) shows the position after black moves to square \nb4. Players alternate turns, except that a player who has no legal moves must pass. \nWhen neither player has any moves, the game is over, and the player with the most \npieces on the board wins. This usually happens because there are no empty squares \nleft, but it occasionally happens earlier in the game. \n\nf g h \n\nO'o ' \n\nFigure 18.1: The Othello Board \n\n. f g . f g h \n\no o \n\no o '' ' ' ' \n'' ' \n\nO o o o o o o\n\n'o ' ' ' \n\no \n\n(b) \n\nFigure 18.2: Legal Othello Moves \n\n\f\n<a id='page-599'></a>\n18.2 Representation Choices \nIn developing an Othello program, we will want to test out various strategies, playing \nthose strategies against each other and against human players. We may also want \nour program to allow two humans to play a game. Therefore, our main function, \nothel 10, will be a monitoring function that takes as arguments two strategies. It \nuses these strategies to get each player's moves, and then applies these moves to a \nrepresentation of the game board, perhaps printing out the board as it goes. \n\nThe first choice to make is how to represent the board and the pieces on it. The \nboard is an 8-by-8 square, and each square can be filled by a black or white piece or \ncan be empty. Thus, an obvious representation choice is to make the board an 8-by-8 \narray, where each element of the array is the symbol bl ack, whi te, or ni 1. \n\nNotice what is happening here: we are following the usual Lisp convention of \nimplementing an enumerated type (the type of pieces that can fill a square) as a set \nof symbols. This is an appropriate representation because it supports the primary \noperation on elements of an enumerated type: test for equality using eq. It also \nsupports input and output quite handily. \n\nIn many other languages (such as C or Pascal), enumerated types are implemented \nas integers. In Pascal one could declare: \n\ntype piece = (black, white, empty); \n\nto define pi ece as a set of three elements that is treated as a subtype of the integers. \nThe language does not allow for direct input and output of such types, but equality \ncan be checked. An advantage of this approach is that an element can be packed into \na small space. In the Othello domain, we anticipate that efficiency will be important, \nbecause one way to pick a good move is to look at a large number of possible sequences \nof moves, and choose a sequence that leads toward a favorable result. Thus, we are \nwilling to look hard at alternative representations to find an efficient one. It takes \nonly two bits to represent one of the three possible types, while it takes many more \n(perhaps 32) to represent a symbol. Thus, we may save space by representing pieces \nas small integers rather than symbols. \n\nNext, we consider the board. The two-dimensional array seems like such an \nobvious choice that it is hard to imagine a better representation. We could consider \nan 8-element list of 8-element lists, but this would just waste space (for the cons \ncells) and time (in accessing the later elements of the lists). However, we will have to \nimplement two other abstract data types that we have not yet considered: the square \nand the direction. We will need, for example, to represent the square that a player \nchooses to move into. This will be a pair of integers, such as 4,5. We could represent \nthis as a two-element list, or more compactly as a cons cell, but this still means that \nwe may have to generate garbage (create a cons cell) every time we want to refer \nto a new square. Similarly, we need to be able to scan in a given direction from a \n\n\f\n<a id='page-600'></a>\n\nsquare, looking for pieces to flip. Directions will be represented as a pair of integers, \nsuch as +1,-1. One clever possibility is to use complex numbers for both squares and \ndirections, with the real component mapped to the horizontal axis and the imaginary \ncomponent mapped to the vertical axis. Then moving in a given direction from a \nsquare is accomplished by simply adding the direction to the square. But in most \nimplementations, creating new complex numbers will also generate garbage. \n\nAnother possibiUty is to represent squares (and directions) as two distinct integers, \nand have the routines that manipulate them accept two arguments instead of \none. This would be efficient, but it is losing an important abstraction: that squares \n(and directions) are conceptually single objects. \n\nA way out of this dilemma is to represent the board as a one-dimensional vector. \nSquares are represented as integers in the range 0 to 63. In most implementations, \nsmall integers (fixnums) are represented as immediate data that can be manipulated \nwithout generating garbage. Directions can also be implemented as integers, representing \nthe numerical difference between adjacent squares along that direction. To \nget a feel for this, take a look at the board: \n\n0 1 2 3 4 5 6 7 \n8 9 10 11 12 13 14 15 \n16 17 18 19 20 21 22 23 \n24 25 26 27 28 29 30 31 \n32 33 34 35 36 37 38 39 \n40 41 42 43 44 45 46 47 \n48 49 50 51 52 53 54 55 \n56 57 58 59 60 61 62 63 \n\nYou can see that the direction +1 corresponds to movement to the right, +7 corresponds \nto diagonal movement downward and to the left, +8 is downward, and +9 is \ndiagonally downward and to the right. The negations of these numbers (-1, -7, -8, -9) \nrepresent the opposite directions. \n\nThere is one complication with this scheme: we need to know when we hit the \nedge of the board. Starting at square 0, we can move in direction +1 seven times to \narrive at the right edge of the board, but we aren't allowed to move in that direction \nyet again to arrive at square 8. It is possible to check for the edge of the board by \nconsidering quotients and remainders modulo 8, but it is somewhat complicated and \nexpensive to do so. \n\nA simpler solution is to represent the edge of the board explicitly, by using a 100element \nvector instead of a 64-element vector. The outlying elements are filled with a \nmarker indicating that they are outside the board proper. This representation wastes \nsome space but makes edge detection much simpler. It also has the minor advantage \nthat legal squares are represented by numbers in the range 11-88, which makes them \neasier to understand while debugging. Here's the new 100-element board: \n\n\f\n<a id='page-601'></a>\n0 1 2 3 4 5 6 7 8 9 \n10 11 12 13 14 15 16 17 18 19 \n20 21 22 23 24 25 26 27 28 29 \n30 31 32 33 34 35 36 37 38 39 \n40 41 42 43 44 45 46 47 48 49 \n50 51 52 53 54 55 56 57 58 59 \n60 61 62 63 64 65 66 67 68 69 \n70 71 72 73 74 75 76 77 78 79 \n80 81 82 83 84 85 86 87 88 89 \n90 91 92 93 94 95 96 97 98 99 \n\nThe horizontal direction is now &plusmn;1, vertical is &plusmn;10, and the diagonals are &plusmn;9 and \n&plusmn;11. We'll tentatively adopt this latest representation, but leave open the possibility \nof changing to another format. With this much decided, we are ready to begin. \nFigure 18.3 is the glossary for the complete program. A glossary for a second version \nof the program is on [page 623](chapter18.md#page-623). \n\nWhat follows is the code for directions and pieces. We explicitly define the type \npiece to be a number from empty to outer (0 to 3), and define the function name-of \nto map from a piece number to a character: a dot for empty, @ for black, 0 for white, \nand a question mark (which should never be printed) for outer. \n\n(defconstant all-directions '(-11 -10 -9-119 10 ID) \n\n(defconstant empty 0 \"An empty square\") \n(defconstant black 1 \"A black piece\") \n(defconstant white 2 \"A white piece\") \n(defconstant outer 3 \"Marks squares outside the 8x8 board\") \n\n(deftype piece () '(integer .empty .outer)) \n\n(defun name-of (piece) (char \".@0?\" piece)) \n\n(defun opponent (player) (if (eql player black) white black)) \n\nAnd here is the code for the board. Note that we introduce the function bref, \nfor \"board reference\" rather than using the built-in function aref. This facilitates \npossible changes to the representation of boards. Also, even though there is no \ncontiguous range of numbers that represents the legal squares, we can define the \nconstant a 11 - squa res to be a list of the 64 legal squares, computed as those numbers \nfrom 11 to 88 whose value mod 10 is between 1 and 8. \n\n(deftype board () '(simple-array piece (100))) \n\n(defun bref (board square) (aref board square)) \n(defsetf bref (board square) (val) \n'(setf (aref .board .square) .val)) \n\n\f\n<a id='page-602'></a>\n\nOthello \n\nempty \nblack \nwhite \nouter \nall-directions \nall-squares \nwinning-value \nlosing-value \n\npiece \n\nboard \n\nget-move \nmake-move \nhuman \nrandom-strategy \nmaximi ze-di fference \n\nmaximizer \nweighted-squares \nmodified-weighted-squares \nmi .imax \nminimax-searcher \nalpha-beta \nalpha-beta-searcher \n\nbref \ncopy-board \ninitial-board \nprint-board \ncount-difference \nname-of \nopponent \nvalid-p \nlegal-p \n\nmake-flips \nwould-flip? \nfind-bracketing-piece \nany-legal-move? \nnext-to-play \nlegal-moves \nfinal-value \nneighbors \nswitch-strategies \n\nrandom-elt \n\nTop-Level Function \n\nPlay a game of Othello. Return the score. \n\nConstants \n\n0 represents an empty square. \n1 represents a black piece. \n2 represents a white piece. \n3 represents a piece outside the 8x8 board. \nA list of integers representing the eight directions. \nA list of all legal squares. \nThe best possible evaluation. \nThe worst possible evaluation. \n\nData Types \n\nAn integer from empty to outer. \nA vector of 100 pieces. \n\nMajor Functions \n\nCall the player's strategy function to get a move. \n\nUpdate board to reflect move by player. \nA strategy that prompts a human player. \nMake any legal move. \n\nA strategy that maximizes the difference in pieces. \nReturn a strategy that maximizes some measure. \nSum of the weights of player's squares minus opponent's. \nLike above, but treating corners better. \nFind the best move according to EVAL.FN, searching PLY levels. \nReturn a strategy that uses mi.i max to search. \nFind the best move according to EVAL-FN, searching PLY levels. \nReturn a strategy that uses al pha- beta to search. \n\nAuxiliary Functions \n\nReference to a position on the board. \nMake a new board. \nReturn a board, empty except for four pieces in the middle. \nPrint a board, along with some statistics. \nCount player's pieces minus opponent's pieces. \nA character used to print a piece. \nThe opponent of black is white, and vice-versa. \nA syntactically vahd square. \nA legal move on the board. \nMake any flips in the given direction. \nWould this move result in any flips in this direction? \nReturn the square number of the bracketing piece. \nDoes player have any legal moves in this position? \nCompute the player to move next, or NIL if nobody can move. \nReturns a list of legal moves for player. \nIs this a win, loss, or draw for player? \nReturn a list of all squares adjacent to a square. \nPlay one strategy for a while, then switch. \n\nPreviously Defined Functions \n\nChoose a random element from a sequence, (pg. 36) \n\nFigure 18.3: Glossary for the Othello Program \n\n\f\n<a id='page-603'></a>\n\n(defun copy-board (board) \n(copy-seq board)) \n\n(defconstant all-squares \n(loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i)) \n\n(defun initial-board () \n\n\"Return a board, empty except for four pieces in the middle.\" \nBoards are 100-element vectors, with elements 11-88 used, \nand the others marked with the sentinel OUTER. Initially \nthe 4 center squares are taken, the others empty, \n\n(let ((board (make-array 100 :element-type 'piece \n:initial-element outer))) \n(dolist (square all-squares) \n(setf (bref board square) empty)) \n(setf (bref board 44) white (bref board 45) black \n(bref board 54) black (bref board 55) white) \nboard)) \n\n(defun print-board (board) \n\"Print a board, along with some statistics.\" \n(format t \"~2& 1 2 3 4 5 6 7 8 [~c=~2a ~c=''2a (~@d)]\" \n\n(name-of black) (count black board) \n(name-of white) (count white board) \n(count-difference black board)) \n\n(loop for row from 1 to 8 do \n(format t \"-& ~d \" (* 10 row)) \n(loop for col from 1 to 8 \n\nfor piece = (bref board (+ col (* 10 row))) \ndo (format t \"\"c \" (name-of piece)))) \n(format t \"~2&\")) \n\n(defun count-difference (player board) \n\"Count player's pieces minus opponent's pieces.\" \n(- (count player board) \n\n(count (opponent player) board))) \n\nNow let's take a look at the initial board, as it is printed by pri nt - boa rd, and by a raw \nwri te (I added the line breaks to make it easier to read): \n\n\f\n<a id='page-604'></a>\n\n> (write (initial-board ) > (print-board (initial-board) ) \nrarray t) \n#(3 33333333 3 1234567 8 C@=2 0=2 (-^0)1 \n300000000 3 10 \n300000000 3 20 \n300000000 3 30 \n300021000 3 40...0@.. . \n300012000 3 50 . ..@0.. . \n300000000 3 60 \n300000000 3 70 \n300000000 3 80 \n33333333 3 3) \n#<ART-2B-100 -72570734> NIL \n\nNotice that pri nt - boa rd provides some additional information: the number of pieces \nthat each player controls, and the difference between these two counts. \n\nThe next step is to handle moves properly: given a board and a square to move \nto, update the board to reflect the effects of the player moving to that square. This \nmeans flipping some of the opponent's pieces. One design decision is whether the \nprocedure that makes moves, make-move, will be responsible for checking for error \nconditions. My choice is that make - move assumes it will be passed a legal move. That \nway, a strategy can use the function to explore sequences of moves that are known to \nbe valid without slowing make - move down. Of course, separate procedures will have \nto insure that a move is legal. Here we introduce two terms: a valid move is one that \nis syntactically correct: an integer from 11 to 88 that is not off the board. A legal move \nis a valid move into an empty square that will flip at least one opponent. Here's the \ncode: \n\n(defun valid-p (move) \n\n\"Valid moves are numbers in the range 11-88 that end in 1-8.\" \n\n(and (integerp move) (<= 11 move 88) (<= 1 (mod move 10) 8))) \n\n(defun legal-p (move player board) \n\n\"A Legal move must be into an empty square, and it must \n\nflip at least one opponent piece.\" \n\n(and (eql (bref board move) empty) \n(some #'(lambda (dir) (would-flip? move player board dir)) \n\nall-directions))) \n\n(defun make-move (move player board) \n\n\"Update board to reflect move by player\" \n\nFirst make the move, then make any flips \n(setf (bref board move) player) \n(dolist (dir all-directions) \n\n(make-flips move player board dir)) \nboard) \n\n\f\n<a id='page-605'></a>\nNow all we need is to make-fl ips. To do that, we search in all directions for a \nbracketing piece: a piece belonging to the player who is making the move, which \nsandwiches a string of opponent pieces. If there are no opponent pieces in that \ndirection, or if an empty or outer piece is hit before the player's piece, then no flips \nare made. Note that would-f 1 ip? is a semipredicate that returns false if no flips \nwould be made in the given direction, and returns the square of the bracketing piece \nif there is one. \n\n(defun make-flips (move player board dir) \n\"Make any flips in the given direction.\" \n(let ((bracketer (would-flip? move player board dir))) \n\n(when bracketer \n(loop for c from (+ move dir) by dir until (eql c bracketer) \ndo (setf (bref board c) player))))) \n\n(defun would-flip? (move player board dir) \n\"Would this move result in any flips in this direction? \nIf so. return the square number of the bracketing piece.\" \n\nA flip occurs if, starting at the adjacent square, c. there \nis a string of at least one opponent pieces, bracketed by \none of player's pieces \n\n(let ((c (+ move dir))) \n(and (eql (bref board c) (opponent player)) \n(find-bracketing-piece (+ c dir) player board dir)))) \n\n(defun find-bracketing-piece (square player board dir) \n\"Return the square number of the bracketing piece.\" \n(cond ((eql (bref board square) player) square) \n\n((eql (bref board square) (opponent player)) \n(find-bracketing-piece (+ square dir) player board dir)) \n(t nil))) \n\nFinally we can write the function that actually monitors a game. But first we are \nfaced with one more important choice: how will we represent a player? We have \nalready distinguished between black and white's pieces, but we have not decided \nhow to ask black or white for their moves. I choose to represent player's strategies \nas functions. Each function takes two arguments: the color to move (black or white) \nand the current board. The function should return a legal move number. \n\n(defun Othello (bl-strategy wh-strategy &optional (print t)) \n\"Play a game of Othello. Return the score, where a positive \ndifference means black (the first player) wins.\" \n(let ((board (initial-board))) \n\n(loop for player = black \nthen (next-to-play board player print) \nfor strategy = (if (eql player black) \n\n\f\n<a id='page-606'></a>\n\nbl-strategy \n\nwh-strategy) \nuntil (null player) \ndo (get-move strategy player board print)) \n\n(when print \n(format t \"~&The game is over. Final result:\") \n(print-board board)) \n\n(count-difference black board))) \n\nWe need to be able to determine who plays next at any point. The rules say that \nplayers alternate turns, but if one player has no legal moves, the other can move \nagain. When neither has a legal move, the game is over. This usually happens \nbecause there are no empty squares left, but it sometimes happens earlier in the \ngame. The player with more pieces at the end of the game wins. If neither player has \nmore, the game is a draw. \n\n(defun next-to-play (board previous-player print) \n\"Compute the player to move next, or NIL if nobody can move.\" \n(let ((opp (opponent previous-player))) \n\n(cond ((any-legal-move? opp board) opp) \n((any-legal-move? previous-player board) \n(when print \n(format t \"\"&^C has no moves and must pass.\" \n(name-of opp))) \nprevious-player) \n(t nil)))) \n\n(defun any-legal-move? (player board) \n\"Does player have any legal moves in this position?\" \n(some #'(lambda (move) (legal-p move player board)) \n\nall-squares)) \n\nNote that the argument print (of Othello, next-to-play, and below, get-move) \ndetermines if information about the progress of the game will be printed. For an \ninteractive game, pri nt should be true, but it is also possible to play a \"batch\" game \nwith pri nt set to false. \n\nIn get - move below, the player's strategy function is called to determine his move. \nIllegal moves are detected, and proper moves are reported when pri nt is true. The \nstrategy function is passed a number representing the player to move (black or white) \nand a copy of the board. If we passed the real game board, the function could cheat \nby changing the pieces on the board! \n\n\f\n<a id='page-607'></a>\n\n(defun get-move (strategy player board print) \n\"Call the player's strategy function to get a move. \nKeep calling until a legal move is made.\" \n(when print (print-board board)) \n(let ((move (funcall strategy player (copy-board board)))) \n\n(cond \n((and (valid-p move) (legal-p move player board)) \n(when print \n(format t \"'^&'. moves to ~d.\" (name-of player) move)) \n(make-move move player board)) \n(t (warn \"Illegal move: ~d\" move) \n(get-move strategy player board print))))) \n\nHere we define two simple strategies: \n\n(defun human (player board) \n\"A human player for the game of Othello\" \n(declare (ignore board)) \n(format t \"~&~c to move: \" (name-of player)) \n(read)) \n\n(defun random-strategy (player board) \n\"Make any legal move.\" \n(random-elt (legal-moves player board))) \n\n(defun legal-moves (player board) \n\"Returns a list of legal moves for player\" \n(loop for move in all-squares \n\nwhen (legal-p move player board) collect move)) \n\nWe are now in a position to play the game. The expression \n(othel 1 0 # * human #'human) will let two people play against each other. Alternately, \n(othel lo #'random-strategy #'human) will allow us to match our wits against a \nparticularly poor strategy. The rest of this chapter shows how to develop a better \nstrategy. \n\n18.3 Evaluating Positions \nThe random-move strategy is, of course, a poor one. We would like to make a good \nmove rather than a random move, but so far we don't know what makes a good \nmove. The only positions we are able to evaluate for sure are final positions: when \nthe game is over, we know that the player with the most pieces wins. This suggests a \nstrategy: choose the move that maximizes count-di f f erence, the piece differential. \n\n\f\n<a id='page-608'></a>\n\nThe function maxi mize-di ff erence does just that. It calls maxi mi zer, a higher-order \n\nfunction that chooses the best move according to an arbitrary evaluation function. \n\n(defun maximize-difference (player board) \n\"A strategy that maximizes the difference in pieces.\" \n(funcall (maximizer #'count-difference) player board)) \n\n(defun maximizer (eval-fn) \n\"Return a strategy that will consider every legal move, \napply EVAL-FN to each resulting board, and choose \nthe move for which EVAL-FN returns the best score. \nFN takes two arguments: the player-to-move and board\" \n#*(lambda (player board) \n\n(let* ((moves (legal-moves player board)) \n(scores (mapcar #'(lambda (move) \n\n(funcall \neval-fn \nplayer \n(make-move move player \n\n(copy-board board)))) \nmoves)) \n(best (apply #*max scores))) \n(elt moves (position best scores))))) \n\n&#9635; Exercise 18.1 Playsomegameswithmaximize -differenceagainst random-strategy \nand human. How good is maximize-difference? \nThose who complete the exercise will quickly see that the maximi ze-di ff erence \nplayer does better than random, and may even beat human players in their first game \nor two. But most humans are able to improve, learning to take advantage of the \noverly greedy play of maximi ze-di ff erence. Humans learn that the edge squares, \nfor example, are valuable because the player dominating the edges can surround the \nopponent, while it is difficult to recapture an edge. This is especially true of corner \nsquares, which can never be recaptured. \nUsing this knowledge, a clever player can temporarily sacrifice pieces to obtain \nedge and corner squares in the short run, and win back pieces in the long run. \nWe can approximate some of this reasoning with the weighted-squa res evaluation \nfunction. Like count-difference, it adds up all the player's pieces and subtracts \nthe opponents, but each piece is weighted according to the square it occupies. Edge \nsquares are weighted highly, corner squares higher still, and squares adjacent to the \ncorners and edges have negative weights, because occupying these squares often \ngives the opponent a means of capturing the desirable square. Figure 18.4 shows \nthe standard nomenclature for edge squares: X, A, B, and C. In general, X and C \n\n\f\n<a id='page-609'></a>\nsquares are to be avoided, because taking them gives the opponent a chance to take \nthe corner. The wei ghted-squares evaluation function reflects this. \n\na b c d e f g h \n\n1 c A . . A C \n\n2 X X\n\nc c \n\n3 A A \n4 . . \n5 .\n\n. \n6 A A \n\n7 C X X C \n\n8 c A . . A c \n\nFigure 18.4: Names for Edge Squares \n\n(defparameter ^weights* \n\n'#(0 0 0 0 0 0 0 0 0 0 \n0 120 -20 20 5 5 20 -20 120 0 \n0 -20 -40 -5 -5 -5 -5 -40 -20 0 \n0 20 -5 15 3 3 15 -5 20 0 \n5-5333 3 -5 5 0 \n5-5333 3 -5 5 0 \n20 -5 15 3 3 15 -5 20 0 \n-20 -40 -5 -5 -5 -5 -40 -20 0 \n120 -20 20 5 5 20 -20 120 0 \n\n0 00000 0 0 0)) \n\n(defun weighted-squares (player board) \n\"Sum of the weights of player's squares minus opponent's.\" \n(let ((opp (opponent player))) \n\n(loop for i in all-squares \nwhen (eql (bref board i) player) \nsum (aref *weights* i) \nwhen (eql (bref board i) opp) \nsum (- (aref ^weights* i))))) \n\n&#9635; Exercise 18.2 Compare strategies by evaluating the two forms below. What happens? \nIs this a good test to determine which strategy is better? \n\n\f\n<a id='page-610'></a>\n\n(Othello (maximizer #'weighted-squares) \n(maximizer #*count-difference) nil) \n\n(Othello (maximizer #'count-difference) \n(maximizer #'weighted-squares) nil) \n\n18.4 Searching Ahead: Minimax \nEven the weighted-squares strategy is no match for an experienced player. There \nare two ways we could improve the strategy. First, we could modify the evaluation \nfunction to take more information into account. But even without changing the \nevaluation function, we can improve the strategy by searching ahead. Instead of \nchoosing the move that leads immediately to the highest score, we can also consider \nthe opponent's possible replies, our replies to those replies, and so on. By searching \nthrough several levels of moves, we can steer away from potential disaster and find \ngood moves that were not immediately apparent. \n\nAnother way to look at the maxi mi zer function is as a search function that searches \nonly one level, or ply, deep: \n\nThe top of the tree is the current board position, and the squares below that indicate \npossible moves. The maxi mi zer function evaluates each of these and picks the best \nmove, which is underlined in the diagram. \n\nNow let's see how a 3-ply search might go. The first step is to apply maxi mi zer to \nthe positions just above the bottom of the tree. Suppose we get the following values: \n\n\f\n<a id='page-611'></a>\n\nEach position is shown as having two possible legal moves, which is unreahstic \nbut makes the diagram fit on the page. In a real game, five to ten legal moves per \nposition is typical. The values at the leaves of the tree were computed by applying \nthe evaluation function, while the values one level up were computed by maxi mi zer. \nThe result is that we know what our best move is for any of the four positions just \nabove the bottom of the tree. \n\nGoing up a level, it is the opponent's turn to move. We can assume the opponent \nwill choose the move that results in the minimal value to us, which would be the \nmaximal value to the opponent. Thus, the opponent's choices would be the 10- and \n9-valued positions, avoiding the 20- and 23-valued positions. \n\n\f\n<a id='page-612'></a>\n\nNow it is our turn to move again, so we apply maxi mi zer once again to get the final \nvalue of the top-level position: \n\nIf the opponent plays as expected, we will always follow the left branch of the tree \nand end up at the position with value 10. If the opponent plays otherwise, we will \nend up at a position with a better value. \n\nThis kind of search is traditionally called a minimax search, because of the alternate \napplication of the maxi mi zer and a hypothetical mi ni mi zer function. Notice that only \nthe leaf positions in the tree are looked at by the evaluation function. The value of all \nother positions is determined by minimizing and maximizing. \n\nWe are almost ready to code the minimax algorithm, but first we have to make \na few design decisions. First, we could write two functions, mi nimax and maxi mi n, \nwhich correspond to the two players' analyses. However, it is easier to write a single \nfunction that maximizes the value of a position for a particular player. In other words, \nby adding the player as a parameter, we avoid having to write two otherwise identical \nfunctions. \n\nSecond, we have to decide if we are going to write a general minimax searcher \nor an Othello-specific searcher. I decided on the latter for efficiency reasons, and \nbecause there are some Othello-specific complications that need to be accounted for. \nFirst, it is possible that a player will not have any legal moves. In that case, we want \nto continue the search with the opponent to move. If the opponent has no moves \neither, then the game is over, and the value of the position can be determined with \nfinality by counting the pieces. \n\nThird, we need to decide the interaction between the normal evaluation function \nand this final evaluation that occurs when the game is over. We could insist that \n\n\f\n<a id='page-613'></a>\neach evaluation function determine when the game is over and do the proper computation. \nBut that overburdens the evaluation functions and may lead to wasteful \nchecking for the end of game. Instead, I implemented a separate f i nal - val ue evaluation \nfunction, which returns 0 for a draw, a large positive number for a win, and \na large negative number for a loss. Because fixnum arithmetic is most efficient, the \nconstants most-positive-fixnum and most-negative-fixnum are used. The evaluation \nfunctions must be careful to return numbers that are within this range. All \nthe evaluation functions in this chapter will be within range if fixnums are 20 bits \nor more. \n\nIn a tournament, it is not only important who wins and loses, but also by how \nmuch. If we were trying to maximize the margin of victory, then f i na1 - va1 ue would \nbe changed to include a small factor for the final difference. \n\n(defconstant winning-value most-positive-fixnum) \n(defconstant losing-value most-negative-fixnum) \n\n(defun final-value (player board) \n\"Is this a win. loss, or draw for player?\" \n(case (Signum (count-difference player board)) \n\n(-1 losing-value) \n( 0 0) \n(+1 winning-value))) \n\nFourth, and finally, we need to decide on the parameters for the minimax function. \nLike the other evaluation functions, it needs the player to move and the current board \nas parameters. It also needs an indication of how many ply to search, and the static \nevaluation function to apply to the leaf positions. Thus, minimax will be a function \nof four arguments. What will it return? It needs to return the best move, but it also \nneeds to return the value of that move, according to the static evaluation function. \nWe use multiple values for this. \n\n(defun minimax (player board ply eval-fn) \n\"Find the best move, for PLAYER, according to EVAL-FN. \nsearching PLY levels deep and backing up values.\" \n(if (= ply 0) \n\n(funcall eval-fn player board) \n(let ((moves (legal-moves player board))) \n(if (null moves) \n(if (any-legal-move? (opponent player) board) \n(- (minimax (opponent player) board \n(- ply 1) eval-fn)) \n(final-value player board)) \n(let ((best-move nil) \n(best-val nil)) \n(dolist (move moves) \n\n\f\n<a id='page-614'></a>\n\n(let* ((board2 (make-move move player \n(copy-board board))) \n\n(val (- (minimax \n(opponent player) board2 \n(- ply 1) eval-fn)))) \n\n(when (or (null best-val) \n\n(> val best-val)) \n(setf best-val val) \n(setf best-move move)))) \n\n(values best-val best-move)))))) \n\nThe mi . i max function cannot be used as a strategy function as is, because it takes too \nmany arguments and returns too many values. The functional minimax-searcher \nreturns an appropriate strategy. Remember that a strategy is a fimction of two \narguments: the player and the board, get-move is responsible for passing the right \narguments to the function, so the strategy need not worry about where the arguments \ncome from. \n\n(defun minimax-searcher (ply eval-fn) \n\"A strategy that searches PLY levels and then uses EVAL-FN.\" \n#*(lambda (player board) \n\n(multiple-value-bind (value move) \n\n(minimax player board ply eval-fn) \n(declare (ignore value)) \nmove))) \n\nWe can test the minimax strategy, and see that searching ahead 3 ply is indeed better \nthan looking at only 1 ply. I show only the final result, which demonstrates that it is \nindeed an advantage to be able to look ahead: \n\n> (Othello (minimax-searcher 3 #*count-difference) \n(maximizer #'count-difference)) \n\nThe game is over. Final result: \n\n12 3 4 5 6 7 8 [@=53 0=0 (+53)] \n\n20@@@@@@@@ \n\n30@@@@@@@@ \n40@@@@@@@@ \n50@@@@@@@@ \n\n60 . . @@ @@ @ @ \n70 . . . @ @ @ @ @ \n80 . . . . @ @ . . \n\f\n<a id='page-615'></a>\n\n18.5 Smarter Searching: Alpha-Beta Search \nThe problem with a full minimax search is that it considers too many positions. It \nlooks at every line of play, including many improbable ones. Fortunately, there is a \nway to find the optimal line of play without looking at every possible position. Let's \ngo back to our familiar search tree: \n\nHere we have marked certain positions with question marks. The idea is that the \nwhole search tree evaluates to 10 regardless of the value of the positions labeled ?i. \nConsider the position labeled ?i. It does not matter what this position evaluates to, \nbecause the opponent will always choose to play toward the 10-position, to avoid the \npossibility of the 15. Thus, we can cut off the search at this point and not consider \nthe ?-position. This kind of cutoff has historically been called a beta cutoff. \n\nNow consider the position labeled ?4. It does not matter what this position \nevaluates to, because we will always prefer to choose the 10 position at the left \nbranch, rather than giving the opponent a chance to play to the 9-position. This is an \nalpha cutoff. Notice that it cuts off a whole subtree of positions below it (labeled ?2 \nand ?3). \n\nIn general, we keep track of two parameters that bound the true value of the \ncurrent position. The lower bound is a value we know we can achieve by choosing a \ncertain line of play. The idea is that we need not even consider moves that will lead \nto a value lower than this. The lower bound has traditionally been called alpha, but \nwe will name it achi evabl e. The upper bound represents a value the opponent can \nachieve by choosing a certain line of play. It has been called beta, but we will call it \ncutoff. Again, the idea is that we need not consider moves with a higher value than \nthis (because then the opponent would avoid the move that is so good for us). The \n\n\f\n<a id='page-616'></a>\n\nalpha-beta algorithm is just minimax, but with some needless evaluations pruned by \nthese two parameters. \n\nIn deeper trees with higher branching factors, many more evaluations can be \npruned. In general, a tree of depth d and branching factor b requires b^ evaluations \nfor full minimax, and as few as 6^/^ evaluations with alpha-beta minimax. \n\nTo implement alpha-beta search, we add two more parameters to the function \nminimax and rename it alpha-beta, achievable is the best score the player can \nachieve; it is what we want to maximize. The cutoff is a value that, when exceeded, \nwill make the opponent choose another branch of the tree, thus making the rest of \nthe current level of the tree irrelevant. The test unti 1 (>= achi evabl e cutoff) in \nthe penultimate line of minimax does the cutoff; all the other changes just involve \npassing the parameters around properly. \n\n(defun alpha-beta (player board achievable cutoff ply eval-fn) \n\"Find the best move, for PLAYER, according to EVAL-FN, \nsearching PLY levels deep and backing up values, \nusing cutoffs whenever possible.\" \n(if (= ply 0) \n\n(funcall eval-fn player board) \n(let ((moves (legal-moves player board))) \n(if (null moves) \n(if (any-legal-move? (opponent player) board) \n\n(- (alpha-beta (opponent player) board \n(- cutoff) (- achievable) \n(- ply 1) eval-fn)) \n\n(final-value player board)) \n(let ((best-move (first moves))) \n(loop for move in moves do \n(let* ((boardZ (make-move move player \n(copy-board board))) \n\n(val (- (alpha-beta \n(opponent player) board2 \n(- cutoff) (- achievable) \n(- ply 1) eval-fn)))) \n\n(when (> val achievable) \n(setf achievable val) \n(setf best-move move))) \n\nuntil (>= achievable cutoff)) \n(values achievable best-move)))))) \n\n(defun alpha-beta-searcher (depth eval-fn) \n\"A strategy that searches to DEPTH and then uses EVAL-FN.\" \n#.(lambda (player board) \n\n(multiple-value-bind (value move) \n(alpha-beta player board losing-value winning-value \ndepth eval-fn) \n\n\f\n<a id='page-617'></a>\n(declare (ignore value)) \nmove))) \n\nIt must be stressed that a 1 pha- beta computes the exact same result as the full-search \nversion of mi . i max. The only advantage of the cutoffs is making the search go faster \nby considering fewer positions. \n\n18.6 An Analysis of Some Games \nNow is a good time to stop and analyze where we have gone. We've demonstrated a \nprogram that can play a legal game of Othello, and some strategies that may or may \nnot play a good game. First, we'll look at some individual games to see the mistakes \nmade by some strategies, and then we'll generate some statistics for series of games. \n\nIs the weighted-squares measure a good one? We can compare it to a strategy of \nmaximizing the number of pieces. Such a strategy would of course be perfect if it \ncould look ahead to the end of the game, but the speed of our computers limits us \nto searching only a few ply, even with cutoffs. Consider the following game, where \nblack is maximizing the difference in the number of pieces, and white is maximizing \nthe weighted sum of squares. Both search to a depth of 4 ply: \n\n> (Othello (alpha-beta-searcher 4 #'count-difference) \n(alpha-beta-searcher 4 #*weighted-squares)) \n\nBlack is able to increase the piece difference dramatically as the game progresses. \nAfter 17 moves, white is down to only one piece: \n\n12 3 4 5 6 7 8 [@=20 0=1 (+19)] \n10 0 @ \n\n20 . @ . . . @ @ . \n30 @ @ @ @ @ @ . . \n40 . @ . @ @ . . . \n50 @ @ @@ @ @ . . \n60 . @ \n70 \n80 \nAlthough behind by 19 points, white is actually in a good position, because the piece \nin the corner is safe and threatens many of black's pieces. White is able to maintain \ngood position while being numerically far behind black, as shown in these positions \nlater in the game: \n\n\f\n<a id='page-618'></a>\n\n12 3 4 5 6 7 8 [e=32 0=15 (+17)] \n10 0 0 0 0 @ @ 0 0 \n20 @ @0 @ @ @ @ @ \n30 @ @ 0 0 @ 0 @ @ \n40 0 0 @ @ @ @ @ @ \n50 @0 @ @ @ @ \n60 @ @0 @ @ 0 \n70 @ . . @ @ . \n80 \n1 2 3 4 5 6 7 8 [@=34 0=19 (+15)] \n10 0 0 0 0 @ @ 0 0 \n20 @ @0 @ @ @ @ @ \n30 @ @ 0 0 @ 0 @ @ \n40 0 @ 0 @ @ @ @ @ \n50 0 @ 0 @ @ @ @ . \n60 0 @ 0 @ @ @ \n70 0 @ @ @ @ . \n80 0 @ 0 . \n\nAfter some give-and-take, white gains the advantage for good by capturing eight \npieces on a move to square 85 on the third-to-last move of the game: \n\n1 2 3 4 5 6 7 8 [@=31 0=30 (+1)] \n10 0 0 0 0 @ @ 0 0 \n20 @ @ 0 0 @ @ @ 0 \n30 @ @ 0 0 0@ @ 0 \n40 0 @ 0 0 0@ @ 0 \n50 0 @ 0 @ 0 @ @ 0 \n\n60 0 @ 0 @ @ @@ 0 \n\n70 0 @ @ @ @ @0 0 \n\n80 0 @ @ @ . . ' 0 \n\n0 moves to 85. \n\n1 2 3 4 5 6 7 8 [@=23 0=39 (-16)] \n10 0 0 0 0 @ @ 0 0 \n20 @ @0 0 @ @ @ 0 \n30 @ @0 0 0@ @ 0 \n40 0 @ 0 0 0@ @ 0 \n50 0 @ 0 @0 @ @ 0 \n60 0 @ 0 @ 0 @ 0 0 \n70 0 @ @ 0 0 0 0 0 \n80 0 0 0 0 0 . ' 0 \n\n@ moves to 86. \n\n\f\n<a id='page-619'></a>\n12 3 4 5 6 7 8 [@=26 0=37 (-11)] \n10 0000@@00 \n20@@00@@@0 \n30@@000@@0 \n40 0@000@@0 \n50 0@0@0@@0 \n60 0@0@0@00 \n70 0@@0@@00 \n80 00000@.0 \n\n0 moves to 87. \nThe game is over. Final result: \n\n1 2 3 4 5 6 7 8 [@=24 0=40 (-16)] \n10 0000@@00 \n20@@00@@@0 \n30@@000@@0 \n40 0@000@@0 \n50 0@0@0@@0 \n60 0@0@0@00 \n70 0@@0@000 \n80 00000000 \n\n-16 \n\nWhite ends up winning by 16 pieces. Black's strategy was too greedy: black was \nwilling to give up position (all four corners and all but four of the edge squares) for \ntemporary gains in material. \n\nIncreasing the depth of search does not compensate for a faulty evaluation function. \nIn the following game, black's search depth is increased to 6 ply, while white's \nis kept at 4. The same things happen, although black's doom takes a bit longer to \nunfold. \n\n> (Othello (alpha-beta-searcher 6 #'count-difference) \n(alpha-beta-searcher 4 #'weighted-squares)) \n\nBlack slowly builds up an advantage: \n\n12 3 4 5 6 7 8 [@=21 0=8 (+13)] \n\n10 . . @ @ @ @ @ \n20 . @ . @ 0 @ . \n30 0@@0@00 \n40 . @. @ 0 @ 0 \n50. @ @ @ @ @ . \n60 . @ . @ . 0 . \n70 \n80 \n\f\n<a id='page-620'></a>\n\nBut at this point white has clear access to the upper left corner, and through that \ncorner threatens to take the whole top edge. Still, black maintains a material edge as \nthe game goes on: \n\n12 3 4 5 6 7 8 [@=34 0=11 (+23)] \n\n10 0 . @ @ @ @@. \n20 . 0 0 @ @ @ . . \n30 0@00@@@@ \n40@@@@0@@ . \n50@@@@@0@. \n60@@@@@@00 \n70 @ . . @ . . @ 0 \n80 \nBut eventually white's weighted-squares strategy takes the lead: \n\n12 3 4 5 6 7 8 [@=23 0=27 (-4)] \n10 00 0 00000 \n20 @ @ 0 @ @ @ . . \n30 0@00@@@@ \n40 0@0@0@@ . \n50 0@0@@0@ . \n60 000@@@00 \n\n70 0 . 0 @ . . @ 0 \n800 \nand is able to hold on to win: \n\n12 3 4 5 6 7 8 [@=24 0=40 (-16)] \n10 00000000 \n20@@0@00@@ \n30 0@00@@@@ \n40 0@00@@@0 \n50 00@@0@00 \n60 000@0@@0 \n70 0000@@00 \n80 00000@@0 \n\n-16 \n\nThis shows that brute-force searching is not a panacea. While it is helpful to be able \nto search deeper, greater gains can be made by making the evaluation function more \naccurate. There are many problems with the weighted-squares evaluation function. \nConsider again this position from the first game above: \n\n\f\n<a id='page-621'></a>\n\n12 3 4 5 6 7 8 [@=20 0=1 (+19)] \n10 0 @ \n\n20 . @ . . . @@ . \n30 @ @ @ @@ @ . . \n40 . @ . @ @ . . . \n50 @ @@ @ @@ . . \n60 . @ \n70 \n80 \nHere white, playing the weighted-squares strategy, chose to play 66. This is probably \na mistake, as 13 would extend white's dominance of the top edge, and allow white to \nplay again (since black would have no legal moves). Unfortunately, white rejects this \nmove, primarily because square 12 is weighted as -20. Thus, there is a disincentive \nto taking this square. But 12 is weighted -20 because it is a bad idea to take such a \nsquare when the corner is empty - the opponent will then have a chance to capture \nthe corner, regaining the 12 square as well. Thus, we want squares like 12 to have a \nnegative score when the corner is empty, but not when it is already occupied. The \nmodi f i ed - wei ghted - squa res evaluation function does just that. \n\n(defun modified-weighted-squares (player board) \n\"Like WEIGHTED-SQUARES, but don't take off for moving \nnear an occupied corner.\" \n(let ((w (weighted-squares player board))) \n\n(dolist (corner '(11 18 81 88)) \n(when (not (eql (bref board corner) empty)) \n(dolist (c (neighbors corner)) \n(when (not (eql (bref board c) empty)) \n(incf w (* (-5 (aref *weights* c)) \n(if (eql (bref board c) player) \n+1 -1))))))) \nw)) \n\n(let ((neighbor-table (make-array 100 linitial-element nil))) \n;; Initialize the neighbor table \n(dolist (square all-squares) \n\n(dolist (dir all-directions) \n(if (valid-p (+ square dir)) \n(push (+ square dir) \n(aref neighbor-table square))))) \n\n(defun neighbors (square) \n\"Return a list of all squares adjacent to a square.\" \n(aref neighbor-table square))) \n\n\f\n<a id='page-622'></a>\n\n18.7 The Tournament Version of Othello \nWhile the othel 1 o function serves as a perfectly good moderator for casual play, \nthere are two points that need to be fixed for tournament-level play. First, tournament \ngames are played under a strict time limit: a player who takes over 30 minutes total \nto make all the moves forfeits the game. Second, the standard notation for Othello \ngames uses square names in the range al to h8, rather than in the 11 to 88 range that \nwe have used so far. al is the upper left corner, a8 is the lower left corner, and h8 is \nthe lower right corner. We can write routines to translate between this notation and \nthe one we were using by creating a table of square names. \n\n(let ((square-names \n\n(cross-product #'symbol \n'(? a b c d e f g h ?) \n'(712345678 ?)))) \n\n(defun h8->88 (str) \n\"Convert from alphanumeric to numeric square notation.\" \n(or (position (string str) square-names rtest #'string-equal) \n\nstr)) \n\n(defun 88->h8 (num) \n\"Convert from numeric to alphanumeric square notation.\" \n(if (valid-p num) \n\n(elt square-names num) \nnum))) \n\n(defun cross-product (fn xlist ylist) \n\"Return a list of all (fn . y) values.\" \n(mappend #*(lambda (y) \n\n(mapcar #'(lambda (x) (funcall fn . y)) \nxlist)) \nylist)) \n\nNote that these routines return their input unchanged when it is not one of the \nexpected values. This is to allow commands other than moving to a particular \nsquare. For example, we will add a feature that recognizes res i gn as a move. \n\nThe h uma. player needs to be changed slightly to read moves in this format. While \nwe're at it, we'll also print the list of possible moves: \n\n(defun human (player board) \n\"A human player for the game of Othello\" \n(format t \"~&~c to move \"a: \" (name-of player) \n\n(mapcar #*88->h8 (legal-moves player board))) \n(h8->88 (read))) \n\n\f\n<a id='page-623'></a>\nTop-Level Functions \n\nOthello-series Play a series of . games. \nrandom-Othello-series Play a series of games, starting from a random position. \nround-robin Play a tournament among strategies. \n\nSpecial Variables \n\n*clock* A copy of the game clock (tournament version only). \n*board* A copy of the game board (tournament version only). \n*move-number* Number of moves made (tournament version only). \n*ply-boards* A vector of boards; used as a resource to avoid consing. \n\nData Structures \n\nnode Holds a board and its evaluation. \n\nMain Functions \n\nalpha-beta2 Sorts moves by static evaluation. \nalpha-beta-searcher2 Strategy using a1 pha- beta2. \nalpha-beta3 Uses the killer heuristic. \nalpha-beta-searcher3 Strategy using a1 pha- beta3. \nlago-eval Evaluation function based on Rosenbloom's program. \nlago Strategy using lago-eval. \n\nAuxiliary Functions \n\nh8->88 Convert from alphanumeric to numeric square notation. \n88->h8 Convert from numeric to alphanumeric square notation. \ntime-string Convert internal time units to a mm.ss string. \nswitch-strategies Play one strategy for a while, then another. \nmobil ity A strategy that counts the number of legal moves. \nlegal-nodes A list of legal moves sorted by their evaluation. \nnegate-node Set the value of a node to its negative. \nput-first Put the killer move first, if it is legal. \n\nPreviously Defined Fimctions \n\ncross-product Apply fn to all pairs of arguments, (pg. 47) \nsymbol Build a symbol by concatenating components. \n\nFigure 18.5: Glossary for the Tournament Version of Othello \n\nThe othel 10 function needn't worry about notation, but it does need to monitor the \ntime. We make up a new data structure, the clock, which is an array of integers \nsaying how much time (in internal units) each player has left. For example, (aref \ncl ock bl ack) is the amount of time black has left to make all his moves. In Pascal, \nwe would declare the clock array as arrayCbl ack. .white], but in Common Lisp all \narrays are zero-based, so we need an array of three elements to allow the subscript \nblack, which is 2. \n\nThe clock is passed to get - move and print - boa rd but is otherwise unused. I could \nhave complicated the main game loop by adding tests for forfeits because of expired \ntime and, as we shall see later, resignation by either player. However, I felt that would \nadd a great deal of complexity for rarely used options. Instead, I wrap the whole game \nloop, along with the computation of the final score, in a catch special form. Then, if \n\n\f\n<a id='page-624'></a>\n\nget-move encounters a forfeit or resignation, it can throw an appropriate final score: \n64 or -64, depending on which player forfeits. \n\n(defvar *move-number* 1 \"The number of the move to be played\") \n\n(defun Othello (bl-strategy wh-strategy \n\n&optional (print t) (minutes 30)) \n\"Play a game of Othello. Return the score, where a positive \ndifference means black, the first player, wins.\" \n(let ((board (initial-board)) \n\n(clock (make-array (+ 1 (max black white)) \n:initial-element \n(* minutes 60 \n\ninternal-time-units-per-second)))) \n(catch 'game-over \n\n(loop for *move-number* from 1 \nfor player = black then (next-to-play board player print) \nfor strategy = (if (eql player black) \n\nbl-strategy \n\nwh-strategy) \nuntil (null player) \ndo (get-move strategy player board print clock)) \n\n(when print \n(format t \"~&The game is over. Final result:\") \n(print-board board clock)) \n\n(count-difference black board)))) \n\nStrategies now have to comply with the time-limit rule, so they may want to look at \nthe time remaining. Rather than passing the clock in as an argument to the strategy,I \ndecided to store the clock in the special variable *cl ock*. The new version of othel 10 \nalso keeps track of the *move-number*. This also could have been passed to the \nstrategy functions as a parameter. But adding these extra arguments would require \nchanges to all the strategies we have developed so far. By storing the information in \nspecial variables, strategies that want to can look at the clock or the move number, \nbut other strategies don't have to know about them. \n\nWe still have the security problem-we don't want a strategy to be able to set the \nopponent's remaining time to zero and thereby win the game. Thus, we use *cl ock* \nonly as a copy of the \"real\" game clock. The function repl ace copies the real clock \ninto *cl ock*, and also copies the real board into *board*. \n\n(defvar *clock* (make-array 3) \"A copy of the game clock\") \n(defvar *board* (initial-board) \"A copy of the game board\") \n\n\f\n<a id='page-625'></a>\n\n(defun get-move (strategy player board print clock) \n\"Call the player's strategy function to get a move. \nKeep calling until a legal move is made.\" \n\nNote we don't pass the strategy function the REAL board. \n;; If we did, it could cheat by changing the pieces on the board, \n(when print (print-board board clock)) \n(replace *clock* clock) \n(let* ((to (get-internal-real-time)) \n\n(move (funcall strategy player (replace *board* board))) \n\n(tl (get-internal-real-time))) \n(decf (elt clock player) (- tl tO)) \n(cond \n\n((< (elt clock player) 0) \n(format t \"\"&^c has no time left and forfeits.\" \n(name-of player)) \n(THROW 'game-over (if (eql player black) -64 64))) \n((eq move 'resign) \n(THROW 'game-over (if (eql player black) -64 64))) \n((and (valid-p move) (legal-p move player board)) \n(when print \n(format t \"^&'O moves to ~a. \" \n(name-of player) (88->h8 move))) \n(make-move move player board)) \n(t (warn \"Illegal move: ~a\" (88->h8 move)) \n(get-move strategy player board print clock))))) \n\nFinally, the function print - boa rd needs to print the time remaining for each player; \nthis requires an auxiliary function to get the number of minutes and seconds from an \ninternal-format time interval. Note that we make the arguments optional, so that in \ndebugging one can say just (print- board) to see the current situation. Also note the \nesoteric format option: \" ~2 / Od\" prints a decimal number using at least two places, \npadding on the left with zeros. \n\n(defun print-board (&optional (board *board*) clock) \n\"Print a board, along with some statistics.\" \nFirst print the header and the current score \n\n(format t \"~2& a b c d e f g h [~c=~2a ~c=~2a (\"d)]\" \n(name-of black) (count black board) \n(name-of white) (count white board) \n(count-difference black board)) \n\nPrint the board itself \n\n(loop for row from 1 to 8 do \n(format t \"~& ~d \" row) \n(loop for col from 1 to 8 \n\nfor piece = (bref board (+ col (* 10 row))) \n\ndo (format t \"~c \" (name-of piece)))) \n\n\f\n<a id='page-626'></a>\n\n;: Finally print the time remaining for each player \n(when clock \n\n(format t \" [\"'c='\"a ~c=~a]~2&\" \n(name-of black) (time-string (elt clock black)) \n(name-of white) (time-string (elt clock white))))) \n\n(defun time-string (time) \n\"Return a string representing this internal time in minisecs. \n(multiple-value-bind (min sec) \n\n(floor (round time internal-time-units-per-second) 60) \n(format nil \"\"Zdrz/Od\" min sec))) \n\n18.8 Playing a Series of Games \nA single game is not enough to establish that one strategy is better than another. The \nfollowing function allows two strategies to compete in a series of games: \n\n(defun Othello -series (strategyl strategy2 n-pairs) \n\"Play a series of 2*n-pairs games, swapping sides.\" \n(let ((scores (loop repeat n-pairs \n\ncollect (Othello strategyl strategy2 nil) \n\ncollect (- (Othello strategy2 strategyl nil))))) \nReturn the number of wins, (1/2 for a tie), \nthe total of thepoint differences, and the \nscores themselves, all from strategyl's point of view, \n\n(values (+ (count-if #'plusp scores) \n\n(/ (count-if #*zerop scores) 2)) \n(apply #'+ scores) \nscores))) \n\nLet's see what happens when we use it to pit the two weighted-squares functions \nagainst each other in a series of ten games: \n\n> (othello-series \n(alpha-beta-searcher 2 #*modified-weighted-squares) \n(alpha-beta-searcher 2 #'weighted-squares) 5) \n\n0 \n60 \n(-28 40 -28 40 -28 40 -28 40 -28 40) \n\nSomething is suspicious here - the same scores are being repeated. A little thought \nreveals why: neither strategy has a random component, so the exact same game \nwas played five times with one strategy going first, and another game was played \n\n\f\n<a id='page-627'></a>\n\nfive times when the other strategy goes first! A more accurate appraisal of the two \n\nstrategies' relative worth would be gained by starting each game from some random \n\nposition and playing from there. \n\nThink for a minute how you would design to run a series of games starting from a \nrandom position. One possibility would be to change the function othel 1 o to accept \nan optional argument indicating the initial state of the board. Then othel 1 o- seri es \ncould be changed to somehow generate a random board and pass it to othel 1 o. While \nthis approach is feasible, it means changing two existing working functions, as well \nas writing another function, generate - random-board. But we couldn't generate just \nany random board: it would have to be a legal board, so it would have to call othel 1 o \nand somehow get it to stop before the game was over. \n\nAn alternative is to leave both Othello and othello-series alone and build \nanother function on top of it, one that works by passing in two new strategies: \nstrategies that make a random move for the first few moves and then revert to \nthe normal specified behavior. This is a better solution because it uses existing \nfunctions rather than modifying them, and because it requires no new functions \nbesides switch-strategies, which could prove useful for other purposes, and \nrandom-othel lo-seri es, which does nothing more than call othel lo-seri es with \nthe proper arguments. \n\n(defun random-Othello-series (strategyl strategy2 \n\nn-pairs &optional (n-random 10)) \n\"Play a series of 2*n games, starting from a random position.\" \n(othello-series \n\n(switch-strategies #'random-strategy n-random strategyl) \n(switch-strategies #*random-strategy n-random strategy2) \nn-pairs)) \n\n(defun switch-strategies (strategyl m strategy2) \n\"Make a new strategy that plays strategyl for m moves, \nthen plays according to strategy2.\" \n#'(lambda (player board) \n\n(funcall (if (<= *move-number* m) strategyl strategy2) \nplayer board))) \n\nThere is a problem with this kind of series: it may be that one of the strategies just \n\nhappens to get better random positions. A fairer test would be to play two games \n\nfrom each random position, one with the each strategy playing first. One way to \n\ndo that is to alter othel 1 o-seri es so that it saves the random state before playing \n\nthe first game of a pair, and then restores the saved random state before playing the \n\nsecond game. That way the same random position will be duplicated. \n\n\f\n<a id='page-628'></a>\n\n(defun Othello-series (strategyl strategy2 n-pairs) \n\"Play a series of 2*n-pairs games, swapping sides.\" \n(let ((scores \n\n(loop repeat n-pairs \nfor random-state = (make-random-state) \ncollect (Othello strategyl strategy2 nil) \ndo (setf *random-state* random-state) \ncollect (- (Othello strategy2 strategyl nil))))) \n\nReturn the number of wins (1/2 for a tie), \nthe total of the point differences, and the \nscores themselves, all from strategyl's point of view, \n\n(values (+ (count-if #*plusp scores) \n\n(/ (count-if #*zerop scores) 2)) \n(apply #'+ scores) \nscores))) \n\nNow we are in a position to do a more meaningful test. In the following, the weighted-\nsquares strategy wins 4 out of 10 games against the modified strategy, losing by a \ntotal of 76 pieces, with the actual scores indicated. \n\n> (random-Othello-series \n(alpha-beta-searcher 2 #'weighted-squares) \n(alpha-beta-searcher 2#'modified-weighted-squares) \n5) \n\n4 \n-76 \n(-8 -40 22 -30 10 -10 12 -18 4 -18) \n\nThe random- othel lo-series function is useful for comparing two strategies. When \nthere are more than two strategies to be compared at the same time, the following \nfunction can be useful: \n\n(defun round-robin (strategies n-pairs &optional \n\n(n-random 10) (names strategies)) \n\"Play a tournament among the strategies. \nN-PAIRS = games each strategy plays as each color against \neach opponent. So with . strategies, a total of \nN*(N-1)*N-PAIRS games are played.\" \n(let* ((N (length strategies)) \n\n(totals (make-array . .-initial-element 0)) \n(scores (make-array (list . .) \n:i ni ti al-element 0))) \nPlay the games \n(dotimes (IN) \n(loop for j from (+ i 1) to (- . 1) do \n(let* ((wins (random-Othello-series \n\n\f\n<a id='page-629'></a>\n(elt strategies i) \n(elt strategies j) \nn-pairs n-random)) \n\n(losses (- (* 2 n-pairs) wins))) \n(incf (aref scores i j) wins) \n(incf (aref scores j i) losses) \n(incf (aref totals i) wins) \n(incf (aref totals j) losses)))) \n\nPrint the results \n\n(dotimes (i N) \n(format t \"~ra~20T ~4f: \" (elt names i) (elt totals i)) \n(dotimes (j N) \n\n(format t \"~4f \" (if (= i j) \n(aref scores i j))))))) \n\nHere is a comparison of five strategies that search only 1 ply: \n\n(defun mobility (player board) \n\"The number of moves a player has.\" \n(length (legal-moves player board))) \n\n> (round-robin \n\n(list (maximizer #'count-difference) \n(maximizer #'mobility) \n(maximizer #*weighted-squares) \n(maximizer #'modified-weighted-squares) \n#'random-strategy) \n\n5 10 \n'(count-difference mobility weighted modified-weighted random)) \n\nCOUNT-DIFFERENCE 12.5: --3.0 \n2.5 0.0 7.0 \nMOBILITY 20.5: 7.0 --1.5 \n5.0 7.0 \nWEIGHTED 28.0: 7.5 8.5 --3.0 \n9.0 \nMODIFIED-WEIGHTED 31.5: 10.0 5.0 7.0 --9.5 \nRANDOM 7.5: 3.0 3.0 1.0 0.5 --\n\n\nThe parameter .-pai rs is 5, meaning that each strategy plays five games as black \nand five as white against each of the other four strategies, for a total of 40 games \nfor each strategy and 100 games overall. The first line of output says that the count-\ndifference strategy won 12.5 of its 40 games, including 3 against the mobility strategy, \n\n2.5 against the weighted strategy, none against the modified weighted, and 7 against \nthe random strategy. The fact that the random strategy manages to win 7.5 out of 40 \ngames indicates that the other strategies are not amazingly strong. Now we see what \nhappens when the search depth is increased to 4 ply (this will take a while to run): \n\f\n<a id='page-630'></a>\n\n> (round-robi. \n\n(list (alpha-beta-searcher 4 #*count-difference) \n(alpha-beta-searcher 4 #'weighted-squares) \n(alpha-beta-searcher 4 #'modified-weighted-squares) \n#'random-strategy) \n\n5 10 \n\n'(count-difference weighted modified-weighted random)) \n\nCOUNT-DIFFERENCE 12.0: --\n2.0 0.0 10.0 \nWEIGHTED 23.5: 8.0 .. . 5.5 10.0 \nMODIFIED-WEIGHTED 24.5: 10.0 4.5 .. . 10.0 \nRANDOM 0.0: 0.0 0.0 0.0 \n\nHere the random strategy does not win any games - an indication that the other \nstrategies are doing something right. Notice that the modified weighted-squares \nhas only a slight advantage over the weighted-squares, and in fact it lost their head-\nto-head series, four games to five, with one draw. So it is not clear which strategy \nis better. \n\nThe output does not break down wins by black or white, nor does it report the \nnumerical scores. I felt that that would clutter up the output too much, but you're \nwelcome to add this information. It turns out that white wins 23 (and draws 1) of \nthe 40 games played between 4-ply searching strategies. Usually, Othello is a fairly \nbalanced game, because black has the advantage of moving first but white usually \ngets to play last. It is clear that these strategies do not play well in the operung game, \nbut for the last four ply they play perfectly. This may explain white's slight edge, or \nit may be a statistical aberration. \n\n18.9 More Efficient Searching \nThe alpha-beta cutoffs work when we have established a good move and another \nmove proves to be not as good. Thus, we will be able to make cutoffs earlier if we \nensure that good moves are considered first. Our current algorithm loops through \nthe list of 1 egal -moves, but 1 egal -moves makes no attempt to order the moves in any \nway. We will call this the random-ordering strategy (even though the ordering is not \nrandom at all-square 11 is always considered first, then 12, etc.). \n\nOne way to try to generate good moves first is to search highly weighted squares \nfirst. Since 1 egal -moves considers squares in the order defined by all -squares, all \nwe have to do is redefine the list al 1 -squares^: \n\n^Remember, when a constant is redefined, it may be necessary to recompile any functions \nthat use the constant. \n\n\f\n<a id='page-631'></a>\n\n(defconstant all-squares \n(sort (loop for i from 11 to 88 \nwhen (<= 1 (mod i 10) 8) collect i) \n#*> :key #'(lambda (sq) (elt *weights* sq)))) \n\nNow the corner squares will automatically be considered first, followed by the other \nhighly weighted squares. We call this the static-ordering strategy, because the ordering \nis not random, but it does not change depending on the situation. \n\nA more informed way to try to generate good moves first is to sort the moves \naccording to the evaluation function. This means making more evaluations. Previously, \nonly the boards at the leaves of the search tree were evaluated. Now we need \nto evaluate every board. In order to avoid evaluating a board more than once, we \nmake up a structure called a node, which holds a board, the square that was taken to \nresult in that board, and the evaluation value of that board. The search is the same \nexcept that nodes are passed around instead of boards, and the nodes are sorted by \ntheir value. \n\n(defstruct (node) square board value) \n\n(defun alpha-beta-searcher2 (depth eval-fn) \n\"Return a strategy that does A-B search with sorted moves.\" \n#'(lambda (player board) \n\n(multiple-value-bind (value node) \n(alpha-beta2 \nplayer (make-node :board board \n.-value (funcall eval-fn player board)) \n\nlosing-value winning-value depth eval-fn) \n(declare (ignore value)) \n(node-square node)))) \n\n(defun alpha-beta2 (player node achievable cutoff ply eval-fn) \n\"A-B search, sorting moves by eval-fn\" \n;; Returns two values: achievable-value and move-to-make \n(if (= ply 0) \n\n(values (node-value node) node) \n(let* ((board (node-board node)) \n(nodes (legal-nodes player board eval-fn))) \n(if (null nodes) \n(if (any-legal-move? (opponent player) board) \n\n(values (- (alpha-beta2 (opponent player) \n(negate-value node) \n(- cutoff) (- achievable) \n(- ply 1) eval-fn)) \n\nnil) \n(values (final-value player board) nil)) \n(let ((best-node (first nodes))) \n(loop for move in nodes \n\n\f\n<a id='page-632'></a>\n\nfor val = (- (alpha-betaZ \n(opponent player) \n(negate-value move) \n(- cutoff) (- achievable) \n(- ply 1) eval-fn)) \n\ndo (when (> val achievable) \n(setf achievable val) \n(setf best-node move)) \n\nuntil (>= achievable cutoff)) \n(values achievable best-node)))))) \n\n(defun negate-value (node) \n\"Set the value of a node to its negative.\" \n(setf (node-value node) (- (node-value node))) \nnode) \n\n(defun legal-nodes (player board eval-fn) \n\"Return a list of legal moves, each one packed into a node.\" \n(let ((moves (legal-moves player board))) \n\n(sort (map-into \nmoves \n#*(lambda (move) \n\n(let ((new-board (make-move move player \n(copy-board board)))) \n\n(make-node \n: squa re move .-board new-board \n:value (funcall eval-fn player new-board)))) \n\nmoves) \n#'> :key #'node-value))) \n\n(Note the use of the function map -i nto. This is part of ANSI Common Lisp, but if it \nis not a part of your implementation, a definition is provided on [page 857](chapter24.md#page-857).) \n\nThe following table compares the performance of the random-ordering strategy, \nthe sorted-ordering strategy and the static-ordering strategy in the course of a single \ngame. All strategies search 6 ply deep. The table measures the number of boards \ninvestigated, the number of those boards that were evaluated (in all cases the evaluation \nfunction was modi f i ed - wei ghted - squa res) and the time in seconds to compute \na move. \n\n\f\n<a id='page-633'></a>\nrandom order sorted order static order \nboards evals sees boards evals sees boards evals sees \n13912 10269 69 5556 5557 22 2365 1599 19 \n9015 6751 56 6571 6572 25 3081 2188 18 \n9820 7191 46 11556 11557 45 5797 3990 31 \n4195 3213 20 5302 5303 17 2708 2019 15 \n10890 7336 60 10709 10710 38 3743 2401 23 \n13325 9679 63 6431 6432 24 4222 2802 24 \n13163 9968 58 9014 9015 32 6657 4922 31 \n16642 12588 70 9742 9743 33 10421 7488 51 \n18016 13366 80 11002 11003 37 9508 7136 41 \n23295 17908 104 15290 15291 48 26435 20282 111 \n34120 25895 143 22994 22995 75 20775 16280 78 \n56117 43230 224 46883 46884 150 48415 36229 203 \n53573 41266 209 62252 62253 191 37803 28902 148 \n43943 33184 175 31039 31040 97 33180 24753 133 \n51124 39806 193 45709 45710 135 19297 15064 69 \n24743 18777 105 20003 20004 65 15627 11737 66 \n1.0 1.0 1.0 .81 1.07 .62 .63 .63 .63 \n\nThe last two lines of the table give the averages and the averages normalized to the \nrandom-ordering strategy's performance. The sorted-ordering strategy takes only \n62% of the time of the random-ordering strategy, and the static-ordering takes 63 %. \nThese times are not to be trusted too much, because a large-scale garbage collection \nwas taking place during the latter part of the game, and it may have thrown off the \ntimes. The board and evaluation count may be better indicators, and they both show \nthe static-ordering strategy doing the best. \n\nWe have to be careful how we evaluate these results. Earlier I said that alpha-beta \nsearch makes more cutoffs when it is presented first with better moves. The actual \ntruth is that it makes more cutoffs when presented first with moves that the evaluation \nfunction thinks are better. In this case the evaluation function and the static-ordering \nstrategy are in strong agreement on what are the best moves, so it is not surprising \nthat static ordering does so well. As we develop evaluation functions that vary from \nthe weighted-squares approach, we will have to run experiments again to see if the \nstatic-ordering is still the best. \n\n18.10 It Pays to Precycle \nThe progressive city of Berkeley, California, has a strong recycling program to reclaim \nglass, paper, and aluminum that would otherwise be discarded as garbage. In 1989, \n\n\f\n<a id='page-634'></a>\n\nBerkeley instituted a novel program of precycling: consumers are encouraged to avoid \nbuying products that come in environmentally wasteful packages. \n\nYour Lisp system also has a recycling program: the Lisp garbage collector automatically \nrecycles any unused storage. However, there is a cost to this program, and \nyou the consumer can get better performance by precycling your data. Don't buy \nwasteful data structures when simpler ones can be used or reused. You, the Lisp \nprogrammer, may not be able to save the rain forests or the ozone layer, but you can \nsave valuable processor time. \n\nWe saw before that the search routines look at tens of thousands of boards per \nmove. Currently, each board position is created anew by copy-board and discarded \nsoon thereafter. We could avoid generating all this garbage by reusing the same board \nat each ply. We'd still need to keep the board from the previous ply for use when \nthe search backs up. Thus, a vector of boards is needed. In the following we assume \nthat we will never search deeper than 40 ply. This is a safe assumption, as even the \nfastest Othello programs can only search about 15 ply before running out of time. \n\n(defvar *ply-boards* \n(apply #*vector (loop repeat 40 collect (initial-board)))) \n\nNow that we have sharply limited the number of boards needed, we may want to \nreevaluate the implementation of boards. Instead of having the board as a vector of \npieces (to save space), we may want to implement boards as vectors of bytes or full \nwords. In some implementations, accessing elements of such vectors is faster. (In \nother implementations, there is no difference.) \n\nAn implementation using the vector of boards will be done in the next section. \nNote that there is another alternative: use only one board, and update it by making \nand retracting moves. This is a good alternative in a game like chess, where a move \nonly alters two squares. In Othello, many squares can be altered by a move, so \ncopying the whole board over and making the move is not so bad. \n\nIt should be mentioned that it is worth looking into the problem of copying a \nposition from one board to another. The function repl ace copies one sequence (or \npart of it) into another, but it is a generic function that may be slow. In particular, if \neach element of a board is only 2 bits, then it may be much faster to use displaced \narrays to copy 32 bits at a time. The advisability of this approach depends on the \nimplementation, and so it is not explored further here. \n\n18.11 Killer Moves \nIn section 18.9, we considered the possibility of searching moves in a different \norder, in an attempt to search the better moves first, thereby getting more alpha-beta \npruning. In this section, we consider the killer heunstic, which states that a move that \n\n\f\n<a id='page-635'></a>\nhas proven to be a good one in one line of play is also likely to be a good one in another \nline of play. To use chess as perhaps a more familiar example, suppose I consider \none move, and it leads to the opponent replying by capturing my queen. This is a \nkiller move, one that I would like to avoid. Therefore, when I consider other possible \nmoves, I want to immediately consider the possibility of the opponent making that \nqueen-capturing move. \n\nThe function alpha-beta3 adds the parameter ki 11 er, which is the best move \nfound so far at the current level. After we determine the legal -moves, we use \nput-first to put the killer move first, if it is in fact a legal move. When it comes \ntime to search the next level, we keep track of the best move in kiHer2. This \nrequires keeping track of the value of the best move in ki 11 er 2- va1. Everything else \nis unchanged, except that we get a new board by recycling the *pl y-boards* vector \nrather than by allocating fresh ones. \n\n(defun alpha-betaS (player board achievable cutoff ply eval-fn \n\nkiller) \n\"A-. search, putting killer move first.\" \n(if (= ply 0) \n\n(funcall eval-fn player board) \n(let ((moves (put-first killer (legal-moves player board)))) \n(if (null moves) \n(if (any-legal-move? (opponent player) board) \n\n(- (alpha-betaS (opponent player) board \n(- cutoff) (- achievable) \n(- ply 1) eval-fn nil)) \n\n(final-value player board)) \n\n(let ((best-move (first moves)) \n(new-board (aref *ply-boards* ply)) \n(killer2 nil) \n(killer2-val winning-value)) \n\n(loop for move in moves \ndo (multiple-value-bind (val reply) \n\n(alpha-betaS \n(opponent player) \n(make-move move player \n\n(replace new-board board)) \n(- cutoff) (- achievable) \n(- ply 1) eval-fn killer2) \n\n(setf val (- val)) \n\n(when (> val achievable) \n(setf achievable val) \n(setf best-move move)) \n\n(when (and reply (< val killer2-val)) \n(setf killer2 reply) \n(setf killer2-val val))) \n\nuntil (>= achievable cutoff)) \n\n\f\n<a id='page-636'></a>\n\n(values achievable best-move)))))) \n\n(defun alpha-beta-searcher3 (depth eval-fn) \n\"Return a strategy that does A-B search with killer moves.\" \n#'(lambda (player board) \n\n(multiple-value-bind (value move) \n(alpha-betaS player board losing-value winning-value \n\ndepth eval-fn nil) \n(declare (ignore value)) \nmove))) \n\n(defun put-first (killer moves) \n\"Move the killer move to the front of moves, \nif the killer move is in fact a legal move.\" \n(if (member killer moves) \n\n(cons killer (delete killer moves)) \nmoves)) \n\nAnother experiment on a single game reveals that adding the killer heuristic to static-\nordering search (again at 6-ply) cuts the number of boards and evaluations, and the \ntotal time, all by about 20%. To summarize, alpha-beta search at 6 ply with random \nordering takes 105 seconds per move (in our experiment), adding static-ordering cuts \nit to 66 seconds, and adding killer moves to that cuts it again to 52 seconds. This \ndoesn't include the savings that alpha-beta cutoffs give over full minimax search. At \n6 ply with a branching factor of 7, full minimax would take about nine times longer \nthan static ordering with killers. The savings increase with increased depth. At \n7 ply and a branching factor of 10, a small experiment shows that static-ordering \nwith killers looks at only 28,000 boards in about 150 seconds. Full minimax would \nevaluate 10 million boards and take 350 times longer. The times for full minimax are \nestimates based on the number of boards per second, not on an actual experiment. \n\nThe algorithm in this section just keeps track of one killer move. It is of course \npossible to keep track of more than one. The Othello program Bill (Lee and Mahajan \n1990b) merges the idea of killer moves with legal move generation: it keeps a list of \npossible moves at each level, sorted by their value. The legal move generator then \ngoes down this list in sorted order. \n\nIt should be stressed once again that all this work on alpha-beta cutoffs, ordering, \nand killer moves has not made any change at all in the moves that are selected. We \nstill end up choosing the same move that would be made by a full minimax search to \nthe given depth, we are just doing it faster, without looking at possibilities that we \ncan prove are not as good. \n\n\f\n<a id='page-637'></a>\n18.12 Championship Programs: lago and Bill \nAs mentioned in the introduction, the unpredictability of Othello makes it a difficult \ngame for humans to master, and thus programs that search deeply can do comparatively \nwell. In fact, in 1981 the reigning champion, Jonathan Cerf, proclaimed \"In \nmy opinion the top programs ... are now equal (if not superior) to the best human \nplayers.\" In discussing Rosenbloom's lago program (1982), Cerf went on to say \"I \nunderstand Paul Rosenbloom is interested in arranging a match against me. Unfortunately \nmy schedule is very full, and I'm going to see that it remains that way for the \nforeseeable future.\" \n\nIn 1989, another program. Bill (Lee and Mahajan 1990) beat the highest rated \nAmerican Othello player, Brian Rose, by a score of 56-8. Bill's evaluation function is \nfast enough to search 6-8 ply under tournament conditions, yet it is so accurate that \nit beats its creator, Kai-Fu Lee, searching only 1 ply. (However, Lee is only a novice \nOthello player; his real interest is in speech recognition; see Waibel and Lee 1991.) \nThere are other programs that also play at a high level, but they have not been written \nup in the AI literature as lago and Bill have. \n\nIn this section we present an evaluation function based on lago's, although it also \ncontains elements of Bill, and of an evaluation function written by Eric Wef aid in 1989. \nThe evaluation function makes use of two main features: mobility and edge stability. \n\nMobility \n\nBoth lago and Bill make heavy use of the concept of mobility. Mobility is a measure of \nthe ability to make moves; basically, the more moves one can make, the better. This \nis not quite true, because there is no advantage in being able to make bad moves, \nbut it is a useful heuristic. We define current mobility as the number of legal moves \navailable to a player, and potential mobility as the number of blank squares that are \nadjacent to opponent's pieces. These include the legal moves. A better measure of \nmobility would try to count only good moves. The following function computes both \ncurrent and potential mobility for a player: \n\n(defun mobility (player board) \n\"Current mobility is the number of legal moves. \nPotential mobility is the number of blank squares \nadjacent to an opponent that are not legal moves. \nReturns current and potential mobility for player.\" \n(let ((opp (opponent player)) \n\n(current 0) ; player's current mobility \n(potential 0)) ; player's potential mobility \n(dolist (square all-squares) \n(when (eql (bref board square) empty) \n(cond ((legal-p square player board) \n\n\f\n<a id='page-638'></a>\n\n(incf current)) \n((some #.(lambda (sq) (eql (bref board sq) opp)) \n(neighbors square)) \n(incf potential))))) \n(values current (+ current potential)))) \n\nEdge Stability \n\nSuccess at Othello often hinges around edge play, and both lago and Bill evaluate \nthe edges carefully. Edge analysis is made easier by the fact that the edges are fairly \nindependent of the interior of the board: once a piece is placed on the edge, no \ninterior moves can flip it. This independence allows a simplifying assumption: to \nevaluate a position's edge strength, evaluate each of the four edges independently, \nwithout consideration of the interior of the board. The evaluation can be made more \naccurate by considering the X-squares to be part of the edge. \n\nEven evaluating a single edge is a time-consuming task, so Bill and lago compile \naway the evaluation by building a table of all possible edge positions. An \"edge\" \naccording to Bill is ten squares: the eight actual edge squares and the two X-squares. \nSince each square can be black, white, or empty, there are 3^^ or 59,049 possible edge \npositions - a large but manageable number. \n\nThe value of each edge position is determined by a process of succesive approximation. \nJust as in a minimax search, we will need a static edge evaluation function \nto determine the value of a edge position without search. This static edge evaluation \nfunction is appHed to every possible edge position, and the results are stored in a \n59,049 element vector. The static evaluation is just a weighted sum of the occupied \nsquares, with different weights given depending on if the piece is stable or unstable. \n\nEach edge position's evaluation can be improved by a process of search. lago \nuses a single ply search: given a position, consider all moves that could be made \n(including no move at all). Some moves will be clearly legal, because they flip pieces \non the edge, but other moves will only be legal if there are pieces in the interior of \nthe board to flip. Since we are only considering the edge, we don't know for sure if \nthese moves are legal. They will be assigned probabilities of legality. The updated \nevaluation of a position is determined by the values and probabilities of each move. \nThis is done by sorting the moves by value and then summing the product of the \nvalue times the probability that the move can be made. This process of iterative \napproximation is repeated five times for each position. At that point, Rosenbloom \nreports, the values have nearly converged. \n\nIn effect, this extends the depth of the normal alpha-beta search by including an \nedge-only search in the evaluation function. Since each edge position with . pieces \nis evaluated as a function of the positions with . -h 1 pieces, the search is complete-it \nis an implicit 10-ply search. \n\n\f\n<a id='page-639'></a>\nCalculating edge stability is a bit more complicated than the other features. The \nfirst step is to define a variable, *eclge - table*, which will hold the evaluation of each \nedge position, and a constant, edge-and-x-1 i sts, which is a list of the squares on \neach of the four edges. Each edge has ten squares because the X-squares are included. \n\n(defvar *edge-table* (make-array (expt 3 10)) \n\"Array of values to player-to-move for edge positions.\") \n\n(defconstant edge-and-x-1ists \n\n'((22 11 12 13 14 15 16 17 18 27) \n(72 81 82 83 84 85 86 87 88 77) \n(22 11 21 31 41 51 61 71 81 72) \n(27 18 28 38 48 58 68 78 88 77)) \n\n\"The four edges (with their X-squares).\") \n\nNow for each edge we can compute an index into the edge table by building a 10-digit \nbase-3 number, where each digit is 1 if the corresponding edge square is occupied by \nthe player, 2 if by the opponent, and 0 if empty. The function edge- i ndex computes \nthis, and edge - stabi 1 i ty sums the values of the four edge indexes. \n\n(defun edge-index (player board squares) \n\"The index counts 1 for player; 2 for opponent, \non each square---summed as a base 3 number.\" \n(let ((index 0)) \n\n(dolist (sq squares) \n(setq index (+ (* index 3) \n\n(cond ((eql (bref board sq) empty) 0) \n((eql (bref board sq) player) 1) \n(t 2))))) \n\nindex)) \n\n(defun edge-stability (player board) \n\"Total edge evaluation for player to move on board.\" \n(loop for edge-list in edge-and-x-1ists \n\nsum (aref *edge-table* \n(edge-index player board edge-list)))) \n\nThe function edge - stabi 1 i ty is all we will need in lago's evaluation function, but we \n\nstill need to generate the edge table. Since this needs to be done only once, we don't \n\nhave to worry about efficiency. In particular, rather than invent a new data structure \n\nto represent edges, we will continue to use complete boards, even though they will \n\nbe mostly empty. The computations for the edge table will be made on the top edge, \n\nfrom the point of view of black, with black to play. But the same table can be used for \n\nwhite, or for one of the other edges, because of the way the edge index is computed. \n\nEach position in the table is first initialized to a static value computed by a kind \nof weighted-squares metric, but with different weights depending on if a piece is in \n\n\f\n<a id='page-640'></a>\n\ndanger of being captured. After that, each position is updated by considering the \npossible moves that can be made from the position, and the values of each of these \nmoves. \n\n(defconstant top-edge (first edge-and-x-lists)) \n\n(defun init-edge-table () \n\"Initialize *edge-table*. starting from the empty board.\" \nInitialize the static values \n(loop for n-pieces from 0 to 10 do \n(map-edge-n-pieces \n#*(lambda (board index) \n(setf (aref *edge-table* index) \n(static-edge-stability black board))) \nblack (initial-board) n-pieces top-edge 0)) \nNow iterate five times trying to improve: \n\n(dotimes (i 5) \n;; Do the indexes with most pieces first \n(loop for n-pieces from 9 downto 1 do \n\n(map-edge-n-pieces \n#'(lambda (board index) \n(setf (aref *edge-table* index) \n(possible-edge-moves-value \nblack board index))) \nblack (initial-board) n-pieces top-edge 0)))) \n\nThe function map-edge-n-pieces iterates through all edge positions with a total of \n. pieces (of either color), applying a function to each such position. It also keeps a \nrunning count of the edge index as it goes. The function should accept two arguments: \nthe board and the index. Note that a single board can be used for all the positions \nbecause squares are reset after they are used. The function has three cases: if the \nnumber of squares remaining is less than n, then it will be impossible to place . pieces \non those squares, so we give up. If there are no more squares then . must also be \nzero, so this is a valid position, and the function f . is called. Otherwise we first try \nleaving the current square blank, then try filling it with player's piece, and then with \nthe opponent's piece, in each case calling map-edge-.-pi eces recursively. \n\n(defun map-edge-n-pieces (fn player board . squares index) \n\"Call fn on all edges with . pieces.\" \n;; Index counts 1 for player; 2 for opponent \n(cond \n\n((< (length squares) n) nil) \n((null squares) (funcall fn board index)) \n(t (let ((index3 (* 3 index)) \n\n(sq (first squares))) \n(map-edge-n-pieces fn player board . (rest squares) indexS) \n\n\f\n<a id='page-641'></a>\n(when (and (> . 0) (eql (bref board sq) empty)) \n(setf (bref board sq) player) \n(map-edge-n-pieces fn player board (- . 1) (rest squares) \n\n(+ 1 index3)) \n(setf (bref board sq) (opponent player)) \n(map-edge-n-pieces fn player board (- . 1) (rest squares) \n\n(+ 2 indexS)) \n(setf (bref board sq) empty)))))) \n\nThe function possible-edge-moves-value searches through all possible moves to \ndetermine an edge value that is more accurate than a static evaluation. It loops \nthrough every empty square on the edge, calling possible-edge-move to return a \n(probability value) pair. Since it is also possible for a player not to make any move at \nall on an edge, the pair (1.0 current-value) is also included. \n\n(defun possible-edge-moves-value (player board index) \n\"Consider all possible edge moves. \nCombine their values into a single number.\" \n(combine-edge-moves \n\n(cons \n(list 1.0 (aref *edge-table* index)) ;; no move \n(loop for sq in top-edge ;; possible moves \n\nwhen (eql (bref board sq) empty) \ncollect (possible-edge-move player board sq))) \nplayer)) \n\nThe value of each position is determined by making the move on the board, then \nlooking up in the table the value of the resulting position for the opponent, and \nnegating it (since we are interested in the value to us, not to our opponent). \n\n(defun possible-edge-move (player board sq) \n\"Return a (prob val) pair for a possible edge move.\" \n(let ((new-board (replace (aref *ply-boards* player) board))) \n\n(make-move sq player new-board) \n(list (edge-move-probability player board sq) \n(- (aref *edge-table* \n(edge-index (opponent player) \nnew-board top-edge)))))) \n\nThe possible moves are combined with combi ne-edge-moves, which sorts the moves \nbest-first. (Since ini t-edge-tabl e started from black's perspective, black tries to \nmaximize and white tries to minimize scores.) We then go down the moves, increasing \nthe total value by the value of each move times the probability of the move, and \ndecreasing the remaining probability by the probability of the move. Since there will \n\n\f\n<a id='page-642'></a>\n\nalways be a least one move (pass) with probability 1.0, this is guaranteed to converge. \nIn the end we round off the total value, so that we can do the run-time calculations \nwith fixnums. \n\n(defun combine-edge-moves (possibilities player) \n\"Combine the best moves.\" \n(let ((prob 1.0) \n\n(val 0.0) \n(fn (if (eql player black) #'> #'<))) \n\n(loop for pair in (sort possibilities fn :key #'second) \nwhile (>= prob 0.0) \ndo (incf val (* prob (first pair) (second pair))) \n\n(decf prob (* prob (first pair)))) \n(round val))) \n\nWe still need to compute the probability that each possible edge move is legal. These \nprobabiUties should reflect things such as the fact that it is easy to capture a corner \nif the opponent is in the adjacent X-square, and very difficult otherwise. First we \ndefine some functions to recognize corner and X-squares and relate them to their \nneighbors: \n\n(let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77)))) \n(defun corner-p (sq) (assoc sq corner/xsqs)) \n(defun x-square-p (sq) (rassoc sq corner/xsqs)) \n(defun x-square-for (corner) (cdr (assoc corner corner/xsqs))) \n(defun corner-for (xsq) (car (rassoc xsq corner/xsqs)))) \n\nNow we consider the probabilities. There are four cases. First, since we don't \nknow anything about the interior of the board, we assume each player has a 50% \nchance of being able to play in an X-square. Second, if we can show that a move \nis legal (because it flips opponent pieces on the edge) then it has 100% probability. \nThird, for the corner squares, we assign a 90% chance if the opponent occupies the \nX-square, 10% if it is empty, and only .1 % if we occupy it. Otherwise, the probability \nis determined by the two neighboring squares: if a square is next to one or more \nopponents it is more likely we can move there; if it is next to our pieces it is less likely. \nIf it is legal for the opponent to move into the square, then the chances are cut in half \n(although we may still be able to move there, since we move first). \n\n(defun edge-move-probability (player board square) \n\"What's the probability that player can move to this square?\" \n(cond \n\n((x-square-p square) .5) ;; X-squares \n((legal-p square player board) 1.0) immediate capture \n((corner-p square) :; move to corner depends on X-square \n\n\f\n<a id='page-643'></a>\n(let ((x-sq (x-square-for square))) \n\n(cond \n((eql (bref board x-sq) empty) .1) \n((eql (bref board x-sq) player) 0.001) \n(t .9)))) \n\n(t (/ (aref \n\n'#2A((.l .4 .7) \n(.05 .3 *) \n(.01 * *)) \n\n(count-edge-neighbors player board square) \n(count-edge-neighbors (opponent player) board square)) \n(if (legal-p square (opponent player) board) 2 1))))) \n\n(defun count-edge-neighbors (player board square) \n\"Count the neighbors of this square occupied by player.\" \n(count-if #'(lambda (inc) \n\n(eql (bref board (+ square inc)) player)) \n'(+1 -1))) \n\nNow we return to the problem of determining the static value of an edge position. \nThis is computed by a weighted-squares metric, but the weights depend on the \nstability of each piece. A piece is called stable if it cannot be captured, unstable if \nit is in immediate danger of being captured, and semistable otherwise. A table of \nweights follows for each edge square and stability. Note that corner squares are \nalways stable, and X-squares we will call semistable if the adjacent corner is taken, \nand unstable otherwise. \n\n(defparameter *static-edge-table* \n\n'#2A(;stab semi un \n( * 0 -2000) X \n( 700 ' *) corner \n(1200 200 -25) C \n(1000 200 75) A \n(1000 200 50) . \n(1000 200 50) . \n(1000 200 75) A \n(1200 200 -25) C \n( 700 ' *) corner \n( * 0 -2000) . X \n\n)) \n\n\f\n<a id='page-644'></a>\n\nThe static evaluation then just sums each piece's value according to this table: \n\n(defun static-edge-stability (player board) \n\"Compute this edge's static stability\" \n(loop for sq in top-edge \n\nfor i from 0 \n\nsum (cond \n((eql (bref board sq) empty) 0) \n((eql (bref board sq) player) \n\n(aref *static-edge-table* i \n(piece-stability board sq))) \n(t (- (aref *static-edge-table* i \n(piece-stability board sq))))))) \n\nThe computation of stability is fairly complex. It centers around finding the two \n\"pieces,\" pi and p2, which lay on either side of the piece in question and which are \nnot of the same color as the piece. These \"pieces\" may be empty, or they may be off \nthe board. A piece is unstable if one of the two is empty and the other is the opponent; \nit is semistable if there are opponents on both sides and at least one empty square to \nplay on, or if it is surrounded by empty pieces. Finally, if either pi or p2 is nil then \nthe piece is stable, since it must be connected by a solid wall of pieces to the corner. \n\n(let ((stable 0) (semi-stable 1) (unstable 2)) \n\n(defun piece-stability (board sq) \n\n(cond \n((corner-p sq) stable) \n((x-square-p sq) \n\n(if (eql (bref board (corner-for sq)) empty) \nunstable semi-stable)) \n\n(t (let* ((player (bref board sq)) \n(opp (opponent player)) \n(pi (find player board :test-not #*eql \n\nistart sq :end 19)) \n\n(p2 (find player board :test-not #'eql \n:start 11 :end sq \n:from-end t))) \n\n(cond \nunstable pieces can be captured immediately \nby playing in the empty square \n\n((or (and (eql pi empty) (eql p2 opp)) \n(and (eql p2 empty) (eql pi opp))) \n\nunstable) \n;; semi-stable pieces might be captured \n((and (eql pi opp) (eql p2 opp) \n\n\f\n<a id='page-645'></a>\n(find empty board :start 11 :end 19)) \nsemi-stable) \n((and (eql pi empty) (eql p2 empty)) \nsemi-stable) \nStable pieces can never be captured \n(t stable))))))) \n\nThe edge table can now be built by a call to i ni t-edge-tabl e. After the table is built \nonce, it is a good idea to save it so that we won't need to repeat the initialization. We \ncould write simple routines to dump the table into a file and read it back in, but it is \nfaster and easier to use existing tools that already do this job quite well: comp i 1 e-f i 1 e \nand 1 oad. All we have to do is create and compile a file containing the single line: \n\n(setf *edge-table* *#.*edge-table*) \n\nThe #. read macro evaluates the following expression at read time. Thus, the \ncompiler will see and compile the current edge table. It will be able to store this more \ncompactly and 1 oad it back in more quickly than if we printed the contents of the \nvector in decimal (or any other base). \n\nCombining the Factors \n\nNow we have a measure of the three factors: current mobility, potential mobility, and \nedge stability. All that remains is to find a good way to combine them into a single \nevaluation metric. The combination function used by Rosenbloom (1982) is a linear \ncombination of the three factors, but each factor's coefficient is dependent on the \nmove number. Rosenbloom's features are normalized to the range [-1000,1000]; we \nnormalize to the range [-1,1] by doing a division after multiplying by the coefficient. \nThat allows us to use fixnuums for the coefficients. Since our three factors are \nnot calculated in quite the same way as Rosenbloom's, it is not surprising that his \ncoefficients are not the best for our program. The edge coefficient was doubled and \nthe potential coefficient cut by a factor of five. \n\n(defun lago-eval (player board) \n\"Combine edge-stability, current mobility and \npotential mobility to arrive at an evaluation.\" \n\nThe three factors are multiplied by coefficients \nthat vary by move number: \n(let ((c-edg(+ 312000 (* 6240 *move-number*))) \n\n(c-cur (if (< *move-number* 25) \n(+ 50000 (* 2000 *move-number*)) \n(+ 75000 (* 1000 *move-number*)))) \n\n(c-pot 20000)) \n\n\f\n<a id='page-646'></a>\n\n(multiple-value-bind (p-cur p-pot) \n(mobility player board) \n(multiple-value-bind (o-cur o-pot) \n\n(mobility (opponent player) board) \n;; Combine the three factors into one sum: \n(+ (round (* c-edg (edge-stability player board)) 32000) \n\n(round (* c-cur (- p-cur o-cur)) (+ p-cur o-cur 2)) \n(round (* c-pot (- p-pot o-pot)) (+ p-pot o-pot 2))))))) \n\nFinally, we are ready to code the lago function. Given a search depth, lago returns a \nstrategy that will do alpha-beta search to that depth using the lago-eval evaluation \nfunction. This version of lago was able to defeat the modified weighted-squares \nstrategy in 8 of 10 games at 3 ply, and 9 of 10 at 4 ply. On an Explorer II, 4-ply search \ntakes about 20 seconds per move. At 5 ply, many moves take over a minute, so the \nprogram runs the risk of forfeiting. At 3 ply, the program takes only a few seconds \nper move, but it still was able to defeat the author in five straight games, by scores \nof 50-14, 64-0, 51-13, 49-15 and 36-28. Despite these successes, it is likely that the \nevaluation function could be improved greatly with a little tuning of the parameters. \n\n(defun lago (depth) \n\"Use an approximation of lago's evaluation function.\" \n(alpha-beta-searcher3 depth #'iago-eval)) \n\n18.13 Other Techniques \nThere are many other variations that can be tried to speed up the search and improve \nplay. Unfortunately, choosing among the techniques is a bit of a black art. You will \nhave to experiment to find the combination that is best for each domain and each \nevaluation function. Most of the following techniques were incorporated, or at least \nconsidered and rejected, in Bill. \n\nIterative Deepening \n\nWe have seen that the average branching factor for Othello is about 10. This means \nthat searching to depth . -f 1 takes roughly 10 times longer than search to depth \n\nn. Thus, we should be willing to go to a lot of overhead before we search one level \ndeeper, to assure two things: that search will be done efficiently, and that we won't \nforfeit due to running out of time. A by-now familiar technique, iterative deepening \n(see chapters 6 and 14), serves both these goals. \n\f\n<a id='page-647'></a>\nIterative deepening is used as follov/s. The strategy determines how much of the \nremaining time to allocate to each move. A simple strategy could allocate a constant \namount of time for each move, and a more sophisticated strategy could allocate more \ntime for moves at crucial points in the game. Once the time allocation is determined \nfor a move, the strategy starts an iterative deepening alpha-beta search. There are \ntwo complications: First, the search at . ply keeps track of the best moves, so that \nthe search at . -h 1 ply will have better ordering information. In many cases it will be \nfaster to do both the . and n + 1 ply searches with the ordering information than to \ndo only the . -i-1 ply search without it. Second, we can monitor how much time has \nbeen taken searching each ply, and cut off the search when searching one more ply \nwould exceed the allocated time limit. Thus, iterative-deepening search degrades \ngracefully as time limits are imposed. It will give a reasonable answer even with a \nshort time allotment, and it will rarely exceed the allotted time. \n\nForward Pruning \n\nOne way to cut the number of positions searched is to replace the legal move generator \nwith a plausible move generator: in other words, only consider good moves, and never \neven look at moves that seem clearly bad. This technique is called forward pruning. \nIt has fallen on disfavor because of the difficulty in determining which moves are \nplausible. For most games, the factors that would go into a plausible move generator \nwould be duplicated in the static evaluation function anyway, so forward pruning \nwould require more effort without much gain. Worse, forward pruning could rule \nout a brilliant sacrifice - a move that looks bad initially but eventually leads to a gain. \n\nFor some games, forward pruning is a necessity. The game of Go, for example, is \nplayed on a 19 by 19 board, so the first player has 361 legal moves, and a 6-ply search \nwould involve over 2 quadrillion positions. However, many good Go programs can \nbe viewed as not doing forward pruning but doing abstraction. There might be 30 \nempty squares in one portion of the board, and the program would treat a move to \nany of these squares equivalently. \n\nBill uses forward pruning in a limited way to rule out certain moves adjacent to \nthe corners. It does this not to save time but because the evaluation function might \nlead to such a move being selected, even though it is in fact a poor move. In other \nwords, forward pruning is used to correct a bug in the evaluation function cheaply. \n\nNonspeculative Forward Pruning \n\nThis technique makes use of the observation that there are limits in the amount the \nevaluation function can change from one position to the next. For example, if we \nare using the count difference as the evaluation function, then the most a move can \nchange the evaluation is +37 (one for placing a piece in the corner, and six captures \nin each of the three directions). The smallest change is 0 (if the player is forced to \n\n\f\n<a id='page-648'></a>\n\npass). Thus, if there are 2 ply left in the search, and the backed-up value of position \nA has been established as 38 points better than the static value of position B, then it \nis useless to expand position B. This assumes that we are evaluating every position, \nperhaps to do sorted ordering or iterative deepening. It also assumes that no position \nin the search tree is a final position, because then the evaluation could change by \nmore than 37 points. In conclusion, it seems that nonspeculative forward pruning is \nnot very useful for Othello, although it may play a role in other games. \n\nAspiration Search \n\nAlpha-beta search is initated with the achievable and cutoff boundaries set to \n. os i ng-val ue and wi nni ng-val ue, respectively. In other words, the search assumes \nnothing: the final position may be anything from a loss to a win. But suppose we are \nin a situation somewhere in the mid-game where we are winning by a small margin \n(say the static evaluation for the current position is 50). In most cases, a single move \nwill not change the evaluation by very much. Therefore, if we invoked the alpha-\nbeta search with a window defined by boundaries of, say, 0 and 100, two things can \nhappen: if the actual backed-up evaluation for this position is in fact in the range 0 \nto 100, then the search will find it, and it will be found quickly, because the reduced \nwindow will cause more pruning. If the actual value is not in the range, then the \nvalue returned will reflect that, and we can search again using a larger window. This \nis called aspiration search, because we aspire to find a value within a given window. \nIf the window is chosen well, then often we will succeed and will have saved some \nsearch time. \n\nPearl (1984) suggests an alternative called zero-window search. At each level, the \nfirst possible move, which we'll call m, is searched using a reasonably wide window \nto determine its exact value, which we'll call v. Then the remaining possible moves \nare searched using . as both the lower and upper bounds of the window. Thus, the \nresult of the search will tell if each subsequent move is better or worse than m, but \nwon't tell how much better or worse. There are three outcomes for zero-window \nsearch. If no move turns out to be better than m, then stick with m. If a single move is \nbetter, then use it. If several moves are better than m, then they have to be searched \nagain using a wider window to determine which is best. \n\nThere is always a trade-off between time spent searching and information gained. \nZero-window search makes an attractive trade-off: we gain some search time by \nlosing information about the value of the best move. We are still guaranteed of \nfinding the best move, we just don't know its exact value. \n\nBill's zero-window search takes only 63% of the time taken by full alpha-beta \nsearch. It is effective because Bill's move-ordering techniques ensure that the first \nmove is often best. With random move ordering, zero-window search would not be \neffective. \n\n\f\n<a id='page-649'></a>\nThink-Ahead \n\nA program that makes its move and then waits for the opponent's reply is wasting \nhalf the time available to it. A better use of time is to compute, or think-ahead while \nthe opponent is moving. Think-ahead is one factor that helps Bill defeat lago. While \nmany programs have done think-ahead by choosing the most likely move by the \nopponent and then starting an iterative-deepening search assuming that move. Bill's \nalgorithm is somewhat more complex. It can consider more than one move by the \nopponent, depending on how much time is available. \n\nHashing and Opening Book Moves \n\nWe have been treating the search space as a tree, but in general it is a directed acyclic \ngraph (dag): there may be more than one way to reach a particular position, but there \nwon't be any loops, because every move adds a new piece. This raises the question \nwe explored briefly in section 6.4: should we treat the search space as a tree or a \ngraph? By treating it as a graph we eliminate duplicate evaluations, but we have the \noverhead of storing all the previous positions, and of checking to see if a new position \nhas been seen before. The decision must be based on the proportion of duplicate \npositions that are actually encountered in play. One compromise solution is to store \nin a hash table a partial encoding of each position, encoded as, say, a single fixnum \n(one word) instead of the seven or so words needed to represent a full board. Along \nwith the encoding of each position, store the move to try first. Then, for each new \nposition, look in the hash table, and if there is a hit, try the corresponding move first. \nThe move may not even be legal, if there is an accidental hash collision, but there is \na good chance that the move will be the right one, and the overhead is low. \n\nOne place where it is clearly worthwhile to store information about previous \npositions is in the opening game. Since there are fewer choices in the opening, it is a \ngood idea to compile an opening \"book\" of moves and to play by it as long as possible, \nuntil the opponent makes a move that departs from the book. Book moves can be \ngleaned from the literature, although not very much has been written about Othello \n(as compared to openings in chess). However, there is a danger in following expert \nadvice: the positions that an expert thinks are advantageous may not be the same as \nthe positions from which our program can play well. It may be better to compile the \nbook by playing the program against itself and determining which positions work \nout best. \n\nThe End Game \n\nIt is also a good idea to try to save up time in the midgame and then make an all-out \neffort to search the complete game tree to completion as soon as feasible. Bill can \nsearch to completion from about 14 ply out. Once the search is done, of course, the \n\n\f\n<a id='page-650'></a>\n\nmost promising lines of play should be saved so that it won't be necessary to solve \nthe game tree again. \n\nMetareasontng \n\nIf it weren't for the clock, Othello would be a trivial game: just search the complete \ngame tree all the way to the end, and then choose the best move. The clock imposes \na complication: we have to make all our moves before we run out of time. The \nalgorithms we have seen so far manage the clock by allocating a certain amount of \ntime to each move, such that the total time is guaranteed (or at least very likely) to \nbe less than the allotted time. This is a very crude policy. A finer-grained way of \nmanaging time is to consider computation itself as a possible move. That is, at every \ntick of the clock, we need to decide if it is better to stop and play the best move we \nhave computed so far or to continue and try to compute a better move. It will be \nbetter to compute more only in the case where we eventually choose a better move; \nit will be better to stop and play only in the case where we would otherwise forfeit \ndue to time constraints, or be forced to make poor choices later in the game. An \nalgorithm that includes computation as a possible move is called a metareasoning \nsystem, because it reasons about how much to reason. \n\nRussell and Wefald (1989) present an approach based on this view. In addition to \nan evaluation function, they assume a variance function, which gives an estimate of \nhow much a given position's true value is likely to vary from its static value. At each \nstep, their algorithm compares the value and variance of the best move computed so \nfar and the second best move. If the best move is clearly better than the second best \n(taking variance into account), then there is no point computing any more. Also, if the \ntop two moves have similar values but both have very low variance, then computing \nwill not help much; we can just choose one of the two at random. \n\nFor example, if the board is in a symmetric position, then there may be two \nsymmetric moves that will have identical value. By searching each move's subtree \nmore carefully, we soon arrive at a low variance for both moves, and then we can \nchoose either one, without searching further. Of course, we could also add special-\ncase code to check for symmetry, but the metareasoning approach will work for \nnonsymmetric cases as well as symmetric ones. If there is a situation where two \nmoves both lead to a clear win, it won't waste time choosing between them. \n\nThe only situation where it makes sense to continue computing is when there \nare two moves with high variance, so that it is uncertain if the true value of one \nexceeds the other. The metareasoning algorithm is predicated on devoting time to \njust this case. \n\n\f\n<a id='page-651'></a>\nLearning \n\nFrom the earhest days of computer game playing, it was realized that a championship \nprogram would need to learn to improve itself. Samuel (1959) describes a program \nthat plays checkers and learns to improve its evaluation function. The evaluation \nfunction is a linear combination of features, such as the number of pieces for each \nplayer, the number of kings, the number of possible forks, and so on. Learning is \ndone by a hill-climbing search procedure: change one of the coefficients for one of \nthe features at random, and then see if the changed evaluation function is better than \nthe original one. \n\nWithout some guidance, this hill-climbing search would be very slow. First, the \nspace is very large - Samuel used 38 different features, and although he restricted \nthe coefficients to be a power of two between 0 and 20, that still leaves 21^^ possible \nevaluation functions. Second, the obvious way of determining the relative worth of \ntwo evaluation functions - playing a series of games between them and seeing which \nwins more of ten - is quite time-consuming. \n\nFortunately, there is a faster way of evaluating an evaluation function. We can \napply the evaluation function to a position and compare this static value with the \nbacked-up value determined by an alpha-beta search. If the evaluation function is \naccurate, the static value should correlate well with the backed-up value. If it does not \ncorrelate well, the evaluation function should be changed in such a way that it does. \nThis approach still requires the trial-and-error of hill-climbing, but it will converge \nmuch faster if we can gain information from every position, rather than just from \nevery game. \n\nIn the past few years there has been increased interest in learning by a process \nof guided search. Neural nets are one example of this. They have been discussed \nelsewhere. Another example is genetic learning algorithms. These algorithms start \nwith several candidate solutions. In our case, each candidate would consist of a set \nof coefficients for an evaluation function. On each generation, the genetic algorithm \nsees how well each candidate does. The worst candidates are eliminated, and the \nbest ones \"mate\" and \"reproduce\" - two candidates are combined in some way to \nyield a new one. If the new offspring has inherited both its parents' good points, then \nit will prosper; if it has inherited both its parents' bad points, then it will quickly die \nout. Either way, the idea is that natural selection will eventually yield a high-quality \nsolution. To increase the chances of this, it is a good idea to allow for mutations: \nrandom changes in the genetic makeup of one of the candidates. \n\n18.14 History and References \nLee and Mahajan (1986,1990) present the current top Othello program. Bill. Their \ndescription outlines all the techniques used but does not go into enough detail to allow \n\n\f\n<a id='page-652'></a>\n\nthe reader to reconstruct the program. Bill is based in large part on Rosenbloom's \nlago program. Rosenbloom's article (1982) is more thorough. The presentation in \nthis chapter is based largely on this article, although it also contains some ideas from \nBill and from other sources. \n\nThe journal Othello Quarterly is the definitive source for reports on both human \nand computer Othello games and strategies. \n\nThe most popular game for computer implementation is chess. Shannon (1950a,b) \nspeculated that a computer might play chess. In a way, this was one of the boldest \nsteps in the history of AI. Today, writing a chess program is a challenging but feasible \nproject for an undergraduate. But in 1950, even suggesting that such a program \nmight be possible was a revolutionary step that changed the way people viewed \nthese arithmetic calculating devices. Shannon introduced the ideas of a game tree \nsearch, minimaxing, and evaluation functions - ideas that remain intact to this day. \nMarsland (1990) provides a good short introduction to computer chess, and David \nLevy has two books on the subject (1976,1988). It was Levy, an international chess \nmaster, who in 1968 accepted a bet from John McCarthy, Donald Michie, and others \nthat a computer chess program would not beat him in the next ten years. Levy won \nthe bet. Levy's Heuristic Programming (1990) and Computer Games (1988) cover a variety \nof computer game playing programs. The studies by DeGroot (1965,1966) give a \nfascinating insight into the psychology of chess masters. \n\nKnuth and Moore (1975) analyze the alpha-beta algorithm, and Pearl's book \nHeuristics (1984) covers all kinds of heuristic search, games included. \n\nSamuel (1959) is the classic work on learning evaluation function parameters. It \nis based on the game of checkers. Lee and Mahajan (1990) present an alternative \nlearning mechanism, using Bayesian classification to learn an evaluation function \nthat optimally distinguishes winning positions from losing positions. Genetic algorithms \nare discussed by L. Davis (1987,1991) and Goldberg (1989). \n\n18-15 Exercises \n\n&#9635; Exercise 18.3 [s] How many different Othello positions are there? Would it be \nfeasible to store the complete game tree and thus have a perfect player? \n\n&#9635; Exercise 18.4 [m] At the beginning of this chapter, we implemented pieces as an \nenumerated type. There is no built-in facility in Common Lisp for doing this, so \nwe had to introduce a series of defconstant forms. Define a macro for defining \nenumerated types. What else should be provided besides the constants? \n\n&#9635; Exercise 18.5 [h] Add fixnum and speed declarations to the lago evaluation func\n\n\n\f\n<a id='page-653'></a>\ntion and the alpha-beta code. How much does this speed up lago? What other \nefficiency measures can you take? \n\n&#9635; Exercise 18.6 [h] Implement an iterative deepening search that allocates time for \neach move and checks between each iteration if the time is exceeded. \n\n&#9635; Exercise 18.7 [h] Implement zero-window search, as described in section 18.13. \n\n&#9635; Exercise 18.8 [d] Read the references on Bill (Lee and Mahajan 1990, and 1986 if \nyou can get it), and reimplement Bill's evaluation function as best you can, using the \ntable-based approach. It will also be helpful to read Rosenbloom 1982. \n\n&#9635; Exercise 18.9 [d] Improve the evaluation function by tuning the parameters, using \none of the techniques described in section 18.13. \n\n&#9635; Exercise 18.10 [h] Write move-generation and evaluation functions for another \ngame, such as chess or checkers. \n\n18.16 Answers \nAnswer 18.2 The wei ghted-squa res strategy wins the first game by 20 pieces, \nbut when count-di ff erence plays first, it captures all the pieces on its fifth move. \nThese two games alone are not enough to determine the best strategy; the function \nothel 1 o-seri es on [page 626](chapter18.md#page-626) shows a better comparison. \n\nAnswer 18.3 3^ = 3,433,683,820,292,512,484,657,849,089,281. No. \n\n\f\n<a id='page-654'></a>\n\nAnswer 18.4 Besides the constants, we provide a def type for the type itself, and \nconversion routines between integers and symbols: \n\n(defmacro define-enumerated-type (type &rest elements) \n\"Represent an enumerated type with integers 0-n. \" \n'(progn \n\n(deftype .type () '(integer 0 ,( - (length elements) 1))) \n(defun .(symbol type *->symbol) (.type) \n(elt '.elements .type)) \n(defun .(symbol 'symbol-> type) (symbol) \n(position symbol '.elements)) \n\n.(loop for element in elements \nfor i from 0 \ncollect '(defconstant .element .i)))) \n\nHere's how the macro would be used to define the piece data type, and the code \nproduced: \n\n> (macroexpand \n'(define-enumerated-type piece \nempty black white outer)) \n\n(PROGN \n(DEFTYPE PIECE () '(INTEGER 0 3)) \n(DEFUN PIECE->SYMBOL (PIECE) \n\n(ELT '(EMPTY BLACK WHITE OUTER) PIECE)) \n(DEFUN SYMBOL->PIECE (SYMBOL) \n\n(POSITION SYMBOL '(EMPTY BLACK WHITE OUTER))) \n(DEFCONSTANT EMPTY 0) \n(DEFCONSTANT BLACK 1) \n(DEFCONSTANT WHITE 2) \n(DEFCONSTANT OUTER 3)) \n\nA more general facility would, like defstruct, provide for several options. For \nexample, it might allow for a documentation string for the type and each constant, \nand for a : cone-name, so the constants could have names like pi ece-empty instead \nof empty. This would avoid conflicts with other types that wanted to use the same \nnames. The user might also want the ability to start the values at some number other \nthan zero, or to assign specific values to some of the symbols. \n\n\f\n## Chapter 19\n<a id='page-655'></a>\n\nIntroduction to \nNatural Language \n\nLanguage is everywhere. It permeates our thoughts, \nmediates our relations with others, and even creeps \ninto our dreams. The overwhelming hulk of human \nknowledge is stored and transmitted in language. \nLanguage is so ubiquitous that we take itfor granted, \nbut without it, society as we know it would \nbe impossible. \n\n- Ronand Langacker \n\nLanguage and its Structure (1967) \n\nA\nA\nnatural language is a language spoken by people, such as English, German, or Tagalog. \nThis is in opposition to artificial languages like Lisp, FORTRAN, or Morse code. \nNatural language processing is an important part of AI because language is intimately \nconnected to thought. One measure of this is the number of important books that mention \nlanguage and thought in the title: in AI, Schank and Colby's Computer Models of Thought \nand Language; in linguistics, Whorf's Language, Thought, and Reality (and Chomsky's Language \nand Mind;) in philosophy, Fodor's The Language of Thought; and in psychology, Vygotsky's \nThought and Language and John Anderson's Language, Memory, and Thought. Indeed, language is \n\n\f\n<a id='page-656'></a>\n\nthe trait many think of as being the most characteristic of humans. Much controversy \nhas been generated over the question of whether animals, especially primates and \ndolphins, can use and \"understand\" language. Similar controversy surrounds the \nsame question asked of computers. \n\nThe study of language has been traditionally separated into two broad classes: \nsyntax, or grammar, and semantics, or meaning. Historically, syntax has achieved \nthe most attention, largely because on the surface it is more amenable to formal and \nsemiformal methods. Although there is evidence that the boundary between the two \nis at best fuzzy, we still maintain the distinction for the purposes of these notes. We \nwill cover the \"easier\" part, syntax, first, and then move on to semantics. \n\nA good artificial language, like Lisp or C, is unambiguous. There is only one \ninterpretation for a valid Lisp expression. Of course, the interpretation may depend \non the state of the current state of the Lisp world, such as the value of global variables. \nBut these dependencies can be explicitly enumerated, and once they are spelled out, \nthen there can only be one meaning for the expression,^ \n\nNatural language does not work like this. Natural expressions are inherently \nambiguous, depending on any number of factors that can never be quite spelled out \ncompletely. It is perfectly reasonable for two people to disagree on what some other \nperson meant by a natural language expression. (Lawyers and judges make their \nliving largely by interpreting natural language expressions - laws - that are meant to \nbe unambiguous but are not.) \n\nThis chapter is a brief introduction to natural language processing. The next \nchapter gives a more thorough treatment from the point of view of logic grammars, \nand the chapter after that puts it all together into a full-fledged system. \n\n19-1 Parsing with a Phrase-Structure Grammar \n\nTo parse a sentence means to recover the constituent structure of the sentence - to \ndiscover what sequence of generation rules could have been applied to come up with \nthe sentence. In general, there may be several possible derivations, in which case \nwe say the sentence is grammatically ambiguous. In certain circles, the term \"parse\" \nmeans to arrive at an understanding of a sentence's meaning, not just its grammatical \nform. We will attack that more difficult question later. \n\n^Some erroneous expressions are underspecified and may return different results in different \nimplementations, but we will ignore that problem. \n\n\f\n<a id='page-657'></a>\n\nWe start with the grammar defined on [page 39](chapter2.md#page-39) for the generate program: \n\n(defvar ^grammar* \"The grammar used by GENERATE.\") \n\n(defparameter *grammarl* \n\n'((Sentence -> (NP VP)) \n(NP -> (Art Noun)) \n(VP -> (Verb NP)) \n(Art -> the a) \n(Noun -> man ball woman table) \n(Verb -> hit took saw liked))) \nOur parser takes as input a list of words and returns a structure containing the parse \ntree and the unparsed words, if any. That way, we can parse the remaining words \nunder the next category to get compound rules. For example, in parsing \"the man \nsaw the table,\" we would first parse \"the man,\" returning a structure representing \nthe noun phrase, with the remaining words \"saw the table.\" This remainder would \nthen be parsed as a verb phrase, returning no remainder, and the two phrases could \nthen be joined to form a parse that is a complete sentence with no remainder. \n\nBefore proceeding, I want to make a change in the representation of grammar \nrules. Currently, rules have a left-hand side and a list of alternative right-hand sides. \nBut each of these alternatives is really a separate rule, so it would be more modular \nto write them separately. For the generate program it was fine to have them all together, \nbecause that made processing choices easier, but now I want a more flexible \nrepresentation. Later on we will want to add more information to each rule, like the \nsemantics of the assembled left-hand side, and constraints between constituents on \nthe right-hand side, so the rules would become quite large indeed if we didn't split up \nthe alternatives. I also take this opportunity to clear up the confusion between words \nand category symbols. The convention is that a right-hand side can be either an \natom, in which case it is a word, or a list of symbols, which are then all interpreted as \ncategories. To emphasize this, I include \"noun\" and \"verb\" as nouns in the grammar \n*grammar3*, which is otherwise equivalent to the previous *grammarl*. \n\n(defparameter *grammar3* \n\n'((Sentence -> (NP VP)) \n\n(NP -> (Art Noun)) \n\n(VP -> (Verb NP)) \n\n(Art -> the) (Art -> a) \n\n(Noun -> man) (Noun -> ball) (Noun -> woman) (Noun -> table) \n\n(Noun -> noun) (Noun -> verb) \n\n(Verb -> hit) (Verb -> took) (Verb -> saw) (Verb -> liked))) \n\n(setf *grammar* *grammar3*) \n\nI also define the data types rul e, parse, and tree, and some functions for getting \n\n\f\n<a id='page-658'></a>\n\nat the rules. Rules are defined as structures of type list with three slots: the left-\nhand side, the arrow (which should always be represented as the literal ->) and the \nright-hand side. Compare this to the treatment on [page 40](chapter2.md#page-40). \n\n(defstruct (rule (:type list)) Ihs -> rhs) \n\n(defstruct (parse) \"A parse tree and a remainder.\" tree rem) \n\n;; Trees are of the form: (Ihs . rhs) \n(defun new-tree (cat rhs) (cons cat rhs)) \n(defun tree-lhs (tree) (first tree)) \n(defun tree-rhs (tree) (rest tree)) \n\n(defun parse-lhs (parse) (tree-lhs (parse-tree parse))) \n\n(defun lexical-rules (word) \n\"Return a list of rules with word on the right-hand side.\" \n(find-all word ^grammar* :key #'rule-rhs :test #'equal)) \n\n(defun rules-starting-with (cat) \n\"Return a list of rules where cat starts the rhs.\" \n(find-all cat *grammar* \n\n:key #'(lambda (rule) (first-or-nil (rule-rhs rule))))) \n\n(defun first-or-nil (x) \n\"The first element of . if it is a list; else nil.\" \n(if (consp X) (first x) nil)) \n\nNow we're ready to define the parser. The main function parser takes a list of \nwords to parse. It calls parse, which returns a Ust of all parses that parse some \nsubsequence of the words, starting at the beginning, parser keeps only the parses \nwith no remainder - that is, the parses that span all the words. \n\n(defun parser (words) \n\"Return all complete parses of a list of words.\" \n(mapcar #'parse-tree (complete-parses (parse words)))) \n\n(defun complete-parses (parses) \n\"Those parses that are complete (have no remainder).\" \n(find-all-if #*null parses :key #*parse-rem)) \n\nThe function parse looks at the first word and considers each category it could be. It \nmakes a parse of the first word under each category, and calls extend - pa rse to try to \ncontinue to a complete parse, pa rse uses mapcan to append together all the resulting \nparses. As an example, suppose we are trying to parse \"the man took the ball.\" pa rse \nwould find the single lexical rule for \"the\" and call extend-pa rse with a parse with \ntree (Art t he) and remainder \"man took the ball,\" with no more categories needed. \n\n\f\n<a id='page-659'></a>\nextend-parse has two cases. If the partial parse needs no more categories to be \ncomplete, then it returns the parse itself, along with any parses that can be formed \nby extending parses starting with the partial parse. In our example, there is one rule \nstartingwith Art, namely (NP -> (Art Noun)), so the function would try to extend \ntheparse tree (NP (Art the)) with remainder \"man took the ball,\" with the category \nNoun needed. That call to extend-parse represents the second case. We first parse \n\"man took the ball,\" and for every parse that is of category Noun (there will be only \none), we combine with the partial parse. In this case we get (NP (Art the) (Noun \nman)). This gets extended as a sentence with a VP needed, and eventually we get a \nparse of the complete hst of words. \n\n(defun parse (words) \n\"Bottom-up parse, returning all parses of any prefix of words.\" \n(unless (null words) \n\n(mapcan #'(lambda (rule) \n(extend-parse (rule-lhs rule) (list (first words)) \n(rest words) nil)) \n(lexical-rules (first words))))) \n\n(defun extend-parse (Ihs rhs rem needed) \n\"Look for the categories needed to complete the parse.\" \n(if (null needed) \n\nIf nothing needed, return parse and upward extensions \n(let ((parse (make-parse :tree (new-tree Ihs rhs) :rem rem))) \n(cons parse \n(mapcan \n#.(lambda (rule) \n\n(extend-parse (rule-lhs rule) \n(list (parse-tree parse)) \nrem (rest (rule-rhs rule)))) \n\n(rules-starting-with Ihs)))) \notherwise try to extend rightward \n(mapcan \n#'(lambda (p) \n(if (eq (parse-lhs p) (first needed)) \n(extend-parse Ihs (appendl rhs (parse-tree p)) \n(parse-rem p) (rest needed)))) \n\n(parse rem)))) \n\nThis makes use of the auxiliary function appendl: \n(defun appendl (items item) \n\"Add item to end of list of items.\" \n(append items (list item))) \n\n\f\n<a id='page-660'></a>\n\nSome examples of the parser in action are shown here: \n\n> (parser '(the table)) \n((NP (ART THE) (NOUN TABLE))) \n\n> (parser '(the ball hit the table)) \n\n((SENTENCE (NP (ART THE) (NOUN BALD) \n\n(VP (VERB HIT) \n\n(NP (ARTTHE) (NOUN TABLE))))) \n\n> (parser '(the noun took the verb)) \n((SENTENCE (NP (ART THE) (NOUN NOUN)) \n(VP (VERB TOOK) \n(NP (ARTTHE) (NOUN VERB))))) \n\n19.2 Extending the Grammar and \nRecognizing Ambiguity \nOverall, the parser seems to work fine, but the range of sentences we can parse is \nquite limited with the current grammar. The following grammar includes a wider \nvariety of linguistic phenomena: adjectives, prepositional phrases, pronouns, and \nproper names. It also uses the usual linguistic conventions for category names, \nsummarized in the table below: \n\nCategory Examples \nSentence John likes Mary\n\ns \n\nNP Noun Phrase John; a blue table \nVP Verb Phrase likes Mary; hit the ball \nPP Prepositional Phrase to Mary; with the man \n\nA Adjective little; blue \n\nA+ A list of one or more adjectives little blue \nD Determiner the; a \n. Noun ball; table \nName Proper Name John; Mary \n. Preposition to; with \nPro Pronoun you; me \nV Verb liked; hit \n\n\f\n<a id='page-661'></a>\n\nHere is the grammar: \n\n(defparameter *grammar4* \n\n'((S -> (NP VP)) \n(NP -> (D N)) \n(NP -> (D A+ N)) \n(NP -> (NP PP)) \n(NP -> (Pro)) \n(NP -> (Name)) \n(VP -> (V NP)) \n(VP -> (V)) \n(VP -> (VP PP)) \n(PP -> (P NP)) \n(A+ -> (A)) \n(A+ -> (A A+)) \n(Pro -> I) (Pro -> you) (Pro -> he) (Pro -> she) \n(Pro -> it) (Pro -> me) (Pro -> him) (Pro -> her) \n(Name -> John) (Name -> Mary) \n(A -> big) (A -> little) (A -> old) (A -> young) \n(A -> blue) (A -> green) (A -> orange) (A -> perspicuous) \n(D -> the) (D -> a) (D -> an) \n(N -> man) (N -> ball) (N -> woman) (N -> table) (N -> orange) \n(N -> saw) (N -> saws) (N -> noun) (N -> verb) \n(P -> with) (P -> for) (P -> at) (P -> on) (P -> by) (P -> of) (P -> in) \n(V -> hit) (V -> took) (V -> saw) (V -> liked) (V -> saws))) \n(setf ^grammar* *grammar4*) \n\nNow we can parse more interesting sentences, and we can see a phenomenon that \nwas not present in the previous examples: ambiguous sentences. The sentence \"The \nman hit the table with the ball\" has two parses, one where the ball is the thing that \nhits the table, and the other where the ball is on or near the table, parser finds both \nof these parses (although of course it assigns no meaning to either parse): \n\n> (parser '(The man hit the table with the ball)) \n((S (NP (D THE) (N MAN)) \n(VP (VP (V HIT) (NP (D THE) (N TABLE))) \n(PP (P WITH) (NP (DTHE) (N BALL))))) \n(S (NP (D THE) (N MAN)) \n(VP (V HIT) \n(NP (NP (D THE) (N TABLE)) \n(PP (P WITH) (NP (DTHE) (N BALL))))))) \n\nSentences are not the only category that can be ambiguous, and not all ambiguities \nhave to be between parses in the same category. Here we see a phrase that is \nambiguous between a sentence and a noun phrase: \n\n\f\n<a id='page-662'></a>\n\n> (parser '(the orange saw)) \n((S (NP (D THE) (N ORANGE)) (VP (V SAW))) \n(NP (D THE) (A+ (A ORANGE)) (N SAW))) \n\n19.3 More Efficient Parsing \nWith more complex grammars and longer sentences, the parser starts to slow down. \nThe main problem is that it keeps repeating work. For example, in parsing \"The \nman hit the table with the ball,\" it has to reparse \"with the ball\" for both of the \nresulting parses, even though in both cases it receives the same analysis, a PP. We \nhave seen this problem before and have already produced an answer: memoization \n(see section 9.6). To see how much memoization will help, we need a benchmark: \n\n> (setf s (generate 's)) \n(THE PERSPICUOUS BIG GREEN BALL BY A BLUE WOMAN WITH A BIG MAN \nHIT A TABLE BY THE SAW BY THE GREEN ORANGE) \n\n> (time (length (parser s))) \nEvaluation of (LENGTH (PARSER S)) took 33.11 Seconds of elapsed time. \n10 \n\nThe sentence S has 10 parses, since there are two ways to parse the subject NP and \nfive ways to parse the VP. It took 33 seconds to discover these 10 parses with the \npa rse function as it was written. \n\nWe can improve this dramatically by memoizing parse (along with the table-\nlookup functions). Besides memoizing, the only change is to clear the memoization \ntable within parser. \n\n(memoize 'lexical-rules) \n(memoize *rules-starting-with) \n(memoize 'parse -.test #*eq) \n\n(defun parser (words) \n\"Return all complete parses of a list of words.\" \n(clear-memoize 'parse) \n(mapcar #'parse-tree (complete-parses (parse words)))) \n\nIn normal human language use, memoization would not work very well, since the \ninterpretation of a phrase depends on the context in which the phrase was uttered. \nBut with context-free grammars we have a guarantee that the context cannot affect the \ninterpretation. The call (parse words) must return all possible parses for the words. \nWe are free to choose between the possibilities based on contextual information, but \n\n\f\n<a id='page-663'></a>\n\ncontext can never supply a new interpretation that is not in the context-free list of \n\nparses. \n\nThe function use is introduced to tell the table-lookup functions that they are out \nof date whenever the grammar changes: \n\n(defun use (grammar) \n\n\"Switch to a new grammar.\" \n\n(clear-memoize 'rules-starting-with) \n\n(clear-memoize 'lexical-rules) \n\n(length (setf *grammar* grammar))) \n\nNow we run the benchmark again with the memoized version of pa rse: \n\n> (time (length (parser s))) \n\nEvaluation of (LENGTH (PARSER S 'S)) took .13 Seconds of elapsed time. \n\n10 \n\nBy memoizing pa rs e we reduce the parse time from 33 to .13 seconds, a 250-fold speedup. \nWe can get a more systematic comparison by looking at a range of examples. \nFor example, consider sentences of the form \"The man hit the table [with the ball]*\" \nfor zero or more repetitions of the PP \"with the ball.\" In the following table we \nrecord N, the number of repetitions of the PP, along with the number of resulting \nparses^, and for both memoized and unmemoized versions of parse, the number \nof seconds to produce the parse, the number of parses per second (PPS), and the \nnumber of recursive calls to parse. The performance of the memoized version is \nquite acceptable; for N=5, a 20-word sentence is parsed into 132 possibilities in .68 \nseconds, as opposed to the 20 seconds it takes in the unmemoized version. \n\n^The number of parses of sentences of this kind is the same as the number of bracketings \nof a arithmetic expression, or the number of binary trees with a given number of leaves. The \nresulting sequence (1,2,5,14,42,...) is known as the Catalan Numbers. This kind of ambiguity \nis discussed by Church and Patil (1982) in their articleCoping with Syntactic Ambiguity, or How \nto Put the Block in the Box on the Table. \n\n\f\n<a id='page-664'></a>\n\nMemoized Unmemoized \n. Parses Sees PPS CaUs Sees PPS CaUs \n0 1 0.02 60 4 0.02 60 17 \n1 2 0.02 120 11 0.07 30 96 \n2 5 0.05 100 21 0.23 21 381 \n3 14 0.10 140 34 0.85 16 1388 \n4 42 0.23 180 50 3.17 13 4999 \n5 132 0.68 193 69 20.77 6 18174 \n6 429 1.92 224 91 -\n7 1430 5.80 247 116 -\n8 4862 20.47 238 144 -\n\n&#9635; Exercise 19.1 Pi] It seems that we could be more efficient still by memoizing with \na table consisting of a vector whose length is the number of words in the input (plus \none). Implement this approach and see if it entails less overhead than the more \ngeneral hash table approach. \n\n19.4 The Unknown-Word Problem \nAs it stands, the parser cannot deal with unknown words. Any sentence containing \na word that is not in the grammar will be rejected, even if the program can parse all \nthe rest of the words perfectly. One way of treating unknown words is to allow them \nto be any of the \"open-class\" categories - nouns, verbs, adjectives, and names, in our \ngrammar. An unknown word will not be considered as one of the \"closed-class\" \ncategories - prepositions, determiners, or pronouns. This can be programmed very \nsimply by having 1 exi ca 1 - rul es return a list of these open-class rules for every word \nthat is not already known. \n\n(defparameter *open-categories* '(NVA Name) \n\"Categories to consider for unknown words\") \n\n(defun lexical-rules (word) \n\"Return a list of rules with word on the right-hand side.\" \n(or (find-all word *grammar* :key #'rule-rhs :test #'equal) \n\n(mapcar #'(lambda (cat) '(.cat -> .word)) *open-categories*))) \n\nWith memoization of 1 exi cal - rul es, this means that the lexicon is expanded every \ntime an unknown word is encountered. Let's try this out: \n\n> (parser '(John liked Mary)) \n((S (NP (NAME JOHN)) \n(VP (V LIKED) (NP (NAME MARY))))) \n\n\f\n<a id='page-665'></a>\n\n> (parser '(Dana liked Dale)) \n((S (NP (NAME DANA)) \n(VP (V LIKED) (NP (NAME DALE))))) \n\n> (parser '(the rab zaggled the woogly quax)) \n((S (NP (D THE) (N RAB)) \n(VP (V ZAGGLED) (NP (D THE) (A+ (A WOOGLY)) (N QUAX))))) \n\nWe see the parser works as well with words it knows (John and Mary) as with new \nwords (Dana and Dale), which it can recognize as names because of their position \nin the sentence. In the last sentence in the example, it recognizes each unknown \nword unambiguously. Things are not always so straightforward, unfortunately, as \nthe following examples show: \n\n> (parser '(the slithy toves gymbled)) \n\n((S (NP (D THE) (N SLITHY)) (VP (V TOVES) (NP (NAME GYMBLED)))) \n(S (NP (D THE) (A+ (A SLITHY)) (N TOVES)) (VP (V GYMBLED))) \n(NP (D THE) (A+ (A SLITHY) (A+ (A TOVES))) (N GYMBLED))) \n\n> (parser '(the slithy toves gymbled on the wabe)) \n((S (NP (D THE) (N SLITHY)) \n(VP (VP (V TOVES) (NP (NAME GYMBLED))) \n(PP (P ON) (NP (D THE) (N WABE))))) \n(S (NP (D THE) (N SLITHY)) \n(VP (V TOVES) (NP (NP (NAME GYMBLED)) \n(PP (P ON) (NP (D THE) (N WABE)))))) \n(S (NP (D THE) (A+ (A SLITHY)) (N TOVES)) \n(VP (VP (V GYMBLED)) (PP (P ON) (NP (D THE) (N WABE))))) \n(NP (NP (D THE) (A+ (A SLITHY) (A+ (A TOVES))) (N GYMBLED)) \n(PP (P ON) (NP (D THE) (N WABE))))) \n\nIf the program knew morphology - that a y at the end of a word often signals an \nadjective, an s a plural noun, and an ed a past-tense verb - then it could do much \nbetter. \n\n19.5 Parsing into a Semantic Representation \nSyntactic parse trees of a sentence may be interesting, but by themselves they're not \nvery useful. We use sentences to communicate ideas, not to display grammatical \nstructures. To explore the idea of the semantics, or meaning, of a phrase, we need \na domain to talk about. Imagine the scenario of a compact disc player capable of \nplaying back selected songs based on their track number. Imagine further that this \nmachine has buttons on the front panel indicating numbers, as well as words such as \n\"play,\" \"to,\" \"and,\" and \"without.\" If you then punch in the sequence of buttons \"play \n\n\f\n<a id='page-666'></a>\n\n1 to 5 without 3/' you could reasonably expect the machine to respond by playing \ntracks 1,2,4, and 5. After a few such successful interactions, you might say that the \nmachine \"understands\" a limited language. The important point is that the utility of \nthis machine would not be enhanced much if it happened to display a parse tree of \nthe input. On the other hand, you would be justifiably annoyed if it responded to \n\"play 1 to 5 without 3\" by playing 3 or skipping 4. \n\nNow let's stretch the imagination one more time by assuming that this CD player \ncomes equipped with a full Common Lisp compiler, and that we are now in charge \nof writing the parser for its input language. Let's first consider the relevant data \nstructures. We need to add a component for the semantics to both the rule and tree \nstructures. Once we've done that, it is clear that trees are nothing more than instances \nof rules, so their definitions should reflect that. Thus, I use an : 1nc1 ude defstruct \nto define trees, and I specify no copier function, because copy-tree is already a \nCommon Lisp function, and I don't want to redefine it. To maintain consistency \nwith the old new-tree function (and to avoid having to put in all those keywords) I \ndefinetheconstructor new-tree. Thisoptiontodefstructmakes (new-tree a b c) \nequivalent to (make-tree :lhs a :sem b :rhsc). \n\n(defstruct (rule (itype list)) \nIhs -> rhs sem) \n\n(defstruct (tree (:type list) (:include rule) (rcopiernil) \n(:constructor new-tree (Ihs sem rhs)))) \n\nWe will adopt the convention that the semantics of a word can be any Lisp object. For \nexample, the semantics of the word \"1\" could be the object 1, and the semantics of \n\"without\" could be the function set-di ff erence. The semantics of a tree is formed \nby taking the semantics of the rule that generated the tree and applying it (as a \nfunction) to the semantics of the constituents of the tree. Thus, the grammar writer \nmust insure that the semantic component of rules are functions that expect the right \nnumber of arguments. For example, given the rule \n\n(NP -> (NP CONJ NP) infix-funcall) \n\nthen the semantics of the phrase \"1 to 5 without 3\" could be determined by first deter-\nminingthesemanticsof\"lto5\"tobe(l 2 3 4 5),of\"without\"tobeset -difference, \nand of \"3\" to be (3). After these sub-constituents are determined, the rule is applied \nby calling the function infix-funcall with the three arguments (1 2 3 4 5), \nset-difference, and (3). Assuming that infix-funcall is defined to apply its \nsecond argument to the other two arguments, the result will be (1 2 4 5). \n\nThis may make more sense if we look at a complete grammar for the CD player \nproblem: \n\n\f\n<a id='page-667'></a>\n\n(use \n\n'((NP -> (NP CONJ NP) infix-funcall) \n(NP -> (N) list) \n(NP -> (N . .) infix-funcall) \n(. -> (DIGIT) identity) \n(P -> to integers) \n(CONJ -> and union) \n(CONJ -> without set-difference) \n(N -> 1 1) (N -> 2 2) (N -> 3 3) (N -> 4 4) (N -> 5 5) \n(N -> 6 6) (N -> 7 7) (N -> 8 8) (N -> 9 9) (N -> 0 0))) \n\n(defun integers (start end) \n\"A list of all the integers in the range [start...end] inclusive.\" \n(if (> start end) nil \n\n(cons start (integers (+ start 1) end)))) \n\n(defun infix-funcall (argl function arg2) \n\"Apply the function to the two arguments\" \n(funcall function argl arg2)) \n\nConsider the first three grammar rules, which are the only nonlexical rules. The first \nsays that when two NPs are joined by a conjunction, we assume the translation of \nthe conjunction will be a function, and the translation of the phrase as a whole is \nderived by calling that function with the translations of the two NPs as arguments. \nThe second rule says that a single noun (whose translation should be a number) \ntranslates into the singleton list consisting of that number. The third rule is similar \nto the first, but concerns joining Ns rather than NPs. The overall intent is that the \ntranslation of an NP will always be a list of integers, representing the songs to play. \n\nAs for the lexical rules, the conjunction \"and\" translates to the union function, \n\"without\" translates to the function that subtracts one set from another, and \"to\" \ntranslates to the function that generates a list of integers between two end points. \nThe numbers \"0\" to \"9\" translate to themselves. Note that both lexical rules like \n\"CONJ -> and\" and nonlexical rules like \"NP -> (N . .)\" can have functions as \ntheir semantic translations; in the first case, the function will just be returned as the \nsemantic translation, whereas in the second case the function will be applied to the \nlist of constituents. \n\nOnly minor changes are needed to par s e to support this kind of semantic processing. \nAs we see in the following, we add a sem argument to extend - pa r se and arrange \nto pass the semantic components around properly. When we have gathered all the \nright-hand-side components, we actually do the function application. All changes \nare marked with We adopt the convention that the semantic value .i 1 indicates \nfailure, and we discard all such parses. \n\n\f\n<a id='page-668'></a>\n\n(defun parse (words) \n\"Bottom-up parse, returning all parses of any prefix of words. \nThis version has semantics.\" \n(unless (null words) \n\n(mapcan #'(lambda (rule) \n(extend-parse (rule-lhs rule) (rule-sem rule) \n(list (first words)) (rest words) nil)) \n(lexical-rules (first words))))) \n\n(defun extend-parse (Ihs sem rhs rem needed) \n\"Look for the categories needed to complete the parse. \nThis version has semantics.\" \n(if (null needed) \n\nIf nothing is needed, return this parse and upward extensions, \n:; unless the semantics fails \n(let ((parse (make-parse rtree (new-tree Ihs sem rhs) :rem rem))) \n\n(unless (null (apply-semantics (parse-tree parse))) \n(cons parse \n(mapcan \n#'(lambda (rule) \n\n(extend-parse (rule-lhs rule) (rule-semrule) \n(list (parse-tree parse)) rem \n(rest (rule-rhs rule)))) \n\n(rules-starting-with Ihs))))) \n;; otherwise try to extend rightward \n(mapcan \n\n#*(lambda (p) \n(if (eq (parse-lhs p) (first needed)) \n(extend-parse Ihs sem (appendl rhs (parse-tree p)) \n(parse-rem p) (rest needed)))) \n\n(parse rem)))) \n\nWe need to add some new functions to support this: \n(defun apply-semantics (tree) \n\"For terminal nodes, just fetch the semantics. \nOtherwise, apply the sem function to its constituents.\" \n(if (terminal-tree-p tree) \n(tree-sem tree) \n(setf (tree-sem tree) \n(apply (tree-sem tree) \n(mapcar #'tree-sem (tree-rhs tree)))))) \n\n(defun terminal-tree-p (tree) \n\"Does this tree have a single word on the rhs?\" \n(and (length=1 (tree-rhs tree)) \n\n(atom (first (tree-rhs tree))))) \n\n\f\n<a id='page-669'></a>\n\n(defun meanings (words) \n\"Return all possible meanings of a phrase. Throw away the syntactic part.\" \n(remove-duplicates (mapcar #'tree-sem (parser words)) :test #'equal)) \n\nHere are some examples of the meanings that the parser can extract: \n\n> (meanings '(1 to 5 without 3)) \n((1 2 4 5)) \n\n> (meanings '(1 to 4 and 7 to 9)) \n((123478 9)) \n\n> (meanings '(1 to 6 without 3 and 4)) \n((12 4 5 6) \n(1 2 5 6)) \n\nThe example \"(1 to 6 without 3 and 4)\" is ambiguous. The first reading corresponds \nto \"((1 to 6) without 3) and 4/' while the second corresponds to \"(1 to 6) \nwithout (3 and 4).\" The syntactic ambiguity leads to a semantic ambiguity - the two \nmeanings have different lists of numbers in them. However, it seems that the second \nreading is somehow better, in that it doesn't make a lot of sense to talk of adding 4 to \na set that already includes it, which is what the first translation does. \n\nWe can upgrade the lexicon to account for this. The following lexicon insists \nthat \"and\" conjoins disjoint sets and that \"without\" removes only elements that were \nalready in the first argument. If these conditions do not hold, then the translation \nwill return nil, and the parse will fail. Note that this also means that an empty list, \nsuch as \"3 to 2,\" will also fail. \n\nThe previous grammar only allowed for the numbers 0 to 9. We can allow larger \nnumbers by stringing together digits. So now we have two rules for numbers: a \nnumber is either a single digit, in which case the value is the digit itself (the i dent i ty \nfunction), or it is a number followed by another digit, in which case the value is 10 \ntimes the number plus the digit. We could alternately have specified a number to be \na digit followed by a number, or even a number followed by a number, but either of \nthose formulations would require a more complex semantic interpretation. \n\n(use \n\n'((NP -> (NP CONJ NP) infix-funcall) \n(NP -> (N) list) \n(NP -> (N . .) infix-funcall) \n(. -> (DIGIT) identity) \n(N -> (N DIGIT) 10*N+D) \n(P -> to integers) \n(CONJ -> and union*) \n(CONJ -> without set-diff) \n(DIGIT -> 1 1) (DIGIT -> 2 2) (DIGIT -> 3 3) \n\n\f\n<a id='page-670'></a>\n\n(DIGIT -> 4 4) (DIGIT -> 5 5) (DIGIT -> 6 6) \n(DIGIT -> 7 7) (DIGIT -> 8 8) (DIGIT -> 9 9) \n(DIGIT -> 0 0))) \n\n(defun union* (x y) (if (null (intersection . y)) (append . y))) \n(defun set-diff (. y) (if (subsetp y .) (set-difference . y))) \n(defun 10*N-^D (N D) (+ (* 10 N) D)) \n\nWith this new grammar, we can get single interpretations out of most reasonable \ninputs: \n\n> (meanings '(1 to 6 without 3 and 4)) \n((1 2 5 6)) \n\n> (meanings '(1 and 3 to 7 and 9 without 5 and 6)) \n((13 4 7 9)) \n\n> (meanings '(1 and 3 to 7 and 9 without 5 and 2)) \n((134679 2)) \n\n> (meanings '(1 9 8 to 2 0 D) \n((198 199 200 201)) \n\n> (meanings '(1 2 3)) \n(123 (123)) \n\nThe example \"1 2 3\" shows an ambiguity between the number 123 and the list (123), \nbut all the others are unambiguous. \n\n19.6 Parsing with Preferences \nOne reason we have unambiguous interpretations is that we have a very limited \ndomain of interpretation: we are dealing with sets of numbers, not lists. This is \nperhaps typical of the requests faced by a CD player, but it does not account for \nall desired input. For example, if you had a favorite song, you couldn't hear it \nthree times with the request \"1 and 1 and 1\" under this grammar. We need some \ncompromise between the permissive grammar, which generated all possible parses, \nand the restrictive grammar, which eliminates too many parses. To get the \"best\" \ninterpretation out of an arbitrary input, we will not only need a new grammar, we \nwill also need to modify the program to compare the relative worth of candidate \ninterpretations. In other words, we will assign each interpretation a numeric score, \nand then pick the interpretation with the highest score. \n\nWe start by once again modifying the rule and tree data types to include a score \ncomponent. As with the sem component, this will be used to hold first a function to \ncompute a score and then eventually the score itself. \n\n\f\n<a id='page-671'></a>\n\n(defstruct (rule (:type list) \n(:constructor \nrule (Ihs -> rhs &optional sem score))) \nIhs -> rhs sem score) \n\n(defstruct (tree (itype list) (rinclude rule) (:copiernil) \n(:constructor new-tree (Ihs sem score rhs)))) \n\nNote that we have added the constructor function rul e. The intent is that the sem \nand score component of grammar rules should be optional. The user does not have \nto supply them, but the function use will make sure that the function rul e is called \nto fill in the missing sem and score values with ni 1. \n\n(defun use (grammar) \n\"Switch to a new grammar.\" \n(clear-memoize 'rules-starting-with) \n(clear-memoize 'lexical-rules) \n(length (setf *grammar* \n\n(mapcar #'(lambda (r) (apply #'rule r)) \ngrammar)))) \n\nNow we modify the parser to keep track of the score. The changes are again minor, \nand mirror the changes needed to add semantics. There are two places where we \nput the score into trees as we create them, and one place where we apply the scoring \nfunction to its arguments. \n\n(defun parse (words) \n\"Bottom-up parse, returning all parses of any prefix of words. \nThis version has semantics and preference scores.\" \n(unless (null words) \n\n(mapcan #'(lambda (rule) \n\n(extend-parse \n(rule-lhs rule) (rule-sem rule) \n(rule-score rule) (list (first words)) \n(rest words) nil)) \n\n(lexical-rules (first words))))) \n\n(defun extend-parse (Ihs sem score rhs rem needed) \n\"Look for the categories needed to complete the parse. \nThis version has semantics and preference scores.\" \n(if (null needed) \n\nIf nothing is needed, return this parse and upward extensions, \n;; unless the semantics fails \n(let ((parse (make-parse :tree (new-tree Ihs sem score rhs) \n\n:rem rem))) \n(unless (null (apply-semantics (parse-tree parse))) \n\n\f\n<a id='page-672'></a>\n\n(apply-scorer (parse-tree parse)) \n(cons parse \n(mapcan \n#'(lambda (rule) \n\n(extend-parse \n(rule-lhs rule) (rule-sem rule) \n(rule-score rule) (list (parse-tree parse)) \nrem (rest (rule-rhs rule)))) \n\n(rules-starting-with Ihs))))) \notherwise try to extend rightward \n(mapcan \n#*(lambda (p) \n(if (eq (parse-lhs p) (first needed)) \n\n(extend-parse Ihs sem score \n(appendl rhs (parse-tree p)) \n(parse-rem p) (rest needed)))) \n\n(parse rem)))) \n\nAgain we need some new functions to support this. Most important is appl y - scorer, \nwhich computes the score for a tree. If the tree is a terminal (a word), then the function \njust looks up the score associated with that word. In this grammar all words have \na score of 0, but in a grammar with ambiguous words it would be a good idea to \ngive lower scores for infrequently used senses of ambiguous words. If the tree is \na nonterminal, then the score is computed in two steps. First, all the scores of the \nconstituents of the tree are added up. Then, this is added to a measure for the tree \nas a whole. The rule associated with each tree will have either a number attached to \nit, which is added to the sum, or a function. In the latter case, the function is applied \nto the tree, and the result is added to obtain the final score. Asa final special case, if \nthe function returns nil, then we assume it meant to return zero. This will simplify \nthe definition of some of the scoring functions. \n\n(defun apply-scorer (tree) \n\"Compute the score for this tree.\" \n(let ((score (or (tree-score tree) 0))) \n\n(setf (tree-score tree) \n(if (terminal-tree-p tree) \nscore \n\nAdd up the constituent's scores, \n;; along with the tree's score \n(+ (sum (tree-rhs tree) #'tree-score-or-0) \n\n(if (numberp score) \nscore \n\n(or (apply score (tree-rhs tree)) 0))))))) \n\nHere is an accessor function to pick out the score from a tree: \n\n\f\n<a id='page-673'></a>\n\n(defun tree-score-or-O (tree) \n\n(if (numberp (tree-score tree)) \n(tree-score tree) \n0)) \n\nHere is the updated grammar. First, I couldn't resist the chance to add more features \nto the grammar. I added the postnominal adjectives \"shuffled,\" which randomly \npermutes the list of songs, and \"reversed,\" which reverses the order of play. I also \nadded the operator \"repeat,\" as in \"1 to 3 repeat 5,\" which repeats a list a certain \nnumber of times. 1 also added brackets to allow input that says explicitly how it \nshould be parsed. \n\n(use \n\n'((NP -> (NP CONJ NP) infix-funcall infix-scorer) \n(NP -> (N . .) infix-funcall infix-scorer) \n(NP -> (.) list) \n(NP ([ NP ]) arg2) \n(NP (NP ADJ) rev-funcal1 rev-scorer) \n(NP -> (NP OP N) infix-funcall) \n(N -> (D) identity) \n(N (N D) 10*N+D) \n(P -> to integers prefer<) \n\n([ -> [ [) \n(] -> ] ]) \n(OP -> repeat repeat) \n(CONJ -> and append prefer-disjoint) \n(CONJ -> without set-difference prefer-subset) \n(ADJ -> reversed reverse inv-span) \n(ADJ -> shuffled permute prefer-not-singleton) \n(D -> 1 1) (D -> 2 2) (D -> 3 3) (D -> 4 4) (D -> 5 5) \n(D -> 6 6) (D -> 7 7) (D -> 8 8) (D -> 9 9) (D -> 0 0))) \n\nThe following scoring functions take trees as inputs and compute bonuses or penalties \nfor those trees. The scoring function pref er<, used for the word \"to,\" gives a \none-point penalty for reversed ranges: \"5 to 1\" gets a score of -1, while \"1 to 5\" gets \na score of 0. The scorer for \"and,\" prefer-di s joi nt, gives a one-point penalty for \nintersecting lists: \"1 to 3 and 7 to 9\" gets a score of 0, while \"1 to 4 and 2 to 5\" gets -1. \nThe \"x without y\" scorer, prefer-subset, gives a three-point penalty when the y list \nhas elements that aren't in the . list. It also awards points in inverse proportion to the \nlength (in words) of the . phrase. The idea is that we should prefer to bind \"without\" \ntightly to some small expression on the left. If the final scores come out as positive \nor as nonintegers, then this scoring component is responsible, since all the other \ncomponents are negative intgers. The \"x shuffled\" scorer, prefer-not-singleton, \nis similar, except that there the penalty is for shuffling a list of less than two songs. \n\n\f\n<a id='page-674'></a>\n\n(defun prefer< (x y) \n(if (>= (sem X) (sem y)) -1)) \n\n(defun prefer-disjoint (x y) \n(if (intersection (sem x) (sem y)) -1)) \n\n(defun prefer-subset (x y) \n(+ (inv-span x) (if (subsetp (sem y) (sem x)) 0 -3))) \n\n(defun prefer-not-singleton (x) \n(+ (inv-span x) (if (< (length (sem x)) 2) -4 0))) \n\nThe inf i x-scorer and rev-scorer functionsdon'taddanythingnew,theyjustassure \nthat the previously mentioned scoring functions will get applied in the right place. \n\n(defun infix-scorer (argl scorer arg2) \n(funcall (tree-score scorer) argl arg2)) \n\n(defun rev-scorer (arg scorer) (funcall (tree-score scorer) arg)) \n\nHere are the functions mentioned in the grammar, along with some useful utilities: \n\n(defun arg2 (al a2 &rest a-n) (declare (ignore al a-n)) a2) \n\n(defun rev-funcall (arg function) (funcall function arg)) \n\n(defun repeat (list n) \n\"Append list . times.\" \n(if (= . 0) \n\nnil \n(append list (repeat list (- . 1))))) \n\n(defun span-length (tree) \n\"How many words are in tree?\" \n(if (terminal-tree-p tree) 1 \n\n(sum (tree-rhs tree) #'span-length))) \n\n(defun inv-span (tree) (/ 1 (span-length tree))) \n\n(defun sem (tree) (tree-sem tree)) \n\n(defun integers (start end) \n\"A list of all the integers in the range [start...end]inclusive. \nThis version allows start > end.\" \n(cond ((< start end) (cons start (integers (+ start 1) end))) \n\n((> start end) (cons start (integers (- start 1) end))) \n(t (list start)))) \n\n(defun sum (numbers &optional fn) \n\"Sum the numbers, or sum (mapcar fn numbers).\" \n(if fn \n\n(loop for X in numbers sum (funcall fn x)) \n(loop for X in numbers sum x))) \n\n\f\n<a id='page-675'></a>\n\n(defun permute (bag) \n\"Return a random permutation of the given input list. \" \n(if (null bag) \n\nnil \n(let ((e (random-elt bag))) \n(cons e (permute (remove e bag rcount 1 :test #*eq)))))) \n\nWe will need a way to show off the preference rankings: \n\n(defun all-parses (words) \n(format t \"~%Score Semantics^ZBT^a\" words) \n(format t \"~% = --251 -~%\") \n(loop for tree in (sort (parser words) #*> :key#'tree-score) \n\ndo (format t \"~5,lf ~9a~25T''a~%\" (tree-score tree) (tree-sem tree) \n(bracketing tree))) \n(values)) \n\n(defun bracketing (tree) \n\"Extract the terminals, bracketed with parens.\" \n(cond ((atom tree) tree) \n\n((length=1 (tree-rhs tree)) \n(bracketing (first (tree-rhs tree)))) \n(t (mapcar #'bracketing (tree-rhs tree))))) \n\nNow we can try some examples: \n\n> (all-parses '(1 to 6 without 3 and 4)) \nScore Semantics (1 TO 6 WITHOUT 3 AND 4) \n\n0.3 (1 2 5 6) ((1 TO 6) WITHOUT (3 AND 4)) \n-0.7 (1 2 4 5 6 4) (((1 TO 6) WITHOUT 3) AND 4) \n> (all -parses '(1 and 3 to 7 and 9 without 5 and 6)) \nScore Semantics (1 AND 3 TO 7 AND 9 WITHOUT 5 AND 6) \n\n0.2 (1 3 4 7 9) (1 AND (((3 TO 7) AND 9) WITHOUT (5 AND 6))) \n0.1 (1 3 4 7 9) (((1 AND (3 TO 7)) AND 9) WITHOUT (5 AND 6)) \n0.1 (1 3 4 7 9) ((1 AND ((3 TO 7) AND 9)) WITHOUT (5 AND 6)) \n-0.8 (1 3 4 6 7 9 6) ((1 AND (((3 TO 7) AND 9) WITHOUT 5)) AND 6) \n-0.8 (1 3 4 6 7 9 6) (1 AND ((((3 TO 7) AND 9) WITHOUT 5) AND 6)) \n-0.9 (1 3 4 6 7 9 6) ((((1 AND (3 TO 7)) AND 9) WITHOUT 5) AND 6) \n-0.9 (1 3 4 6 7 9 6) (((1 AND ((3 TO 7) AND 9)) WITHOUT 5) AND 6) \n-2.0 (1 3 4 5 6 7 9) ((1 AND (3 TO 7)) AND (9 WITHOUT (5 AND 6))) \n-2.0 (1 3 4 5 6 7 9) (1 AND ((3 TO 7) AND (9 WITHOUT (5 AND 6)))) \n-3.0 (1 3 4 5 6 7 9 6) (((1 AND (3 TO 7)) AND (9 WITHOUT 5)) AND 6) \n-3.0 (1 3 4 5 6 7 9 6) ((1 AND (3 TO 7)) AND ((9 WITHOUT 5) AND 6)) \n-3.0 (1 3 4 5 6 7 9 6) ((1 AND ((3 TO 7) AND (9 WITHOUT 5))) AND 6) \n\f\n<a id='page-676'></a>\n\n-3.0 (1 3 4 5 6 7 9 6) (1 AND (((3 TO 7) AND (9 WITHOUT 5)) AND 6)) \n-3.0 (13 4 5 6 7 9 6) (1 AND ((3 TO 7) AND ((9 WITHOUT 5) AND 6))) \n\n> (all -parses '(1 and 3 :o 7 and 9 without 5 and 2)) \nScore Semantics (1 AND 3 TO 7 AND 9 WITHOUT 5 AND 2) \n\n0.2 (1 3 4 6 7 9 2) ((1 AND (((3 TO 7) AND 9) WITHOUT 5)) AND 2) \n0.2 (1 3 4 6 7 9 2) (1 AND ((((3 TO 7) AND 9) WITHOUT 5) AND 2)) \n0.1 (1 3 4 6 7 9 2) ((((1 AND (3 TO 7)) AND 9) WITHOUT 5) AND 2) \n0.1 (1 3 4 6 7 9 2) (((1 AND ((3 TO 7) AND 9)) WITHOUT 5) AND 2) \n-2.0 (1 3 4 5 6 7 9 2) (((1 AND (3 TO 7)) AND (9 WITHOUT 5)) AND 2) \n-2.0 (1 3 4 5 6 7 9 2) ((1 AND (3 TO 7)) AND ((9 WITHOUT 5) AND 2)) \n-2.0 (1 3 4 5 6 7 9) ((1 AND (3 TO 7)) AND (9 WITHOUT (5 AND 2))) \n-2.0 (1 3 4 5 6 7 9 2) ((1 AND ((3 TO 7) AND (9 WITHOUT 5))) AND 2) \n-2.0 (1 3 4 5 6 7 9 2) (1 AND (((3 TO 7) AND (9 WITHOUT 5)) AND 2)) \n-2.0 (1 3 4 5 6 7 9 2) (1 AND ((3 TO 7) AND ((9 WITHOUT 5) AND 2))) \n-2.0 (1 3 4 5 6 7 9) (1 AND ((3 TO 7) AND (9 WITHOUT (5 AND 2)))) \n-2.8 (1 3 4 6 7 9) (1 AND (((3 TO 7) AND 9) WITHOUT (5 AND 2))) \n-2.9 (1 3 4 6 7 9) (((1 AND (3 TO 7)) AND 9) WITHOUT (5 AND 2)) \n-2.9 (1 3 4 6 7 9) ((1 AND ((3 TO 7) AND 9)) WITHOUT (5 AND 2)) \nIn each case, the preference rules are able to assign higher scores to more reasonable \ninterpretations. It turns out that, in each case, all the interpretations with positive \nscores represent the same set of numbers, while interpretations with negative scores \nseem worse. Seeing all the scores in gory detail may be of academic interest, but what \nwe really want is something to pick out the best interpretation. The following code \nis appropriate for many situations. It picks the top scorer, if there is a unique one, \nor queries the user if several interpretations tie for the best score, and it complains \nif there are no valid parses at all. The query-user function may be useful in many \napplications, but note that meani ng uses it only as a default; a program that had some \nautomatic way of deciding could supply another ti e-breaker function to meani ng. \n\n(defun meaning (words &optional (tie-breaker #'query-user)) \n\"Choose the single top-ranking meaning for the words.\" \n(let* ((trees (sort (parser words) #*> :key #'tree-score)) \n\n(best-score (if trees (tree-score (first trees)) 0)) \n(best-trees (delete best-score trees \n:key #*tree-score :test-not #'eql)) \n(best-sems (delete-duplicates (mapcar #'tree-sem best-trees) \n.-test #'equal))) \n\n(case (length best-sems) \n(0 (format t \"~&Sorry. I didn't understand that.\") nil) \n(1 (first best-sems)) \n(t (funcall tie-breaker best-sems))))) \n\n\f\n<a id='page-677'></a>\n\n(defun query-user (choices &optiona1 \n(header-str \"~&Please pick one:\") \n(footer-str \"~&Your choice? \")) \n\n\"Ask user to make a choice.\" \n(format *query-io* header-str) \n(loop for choice in choices for i from 1 do \n\n(format *query-io* \"~&~3d: ~a\" i choice)) \n(format *query-io* footer-str) \n(nth (- (read) 1) choices)) \n\nHere we see some final examples: \n\n> (meaning '(1 to 5 without 3 and 4)) \n(1 2 5) \n\n> (meaning '(1 to 5 without 3 and 6)) \n(12 4 5 6) \n\n> (meaning '(1 to 5 without 3 and 6 shuffled)) \n(64125) \n\n> (meaning '([ 1 to 5 without C 3 and 6 ] ] reversed)) \n(5 4 2 1) \n\n> (meaning '(1 to 5 to 9)) \n\nSorry. I didn't understand that. \nNIL \n\n> (meaning '(1 to 5 without 3 and 7 repeat 2)) \nPlease pick one: \n\n1: (12 4 5 7 12 4 5 7) \n2: (12 4 5 7 7) \nYour choice? 1 \n(12 4 5 7 12 4 5 7) \n\n> (all-parses '(1 to 5 without 3 and 7 repeat 2)) \nScore Semantics (1 TO 5 WITHOUT 3 AND 7 REPEAT 2) \n\n0.3 (12 4 5 7 12 4 5 7) ((((1 TO 5) WITHOUT 3) AND 7) REPEAT 2) \n0.3 (12 4 5 7 7) (((1 TO 5) WITHOUT 3) AND (7 REPEAT 2)) \n-2.7 (12 4 5 12 4 5) (((1 TO 5) WITHOUT (3 AND 7)) REPEAT 2) \n-2.7 (12 4 5) ((1 TO 5) WITHOUT ((3 AND 7) REPEAT 2)) \n-2.7 (12 4 5) ((1 TO 5) WITHOUT (3 AND (7 REPEAT 2))) \nThis last example points out a potential problem: I wasn't sure what was a good \nscoring function for \"repeat,\" so I left it blank, it defaulted to 0, and we end up \nwith two parses with the same score. This example suggests that \"repeat\" should \nprobably involve inv-span like the other modifiers, but perhaps other factors should \nbe involved as well. There can be a complicated interplay between phrases, and it \n\n\f\n<a id='page-678'></a>\n\nis not always clear where to assign the score. For example, it doesn't make much \nsense to repeat a \"without\" phrase; that is, the bracketing (. without (y repeat \n.)) is probably a bad one. But the scorer for \"without\" nearly handles that already. \nIt assigns a penalty if its right argument is not a subset of its left. Unfortunately, \nrepeated elements are not counted in sets, so for example, the list (1 2 3 1 2 3) is a \nsubset of (1 2 3 4). However, we could change the scorer for \"without\" to test for \nsub-bag-. (not a built-in Common Lisp function) instead, and then \"repeat\" would \nnot have to be concerned with that case. \n\n19.7 The Problem with Context-Free \nPhrase-Structure Rules \nThe fragment of English grammar we specified in section 19.2 admits a variety of \nungrammatical phrases. For example, it is equally happy with both \"I liked her\" and \n\"me liked she.\" Only the first of these should be accepted; the second should be \nruled out. Similarly, our grammar does not state that verbs have to agree with their \nsubjects in person and number. And, since the grammar has no notion of meaning, \nit will accept sentences that are semantically anomalous (or at least unusual), such \nas \"the table liked the man.\" \n\nThere are also some technical problems with context-free grammars. For example, \nit can be shown that no context-free grammar can be written to account for the \nlanguage consisting of just the strings ABC, AABBCC, AAABBBCCC, and so forth, \nwhere each string has an equal number of As, Bs, and Cs. Yet sentences roughly of \nthat form show up (admittedly rarely) in natural languages. An example is \"Robin \nand Sandy loved and hated Pat and Kim, respectively.\" While there is still disagreement \nover whether it is possible to generate natural languages with a context-free \ngrammar, clearly it is much easier to use a more powerful grammatical formalism. \nFor example, consider solving the subject-predicate agreement problem. It is possible \nto do this with a context-free language including categories like singular-NP, \nplural-NP, singular-VP, and plural-VP, but it is far easier to augment the grammatical \nformahsm to allow passing features between constituents. \n\nIt should be noted that context-free phrase-structure rules turned out to be very \nuseful for describing programming languages. Starting with Algol 60, the formalism \nhas been used under the name Bflcfcus-Nflwr Form (BNF) by computer scientists. In this \nbook we are more interested in natural languages, so in the next chapter we will see a \nmore powerful formalism known as unification grammar that can handle the problem \nof agreement, as well as other difficulties. Furthermore, unification grammars allow a \nnatural way of attaching semantics to a parse. \n\n\f\n<a id='page-679'></a>\n\n19.8 History and References \nThere is a class of parsing algorithms known as chart parsers that explicitly cache \npartial parses and reuse them in constructing larger parses. Barley's algorithm (1970) \nis the first example, and Martin Kay (1980) gives a good overview of the field and \nintroduces a data structure, the chart, for storing substrings of a parse. Winograd \n(1983) gives a complex (five-page) specification of a chart parser. None of these \nauthors have noticed that one can achieve the same results by augmenting a simple \n(one-page) parser with memoization. In fact, it is possible to write a top-down parser \nthat is even more succinct. (See exercise 19.3 below.) \n\nFor a general overview of natural language processing, my preferences (in order) \nare Allen 1987, Winograd 1983 or Gazdar and Mellish 1989. \n\n19.9 Exercises \n&#9635; Exercise 19.2 [m-h] Experiment with the grammar and the parser. Find sentences \nit cannot parse correctly, and try to add new syntactic rules to account for them. \n\n&#9635; Exercise 19.3 [m-h] The parser works in a bottom-up fashion. Write a top-down \nparser, and compare it to the bottom-up version. Can both parsers work with the \nsame grammar? If not, what constraints on the grammar does each parsing strategy \nimpose? \n\n&#9635; Exercise 19.4 [h] Imagine an interface to a dual cassette deck. Whereas the CD \nplayer had one assumed verb, \"play,\" this unit has three explicit verb forms: \"record,\" \n\"play,\" and \"erase.\" There should also be modifiers \"from\" and \"to,\" where the object \nof a \"to\" is either 1 or 2, indicating which cassette to use, and the object of a \"from\" \nis either 1 or 2, or one of the symbols PHONO, CD, or AUX. It's up to you to design \nthe grammar, but you should allow input something like the following, where I have \nchosen to generate actual Lisp code as the meaning: \n\n> (meaning '(play 1 to 5 from CD shuffled and \nrecord 1 to 5 from CD and 1 and 3 and 7 from 1)) \n\n(PROGN (PLAY '(15 2 3 4) :FROM 'CD) \n(RECORD '(12345) :FROM 'CD) \n(RECORD '(1 3 7) :FROM .)) \n\nThis assumes that the functions play and record take keyword arguments (with \ndefaults) for : from and : to. You could also extend the grammar to accommodate an \nautomatic timer, with phrases like \"at 3:00.\" \n\n\f\n<a id='page-680'></a>\n\n&#9635; Exercise 19.5 [m] In the definition of permute, repeated here, why is the :test \n#'eq needed? \n\n(defun permute (bag) \n\"Return a random permutation of the given input list. \" \n(if (null bag) \n\nnil \n(let ((e (random-elt bag))) \n(cons e (permute (remove e bag :count 1 :test #'eq)))))) \n\n&#9635; Exercise 19.6 [m] The definition of permute takes 0{n^). Replace it by an 0 (n) \nalgorithm. \n\n19.10 Answers \nAnswer 19.1 \n\n(defun parser (words) \n\"Return all complete parses of a list of words.\" \n(let* ((table (make-array (+ (length words) 1) :initial-element 0)) \n\n(parses (parse words (length words) table))) \n(mapcar #'parse-tree (complete-parses parses)))) \n\n(defun parse (words num-words table) \n\"Bottom-up parse, returning all parses of any prefix of words.\" \n(unless (null words) \n\n(let ((ans (aref table num-words))) \n\n(if (not (eq ans 0)) \nans \n(setf (aref table num-words) \n\n(mapcan #*(lambda (rule) \n\n(extend-parse (rule-lhs rule) \n(list (firstwords)) \n(rest words) nil \n(- num-words 1) table)) \n\n(lexical-rules (first words)))))))) \n\n\f\n<a id='page-681'></a>\n\n(defun extend-parse (Ihs rhs rem needed num-words table) \n\"Look for the categories needed to complete the parse.\" \n(if (null needed) \n\nIf nothing is needed, return this parse and upward extensions \n(let ((parse (make-parse :tree (new-tree Ihs rhs) :rem rem))) \n(cons parse \n(mapcan \n#*(lambda (rule) \n\n(extend-parse (rule-lhs rule) \n(list (parse-tree parse)) \nrem (rest (rule-rhs rule)) \nnum-words table)) \n\n(rules-starting-with Ihs)))) \notherwise try to extend rightward \n(mapcan \n#'(lambda (p) \n(if (eq (parse-lhs p) (first needed)) \n\n(extend-parse Ihs (appendl rhs (parse-tree p)) \n(parse-rem p) (rest needed) \n(length (parse-rem p)) table))) \n\n(parse rem num-words table)))) \n\nIt turns out that, for the Lisp system used in the timings above, this version is no \nfaster than normal memoization. \n\nAnswer 19.3 Actually, the top-down parser is a little easier (shorter) than the \n\nbottom-up version. The problem is that the most straightforward way of imple\n\n\nmenting a top-down parser does not handle so-called left recursive rules - rules of the \n\nform(X -> (X ...)). This includes rules we've used, like (NP -> (NP and NP)). \n\nThe problem is that the parser will postulate an NP, and then postulate that it is of \n\nthe form (NP and NP), and that the first NP of that expression is of the form (NP and \n\nNP), and so on. An infinite structure of NPs is explored before even the first word is \n\nconsidered. \n\nBottom-up parsers are stymied by rules with null right-hand sides: (X -> ()) . \nNote that I was careful to exclude such rules in my grammars earlier. \n\n(defun parser (words &optional (cat *S)) \n\"Parse a list of words; return only parses with no remainder.\" \n(mapcar #*parse-tree (complete-parses (parse words cat)))) \n\n(defun parse (tokens start-symbol) \n\"Parse a list of tokens, return parse trees and remainders.\" \n(if (eq (first tokens) start-symbol) \n\n(list (make-parse rtree (first tokens) :rem (rest tokens))) \n(mapcan #*(lambda (rule) \n(extend-parse (Ihs rule) nil tokens (rhs rule))) \n(rules-for start-symbol)))) \n\n\f\n<a id='page-682'></a>\n\n(defun extend-parse (Ihs rhs rem needed) \n\"Parse the remaining needed symbols.\" \n(if (null needed) \n\n(list (make-parse :tree (cons Ihs rhs) :rem rem)) \n(mapcan \n#'(lambda (p) \n(extend-parse Ihs (append rhs (list (parse-tree p))) \n(parse-rem p) (rest needed))) \n(parse rem (first needed))))) \n\n(defun rules-for (cat) \n\"Return all the rules with category on Ihs\" \n(find-all cat ^grammar* :key #'rule-lhs)) \n\nAnswer 19.5 If it were omitted, then : tes t would default to #'eql, and it would be \npossible to remove the \"wrong\" element from the list. Consider the list (1.0 1.0) in \nan implementation where floating-point numbers are eql but not eq. if random-el t \nchooses the first 1.0 first, then everything is satisfactory - the result Ust is the same \nas the input list. However, if random-el t chooses the second 1.0, then the second \n\n1.0will be the first element of the answer, but remove will remove the wrong 1.0! It \nwill remove the first 1.0, and the final answer will be a list with two pointers to the \nsecond 1.0 and none to the first. In other words, we could have: \n> (member (first x) (permute x) .-test #'eq) \nNIL \n\nAnswer 19.6 \n\n(defun permute (bag) \n\n\"Return a random permutation of the bag.\" \nIt is done by converting the bag to a vector, but the \nresult is always the same type as the input bag. \n\n(let ((bag-copy (replace (make-array (length bag)) bag)) \n(bag-type (if (listp bag) 'list (type-of bag)))) \n(coerce (permute-vector! bag-copy) bag-type))) \n\n(defun permute-vector! (vector) \n\"Destructively permute (shuffle) the vector.\" \n(loop for i from (length vector) downto 2 do \n\n(rotatef (aref vector (-i D) \n(aref vector (random i)))) \nvector) \n\nThe answer uses rotatef, a relative of setf that swaps 2 or more values. That is, \n(rotatef a b) is like: \n\n\f\n<a id='page-683'></a>\n(let ((temp a)) \n(setf a b) \n(setf b temp) \nnil) \nRarely, rotatef is used with more than two arguments, (rotatef a b c) is like: \n(let ((temp a)) \n(setf a b) \n(setf b c) \n(setf c temp) \nnil) \n\n\f\n## Chapter 20\n<a id='page-684'></a>\n\nUnification Grammars \n\nP\nP\nrolog was invented because Alain Colmerauer wanted a formalism to describe the grammar \nof French. His intuition was that the combination of Horn clauses and unification \nresulted in a language that was just powerful enough to express the kinds of constraints \nthat show up in natural languages, while not as powerful as, for example, full predicate calculus. \nThis lack of power is important, because it enables efficient implementation of Prolog, and \nhence of the language-analysis programs built on top of it. \n\nOf course, Prolog has evolved and is now used for many applications besides natural language, \nbut Colmerauer's underlying intuition remains a good one. This chapter shows how \nto view a grammar as a set of logic programming clauses. The clauses define what is a legal \nsentence and what isn't, without any explicit reference to the process of parsing or generation. \nThe amazing thing is that the clauses can be defined in a way that leads to a very efficient \nparser. Furthermore, the same grammar can be used for both parsing and generation (at least \nin some cases). \n\n\f\n<a id='page-685'></a>\n20. 1 Parsing as Deduction \nHere's how we could express the grammar rule \"A sentence can be composed of a \nnoun phrase followed by a verb phrase\" in Prolog: \n\n(<- (S ?s) \n(NP ?np) \n(VP ?vp) \n(concat ?np ?vp ?s)) \n\nThe variables represent strings of words. As usual, they will be implemented as lists \nof symbols. The rule says that a given string of words ? s is a sentence if there is a string \nthat is noun phrase and one that is a verb phrase, and if they can be concatenated to \nform ?s. Logically, this is fine, and it would work as a program to generate random \nsentences. However, it is a very inefficient program for parsing sentences. It will \nconsider all possible noun phrases and verb phrases, without regard to the input \nwords. Only when it gets to the concat goal (defined on [page 411](chapter12.md#page-411)) will it test to see if \nthe two constituents can be concatenated together to make up the input string. Thus, \na better order of evaluation for parsing is: \n\n(<- (S ?s) \n(concat ?np ?vp ?s) \n(NP ?np) \n(VP ?vp)) \n\nThe first version had NP and VP guessing strings to be verified by concat. In most \ngrammars, there will be a very large or infinite number of NPs and VPs. This second \nversion has concat guessing strings to be verified by NP and VP. If there are . words \nin the sentence, then concat can only make . -h 1 guesses, quite an improvement. \nHowever, it would be better still if we could in effect have concat and .. work together \nto make a more constrained guess, which would then be verified by VP. \n\nWe have seen this type of problem before. In Lisp, the answer is to return multiple \nvalues. NP would be a function that takes a string as input and returns two values: \nan indication of success or failure, and a remainder string of words that have not yet \nbeen parsed. When the first value indicates success, then VP would be called with \nthe remaining string as input. In Prolog, return values are just extra arguments. So \neach predicate will have two parameters: an input string and a remainder string. \nFollowing the usual Prolog convention, the output parameter comes after the input. \nIn this approach, no calls to concat are necessary, no wild guesses are made, and \nProlog's backtracking takes care of the necessary guessing: \n\n\f\n<a id='page-686'></a>\n\n(<- (S ?sO ?s2) \n(NP ?sO ?sl) \n(VP ?sl ?s2)) \n\nThis rule can be read as \"The string from s0 to s2 is a sentence if there is an si such \nthat the string from sq to si is a noun phrase and the string from 5i to S2 is a verb \nphrase.\" \n\nA sample query would be (? - (S (The boy ate the apple) ())). With \nsuitable definitions of . . and VP, this would succeed, with the following bindings \nholding within S: \n\n?sO = (The boy ate the apple) \n\n?sl = (ate the apple) \n\n?s2 = () \n\nAnother way of reading the goal (NP ?sO ?sl), for example, is as \"IS the Hst ?sO \nminus the Ust ?sl a noun phrase?\" In this case, ?sO minus ?sl is the Ust (The boy). \nThe combination of two arguments, an input list and an output list, is often called a \ndifference list, to emphasize this interpretation. More generally, the combination of an \ninput parameter and output parameter is caUed an accumulator. Accumulators, particularly \ndifference lists, are an important technique throughout logic programming \nand are also used in functional programming, as we saw on [page 63](chapter3.md#page-63). \n\nIn our rule for S, the concatenation of difference lists was implicit. If we prefer, \nwe could define a version of concat for difference lists and call it explicitly: \n\n(<- (S ?s-in ?s-rem) \n(NP ?np-in ?np-rem) \n(VP ?vp-in ?vp-rem) \n\n(concat ?np-in ?np-rem ?vp-in ?vp-rem ?s-in ?s-rem)) \n\n(<- (concat ?a ?b ?b ?c ?a ?c)) \n\nBecause this version of concat has a different arity than the old version, they can \nsafely coexist. It states the difference list equation {a -b) -\\- {b -c) = {a - c). \n\nIn the last chapter we stated that context-free phrase-structure grammar is inconvenient \nfor expressing things like agreement between the subject and predicate of a \nsentence. With the Horn-clause-based grammar formalism we are developing here, \nwe can add an argument to the predicates NP and VP to represent agreement. In \nEnglish, the agreement rule does not have a big impact. For all verbs except be, the \ndifference only shows up in the third-person singular of the present tense: \n\n\f\n<a id='page-687'></a>\nSingular Plural \n\nfirst person I sleep we sleep \n\nsecond person you sleep you sleep \n\nthird person he/she sleeps they sleep \n\nThus, the agreement argument will take on one of the two values 3sg or ~3sg to \nindicate third-person-singular or not-third-person-singular. We could write: \n\n(<- (S ?sO ?s2) \n(NP ?agr ?sO ?sl) \n(VP ?agr ?sl ?s2)) \n\n(<- (NP 3sg (he . ?s) ?s)) \n(<- (NP ~3sg (they . ?s) ?$)) \n\n(<- (VP 3sg (sleeps . ?s) ?s)) \n(<- (VP ~3sg (sleep . Is) Is)) \n\nThis grammar parses just the right sentences: \n\n> (?- (S (He sleeps) ())) \nYes. \n\n> (?- (S (He sleep) ())) \nNo. \n\nLet's extend the grammar to allow common nouns as well as pronouns: \n\n(<- (NP ?agr ?sO ?s2) \n(Det ?agr ?sO ?sl) \n(N ?agr ?sl ?s2)) \n\n(<- (Det ?any (the . ?s) ?s)) \n(<- (N 3sg (boy . Is) Is)) \n(<- (N 3sg (girl . ?s) ?s)) \n\nThe same grammar rules can be used to generate sentences as well as parse. Here \nare all possible sentences in this trivial grammar: \n\n> (?- (S ?words ())) \n7W0RDS = (HE SLEEPS); \n7W0RDS = (THEY SLEEP); \n?WORDS = (THE BOY SLEEPS); \n7W0RDS = (THE GIRL SLEEPS); \nNo. \n\nSo far all we have is a recognizer: a predicate that can separate sentences from \n\n\f\n<a id='page-688'></a>\n\nnonsentences. But we can add another argument to each predicate to build up the \nsemantics. The result is not just a recognizer but a true parser: \n\n(<- (S (?pred ?subj) ?sO ?s2) \n\n(NP ?agr ?subj ?sO ?sl) \n\n(VP ?agr ?pred ?sl ?s2)) \n\n(<- (NP 3sg (the male) (he . ?s) ?s)) \n(<- (NP ~3sg (some objects) (they . ?s) ?s)) \n\n(<- (NP ?agr (?det ?n) ?sO ?s2) \n\n(Det ?agr ?det ?sO ?sl) \n\n(N ?agr ?n ?sl ?s2)) \n\n(<- (VP 3sg sleep (sleeps . ?s) ?s)) \n(<- (VP ~3sg sleep (sleep . ?s) ?s)) \n\n(<- (Det ?any the (the . ?s) ?s)) \n(<- (N 3sg (young male human) (boy . ?s) ?s)) \n(<- (N 3sg (young female human) (girl . ?s) ?s)) \n\nThe semantic translations of individual words is a bit capricious. In fact, it is not too \nimportant at this point if the translation of boy is (young mal e human) or just boy. \nThere are two properties of a semantic representation that are important. First, it \nshould be unambiguous. The representation of orange the fruit should be different \nfrom orange the color (although the representation of the fruit might well refer to \nthe color, or vice versa). Second, it should express generalities, or allow them to \nbe expressed elsewhere. So either sleep and sleeps should have the same or similar \nrepresentation, or there should be an inference rule relating them. Similarly, if the \nrepresentation of boy does not say so explicitly, there should be some other rule \nsaying that a boy is a male and a human. \n\nOnce the semantics of individual words is decided, the semantics of higher-level \ncategories (sentences and noun phrases) is easy. In this grammar, the semantics of \na sentence is the application of the predicate (the verb phrase) to the subject (the \nnoun phrase). The semantics of a compound noun phrase is the application of the \ndeterminer to the noun. \n\nThis grammar returns the semantic interpretation but does not build a syntactic \ntree. The syntactic structure is implicit in the sequence of goals: S calls NP and VP, \nand . . can call Det and N. If we want to make this explicit, we can provide yet another \nargument to each nonterminal: \n\n(<- (S (?pred ?subj) (s ?np ?vp)?sO ?s2) \n(NP ?agr ?subj ?np ?sO ?sl) \n(VP ?agr ?pred ?vp ?sl ?s2)) \n\n(<- (NP 3sg (the male) (np he) (he . Is) ?s)) \n(<- (NP ~3sg (some objects) (np they) (they . ?s) ?s)) \n\n\f\n<a id='page-689'></a>\n(<- (NP ?agr (?det ?n) (np ?det-syn ?n-syn) ?sO ?s2) \n(Det ?agr ?det ?det-syn ?sO ?sl) \n(N ?agr ?n ?n-syn ?sl ?s2)) \n\n(<- (VP 3sg sleep (vp sleeps) (sleeps . ?s) ?s)) \n(<- (VP \"\"Ssg sleep (vp sleep) (sleep . ?s) ?s)) \n\n(<- (Det ?any the (det the) (the . ?s) ?s)) \n(<- (N 3sg (young male human) (n boy) (boy . ?s) ?s)) \n(<- (N 3sg (young female human) (n girl) (girl . ?s) ?s)) \n\nThis grammar can still be used to parse or generate sentences, or even to enumerate \nall syntax/semantics/sentence triplets: \n\nParsing: \n> (?- (S ?sem ?syn (He sleeps) ())) \n?SEM = (SLEEP (THE MALE)) \n?SYN = (S (NP HE) (VP SLEEPS)). \n\nGenerating: \n> (?- (S (sleep (the male)) ? ?words ())) \n7W0RDS = (HE SLEEPS) \n\nEnumerating: \n> (?- (S ?sem ?syn ?words ())) \n?SEM = (SLEEP (THE MALE)) \n?SYN = (S (NP HE) (VP SLEEPS)) \n?WORDS = (HE SLEEPS); \n\n?SEM = (SLEEP (SOME OBJECTS)) \n\n?SYN = (S (NP THEY) (VP SLEEP)) \n\n7W0RDS = (THEY SLEEP); \n\n?SEM = (SLEEP (THE (YOUNG MALE HUMAN))) \n?SYN = (S (NP (DET THE) (N BOY)) (VP SLEEPS)) \n7W0RDS = (THE BOY SLEEPS); \n\n?SEM = (SLEEP (THE (YOUNG FEMALE HUMAN))) \n?SYN = (S (NP (DET THE) (N GIRD) (VP SLEEPS)) \n7W0RDS = (THE GIRL SLEEPS); \n\nNo. \n\n20.2 Definite Clause Grammars \nWe now have a powerful and efficient tool for parsing sentences. However, it is \ngetting to be a very messy tool - there are too many arguments to each goal, and it \n\n\f\n<a id='page-690'></a>\n\nis hard to tell which arguments represent syntax, which represent semantics, which \nrepresent in/out strings, and which represent other features, like agreement. So, \nwe will take the usual step when our bare programming language becomes messy: \ndefine a new language. \n\nEdinburgh Prolog recognizes assertions called definite clause grammar (DCG) rules. \nThe term definite clause is just another name for a Prolog clause, so DCGs are also \ncalled \"logic grammars.\" They could have been called \"Horn clause grammars\" or \n\"Prologgrammars\" as well. \n\nDCG rules are clauses whose main functor is an arrow, usually written - ->. They \ncompile into regular Prolog clauses with extra arguments. In normal DCG rules, only \nthe string arguments are automatically added. But we will see later how this can be \nextended to add other arguments automatically as well. \n\nWe will implement DCG rules with the macro rule and an infix arrow. Thus, we \nwant the expression: \n\n(rule (S) --> (NP) (VP)) \n\nto expand into the clause: \n\n(<- (S ?sO ?s2) \n\n(NP ?sO ?sl) \n\n(VP ?sl ?s2)) \n\nWhile we're at it, we may as well give rul e the ability to deal with different types of \nrules, each one represented by a different type of arrow. Here's the rul e macro: \n\n(defmacro rule (head &optional (arrow *:-) &body body) \n\"Expand one of several types of logic rules into pure Prolog.\" \nThis is data-driven, dispatching on the arrow \n(funcall (get arrow 'rule-function) head body)) \n\nAs an example of a rule function, the arrow: - will be used to represent normal Prolog \nclauses. That is, the form (rul e head : -body) will be equivalent to (<-head body). \n\n(setf (get *:- 'rule-function) \n#'(lambda (head body) .(<- .head .,body))) \n\nBefore writing the rule function for DCG rules, there are two further features of the \nDCG formalism to consider. First, some goals in the body of a rule may be normal \nProlog goals, and thus do not require the extra pair of arguments. In Edinburgh \nProlog, such goals are surrounded in braces. One would write: \n\n\f\n<a id='page-691'></a>\ns(Sem) --> np(Subj), vp(Pred). \n{combi ne(Subj,Pred. Sem)}. \n\nwhere the idea is that combi ne is riot a grammatical constituent, but rather a Prolog \npredicate that could do some calculations on Subj and Pred to arrive at the proper \nsemantics, Sem. We will mark such a test predicate not by brackets but by a list \nheaded by the keyword : test, as in: \n\n(rule (S ?sem) --> (NP ?subj) (VP ?pred) \n(:test (combine ?subj ?pred ?sem))) \n\nSecond, we need some way of introducing individual words on the right-hand side, \nas opposed to categories of words. In Prolog, brackets are used to represent a word \nor Ust of words on the right-hand side: \n\nverb --> [sleeps]. \n\nWe will use a list headed by the keyword : word: \n\n(rule (NP (the male) 3sg) --> (:word he)) \n(rule (VP sleeps 3sg) --> (:word sleeps)) \n\nThe following predicates test for these two special cases. Note that the cut is also \nallowed as a normal goal. \n\n(defun dcg-normal-goal-p (x) (or (starts-with . :test) (eq . '!))) \n(defun dcg-word-list-p (x) (starts-with . 'iword)) \n\nAt last we are in a position to present the rule function for DCG rules. The function \nmake-deg inserts variables to keep track of the strings that are being parsed. \n\n(setf (get '--> 'rule-function) 'make-dcg) \n\n(defun make-dcg (head body) \n(let ((n (count-if (complement #'dcg-normal-goal-p) body))) \n.(<- (,@head ?sO .(symbol *?s n)) \n.,(make-dcg-body body 0)))) \n\n\f\n<a id='page-692'></a>\n\n(defun make-dcg-body (body n) \n\"Make the body of a Definite Clause Grammar (DCG) clause. \nAdd ?string-in and -out variables to each constituent. \nGoals like (:test goal) are ordinary Prolog goals, \nand goals like (:word hello) are literal words to be parsed.\" \n(if (null body) \n\nnil \n(let ((goal (first body))) \n\n(cond \n((eq goal '!) (cons . (make-dcg-body (rest body) n))) \n((dcg-normal-goal-p goal) \n\n(append (rest goal) \n(make-dcg-body (rest body) n))) \n((dcg-word-list-p goal) \n(cons \n'(= .(symbol 'Is n) \n(.(rest goal) ..(symbol '?s (+ . 1)))) \n(make-dcg-body (rest body) (+ . 1)))) \n(t (cons \n(append goal \n(list (symbol '?s n) \n(symbol '?s (+ . 1)))) \n(make-dcg-body (rest body) (+ . 1)))))))) \n\n&#9635; Exercise 20.1 [m] make - dcg violates one of the cardinal rules of macros. What does \nit do wrong? How would you fix it? \n\n20.3 A Simple Grammar in DCG Format \nHere is the trivial grammar from [page 688](chapter20.md#page-688) in DCG format. \n\n(rule (S (?pred ?subj)) --> \n(NP ?agr ?subj) \n(VP ?agr ?pred)) \n\n(rule (NP ?agr (?det ?n)) --> \n(Det ?agr ?det) \n(N ?agr ?n)) \n\n\f\n<a id='page-693'></a>\n\n(rule (NP 3sg (the male)) --> (:word he)) \n\n(rule (NP ~3sg (some objects)) --> (:word they)) \n\n(rule (VP 3sg sleep) --> (:word sleeps)) \n\n(rule (VP ~3sg sleep) --> (:word sleep)) \n\n(rule (Det ?any the) --> (:word the)) \n\n(rule (N 3sg (young male human)) --> (:word boy)) \n\n(rule (N 3sg (young female human)) --> (:word girl)) \n\nThis grammar is quite limited, generating only four sentences. The first way we will \nextend it is to allow verbs with objects: in addition to \"The boy sleeps,\" we will allow \n\"The boy meets the girl.\" To avoid generating ungrammatical sentences like \"* The \nboy meets,\"^ we will separate the category of verb into two subcategories: transitive \nverbs, which take an object, and intransitive verbs, which don't. \n\nTransitive verbs complicate the semantic interpretation of sentences. We would \nliketheinterpretationof \"Terry kisses Jean\" tobe (kiss Terry Jean). The interpretation \nof the noun phrase \"Terry\" is just Te r ry, but then what should the interpretation \nof the verb phrase \"kisses Jean\" be? To fit our predicate application model, it must \nbe something equivalent to (lambda (x) (kiss . Jean)). When applied to the \nsubject, we want to get the simplification: \n\n((lambda (x) (kiss . Jean)) Terry) => (kiss Terry Jean) \n\nSuch simplification is not done automatically by Prolog, but we can write a predicate \nto do it. We will call it funcall, because it is similar to the Lisp function of that name, \nalthough it only handles replacement of the argument, not full evaluation of the \nbody. (Technically, this is the lambda-calculus operation known as beta-reduction.) \nThe predicate funcall is normally used with two input arguments, a function and its \nargument, and one output argument, the resulting reduction: \n\n(<- (funcall (lambda (?x) ?body) ?x ?body)) \n\nWith this we could write our rule for sentences as: \n\n(rule (S ?sem) --> \n(NP ?agr ?subj) \n(VP ?agr ?pred) \n(:test (funcall ?pred ?subj ?sem))) \n\nAn alternative is to, in effect, compile away the call to funcall. Instead of having the \nsemantic representation of VP be a single lambda expression, we can represent it as \n\n^The asterisk at the start of a sentence is the standard linguistic notation for an utterance \nthat is ungrammatical or otherwise ill-formed. \n\n\f\n<a id='page-694'></a>\n\ntwo arguments: an input argument, ?subj, which acts as a parameter to the output \nargument, ?pred, which takes the place of the body of the lambda expression. By \nexplicitly manipulating the parameter and body, we can eliminate the call to funcall. \nThe trick is to make the parameter and the subject one and the same: \n\n(rule (S ?pred) --> \n(NP ?agr ?subj) \n(VP ?agr ?subj ?pred)) \n\nOne way of reading this rule is \"To parse a sentence, parse a noun phrase followed \nbya verb phrase. If they have different agreement features then fail, but otherwise \ninsert the interpretation of the noun phrase, ?subj, into the proper spot in the \ninterpretation of the verb phrase, ?pred, and return ?pred as the final interpretation \nof the sentence.\" \n\nThe next step is to write rules for verb phrases and verbs. Transitive verbs are \nUsted under the predicate Verb/tr, and intransitive verbs are Usted as Verb/intr. \nThe semantics of tenses (past and present) has been ignored. \n\n(rule (VP ?agr ?subj ?pred) --> \n(Verb/tr ?agr ?subj ?pred ?obj) \n(NP ?any-agr ?obj)) \n\n(rule (VP ?agr ?subj ?pred) --> \n(Verb/intr ?agr ?subj ?pred)) \n\n(rule (Verb/tr ~3sg ?x (kiss ?x ?y) ?y) --> (iword kiss)) \n(rule (Verb/tr 3sg ?x (kiss ?x ?y) ?y) --> (:word kisses)) \n(rule (Verb/tr ?any ?x (kiss ?x ?y) ?y) --> (:word kissed)) \n\n(rule (Verb/intr ~3sg ?x (sleep ?x)) --> (iword sleep)) \n(rule (Verb/intr 3sg ?x (sleep ?x)) --> (iword sleeps)) \n(rule (Verb/intr ?any ?x (sleep ?x)) --> (:word slept)) \n\nHere are the rules for noun phrases and nouns: \n\n(rule (NP ?agr ?sem) --> \n(Name ?agr ?sem)) \n\n(rule (NP ?agr (?det-sem ?noun-sem)) --> \n(Det ?agr ?det-sem) \n(Noun ?agr ?noun-sem)) \n\n(rule (Name 3sg Terry) --> (iword Terry)) \n(rule (Name 3sg Jean) --> (iword Jean)) \n\n\f\n<a id='page-695'></a>\n(rule (Noun 3sg (young male human)) --> (:word boy)) \n(rule (Noun 3sg (young female human)) --> (rword girl)) \n(rule (Noun ~3sg (group (young male human))) --> (:word boys)) \n(rule (Noun ~3sg (group (young female human))) --> (:word girls)) \n\n(rule (Det ?any the) --> (:word the)) \n(rule (Det 3sg a) --> (rword a)) \n\nThis grammar and lexicon generates more sentences, although it is still rather limited. \nHere are some examples: \n\n> (?- (S ?sem (The boys kiss a girl) ())) \n?SEM = (KISS (THE (GROUP (YOUNG MALE HUMAN))) \n(A (YOUNG FEMALE HUMAN))). \n\n> (?- (S ?sem (The girls kissed the girls) ())) \n?SEM = (KISS (THE (GROUP (YOUNG FEMALE HUMAN))) \n(THE (GROUP (YOUNG FEMALE HUMAN)))). \n\n> (?- (S ?sem (Terry kissed the girl) ())) \n?SEM = (KISS TERRY (THE (YOUNG FEMALE HUMAN))). \n\n> (?- (S ?sem (The girls kisses the boys) ())) \nNo. \n\n> (?- (S ?sem (Terry kissed a girls) ())) \nNo. \n\n> (?- (S ?sem (Terry sleeps Jean) ())) \nNo. \n\nThe first three examples are parsed correctly, while the final three are correctly \nrejected. The inquisitive reader may wonder just what is going on in the interpretation \nof a sentence like \"The girls kissed the girls.\" Do the subject and object represent the \nsame group of girls, or different groups? Does everyone kiss everyone, or are there \nfewer kissings going on? Until we define our representation more carefully, there is no \nway to tell. Indeed, it seems that there is a potential problem in the representation, in \nthat the predicate ki ss sometimes has individuals as its arguments, and sometimes \ngroups. More careful representations of \"The girls kissed the girls\" include the \nfollowing candidates, using predicate calculus: \n\nVxVy xegirls . yegirls => kiss(x,y) \nVxVy xegirls . yegirls . x^^y => kiss(x,y) \nVx3y,z xegirls . yegirls . zegirls => kiss(x,y) . kiss(z,x) \nVx3y xegirls . yegirls => kiss(x,y) V kiss(y,x) \n\nThe first of these says that every girl kisses every other girl. The second says the same \nthing, except that a girl need not kiss herself. The third says that every girl kisses \n\n\f\n<a id='page-696'></a>\n\nand is kissed by at least one other girl, but not necessarily all of them, and the fourth \nsays that everbody is in on at least one kissing. None of these interpretations says \nanything about who \"the girls\" are. \n\nClearly, the predicate calculus representations are less ambiguous than the representation \nproduced by the current system. On the other hand, it would be wrong \nto choose one of the representations arbitrarily, since in different contexts, \"The girls \nkissed the girls\" can mean different things. Maintaining ambiguity in a concise form \nis useful, as long as there is some way eventually to recover the proper meaning. \n\n20.4 A DCG Grammar with Quantifiers \nThe problem in the representation we have been using becomes more acute when we \nconsider other determiners, such as \"every.\" Consider the sentence \"Every picture \npaints a story.\" The preceding DCG, if given the right vocabulary, would produce \nthe interpretation: \n\n(paints (every picture) (a story)) \n\nThis can be considered ambiguous between the following two meanings, in predicate \ncalculus form: \n\nVX picture(x) 3 y story(y) . paint(x,y) \n3 y story(y) . V . picture(x) => paint(x,y) \n\nThe first says that for each picture, there is a story that it paints. The second says that \nthere is a certain special story that every picture paints. The second is an unusual \ninterpretation for this sentence, but for \"Every U.S. citizen has a president,\" the \nsecond interpretation is perhaps the preferred one. In the next section, we will see \nhow to produce representations that can be transformed into either interpretation. \nFor now, it is a useful exercise to see how we could produce just the first representation \nabove, the interpretation that is usually correct. First, we need to transcribe it into \nLisp: \n\n(all ?x (-> (picture ?x) (exists ?y (and (story ?y) (paint ?x ?y))))) \n\nThe first question is how the a 11 and exi sts forms get in there. They must come from \nthe determiners, \"every\" and \"a.\" Also, it seems that a 11 is followed by an implication \narrow, ->, while exi sts is followed by a conjunction, and. So the determiners will \nhave translations looking like this: \n\n\f\n<a id='page-697'></a>\n(rule (Det ?any ?x ?p ?q (the ?x (and ?p ?q))) --> (:word the)) \n(rule (Det 3sg ?x ?p ?q (exists ?x (and ?p ?q))) --> (:word a)) \n(rule (Det 3sg ?x ?p ?q (all ?x (-> ?p ?q))) --> (:word every)) \n\nOnce we have accepted these translations of the determiners, everything else follows. \nThe formulas representing the determiners have two holes in them, ?p and ?q. The \nfirst will be filled by a predicate representing the noun, and the latter will be filled \nby the predicate that is being applied to the noun phrase as a whole. Notice that a \ncurious thing is happening. Previously, translation to logical form was guided by \nthe sentence's verb. Linguisticly, the verb expresses the main predicate, so it makes \nsense that the verb's logical translation should be the main part of the sentence's \ntranslation. In linguistic terms, we say that the verb is the head of the sentence. \n\nWith the new translations for determiners, we are in effect turning the whole \nprocess upside down. Now the subject's determiner carries the weight of the whole \nsentence. The determiner's interpretation is a function of two arguments; it is applied \nto the noun first, yielding a function of one argument, which is in turn applied to the \nverb phrase's interpretation. This primacy of the determiner goes against intuition, \nbut it leads directly to the right interpretation. \n\nThe variables ?p and ?q can be considered holes to be filled in the final interpretation, \nbut the variable ?x fills a quite different role. At the end of the parse, ?x will \nnot be filled by anything; it will still be a variable. But it will be referred to by the \nexpressions filling ?p and ?q. We say that ?x is a metavariable, because it is a variable \nin the representation, not a variable in the Prolog implementation. It just happens \nthat Prolog variables can be used to implement these metavariables. \n\nHere are the interpretations for each word in our target sentence and for each \nintermediate constituent: \n\nEvery = (all ?x (-> ?pl ?ql)) \npicture = (picture ?x) \npaints = (paint ?x ?y) \na = (exists ?y (and ?p2 ?q2)) \nstory = (story ?y) \n\nEvery picture = (all ?x (-> (picture ?x) ?ql)) \na story = (exists ?y (and (story ?y) ?q2)) \npaints a story = (exists ?y (and (story ?y) (paint ?x ?y))) \n\nThe semantics of a noun has to fill the ?p hole of a determiner, possibly using the \nmetavariable ?x. The three arguments to the Noun predicate are the agreement, the \nmetavariable ?x, and the assertion that the noun phrase makes about ?x: \n\n\f\n<a id='page-698'></a>\n\n(rule (Noun 3sg ?x (picture ?x)) --> (:word picture)) \n(rule (Noun 3sg ?x (story ?x)) --> (:word story)) \n(rule (Noun 3sg ?x (and (young ?x) (male ?x) (human ?x))) --> \n\n(iword boy)) \n\nThe NP predicate is changed to take four arguments. First is the agreement, then \nthe metavariable ?x. Third is a predicate that will be supplied externally, by the verb \nphrase. The final argument returns the interpretation of the NP as a whole. As we \nhave stated, this comes from the determiner: \n\n(rule (NP ?agr ?x ?pred ?pred) --> \n(Name ?agr ?name)) \n\n(rule (NP ?agr ?x ?pred ?np) --> \n(Det ?agr ?x ?noun ?pred ?np) \n(Noun ?agr ?x ?noun)) \n\nThe rule for an NP with determiner is commented out because it is convenient to \nintroduce an extended rule to replace it at this point. The new rule accounts for \ncertain relative clauses, such as \"the boy that paints a picture\": \n\n(rule (NP ?agr ?x ?pred ?np) --> \n(Det ?agr ?x ?noun&rel ?pred ?np) \n(Noun ?agr ?x ?noun) \n(rel-clause ?agr ?x ?noun ?noun&rel)) \n\n(rule (rel-clause ?agr ?x ?np ?np) --> ) \n\n(rule (rel-clause ?agr ?x ?np (and ?np ?rel)) --> \n(iword that) \n(VP ?agr ?x ?rel)) \n\nThe new rule does not account for relative clauses where the object is missing, such \nas \"the picture that the boy paints.\" Nevertheless, the addition of relative clauses \nmeans we can now generate an infinite language, since we can always introduce a \nrelative clause, which introduces a new noun phrase, which in turn can introduce \nyet another relative clause. \n\nThe rules for relative clauses are not complicated, but they can be difficult to \nunderstand. Of the four arguments to rel -clause, the first two hold the agreement \nfeatures of the head noun and the metavariable representing the head noun. \nThe last two arguments are used together as an accumulator for predications about \nthe metavariable: the third argument holds the predications made so far, and the \nfourth will hold the predications including the relative clause. So, the first rule for \nrel -cl ause says that if there is no relative clause, then what goes in to the accumulator \nis the same as what goes out. The second rule says that what goes out is the \nconjunction of what comes in and what is predicated in the relative clause itself. \n\n\f\n<a id='page-699'></a>\nVerbs apply to either one or two metavariables, just as they did before. So we can \nuse the definitions of Verb/tr and Verb/i ntr unchanged. For variety, I've added a \nfew more verbs: \n\n(rule (Verb/tr ~3sg ?x ?y (paint ?x ?y)) --> (rword paint)) \n(rule (Verb/tr 3sg ?x ?y (paint ?x ?y)) --> (iword paints)) \n(rule (Verb/tr ?any ?x ?y (paint ?x ?y)) --> (.-word painted)) \n\n(rule (Verb/intr ''3sg ?x (sleep ?x)) --> (:word sleep)) \n(rule (Verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps)) \n(rule (Verb/intr ?any ?x (sleep ?x)) --> (:word slept)) \n\n(rule (Verb/intr 3sg ?x (sells ?x)) --> (:word sells)) \n\n(rule (Verb/intr 3sg ?x (stinks ?x)) --> (:word stinks)) \n\nVerb phrases and sentences are almost as before. The only difference is in the call to \nNP, which now has extra arguments: \n\n(rule (VP ?agr ?x ?vp) --> \n(Verb/tr ?agr ?x ?obj ?verb) \n(NP ?any-agr ?obj ?verb ?vp)) \n\n(rule (VP ?agr ?x ?vp) --> \n(Verb/intr ?agr ?x ?vp)) \n\n(rule (S ?np) --> \n(NP ?agr ?x ?vp ?np) \n(VP ?agr ?x ?vp)) \n\nWith this grammar, we get the following correspondence between sentences and \nlogical forms: \n\nEvery picture paints a story. \n(ALL ?3 (-> (PICTURE ?3) \n(EXISTS ?14 (AND (STORY ?14) (PAINT ?3 ?14))))) \n\nEvery boy that paints a picture sleeps. \n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3)) \n(EXISTS ?19 (AND (PICTURE ?19) \n(PAINT ?3 ?19)))) \n(SLEEP ?3))) \n\nEvery boy that sleeps paints a picture. \n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3)) \n(SLEEP ?3)) \n(EXISTS ?22 (AND (PICTURE ?22) (PAINT ?3 ?22))))) \n\n\f\n<a id='page-700'></a>\n\nEvery boy that paints a picture that sells \npaints a picture that stinks. \n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3)) \n\n(EXISTS ?19 (AND (AND (PICTURE ?19) (SELLS ?19)) \n(PAINT ?3 ?19)))) \n(EXISTS ?39 (AND (AND (PICTURE ?39) (STINKS ?39)) \n(PAINT ?3 ?39))))) \n\n20.5 Preserving Quantifier Scope Ambiguity \nConsider the simple sentence \"Every man loves a woman.\" This sentence is ambiguous \nbetween the following two interpretations: \n\nVm3w man(m) . woman(w) . loves(m,w) \n3wVm man(m) . woman(w) . Ioves(m,w) \n\nThe first interpretation is that every man loves some woman - his wife, perhaps. \nThe second interpretation is that there is a certain woman whom every man loves - \nNatassja Kinski, perhaps. The meaning of the sentence is ambiguous, but the structure \nis not; there is only one syntactic parse. \n\nIn the last section, we presented a parser that would construct one of the two \ninterpretations. In this section, we show how to construct a single interpretation \nthat preserves the ambiguity, but can be disambiguated by a postsyntactic process. \nThe basic idea is to construct an intermediate logical form that leaves the scope of \nquantifiers unspecified. This intermediate form can then be rearranged to recover \nthe final interpretation. \n\nTo recap, here is the interpretation we would get for \"Every man loves a woman,\" \ngiven the grammar in the previous section: \n\n(all ?m (-> (man ?m) (exists ?w) (and (woman ?w) (loves ?m ?w)))) \n\nWe will change the grammar to produce instead the intermediate form: \n\n(and (all ?m (man ?m)) \n(exists ?w (wowan ?w)) \n(loves ?m ?w)) \n\nThe difference is that logical components are produced in smaller chunks, with \nunscoped quantifiers. The typical grammar rule will build up an interpretation by \nconjoining constituents with and, rather than by fitting pieces into holes in other \n\n\f\n<a id='page-701'></a>\npieces. Here is the complete grammar and a just-large-enough lexicon in the new \nformat: \n\n(rule (S (and ?np ?vp)) --> \n(NP ?agr ?x ?np) \n(VP ?agr ?x ?vp)) \n\n(rule (VP ?agr ?x (and ?verb ?obj)) --> \n(Verb/tr ?agr ?x ?o ?verb) \n(NP ?any-agr ?o ?obj)) \n\n(rule (VP ?agr ?x ?verb) --> \n(Verb/intr ?agr ?x ?verb)) \n\n(rule (NP ?agr ?name t) --> \n(Name ?agr ?name)) \n\n(rule (NP ?agr ?x ?det) --> \n(Det ?agr ?x (and ?noun ?rel) ?det) \n(Noun ?agr ?x ?noun) \n(rel-clause ?agr ?x ?rel)) \n\n(rule (rel-clause ?agr ?x t) --> ) \n\n(rule (rel-clause ?agr ?x ?rel) --> \n(:word that) \n(VP ?agr ?x ?rel)) \n\n(rule (Name 3sg Terry) --> (:word Terry)) \n(rule (Name 3sg Jean) --> (:word Jean)) \n(rule (Det 3sg ?x ?restr (all ?x ?restr)) --> (:word every)) \n(rule (Noun 3sg ?x (man ?x)) --> (:word man)) \n(rule (Verb/tr 3sg ?x ?y (love ?x ?y)) --> (iword loves)) \n(rule (Verb/intr 3sg ?x (lives ?x)) --> (iword lives)) \n(rule (Det 3sg ?x ?res (exists ?x ?res)) --> (iword a)) \n(rule (Noun 3sg ?x (woman ?x)) --> (iword woman)) \n\nThis gives us the following parse for \"Every man loves a woman\": \n\n(and (all ?4 (and (man ?4) t)) \n(and (love ?4 ?12) (exists ?12 (and (woman ?12) t)))) \n\nIf we simplified this, eliminating the ts and joining ands, we would get the desired \nrepresentation: \n\n(and (all ?m (man ?m)) \n(exists ?w (wowan ?w)) \n(loves ?m ?w)) \n\nFrom there, we could use what we know about syntax, in addition to what we know \n\n\f\n<a id='page-702'></a>\n\nabout men, woman, and loving, to determine the most likely final interpretation. \nThis will be covered in the next chapter. \n\n20.6 Long-Distance Dependencies \nSo far, every syntactic phenomena we have considered has been expressible in a \nrule that imposes constraints only at a single level. For example, we had to impose \nthe constraint that a subject agree with its verb, but this constraint involved two \nimmediate constituents of a sentence, the noun phrase and verb phrase. We didn't \nneed to express a constraint between, say, the subject and a modifier of the verb's \nobject. However, there are linguistic phenomena that require just these kinds of \nconstraints. \n\nOur rule for relative clauses was a very simple one: a relative clause consists of the \nword \"that\" followed by a sentence that is missing its subject, as in \"every man that \nloves a woman.\" Not all relative clauses follow this pattern. It is also possible to form \na relative clause by omitting the object of the embedded sentence: \"every man that a \nwoman loves In this sentence, the symbol u indicates a gap, which is understood \nas being filled by the head of the complete noun phrase, the man. This has been \ncalled a filler-gap dependency. It is also known as a long-distance dependency, because \nthe gap can occur arbitrarily far from the filler. For example, all of the following are \nvalid noun phrases: \n\nThe person that Lee likes u \n\nThe person that Kim thinks Lee likes ' \n\nThe person that Jan says Kim thinks Lee likes u \n\nIn each case, the gap is filled by the head noun, the person. But any number of relative \nclauses can intervene between the head noun and the gap. \n\nThe same kind of filler-gap dependency takes place in questions that begin with \n\"who,\" \"what,\" \"where,\" and other interrogative pronouns. For example, we can ask \na question about the subject of a sentence, as in \"Who likes Lee?\", or about the object, \nas in \"Who does Kim like '?\" \n\nHere is a grammar that covers relative clauses with gapped subjects or objects. \nThe rules for S, VP, and .. are augmented with a pair of arguments representing \nan accumulator for gaps. Like a difference list, the first argument minus the second \nrepresents the presence or absence of a gap. For example, in the first two rules for \nnoun phrases, the two arguments are the same, ?gO and ?gO. This means that the rule \nas a whole has no gap, since there can be no difference between the two arguments. \nIn the third rule for NP, the first argument is of the form (gap ...), and the second \nis nogap. This means that the right-hand side of the rule, an empty constituent, can \nbe parsed as a gap. (Note that if we had been using true difference lists, the two \n\n\f\n<a id='page-703'></a>\n\narguments would be ((gap ...) ?gO) and ?gO. But since we are only dealing with \none gap per rule, we don't need true difference lists.) \n\nThe rule for S says that a noun phrase with gap ?gO minus ?gl followed by a verb \nphrase with gap ?gl minus ?g2 comprise a sentence with gap ?gO minus ?g2. The \nrule for relative clauses finds a sentence with a gap anywhere; either in the subject \nposition or embedded somewhere in the verb phrase. Here's the complete grammar: \n\n(rule (S ?gO ?g2 (and ?np ?vp)) --> \n(NP ?gO ?gl ?agr ?x ?np) \n(VP ?gl ?g2 ?agr ?x ?vp)) \n\n(rule (VP ?gO ?gl ?agr ?x (and ?obj ?verb)) --> \n(Verb/tr ?agr ?x ?o ?verb) \n(NP ?gO ?gl ?any-agr ?o ?obj)) \n\n(rule (VP ?gO ?gO ?agr ?x ?verb) --> \n(Verb/intr ?agr ?x ?verb)) \n\n(rule (NP ?gO ?gO ?agr ?name t) --> \n(Name ?agr ?name)) \n\n(rule (NP ?gO ?gO ?agr ?x ?det) --> \n(Det ?agr ?x (and ?noun ?rel) ?det) \n(Noun ?agr ?x ?noun) \n(rel-clause ?agr ?x ?rel)) \n\n(rule (NP (gap NP ?agr ?x) nogap ?agr ?x t) --> ) \n\n(rule (rel-clause ?agr ?x t) --> ) \n\n(rule (rel-clause ?agr ?x ?rel) --> \n(:word that) \n\n(S (gap NP ?agr ?x) nogap ?rel)) \n\nHere are some sentence/parse pairs covered by this grammar: \nEvery man that ' loves a woman likes a person. \n(AND (ALL ?28 (AND (MAN ?28) \n(AND . (AND (LOVE ?28 ?30) \n(EXISTS ?30 (AND (WOMAN ?30) \nT)))))) \n(AND (EXISTS ?39 (AND (PERSON ?39) T)) (LIKE ?28 ?39))) \n\nEvery man that a woman loves yUkes a person. \n(AND (ALL ?37 (AND (MAN ?37) \n(AND (EXISTS ?20 (AND (WOMAN ?20) T)) \n(AND . (LOVE ?20 137))))) \n(AND (EXISTS ?39 (AND (PERSON ?39) T)) (LIKE ?37 ?39))) \n\n\f\n<a id='page-704'></a>\n\nEvery man that loves a bird that u^Hes likes a person. \n(AND (ALL ?28 (AND (MAN ?28) \n(AND . (AND (EXISTS ?54 \n(AND (BIRD ?54) \n(AND . (FLY ?54)))) \n(LOVE ?28 ?54))))) \n(AND (EXISTS ?60 (AND (PERSON ?60) T)) (LIKE ?28 ?60))) \n\nActually, there are limitations on the situations in which gaps can appear. In particular, \nit is rare to have a gap in the subject of a sentence, except in the case of a relative \nclause. In the next chapter, we will see how to impose additional constraints on gaps. \n\n20.7 Augmenting DCG Rules \nIn the previous section, we saw how to build up a semantic representation of a \nsentence by conjoining the semantics of the components. One problem with this \napproach is that the semantic interpretation is often something of the form (and \n(and t a) when we would prefer (and ab). There are two ways to correct \nthis problem: either we add a step that takes the final semantic interpretation and \nsimplifies it, or we complicate each individual rule, making it generate the simplified \nform. The second choice would be slightly more efficient, but would be very ugly \nand error prone. We should be doing all we can to make the rules simpler, not more \ncomplicated; that is the whole point of the DCG formalism. This suggests a third \napproach: change the rule interpreter so that it automatically generates the semantic \ninterpretation as a conjunction of the constituents, unless the rule explicitly says \notherwise. This section shows how to augment the DCG rules to handle common \ncases like this automatically. \n\nConsider again a rule from section 20.4: \n\n(rule (S (and ?np ?vp))--> \n(NP ?agr ?x ?np) \n(VP ?agr ?x ?vp)) \n\nIf we were to alter this rule to produce a simplified semantic interpretation, it would \nlook like the following, where the predicate and* simplifies a list of conjunctions into \na single conjunction: \n\n\f\n<a id='page-705'></a>\n(rule (S ?sem) --> \n(np ?agr ?x ?np) \n(vp ?agr ?x ?vp) \n(:test (ancl*(?np ?vp) ?sem))) \n\nMany rules will have this form, so we adopt a simple convention: if the last argument \nof the constituent on the left-hand side of a rule is the keyword : sem, then we will \nbuild the semantics by replacing : sem with a conjunction formed by combining all \nthe last arguments of the constituents on the right-hand side of the rule. A==> arrow \nwill be used for rules that follow this convention, so the following rule is equivalent \nto the one above: \n\n(rule (S :sem) ==> \n(NP ?agr ?x ?np) \n(VP ?agr ?x ?vp)) \n\nIt is sometimes useful to introduce additional semantics that does not come from one \nof the constituents. This can be indicated with an element of the right-hand side that \nis a list starting with : sem. For example, the following rule adds to the semantics the \nfact that ?x is the topic of the sentence: \n\n(rule (S ;sem) ==> \n(NP ?agr ?x ?np) \n(VP ?agr ?x ?vp) \n(:sem (topic ?x))) \n\nBefore implementing the rule function for the ==> arrow, it is worth considering if \nthere are other ways we could make things easier for the rule writer. One possibility is \nto provide a notation for describing examples. Examples make it easier to understand \nwhat a rule is designed for. For the S rule, we could add examples like this: \n\n(rule (S :sem) ==> \n(:ex \"John likes Mary\" \"He sleeps\") \n(NP ?agr ?x ?np) \n(VP ?agr ?x ?vp)) \n\nThese examples not only serve as documentation for the rule but also can be stored \nunder S and subsequently run when we want to test if S is in fact implemented \nproperly. \n\nAnother area where the rule writer could use help is in handling left-recursive \n\nrules. Consider the rule that says that a sentence can consist of two sentences joined \n\nby a conjunction: \n\n\f\n<a id='page-706'></a>\n\n(rule (S (?conj ?sl ?s2)) ==> \n(:ex \"John likes Mary and Mary likes John\") \n(S ?sl) \n(Conj ?conj) \n(S ?s2)) \n\nWhile this rule is correct as a declarative statement, it will run into difficulty when \nrun by the standard top-down depth-first DCG interpretation process. The top-level \ngoal of parsing an S will lead immediately to the subgoal of parsing an S, and the \nresult will be an infinite loop. \n\nFortunately, we know how to avoid this kind of infinite loop: split the offending \npredicate, S, into two predicates: one that supports the recursion, and one that is at \na lower level. We will call the lower-level predicate S_. Thus, the following rule says \nthat a sentence can consist of two sentences, where the first one is not conjoined and \nthe second is possibly conjoined: \n\n(rule (S (?conj ?sl ?s2)) ==> \n\n(S- ?sl) \n\n(Conj ?conj) \n\n(S ?s2)) \n\nWe also need a rule that says that a possibly conjoined sentence can consist of a \nnonconjoined sentence: \n\n(rule (S ?sem) ==> (S_ ?sem)) \n\nTo make this work, we need to replace any mention of S in the left-hand side of a rule \nwith S_. References to S in the right-hand side of rules remain unchanged. \n\n(rule (S_ ?sem) ==> ...) \n\nTo make this all automatic, we will provide a macro, conj-rule, that declares a \ncategory to be one that can be conjoined. Such a declaration will automatically \ngenerate the recursive and nonrecursive rules for the category, and will insure that \nfuture references to the category on the left-hand side of a rule will be replaced with \nthe corresponding lower-level predicate. \n\nOne problem with this approach is that it imposes a right-branching parse on \nmultiple conjoined phrases. That is, we will get parses like \"spaghetti and (meatballs \nand salad)\" not \"(spaghetti and meatballs) and salad.\" Clearly, that is the wrong \ninterpretation for this sentence. Still, it can be argued that it is best to produce \na single canonical parse, and then let the semantic interpretation functions worry \nabout rearranging the parse in the right order. We will not attempt to resolve this \n\n\f\n<a id='page-707'></a>\ndebate but will provide the automatic conjunction mechanism as a tool that can be \nconvenient but has no cost for the user who prefers a different solution. \n\nWe are now ready to implement the extended DCG rule formalism that handles \n:sem, :ex, and automatic conjunctions. The function make-augmented-dcg, stored \nunder the arrow = =>, will be used to implement the formalism: \n\n(setf (get '==> 'rule-function) 'make-augmented-dcg) \n\n(defun make-augmented-dcg (head body) \n\"Build an augmented DCG rule that handles :sem. :ex, \nand automatic conjunctiontive constituents.\" \n(if (eq (lastl head) :sem) \n\n;; Handle :sem \n\n(let* ((?sem (gensym \"?SEM\"))) \n\n(make-augmented-dcg \n'(.(butlast head) .?sem) \n'(.(remove :sem body :key #'first-or-nil) \n\n(:test .(collect-sems body ?sem))))) \nSeparate out examples from body \n(multiple-value-bind (exs new-body) \n(partition-if #'(lambda (x) (starts-with . :ex)) body) \nHandle conjunctions \n(let ((rule '(rule .(handle-conj head) --> .new-body))) \n\n(if (null exs) \nrule \n'(progn (:ex .head ..(mappend #'rest exs)) \n\n.rule)))))) \n\nFirst we show the code that collects together the semantics of each constituent and \nconjoins them when :sem is specified. The function collect-sems picks out the \nsemantics and handles the trivial cases where there are zero or one constituents on \nthe right-hand side. If there are more than one, it inserts a call to the predicate and*. \n\n(defun collect-sems (body ?sem) \n\"Get the semantics out of each constituent in body, \nand combine them together into ?sem.\" \n(let ((sems (loop for goal in body \n\nunless (or (dcg-normal-goal-p goal) \n(dcg-word-list-p goal) \n(starts-with goal :ex) \n(atom goal)) \n\ncollect (lastl goal)))) \n\n(case (length sems) \n(0 '(= .?sem t)) \n(1 '(= .?sem .(first sems))) \n(t '(and* .sems .?sem))))) \n\n\f\n<a id='page-708'></a>\n\nWe could have implemented and* with Prolog clauses, but it is slightly more efficient \nto do it directly in Lisp. A call to conjuncts collects all the conjuncts, and we then \nadd an and if necessary: \n\n(defun and*/2 (in out cont) \n\"IN is a list of conjuncts that are conjoined into OUT.\" \nE.g.: (and* (t (and a b) t (and c d) t) ?x) ==> \n;; ?x= (and abed) \n(if (unify! out (maybe-add 'and (conjuncts (cons 'and in)) t)) \n(funcall cont))) \n\n(defun conjuncts (exp) \n\"Get all the conjuncts from an expression.\" \n(deref exp) \n(cond ((eq exp t) nil) \n\n((atom exp) (list exp)) \n((eq (deref (first exp)) 'nil) nil) \n((eq (first exp) 'and) \n\n(mappend #'conjuncts (rest exp))) \n(t (list exp)))) \n\nThe next step is handling example phrases. The code in make-augmented-dcg turns \nexamples into expressions of the form: \n\n(:ex (S ?sem) \"John likes Mary\" \"He sleeps\") \n\nTo make this work, : ex will have to be a macro: \n\n(defmacro :ex ((category . args) &body examples) \n\"Add some example phrases, indexed under the category.\" \n'(add-examples ',category ',args ',examples)) \n\n: ex calls add-exampl es to do all the work. Each example is stored in a hash table \nindexed under the the category. Each example is transformed into a two-element list: \nthe example phrase string itself and a call to the proper predicate with all arguments \nsupplied. The function add-exampl es does this transformation and indexing, and \nrun-examples retrieves the examples stored under a category, prints each phrase, \nand calls each goal. The auxiliary functions get-exampl es and cl ear-exampl es are \nprovided to manipulate the example table, and remove-punction, punctuation-p \nand stri ng ->1 i st are used to map from a string to a Hst of words. \n\n(defvar *examples* (make-hash-table :test #'eq)) \n\n(defun get-examples (category) (gethash category *examples*)) \n\n(defun clear-examples () (clrhash *examples*)) \n\n\f\n<a id='page-709'></a>\n(defun add-examples (category args examples) \n\"Add these example strings to this category, \nand when it comes time to run them, use the args.\" \n(dolist (example examples) \n\n(when (stringp example) \n(let ((ex '(.example \n(.category .@args \n.(string->list \n(remove-punctuation example)) ())))) \n(unless (member ex (get-examples category) \n:test #'equal) \n(setf (gethash category ^examples*) \n(nconc (get-examples category) (1 ist ex)))))))) \n\n(defun run-examples (&optional category) \n\"Run all the example phrases stored under a category. \nWith no category, run ALL the examples.\" \n(prolog-compi1e-symbols) \n(if (null category) \n\n(maphash #'(lambda (cat val) \n(declare (ignore val)) \n(format t \"~2&Examples of ~a:~&\" cat) \n(run-examples cat)) \n\n^examples*) \n\n(dolist (example (get-examples category)) \n(format t \"~2&EXAMPLE: ~{~a~r9T~a~}\" example) \n(top-level-prove (cdr example))))) \n\n(defun remove-punctuation (string) \n\"Replace punctuation with spaces in string. \" \n(substitute-if #\\space #'punctuation-p string)) \n\n(defun string->list (string) \n\"Convert a string to a list of words.\" \n(read-from-string(concatenate 'string \"(\"string \")\"))) \n\n(defun punctuation-p (char) (find char \"*...;:'!?#-()\\\\\\\"\")) \n\nThe final part of our augmented DCG formalism is handling conjunctive constituents \nautomatically. We already arranged to translate category symbols on the left-hand \nside of rules into the corresponding conjunctive category, as specified by the function \nhandl e-con j. We also want to generate automatically (or as easily as possible) rules \nof the following form: \n\n(rule (S (?conj ?sl ?s2)) ==> \n(S_ ?sl) \n(Conj ?conj) \n(S ?s2)) \n\n\f\n<a id='page-710'></a>\n\n(rule (S ?sem) ==> (S_ ?sem)) \n\nBut before we generate these rules, let's make sure they are exactly what we want. \nConsider parsing a nonconjoined sentence with these two rules in place. The first \nrule would parse the entire sentence as a S_, and would then fail to see a Con j, and thus \nfail. The second rule would then duplicate the entire parsing process, thus doubling \nthe amount of time taken. If we changed the order of the two rules we would be able \nto parse nonconjoined sentences quickly, but would have to backtrack on conjoined \nsentences. \n\nThe following shows a better approach. A single rule for S parses a sentence \nwith S_, and then calls Conj.S, which can be read as \"either a conjunction followed \nby a sentence, or nothing.\" If the first sentence is followed by nothing, then we just \nuse the semantics of the first sentence; if there is a conjunction, we have to form a \ncombined semantics. I have added ... to show where arguments to the predicate \nother than the semantic argument fit in. \n\n(rule (S ... ?s-combi ned) ==> \n(S_ ... ?seml) \n(Conj_S ?seml ?s-combined)) \n\n(rule (Conj.S ?seml (?conj ?seml ?sem2)) ==> \n(Conj ?conj) \n(S ... ?sem2)) \n\n(rule (Conj_S ?seml ?seml) ==>) \n\nNow all we need is a way for the user to specify that these three rules are desired. \nSince the exact method of building up the combined semantics and perhaps even \nthe call to Conj may vary depending on the specifics of the grammar being defined, \nthe rules cannot be generated entirely automatically. We will settle for a macro, \nconj - rule, that looks very much like the second of the three rules above but expands \ninto all three, plus code to relate S_ to S. So the user will type: \n\n(conj-rule (Conj.S ?seml (?conj ?seml ?sem2)) ==> \n(Conj ?conj) \n(S ?a ?b ?c ?sem2)) \n\nHere is the macro definition: \n\n(defmacro conj-rule ((conj-cat semi combined-sem) ==> \n\nconj (cat . args)) \n\"Define this category as an automatic conjunction.\" \n'(progn \n\n(setf (get ',cat 'conj-cat) '.(symbol cat '_)) \n\n\f\n<a id='page-711'></a>\n(rule (.cat ,@(butlast args) ?combined-sem) ==> \n(.(symbol cat '_) .(butlast args) .semi) \n(.conj-cat ,seml ?combined-sem)) \n\n(rule (,conj-cat .semi .combined-sem) ==> \n.conj \n(.cat .args)) \n\n(rule (.conj-cat ?seml ?seml) ==>))) \n\nand here we define handl e-conj to substitute S_for S in the left-hand side of rules: \n\n(defun handle-conj (head) \n\"Replace (Cat ...) with (Cat. ...) if Cat is declared \nas a conjunctive category.\" \n(if (and (listp head) (conj-category (predicate head))) \n\n(cons (conj-category (predicate head)) (args head)) \nhead)) \n\n(defun conj-category (predicate) \n\"If this is a conjunctive predicate, return the Cat. symbol.\" \n(get predicate 'conj-category)) \n\n20.8 History and References \nAs we have mentioned, Alain Colmerauer invented Prolog to use in his grammar of \nFrench (1973). His metamorphosis grammar formalismwas more expressive but much \nless efficient than the standard DCG formalism. \n\nThe grammar in section 20.4 is essentially the same as the one presented in Fernando \nPereira and David H. D. Warren's 1980 paper, which introduced the Definite \nClause Grammar formalism as it is known today. The two developed a much more \nsubstantial grammar and used it in a very influential question-answering system \ncalled Chat-80 (Warren and Pereira, 1982). Pereira later teamed with Stuart Shieber \non an excellent book covering logic grammars in more depth: Prolog and Natural-\nLanguage Analysis (1987). The book has many strong points, but unfortunately it does \nnot present a grammar anywhere near as complete as the Chat-80 grammar. \n\nThe idea of a compositional semantics based on mathematical logic owes much \nto the work of the late linguist Richard Montague. The introduction by Dowty, Wall, \nand Peters (1981) and the collection by Rich Thomason (1974) cover Montague's \napproach. \n\nThe grammar in section 20.5 is based loosely on Michael McCord's modular logic \ngrammar, as presented in Walker et al. 1990. \nIt should be noted that logic grammars are by no means the only approach to \nnatural language processing. Woods (1970) presents an approach based on the \n\n\f\n<a id='page-712'></a>\n\naugmented transition network, or ATN. A transition network is like a context-free \ngrammar. The augmentation is a way of manipulating features and semantic values. \nThis is just like the extra arguments in DCGs, except that the basic operations are \nsetting and testing variables rather than unification. So the choice between ATNs and \nDCGs is largely a matter of what programming approach you are most comfortable \nwith: procedural for ATNs and declarative for DCGs. My feeling is that unification is \na more suitable primitive than assignment, so I chose to present DCGs, even though \nthis required bringing in Prolog's backtracking and unification mechanisms. \nIn either approach, the same linguistic problems must be addressed - agreement, \nlong-distance dependencies, topicalization, quantifier-scope ambiguity, and so on. \nComparing Woods's (1970) ATN grammar to Pereira and Warren's (1980) DCG grammar, \nthe careful reader will see that the solutions have much in common. The analysis \nis more important than the notation, as it should be. \n20.9 Exercises \n&#9635; Exercise 20.2 [m] Modify the grammar (from section 20.4, 20.5,\nfor adjectives before a noun. \nor 20.6) to allow \n\n&#9635; Exercise 20.3 [m] Modify the grammar to allow for prepositional phrase modifiers \non verb and noun phrases. \n\n&#9635; Exercise 20.4 [m] Modify the grammar to allow for ditransitive verbs?erbs that \ntake two objects, as in \"give the dog a bone.\" \n\n&#9635; Exercise 20.5 Suppose we wanted to adopt the Prolog convention of writing DCG \ntests and words in brackets and braces, respectively. Write a function that will alter \nthe readtable to work this way. \n\n&#9635; Exercise 20.6 [m] Define a rule function for a new type of DCG rule that automatically \nbuilds up a syntactic parse of the input. For example, the two rules: \n(rule is) => (np) (vp)) \n(rule (np) => (iword he)) \nshould be equivalent to: \n\n\f\n<a id='page-713'></a>\n(rule (s (s ?1 ?2)) --> (np ?1) (vp 12)) \n(rule (np (np he)) --> (:word he)) \n\n&#9635; Exercise 20.7 [m] There are advantages and disadvantages to the approach that \nProlog takes in dividing predicates into clauses. The advantage is that it is easy to \nadd a new clause. The disadvantage is that it is hard to alter an existing clause. If \nyou edit a clause and then evaluate it, the new clause will be added to the end of the \nclause list, when what you really wanted was for the new clause to take the place \nof the old one. To achieve that effect, you have to call cl ear-predicate, and then \nreload all the clauses, not just the one that has been changed. \n\nWrite a macro named - rul e that is just like rul e, except that it attaches names to \nclauses. When a named rule is reloaded, it replaces the old clause rather than adding \na new one. \n\n&#9635; Exercise 20.8 [h] Extend the DCG rule function to allow or goals in the right-hand \nside. To make this more useful, also allow and goals. For example: \n\n(rule (A) --> (B) (or (C) (and (D) (E))) (F)) \n\nshould compile into the equivalent of: \n\n(<- (A ?S0 ?S4) \n(B ?S0 ?S1) \n(OR (AND (C ?S1 ?S2) (= ?S2 ?S3)) \n\n(AND (D ?S1 ?S2) (E ?S2 ?S3))) \n(F ?S3 ?S4)) \n\n20.10 Answers \nAnswer 20.1 It uses local variables (?s0, ?sl ...) that are not guaranteed to be \nunique. This is a problem if the grammar writer wants to use these symbols anywhere \nin his or her rules. The fix is to gensym symbols that are guaranteed to be unique. \n\n\f\n<a id='page-714'></a>\n\nAnswer 20.5 \n\n(defun setup-braces (&optional (on? t) (readtable *readtable*)) \n\"Make Ca b] read as (:word a b) and {a b} as (rtest a b c) \nif ON? is true; otherwise revert {[]} to normal.\" \n(if (not on?) \n\n(map nil #'(lambda (c) \n(set-macro-character c (get-macro-character #\\a) \nt readtable)) \n\"{[]}\") \n(progn \n(set-macro-character \n#\\] (get-macro-character #\\)) nil readtable) \n(set-macro-character \n#\\} (get-macro-character #\\)) nil readtable) \n(set-macro-character \n#\\[ #'(lambda (s ignore) \n(cons :word (read-delimited-1ist #\\] s t))) \nnil readtable) \n(set-macro-character \n#\\{ #'(lambda (s ignore) \n(cons rtest (read-delimited-1ist #\\} s t))) \nnil readtable)))) \n\n\f\n## Chapter 21\n<a id='page-715'></a>\n\nA Grammar of English \n\nPrefer geniality to grammar. \n\n- Henry Watson Fowler \n\nThe King's English 906) \n\nI I 1 he previous two chapters outline techniques for writing grammars and parsers based on \n\nI those grammars. It is quite straightforward to apply these techniques to applications \n\nJL like the CD player problem where input is limited to simple sentences like \"Play 1 to \n8 without 3.\" But it is a major undertaking to write a grammar for unrestricted English input. \nThis chapter develops a grammar that covers all the major syntactic constructions of English. It \nhandles sentences of much greater complexity, such as \"Kim would not have been persuaded \nby Lee to look after the dog.\" The grammar is not comprehensive enough to handle sentences \nchosen at random from a book, but when augmented by suitable vocabulary it is adequate for a \nwide variety of applications. \n\nThis chapter is organized as a tour through the English language. We first cover noun \nphrases, then verb phrases, clauses, and sentences. For each category we introduce examples, \nanalyze them linguistically, and finally show definite clause grammar rules that correspond to \nthe analysis. \n\n\f\n<a id='page-716'></a>\n\nAs the last chapter should have made clear, analysis more often results in complication \nthan in simplification. For example, starting with a simple rule like (S \n- -> . . VP), we soon find that we have to add arguments to handle agreement, semantics, \nand gapping information. Figure 21.1 lists the grammatical categories and \ntheir arguments. Note that the semantic argument, sem, is always last, and the gap \naccumulators, gapl and gap2, are next-to-last whenever they occur. All single-letter \narguments denote metavariables; for example, each noun phrase (category NP) will \nhave a semantic interpretation, sem, that is a conjunction of relations involving the \nvariable x. Similarly, the h in modif i ers is a variable that refers to the head - the thing \nthat is being modified. The other arguments and categories will be explained in turn, \nbut it is handy to have this figure to refer back to. \n\nCategory Arguments \nPreterminals \n\nname agr name \nverb verb inflection slots . sem \nrel-pro case type \n\npronoun agr case wh . sem \nart agr quant \nadj X sem \ncardinal number agr \nordinal number \nprep prep sem \nnoun agr slots . sem \naux inflection needs-inflection . sem \nadverb X sem \n\nNonterminals \n\nS s sem \naux-inv-S subject s sem \nclause inflection . int-subj . gapl gap2 sem \nsubject agr . subj-slot int-subj gapl gap2 sem \nVP inflection . subject-slot . gapl gap2 vp \n\nNP agr case wh . gapl gap2 np \nNP2 agr case . gapl gap2 sem \n\nPP prep role wh np . gapl gap2 sem \nXP slot constituent wh . gapl gap2 sem \nDet agr wh . restriction sem \nrel-clause agr . sem \nmodifiers pre/post cat info slots h gapl gap2 sem \ncomplement cat info slot h gapl gap2 sem \nadjunct pre/post cat info h gapl gap2 sem \nadvp wh X gapl gap2 sem \n\nFigure 21.1: Grammatical Categories and their Arguments \n\n\f\n<a id='page-717'></a>\n21.1 Noun Phrases \nThe simplest noun phrases are names and pronouns, such as \"Kim\" and \"them.\" \nThe rules for these cases are simple: we build up a semantic expression from a name \nor pronoun, and since there can be no gap, the two gap accumulator arguments are \nthe same (?gl). Person and number agreement is propagated in the variable ?agr, \nand we also keep track of the case of the noun phrase. English has three cases that \nare reflected in certain pronouns. In the first person singular, \". is the nominative or \nsubjective case, \"me\" is the accusative or objective case, and \"my\" is the genitive case. To \ndistinguish them from the genitive, we refer to the nominative and the objective cases \nas the common cases. Accordingly, the three cases will be marked by the expressions \n(common nom), (common obj), and gen, respectively. Many languages of the world \nhave suffixes that mark nouns as being one case or another, but English does not. \nThus, we use the expression (common ?) to mark nouns. \n\nWe also distinguish between noun phrases that can be used in questions, like \n\"who,\" and those that cannot. The ?wh variable has the value +wh for noun phrases \nlike \"who\" or \"which one\" and - wh for nonquestion phrases. Here, then, are the rules \nfor names and pronouns. The predicates name and pronoun are used to look up words \nin the lexicon. \n\n(rule (NP ?agr (common ?) -wh ?x ?gl ?gl (the ?x (name ?name ?x))) ==> \n(name ?agr ?name)) \n\n(rule (NP ?agr ?case ?wh ?x ?gl ?gl ?sem) ==> \n(pronoun ?agr ?case ?wh ?x ?sem)) \n\nPlural nouns can stand alone as noun phrases, as in \"dogs,\" but singular nouns need \na determiner, as in \"the dog\" or \"Kim's friend's biggest dog.\" Plural nouns can also \ntake a determiner, as in \"the dogs.\" The category Det is used for determiners, and \nNP2 is used for the part of a noun phrase after the determiner: \n\n(rule (NP (---+) ?case -wh ?x ?gl ?g2 (group ?x ?sem)) ==> \n(:ex \"dogs\") ; Plural nouns don't need a determiner \n(NP2 ( +) ?case ?x ?gl ?g2 ?sem)) \n\n(rule (NP ?agr (common ?) ?wh ?x ?gl ?g2 ?sem) ==> \n(:ex \"Every man\" \"The dogs on the beach\") \n(Det ?agr ?wh ?x ?restriction ?sem) \n(NP2 ?agr (common ?) ?x ?gl ?g2 ?restriction)) \n\nFinally, a noun phrase may appear externally to a construction, in which case the \nnoun phrase passed in by the first gap argument will be consumed, but no words \nfrom the input will be. An example is the u in \"Whom does Kim like \n\n\f\n<a id='page-718'></a>\n\n(rule (NP ?agr ?case ?wh ?x (gap (NP ?agr ?case ?x)) (gap nil) t) \n==> Gapped NP \n) \n\nNow we address the heart of the noun phrase, the NP2 category. The lone rule for NP2 \nsays that it consists of a noun, optionally preceded and followed by modifiers: \n\n(rule (NP2 ?agr (common ?) ?x ?gl ?g2 :sem) ==> \n\n(modifiers pre noun ?agr () ?x (gap nil) (gap nil) ?pre) \n\n(noun ?agr ?slots ?x ?noun) \n\n(modifiers post noun ?agr ?slots ?x ?gl ?g2 ?post)) \n\n21.2 Modifiers \nModifiers are split into type types: Complements are modifiers that are expected by the \nhead category that is being modified; they cannot stand alone. Adjuncts are modifiers \nthat are not required but bring additional information. The distinction is clearest \nwith verb modifiers. In \"Kim visited Lee yesterday,\" \"visited\" is the head verb, \"Lee\" \nis a complement, and \"yesterday\" is an adjunct. Returning to nouns, in \"the former \nmayor of Boston,\" \"mayor\" is the head noun, \"of Boston\" is a complement (although \nan optional one) and \"former\" is an adjunct. \n\nThe predicate modi f i ers takes eight arguments, so it can be tricky to understand \nthem all. The first two arguments tell if we are before or after the head (pre or \npost) and what kind of head we are modifying (noun, verb, or whatever). Next is \nan argument that passes along any required information - in the case of nouns, it \nis the agreement feature. The fourth argument is a list of expected complements, \nhere called ?slots. Next is the metavariable used to refer to the head. The final \nthree arguments are the two gap accumulators and the semantics, which work the \nsame way here as we have seen before. Notice that the lexicon entry for each Noun \ncan have a list of complements that are considered as postnoun modifiers, but there \ncan be only adjuncts as prenoun modifiers. Also note that gaps can appear in the \npostmodifiers but not in the premodifiers. For example, we can have \"What is Kevin \nthe former mayor of where the answer might be \"Boston.\" But even though \nwe can construct a noun phrase like \"the education president,\" where \"education\" \nis a prenoun modifier of \"president,\" we cannot construct \"* What is George the u \npresident?,\" intending that the answer be \"education.\" \n\nThere are four cases for modification. First, a complement is a kind of modifier. \nSecond, if a complement is marked as optional, it can be skipped. Third, an adjunct \ncan appear in the input. Fourth, if there are no complements expected, then there \nneed not be any modifiers at all. The following rules implement these four cases: \n\n\f\n<a id='page-719'></a>\n\n(rule (modifiers ?pre/post ?cat ?info (?slot . ?slots) ?h \n\n?gl ?g3 :sem) ==> \n(complement ?cat ?info ?slot ?h ?gl ?g2 ?mod) \n(modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods)) \n\n(rule (modifiers ?pre/post ?cat ?info ((? (?) ?) . ?slots) ?h \n?gl ?g2 ?mods) == > \n(modifiers ?pre/post ?cat ?info ?slots ?h ?gl ?g2 ?mods)) \n\n(rule (modifiers ?pre/post ?cat ?info ?slots ?h ?gl ?g3 :sem) ==> \n(adjunct ?pre/post ?cat ?info ?h ?gl ?g2 ?adjunct) \n(modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods)) \n\n(rule (modifiers ???()? ?gl ?gl t) ==> ) \n\nWe need to say more about the Ust of complements, or slots, that can be associated \nwith words in the lexcion. Each slot is a list of the form i role number form), where \nthe role refers to some semantic relation, the number indicates the ordering of the \ncomplements, and the form is the type of constituent expected: noun phrase, verb \nphrase, or whatever. The details will be covered in the following section on verb \nphrases, and compi ement will be covered in the section on XPs. For now, we give a \nsingle example. The complement list for one sense of the verb \"visit\" is: \n\n((agt 1 (NP ?)) (obj 2 (NP ?))) \n\nThis means that the first complement, the subject, is a noun phrase that fills the agent \nrole, and the second complement is also a noun phrase that fills the object role. \n\n21.3 Noun Modifiers \nThere are two main types of prenoun adjuncts. Most common are adjectives, as \nin \"big slobbery dogs.\" Nouns can also be adjuncts, as in \"water meter\" or \"desk \nlamp.\" Here it is clear that the second noun is the head and the first is the modifier: \na desk lamp is a lamp, not a desk. These are known as noun-noun compounds. In \nthe following rules, note that we do not need to say that more than one adjective is \nallowed; this is handled by the rules for modi f i ers. \n\n(rule (adjunct pre noun ?info ?x ?gap ?gap ?sem) ==> \n(adj ?x ?sem)) \n\n(rule (adjunct pre noun ?info ?h ?gap ?gap :sem) ==> \n(:sem (noun-noun ?h ?x)) \n(noun ?agr () ?x ?sem)) \n\nAfter the noun there is a wider variety of modifiers. Some nouns have complements. \n\n\f\n<a id='page-720'></a>\n\nwhich are primarily prepositional phrases, as in \"mayor of Boston.\" These will be \ncovered when we get to the lexical entries for nouns. Prepositional phrases can be \nadjuncts for nouns or verbs, as in \"man in the middle\" and \"slept for an hour.\" We \ncan write one rule to cover both cases: \n\n(rule (adjunct post ?cat ?info ?x ?gl ?g2 ?sem) ==> \n(PP ?prep ?prep ?wh ?np ?x ?gl ?g2 ?sem)) \n\nHere are the rules for prepositional phrases, which can be either a preposition \nfollowed by a noun phrase or can be gapped, as in \"to whom are you speaking \nThe object of a preposition is always in the objective case: \"with him\" not \"*with he.\" \n\n(rule (PP ?prep ?role ?wh ?np ?x ?gl ?g2 :sem) ==> \n(prep ?prep t) \n(:sem (?role ?x ?np)) \n(NP ?agr (common obj) ?wh ?np ?gl ?g2 ?np-sem)) \n\n(rule (PP ?prep ?role ?wh ?np ?x \n(gap (PP ?prep ?role ?np ?x)) (gap nil) t) ==> ) \n\nNouns can be modified by present participles, past participles, and relative clauses. \nExamples are \"the man eating the snack,\" \"the snack eaten by the man,\" and \"the \nman that ate the snack,\" respectively. We will see that each verb in the lexicon is \nmarked with an inflection, and that the marker - i ng is used for present participles \nwhile - en is used for past participles. The details of the clause will be covered later. \n\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==> \n(:ex (the man) \"visiting me\" (the man) \"visited by me\") \n(:test (member ?infl (-ing passive))) \n(clause ?infl ?x ? ?v (gap (NP ?agr ? ?x)) (gap nil) ?sem)) \n\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==> \n(rel-clause ?agr ?x ?sem)) \n\nIt is possible to have a relative clause where it is an object, not the subject, that the \nhead refers to: \"the snack that the man ate.\" In this kind of relative clause the relative \npronoun is optional: \"The snack the man ate was delicious.\" The following rules say \nthat if the relative pronoun is omitted then the noun that is being modified must be \nan object, and the relative clause should include a subject internally. The constant \nint-subj indicates this. \n\n(rule (rel-clause ?agr ?x :sem) ==> \n(:ex (the man) \"that she liked\" \"that liked her\" \n\"that I know Lee liked\") \n\n\f\n<a id='page-721'></a>\n(opt-rel-pronoun ?case ?x ?int-subj ?rel-sem) \n(clause (finite ? ?) ? ?int-subj ?v \n(gap (NP ?agr ?case ?x)) (gap nil) ?clause-sem)) \n\n(rule (opt-rel-pronoun ?case ?x ?int-subj (?type ?x)) ==> \n(rword ?rel-pro) \n\n(:test (word ?rel-pro rel-pro ?case ?type))) \n\n(rule (opt-rel-pronoun (common obj) ?x int-subj t) ==> ) \n\nIt should be noted that it is rare but not impossible to have names and pronouns \nwith modifiers: \"John the Baptist/' \"lovely Rita, meter maid,\" \"Lucy in the sky with \ndiamonds,\" \"Sylvia in accounting on the 42nd floor,\" \"she who must be obeyed,\" \nHere and throughout this chapter we will raise the possibility of such rare cases, \nleaving them as exercises for the reader. \n\n21.4 Determiners \nWe will cover three kinds of determiners. The simplest is the article: \"a dog\" or \"the \ndogs.\" We also allow genitive pronouns, as in \"her dog,\" and numbers, as in \"three \ndogs.\" The semantic interpretation of a determiner-phrase is of the form (quantifier \nvariable restriction). ... example A Si ?x (dog ?x)) or ((number 3) ?x (dog ?x)). \n\n(rule (Det ?agr ?wh ?x ?restriction (?art ?x ?restriction)) ==> \n(:ex \"the\" \"every\") \n(art ?agr ?art) \n(:test (if (= ?art wh) (= ?wh +wh) (= ?wh -wh)))) \n\n(rule (Det ?agr ?wh ?x ?r (the ?x ?restriction)) ==> \n(:ex \"his\" \"her\") \n(pronoun ?agr gen ?wh ?y ?sem) \n(:test (and* ((genitive ?y ?x) ?sem ?r) ?restriction))) \n\n(rule (Det ?agr -wh ?x ?r ((number ?n) ?x ?r)) ==> \n(:ex \"three\") \n(cardinal ?n ?agr)) \n\nThese are the most important determiner types, but there are others, and there are \npre- and postdeterminers that combine in restricted combinations. Predeterminers \ninclude all, both, half, double, twice, and such. Postdeterminers include every, \nmany, several, and few. Thus, we can say \"all her many good ideas\" or \"all the King's \nmen.\" But we can not say \"*all much ideas\" or \"*the our children.\" The details are \ncomplicated and are omitted from this grammar. \n\n\f\n<a id='page-722'></a>\n\n21.5 Verb Phrases \nNow that we have defined modi f i ers, verb phrases are easy. In fact, we only need \ntwo rules. The first says a verb phrase consists of a verb optionally preceded and \nfollowed by modifiers, and that the meaning of the verb phrase includes the fact that \nthe subject fills some role: \n\n(rule (VP ?infl ?x ?subject-slot ?v ?gl ?g2 :sem) ==> \n(:ex \"sleeps\" \"quickly give the dog a bone\") \n(modifiers pre verb ? () ?v (gap nil) (gap nil) ?pre-sem) \n(:sem (?role ?v ?x)) (:test (= ?subject-slot (?role 1 ?))) \n(verb ?verb ?infl (?subject-slot . ?slots) ?v ?v-sem) \n(modifiers post verb ? ?slots ?v ?gl ?g2 ?mod-sem)) \n\nThe VP category takes seven arguments. The first is an inflection, which represents \nthe tense of the verb. To describe the possibilities for this argument we need a quick \nreview of some basic Unguistics. A sentence must have a finite verb, meaning a \nverb in the present or past tense. Thus, we say \"Kim likes Lee,\" not \"*Kim liking \nLee.\" Subject-predicate agreement takes effect for finite verbs but not for any other \ntense. The other tenses show up as complements to other verbs. For example, the \ncomplement to \"want\" is an infinitive: \"Kim wants to like Lee\" and the complement \nto the modal auxiliary verb \"would\" is a nonf inite verb: \"Kim would like Lee.\" If this \nwere in the present tense, it would be \"likes,\" not \"like.\" The inflection argument \ntakes on one of the forms in the table here: \n\nExpression Type Example \n(finite ?agr present) present tense eat, eats \n(finite ?agr past) past tense ate \nnonfinite nonfinite eat \ninfinitive infinitive to eat \n-en past participle eaten \n-ing present participle eating \n\nThe second argument is a metavariable that refers to the subject, and the third is \nthe subject's complement slot. We adopt the convention that the subject slot must \nalways be the first among the verb's complements. The other slots are handled by \nthe postverb modifiers. The fourth argument is a metavariable indicating the verb \nphrase itself. The final three are the familiar gap and semantics arguments. As an \nexample, if the verb phrase is the single word \"slept,\" then the semantics of the verb \nphrase will be (and (past ?v) (sleep ?v)). Of course, adverbs, complements, \nand adjuncts will also be handled by this rule. \n\nThe second rule for verb phrases handles auxiliary verbs, such as \"have,\" \"is\" \nand \"would.\" Each auxiliary verb (or aux) produces a verb phrase with a particular \n\n\f\n<a id='page-723'></a>\n\ninflection when followed by a verb phrase with the required inflection. To repeat \nan example, \"would\" produces a finite phrase when followed by a nonfinite verb. \n\"Have\" produces a nonfinite when followed by a past participle. Thus, \"would have \nliked\" is a finite verb phrase. \n\nWe also need to account for negation. The word \"not\" can not modify a bare main \nverb but can follow an auxiliary verb. That is, we can't say \"*Kim not like Lee,\" but \nwe can add an auxiliary to get \"Kim does not like Lee.\" \n\n(rule (VP ?infl ?x ?subject-slot ?v ?gl ?g2 :sem) ==> \n(:ex \"is sleeping\" \"would have given a bone to the dog.\" \n\"did not sleep\" \"was given a bone by this old man\") \n\nAn aux verb, followed by a VP \n(aux ?infl ?needs-infl ?v ?aux) \n(modifiers post aux ? () ?v (gap nil) (gap nil) ?mod) \n(VP ?needs-infl ?x ?subject-slot ?v ?gl ?g2 ?vp)) \n\n(rule (adjunct post aux ? ?v ?gap ?gap (not ?v)) ==> \n(:word not)) \n\n21.6 Adverbs \nAdverbs can serve as adjuncts before or after a verb: \"to boldly go,\" \"to go boldly.\" \nThere are some limitations on where they can occur, but it is difficult to come up \nwith firm rules; here we allow any adverb anywhere. We define the category advp \nfor adverbial phrase, but currently restrict it to a single adverb. \n\n(rule (adjunct ?pre/post verb ?info ?v ?gl ?g2 ?sem) ==> \n(advp ?wh ?v ?gl ?g2 ?sem)) \n\n(rule (advp ?wh ?v ?gap ?gap ?sem) ==> \n(adverb ?wh ?v ?sem)) \n\n(rule (advp ?wh ?v (gap (advp ?v)) (gap nil) t) ==> ) \n\n21.7 Clauses \nA clause consists of a subject followed by a predicate. However, the subject need not \nbe realized immediately before the predicate. For example, in \"Alice promised Bob \nto lend him her car\" there is an infinitive clause that consists of the predicate \"to lend \nhim her car\" and the subject \"Alice.\" The sentence as a whole is another clause. In \n\n\f\n<a id='page-724'></a>\n\nour analysis, then, a clause is a subject followed by a verb phrase, with the possibility \nthat the subject will be instantiated by something from the gap arguments: \n\n(rule (clause ?infl ?x ?int-subj ?v ?gapl ?gap3 :sem) ==> \n(subject ?agr ?x ?subj-slot ?int-subj ?gapl ?gap2 ?subj-sem) \n(VP ?infl ?x ?subj-slot ?v ?gap2 ?gap3 ?pred-sem) \n(itest (subj-pred-agree ?agr ?infl))) \n\nThere are now two possibilities for subject. In the first case it has already been \nparsed, and we pick it up from the gap list. If that is so, then we also need to find the \nagreement feature of the subject. If the subject was a noun phrase, the agreement will \nbe present in the gap list. If it was not, then the agreement is third-person singular. \nAn example of this is\" That the Red Sox won surprises me,\" where the italicized phrase \nis a non-NP subject. The fact that we need to use \"surprises\" and not \"surprise\" \nindicates that it is third-person singular. We will see that the code (--->--) is used \nfor this. \n\n(rule (subject ?agree ?x ?subj-slot ext-subj \n(gap ?subj) (gap nil) t) ==> \nExternally realized subject (the normal case for S) \n(rtest (slot-constituent ?subj-slot ?subj ?x ?) \n\n(if (= ?subj (NP ?agr ?case ?x)) \n(= ?agree ?agr) \n(= ?agree (-- + -))))) ;Non-NP subjects are 3sing \n\nIn the second case we just parse a noun phrase as the subject. Note that the fourth \nargument to subject is either ext-subj or int-subj depending on if the subject is \nrealized internally or externally. This will be important when we cover sentences in \nthe next section. In case it was not already clear, the second argument to both clause \nand subject is the metavariable representing the subject. \n\n(rule (subject ?agr ?x (?role 1 (NP ?x)) int-subj ?gap ?gap ?sem) \n= => \n(NP ?agr (common nom) ?wh ?x (gap nil) (gap nil) ?sem)) \n\nFinally, the rules for subject-predicate agreement say that only finite predicates need \nto agree with their subject: \n\n(<- (subj-pred-agree ?agr (finite ?agr ?))) \n(<- (subj-pred-agree ? ?infl) (atom ?infl)) \n\n\f\n<a id='page-725'></a>\n21.8 Sentences \nIn the previous chapter we allowed only simple declarative sentences. The current \ngrammar supports commands and four kinds of questions in addition to declarative \nsentences. It also supports thematic fronting: placing a nonsubject at the beginning of \na sentence to emphasize its importance, as in \"Smith he says his name is\" or \"Murder, \nshe wrote\" or \"In God we trust.\" In the last example it is a prepositional phrase, not a \nnoun phrase, that occurs first. It is also possible to have a subject that is not a noun \nphrase: \"That the dog didn't hark puzzled Holmes.\" To support all these possibilities, \nwe introduce a new category, XP, which stands for any kind of phrase. A declarative \nsentence is then just an XP followed by a clause, where the subject of the clause may \nor may not turn out to be the XP: \n\n(rule (S ?s :sem) ==> \n\n(:ex \"Kim likes Lee\" \"Lee, I like _\" \"In god, we trust _\" \n\n\"Who likes Lee?\" \"Kim likes who?\") \n(XP ?kind ?constituent ?wh ?x (gap nil) (gap nil) ?topic-sem) \n(clause (finite ? ?) ?x ? ?s (gap ?constituent) (gap nil) ?sem)) \n\nAs it turns out, this rule also serves for two types of questions. The simplest kind \nof question has an interrogative noun phrase as its subject: \"Who likes Lee?\" or \n\"What man likes Lee?\" Another kind is the so-called echo question, which can be \nused only as a reply to another statement: if I tell you Kim likes Jerry Lewis, you \ncould reasonably reply \"Kim likes whoT Both these question types have the same \nstructure as declarative sentences, and thus are handled by the same rule. \n\nThe following table lists some sentences that can be parsed by this rule, showing \nthe XP and subject of each. \n\nSentence XP Subject \nKim likes Lee Kim Kim \nLee, Kim likes Lee Kim \nIn god, we trust In god we \nThat Kim likes Lee amazes That Kim likes Lee That Kim likes Lee \nWho likes Lee? Who Who \n\nThe most common type of command has no subject at all: \"Be quiet\" or \"Go to \nyour room.\" When the subject is missing, the meaning is that the command refers \ntoyou, the addressee of the command. The subject can also be mentioned explicitly, \nand it can be \"you,\" as in \"You be quiet,\" but it need not be: \"Somebody shut the \ndoor\" or \"Everybody sing along.\" We provide a rule only for commands with subject \nomitted, since it can be difficult to distinguish a command with a subject from a \ndeclarative sentence. Note that commands are always nonfinite. \n\n\f\n<a id='page-726'></a>\n\n(rule (S ?s :sem) ==> \n\nCommands have implied second-person subject \n(:ex \"Give the dog a bone.\") \n(:sem (command ?s)) \n(:sem (listener ?x)) \n(clause nonfinite ?x ext-subj ?s \n\n(gap (NP ? ? ?x)) (gap nil) ?sem)) \n\nAnother form of command starts with \"let,\" as in \"Let me see what I can do\" and \n\"Let us all pray.\" The second word is better considered as the object of \"let\" rather \nthan the subject of the sentence, since the subject would have to be \"I\" or \"we.\" This \nkind of command can be handled with a lexical entry for \"let\" rather than with an \nadditional rule. \n\nWe now consider questions. Questions that can be answered by yes or no have \nthe subject and auxiliary verb inverted: \"Did you see him?\" or \"Should I have been \ndoing this?\" The latter example shows that it is only the first auxiliary verb that \ncomes before the subject. The category a ux -i ..-S is used to handle this case: \n\n(rule (S ?s (yes-no ?s ?sem)) ==> \n(:ex \"Does Kim like Lee?\" \"Is he a doctor?\") \n(aux-inv-S nil ?s ?sem)) \n\nQuestions that begin with a wh-phrase also have the auxihary verb before the subject, \nas in \"Who did you see?\" or \"Why should I have been doing this?\" The first \nconstituent can also be a prepositional phrase: \"For whom am I doing this?\" The \nfollowing rule parses an XP that must have the +wh feature and then parses an \naux -i nv-S to arrive at a question: \n\n(rule (S ?s :sem) ==> \n(:ex \"Who does Kim like _?\" \"To whom did he give it _? \" \n\n\"What dog does Kim like _?\") \n(XP ?slot ?constituent +wh ?x (gap nil) (gap nil) ?subj-sem) \n(aux-inv-S ?constituent ?s ?sem)) \n\nA question can also be signaled by rising intonation in what would otherwise be a \ndeclarative statement: \"You want some?\" Since we don't have intonation information, \nwe won't include this kind of question. \n\nThe implementation for aux-inv-S is straightforward: parse an auxiliary and \nthen a clause, pausing to look for modifiers in between. (So far, a \"not\" is the only \nmodifier allowed in that position.) \n\n\f\n<a id='page-727'></a>\n\n(rule (aux-inv-S ?constituent ?v :sem) ==> \n(:ex \"Does Kim like Lee?\" (who) \"would Kim have liked\") \n(aux (finite ?agr ?tense) ?needs-infl ?v ?aux-sem) \n(modifiers post aux ? () ?v (gap nil) (gap nil) ?mod) \n(clause ?needs-infl ?x int-subj ?v (gap ?constituent) (gap nil) \n\n?clause-sem)) \n\nThere is one more case to consider. The verb \"to be\" is the most idiosyncratic in \nEnglish. It is the only verb that has agreement differences for anything besides third-\nperson singular. And it is also the only verb that can be used in an a ux - i ..-S without \na main verb. An example of this is \"Is he a doctor?,\" where \"is\" clearly is not an \nauxihary, because there is no main verb that it could be auxiliary to. Other verb can \nnot be used in this way: \"*Seems he happy?\" and\"*Didtheyit?\" are ungrammatical. \nThe only possibiUty is \"have,\" as in \"Have you any wool?,\" but this use is rare. \n\nThe following rule parses a verb, checks to see that it is a version of \"be,\" and then \nparses the subject and the modifiers for the verb. \n\n(rule (aux-inv-S ?ext ?v :sem) ==> \n(:ex \"Is he a doctor?\") \n(verb ?be (finite ?agr ?) ((?role ?n ?xp) . ?slots) ?v ?sem) \n(rtest (word ?be be)) \n(subject ?agr ?x (?role ?n ?xp) int-subj \n\n(gap nil) (gap nil) ?subj-sem) \n(:sem (?role ?v ?x)) \n(modifiers post verb ? ?slots ?v (gap ?ext) (gap nil) ?mod-sem)) \n\n21.9 XPs \nAll that remains in our grammar is the XP category. XPs are used in two ways: First, \na phrase can be extraposed, as in \"In god we trust,\" where \"in god\" will be parsed as \nan XP and then placed on the gap list until it can be taken off as an adjunct to \"trust.\" \nSecond, a phrase can be a complement, as in \"He wants to be a fireman\" where the \ninfinitive phrase is a complement of \"wants.\" \n\nAs it turns out, the amount of information that needs to appear in a gap list \nis slightly different from the information that appears in a complement slot. For \nexample, one sense of the verb \"want\" has the following complement list: \n\n((agt 1 (NP ?x)) (con 3 (VP infinitive ?x))) \n\nThis says that the first complement (the subject) is a noun phrase that serves as the \nagent of the wanting, and the second is an infinitive verb phrase that is the concept of \n\n\f\n<a id='page-728'></a>\n\nthe wanting. The subject of this verb phrase is the same as the subject of the wanting, \nso in \"She wants to go home,\" it is she who both wants and goes. (Contrast this to \n\"He persuaded her to go home,\" where it is he that persuades, but she that goes.) \n\nBut when we put a noun phrase on a gap list, we need to include its number and \ncase as well as the fact that it is an NP and its metavariable, but we don't need to \ninclude the fact that it is an agent. This difference means we have two choices: either \nwe can merge the notions of slots and gap lists so that they use a common notation \ncontaining all the information that either can use, or we need some way of mapping \nbetween them. I made the second choice, on the grounds that each notation was \ncomplicated enough without bringing in additional information. \n\nThe relation slot-constituent maps between the slot notation used for complements \nand the constituent notation used in gap lists. There are eight types of \ncomplements, five of which can appear in gap lists: noun phrases, clauses, prepositional \nphrases, the word \"it\" (as in \"it is raining\"), and adverbial phrases. The three \nphrases that are allowed only as complements are verb phrases, particles (such as \n\"up\" in \"look up the number\"), and adjectives. Here is the mapping between the two \nnotations. The *** indicates no mapping: \n\n(<- (slot-constituent (?role ?n (NP ?x)) \n(NP ?agr ?case ?x) ?x ?h)) \n(<- (slot-constituent (?role ?n (clause ?word ?infl)) \n(clause ?word ?infl ?v) ?v ?h)) \n(<- (slot-constituent (?role ?n (PP ?prep ?np)) \n\n(PP ?prep ?role ?np ?h) ?np ?h)) \n(<- (slot-constituent (?role ?n it) (it ? ? ?x) ?x ?)) \n(<- (slot-constituent (manner 3 (advp ?x)) (advp ?v) ? ?v)) \n(<- (slot-constituent (?role ?n (VP ?infl ?x)) *** ? ?)) \n(<- (slot-constituent (?role ?n (Adj ?x)) *** ?x ?)) \n(<- (slot-constituent (?role ?n (P ?particle)) *** ? ?)) \n\nWe are now ready to define compi ement. It takes a slot descrption, maps it into a \nconstituent, and then calls XP to parse that constituent: \n\n(rule (complement ?cat ?info (?role ?n ?xp) ?h ?gapl ?gap2 :sem) \n\n;; A complement is anything expected by a slot \n(:sem (?role ?h ?x)) \n(itest (slot-constituent (?role ?n ?xp) ?constituent ?x ?h)) \n(XP ?xp ?constituent ?wh ?x ?gapl ?gap2 ?sem)) \n\nThe category XP takes seven arguments. The first two are the slot we are trying \nto fill and the constituent we need to fill it. The third is used for any additional \ninformation, and the fourth is the metavariable for the phrase. The last three supply \ngap and semantic information. \n\n\f\n<a id='page-729'></a>\n\nHere are the first five XP categories: \n\n(rule (XP (PP ?prep ?np) (PP ?prep ?role ?np ?h) ?wh ?np \n?gapl ?gap2 ?sem) ==> \n(PP ?prep ?role ?wh ?np ?h ?gapl ?gap2 ?sem)) \n\n(rule (XP (NP ?x) (NP ?agr ?case ?x) ?wh ?x ?gapl ?gap2 ?sem) ==> \n(NP ?agr ?case ?wh ?x ?gapl ?gap2 ?sem)) \n\n(rule (XP it (it ? ? ?x) -wh ?x ?gap ?gap t) ==> \n(:word it)) \n\n(rule (XP (clause ?word ?infl) (clause ?word ?infl ?v) -wh ?v \n\n?gapl ?gap2 ?sem) ==> \n(:ex (he thinks) \"that she is tall\") \n(opt-word ?word) \n\n(clause ?infl ?x int-subj ?v ?gapl ?gap2 ?sem)) \n\n(rule (XP (?role ?n (advp ?v)) (advp ?v) ?wh ?v ?gapl ?gap2 ?sem) \n\n(advp ?wh ?v ?gapl ?gap2 ?sem)) \n\nThe category opt-word parses a word, which may be optional. For example, one \n\nsense of \"know\" subcategorizes for a clause with an optional \"that\": we can say \n\neither \"I know that he's here\" or \"I know he's here.\" The complement hst for \"know\" \n\nthuscontains the slot (con 2 (clause (that) (finite ? ?))). If the \"that\" had \n\nbeen obligatory, it would not have parentheses around it. \n\n(rule (opt-word ?word) ==> (:word ?word)) \n(rule (opt-word (?word)) ==> (iword ?word)) \n(rule (opt-word (?word)) ==>) \n\nFinally, here are the three XPs that can not be extraposed: \n\n(rule (XP (VP ?infl ?x) *** -wh ?v ?gapl ?gap2 ?sem) ==> \n(:ex (he promised her) \"to sleep\") \n(VP ?infl ?x ?subj-slot ?v ?gapl ?gap2 ?sem)) \n\n(rule (XP (Adj ?x) *** -wh ?x ?gap ?gap ?sem) ==> \n(Adj ?x ?sem)) \n\n(rule (XP (P ?particle) *** -wh ?x ?gap ?gap t) ==> \n(prep ?particle t)) \n\n\f\n<a id='page-730'></a>\n\n21.10 Word Categories \nEach word category has a rule that looks words up in the lexicon and assigns the right \nfeatures. The relation word is used for all lexicon access. We will describe the most \ncomplicated word class, verb, and just list the others. \n\nVerbs are complex because they often are polysemous - they have many meanings. \nIn addition, each meaning can have several different complement lists. Thus, an \nentry for a verb in the lexicon will consist of the verb form, its inflection, and a list \nof senses, where each sense is a semantics followed by a list of possible complement \nlists. Here is the entry for the verb \"sees,\" indicating that it is a present-tense verb with \nthree senses. The understand sense has two complement lists, which correspond to \n\"He sees\" and \"He sees that you are right.\" The 100 k sense has one complement list \ncorresponding to \"He sees the picture,\" and the dati ng sense, corresponding to \"He \nsees her (only on Friday nights),\" has the same complement list. \n\n> (?- (word sees verb ?infl ?senses)) \n?INFL = (FINITE (--+-) PRESENT) \n7SENSES = ((UNDERSTAND ((AGT 1 (NP ?3))) \n\n((EXP 1 (NP ?4)) \n\n(CON 2 (CLAUSE (THAT) (FINITE ?5 ?6))))) \n(LOOK ((AGT 1 (NP 17)) (OBJ 2 (NP ?8)))) \n(DATING ((AGT 1 (NP ?9)) (OBJ 2 (NP ?10))))) \n\nThe category verb takes five arguments: the verb itself, its inflection, its complement \nlist, its metavariable, and its semantics. The member relations are used to pick a sense \nfrom the list of senses and a complement Hst from the list of lists, and the semantics \nis built from semantic predicate for the chosen sense and the metavariable for the \nverb: \n\n(rule (verb ?verb ?infl ?slots ?v :sem) ==> \n(:word ?verb) \n(:test (word ?verb verb ?infl ?senses) \n\n(member (?sem . ?subcats) ?senses) \n(member ?slots ?subcats) \n(tense-sem ?infl ?v ?tense-sem)) \n\n(:sem ?tense-sem) \n(:sem (?sem ?v))) \n\nIt is difficulty to know how to translate tense information into a semantic interpretation. \nDifferent applications will have different models of time and thus will want \ndifferent interpretations. The relation tense-sem gives semantics for each tense. \nHere is a very simple definition of tense-sem: \n\n\f\n<a id='page-731'></a>\n(<- (tense-sem (finite ? ?tense) ?v (?tense ?Y))) \n(<- (tense-sem -ing ?v (progressive ?v))) \n(<- (tense-sem -en ?v (past-participle ?v))) \n(<- (tense-sem infinitive ?v t)) \n(<- (tense-sem nonfinite ?v t)) \n(<- (tense-sem passive ?v (passive ?v))) \n\nAuxiliary verbs and modal verbs are listed separately: \n\n(rule (aux ?infl ?needs-infl ?v ?tense-sem) ==> \n(:word ?aux) \n(itest (word ?aux aux ?infl ?needs-infl) \n\n(tense-sem ?infl ?v ?tense-sem))) \n\n(rule (aux (finite ?agr ?tense) nonfinite ?v (?sem ?v)) ==> \n(:word ?modal) \n(:test (word ?modal modal ?sem ?tense))) \n\nNouns, pronouns, and names are also listed separately, although they have much \nin common. For pronouns we use quantifier wh or pro, depending on if it is a wh-\npronoun or not. \n\n(rule (noun ?agr ?slots ?x (?sem ?x)) ==> \n(:word ?noun) \n(:test (word ?noun noun ?agr ?slots ?sem))) \n\n(rule (pronoun ?agr ?case ?wh ?x (?quant ?x (?sem ?x))) ==> \n(rword ?pro) \n(:test (word ?pro pronoun ?agr ?case ?wh ?sem) \n\n(if (= ?wh +wh) (= ?quant wh) (= ?quant pro)))) \n\n(rule (name ?agr ?name) ==> \n(iword ?name) \n\n(:test (word ?name name ?agr))) \n\nHere are the rules for the remaining word classes: \n\n(rule (adj ?x (?sem ?x)) ==> \n(:word ?adj) \n(:test (word ?adj adj ?sem))) \n\n(rule (adj ?x ((nth ?n) ?x)) ==> (ordinal ?n)) \n\n(rule (art ?agr ?quant) ==> \n(:word ?art) \n(:test (word ?art art ?agr ?quant))) \n\n\f\n<a id='page-732'></a>\n\n(rule (prep ?prep t) ==> \n(:word ?prep) \n(:test (word ?prep prep))) \n\n(rule (adverb ?wh ?x ?sem) ==> \n(rword ?adv) \n(:test (word ?adv adv ?wh ?pred) \n\n(if (= ?wh +wh) \n(= ?sem (wh ?y (?pred ?x ?y))) \n(= ?sem (?pred ?x))))) \n\n(rule (cardinal ?n ?agr) ==> \n(:ex \"five\") \n(rword ?num) \n(rtest (word ?nuni cardinal ?n ?agr))) \n\n(rule (cardinal ?n ?agr) ==> \n(rex \"5\") \n(rword ?n) \n(rtest (numberp ?n) \n\n(if (= ?n 1) \n(= ?agr (-- + -)) ;3sing \n(= ?agr ( +))))) ;3plur \n\n(rule (ordinal ?n) ==> \n(rex \"fifth\") \n(rword ?num) \n(rtest (word ?num ordinal ?n))) \n\n21.11 The Lexicon \nThe lexicon itself consists of a large number of entries in the word relation, and it \nwould certainly be possible to ask the lexicon writer to make a long list of word facts. \nBut to make the lexicon easier to read and write, we adopt three useful tools. First, \nwe introduce a system of abbreviations. Common expressions can be abbreviated \nwith a symbol that will be expanded by word. Second, we provide the macros verb \nand noun to cover the two most complex word classes. Third, we provide a macro \nword that makes entries into a hash table. This is more efficient than compiling a \nword relation consisting of hundreds of Prolog clauses. \n\nThe implementation of these tools is left for the next section; here we show the \nactual lexicon, starting with the list of abbreviations. \n\nThe first set of abbreviations defines the agreement features. The obvious way to \nhandle agreement is with two features, one for person and one for number. So first-\nperson singular might be represented (1 si ng). A problem arises when we want \n\n\f\n<a id='page-733'></a>\n\nto describe verbs. Every verb except \"be\" makes the distinction only between third-\nperson singular and all the others. We don't want to make five separate entries in the \nlexicon to represent all the others. One alternative is to have the agreement feature be \na set of possible values, so all the others would be a single set of five values rather than \nfive separate values. This makes a big difference in cutting down on backtracking. \nThe problem with this approach is keeping track of when to intersect sets. Another \napproach is to make the agreement feature be a list of four binary features, one each \nfor first-person singular, first-person plural, third-person singular, and third-person \nplural. Then \"all the others\" can be represented by the list that is negative in the third \nfeature and unknown in all the others. There is no way to distinguish second-person \nsingular from plural in this scheme, but English does not make that distinction. Here \nare the necessary abbreviations: \n\n(abbrev Ising (+---)) \n(abbrev Iplur (-+ - -)) \n(abbrev 3sing (--+-)) \n(abbrev Splur (---+)) \n(abbrev 2pers (--- -)) \n(abbrev ~3sing (??-?)) \n\nThe next step is to provide abbreviations for some of the common verb complement \nlists: \n\n(abbrev v/intrans ((agt 1 (NP ?)))) \n(abbrev v/trans ((agt 1 (NP ?)) (obj 2 (NP ?)))) \n(abbrev v/ditrans ((agt 1 (NP ?)) (goal 2 (NP ?)) (obj 3 (NP ?)))) \n(abbrev v/trans2 ((agt 1 (NP ?)) (obj 2 (NP ?)) (goal 2 (PP to ?)))) \n(abbrev v/trans4 ((agt 1 (NP ?)) (obj 2 (NP ?)) (ben 2 (PP for ?)))) \n(abbrev v/it-null ((nil 1 it))) \n(abbrev v/opt-that ((exp 1 (NP ?)) (con 2 (clause (that) (finite ? ?))))) \n(abbrev v/subj-that ((con 1 (clause that (finite ? ?))) (exp 2 (NP ?)))) \n(abbrev v/it-that ((nil 1 it) (exp 2 (NP ?)) \n\n(con 3 (clause that (finite ? ?))))) \n(abbrev v/inf ((agt 1 (NP ?x)) (con 3 (VP infinitive ?x)))) \n(abbrev v/promise ((agt 1 (NP ?x)) (goal (2) (NP ?y)) \n\n(con 3 (VP infinitive ?x)))) \n(abbrev v/persuade ((agt 1 (NP ?x)) (goal 2 (NP ?y)) \n\n(con 3 (VP infinitive ?y)))) \n(abbrev v/want ((agt 1 (NP ?x)) (con 3 (VP infinitive ?x)))) \n(abbrev v/p-up ((agt 1 (NP ?)) (pat 2 (NP ?)) (nil 3 (P up)))) \n(abbrev v/pp-for ((agt 1 (NP ?)) (pat 2 (PP for ?)))) \n(abbrev v/pp-after ((agt 1 (NP ?)) (pat 2 (PP after ?)))) \n\n\f\n<a id='page-734'></a>\n\nVerbs \n\nThe macro verb allows us to list verbs in the form below, where the spellings of each \ntense can be omitted if the verb is regular: \n\n(verb (base past-tense past-participle present-participle present-plural) \n{semantics complement-list,..) ...) \n\nFor example, in the following list \"ask\" is regular, so only its base-form spelling is \nnecessary. \"Do,\" on the other hand, is irregular, so each form is spelled out. The \nhaphazard list includes verbs that are either useful for examples or illustrate some \nunusual complement list. \n\n(verb (ask) (query v/ditrans)) \n(verb (delete) (delete v/trans)) \n(verb (do did done doing does) (perform v/trans)) \n(verb (eat ate eaten) (eat v/trans)) \n(verb (give gave given giving) (give-1 v/trans2 v/ditrans) \n\n(donate v/trans v/intrans)) \n(verb (go went gone going goes)) \n(verb (have had had having has) (possess v/trans)) \n(verb (know knew known) (know-that v/opt-that) (know-of v/trans)) \n(verb (like) (like-1 v/trans)) \n(verb (look) (look-up v/p-up) (search v/pp-for) \n\n(take-care v/pp-after) (look v/intrans)) \n(verb (move moved moved moving moves) \n\n(self-propel v/intrans) (transfer v/trans2)) \n(verb (persuade) (persuade v/persuade)) \n(verb (promise) (promise v/promise)) \n(verb (put put put putting)) \n(verb (rain) (rain v/it-nulD) \n(verb (saw) (cut-with-saw v/trans v/intrans)) \n(verb (see saw seen seeing) (understand v/intrans v/opt-that) \n\n(look v/trans)(dating v/trans)) \n(verb (sleep slept) (sleep v/intrans)) \n(verb (surprise) (surprise v/subj-that v/it-that)) \n(verb (tell told) (tell v/persuade)) \n(verb (trust) (trust v/trans ((agt 1 (NP ?)) (obj 2 (PP in ?))))) \n(verb (try tried tried trying tries) (attempt v/inf)) \n(verb (visit) (visit v/trans)) \n(verb (want) (desire v/want v/persuade)) \n\n\f\n<a id='page-735'></a>\n\nAuxiliary Verbs \n\nAuxiliary verbs are simple enough to be described directly with the word macro. Each \nentry lists the auxiliary itself, the tense it is used to construct, and the tense it must \nbe followed by. The auxiliaries \"have\" and \"do\" are listed, along with \"to,\" which is \nused to construct infinitive clauses and thus can be treated as if it were an auxiliary. \n\n(word have aux nonfinite -en) \n(word have aux (finite ~3sing present) -en) \n(word has aux (finite 3sing present) -en) \n(word had aux (finite ? past) -en) \n(word having aux -ing -en) \n\n(word do aux (finite ~3sing present) nonfinite) \n(word does aux (finite 3sing present) nonfinite) \n(word did aux (finite ? past) nonfinite) \n\n(word to aux infinitive nonfinite) \n\nThe auxiliary \"be\" is special: in addition to its use as both an auxiliary and main \nverb, it also is used in passives and as the main verb in aux-inverted sentences. The \nfunction copul a is used to keep track of all these uses. It will be defined in the next \nsection, but you can see it takes two arguments, a list of senses for the main verb, and \na list of entries for the auxiliary verb. The three senses correspond to the examples \n\"He is a fool,\" \"He is a Republican,\" and \"He is in Indiana,\" respectively. \n\n(copula \n\n'((nil ((nil 1 (NP ?x)) (nil 2 (Adj ?x)))) \n(is-a ((exp 1 (NP ?x)) (arg2 2 (NP ?y)))) \n(is-loc ((exp 1 (NP ?x)) (?prep 2 (PP ?prep ?))))) \n\n'((be nonfinite -ing) \n(been -en -ing) \n(being -ing -en) \n(am (finite Ising present) -ing) \n(is (finite 3sing present) -ing) \n(are (finite 2pers present) -ing) \n(were (finite (--??) past) -ing) ; 2nd sing or pi \n(was (finite (?-?-) past) -ing))) ; 1st or 3rd sing \n\nFollowing are the modal auxiliary verbs. Again, it is difficult to specify semantics \nfor them. The word \"not\" is also listed here; it is not an auxiliary, but it does modify \nthem. \n\n\f\n<a id='page-736'></a>\n\n(word can modal able past) \n(word could modal able present) \n(word may modal possible past) \n(word might modal possible present) \n(word shall modal mandatory past) \n(word should modal mandatory present) \n(word will modal expected past) \n(word would modal expected present) \n(word must modal necessary present) \n\n(word not not) \n\nNouns \n\nNo attempt has been made to treat nouns seriously. We list enough nouns here to \nmake some of the examples work. The first noun shows a complement list that is \nsufficient to parse \"the destruction of the city by the enemy.\" \n\n(noun destruction * destruction \n\n(pat (2) (PP of ?)) (agt (2) (PP by ?))) \n(noun beach) \n(noun bone) \n(noun box boxes) \n(noun city cities) \n(noun color) \n(noun cube) \n(noun doctor) \n(noun dog dogs) \n(noun enemy enemies) \n(noun file) \n(noun friend friends friend (friend-of (2) (PP of ?))) \n(noun furniture *) \n(noun hat) \n(noun man men) \n(noun saw) \n(noun woman women) \n\nPronouns \n\nHere we list the nominative, objective, and genitive pronouns, followed by interrogative \nand relative pronouns. The only thing missing are reflexive pronouns, such as \n\"myself.\" \n\n\f\n<a id='page-737'></a>\n\n(word I pronoun Ising (common nom) -wh speaker) \n(word we pronoun Iplur (common nom) -wh speaker+other) \n(word you pronoun 2pers (common ?) -wh 1istener) \n(word he pronoun 3sing (common nom) -wh male) \n(word she pronoun 3s ing (common nom) -wh female) \n(word it pronoun 3s ing (common ?) -wh anything) \n(word they pronoun 3plur (common nom) -wh anything) \n\n(word me pronoun Ising (common obj) -wh speaker) \n(word us pronoun Iplur (common obj) -wh speaker+other) \n(word him pronoun 3sing (common obj) -wh male) \n(word her pronoun 3sing (common obj) -wh female) \n(word them pronoun 3plur (common obj) -wh anything) \n\n(word my pronoun Ising gen -wh speaker) \n(word our pronoun Iplur gen -wh speaker+other) \n(word your pronoun 2pers gen -wh 1istener) \n(word his pronoun 3sing gen -wh male) \n(word her pronoun 3sing gen -wh female) \n(word its pronoun 3s ing gen -wh anything) \n(word their pronoun 3plur gen -wh anything) \n(word whose pronoun 3sing gen +wh anything) \n\n(word who pronoun ? (common ?) +wh person) \n(word whom pronoun ? (common obj) +wh person) \n(word what pronoun ? (common ?) +wh thing) \n(word which pronoun ? (common ?) +wh thing) \n\n(word who rel-pro ? person) \n(word which rel-pro ? thing) \n(word that rel-pro ? thing) \n(word whom rel-pro (common obj) person) \n\nNames \n\nThe following names were convenient for one example or another: \n\n(word God name 3sing) (word Lynn name 3sing) \n(word Jan name 3sing) (word Mary name 3sing) \n(word John name 3sing) (word NY name 3sing) \n(word Kim name 3sing) (word LA name 3sing) \n(word Lee name 3sing) (word SF name 3sing) \n\n\f\n<a id='page-738'></a>\n\nAdjectives \n\nHere are a few adjectives: \n\n(word big adj big) (word bad adj bad) \n(word old adj old) (word smart adj smart) \n(word green adj green) (word red adj red) \n(word tal l adj tall ) (word fun adj fun) \n\nAdverbs \n\nThe adverbs covered here include interrogatives: \n\n(word quickly adv -wh quickly) \n(word slowly adv -wh slowly) \n\n(word where adv +wh loc) \n(word when adv +wh time) \n(word why adv +wh reason) \n(word how adv +wh manner) \n\nArticles \n\nThe common articles are listed here: \n\n(word the art 3sing the) \n(word the art Splur group) \n(word a art Ssing a) \n(word an art Ssing a) \n(word every art Ssing every) \n(word each art Ssing each) \n(word all art Ssing all) \n(word some art ? some) \n\n(word this art Ssing this) \n(word that art Ssing that) \n(word these art Splur this) \n(word those art Splur that) \n\n(word what art ? wh) \n(word which art ? wh) \n\n\f\n<a id='page-739'></a>\n\nCardinal and Ordinal Numbers \n\nWe can take advantage of format's capabilities to fill up the lexicon. To go beyond \n20, we would need a subgrammar of numbers. \n\nThis puts in numbers up to twenty, as if by \n\n(word five cardinal 5 3plur) \n\n(word fifth ordinal 5) \n\n(dotimes (i 21) \n(add-word (read-from-string (format nil \"~r\" i)) \n'cardinal i (if (= i 1) 'Ssing 'Splur)) \n(add-word (read-from-string (format nil \"~:r\" i)) Ordinal i)) \n\nPrepositions \n\nHere is a fairly complete list of prepositions: \n\n(word above prep) (word about prep) (word around prep) \n(word across prep) (word after prep) (word against prep) \n(word along prep) (word at prep) (word away prep) \n(word before prep) (word behind prep) (word below prep) \n\n(word beyond prep) (word by prep) (word down prep) \n(word for prep) (word from prep) (word in prep) \n(word of prep) (word off prep) (word on prep) \n(word out prep) (word over prep) (word past prep) \n\n(word since prep) (word through prep)(word throughout prep) \n\n(word till prep) (word to prep) (word under prep) \n\n(word until prep) (word up prep) (word with prep) \n\n(word without prep) \n\n21.12 Supporting the Lexicon \nThis section describes the implementation of the macros word, verb, noun, and \nabbrev. Abbreviations are stored in a hash table. The macro abbrev and the functions \nget-abbrev and clear-abbrevs define the interface. We will see how to expand \nabbreviations later. \n\n\f\n<a id='page-740'></a>\n\n(defvar *abbrevs* (make-hash-table)) \n\n(defmacro abbrev (symbol definition) \n\"Make symbol be an abbreviation for definition.\" \n\n'(setf (gethash '.symbol *abbrevs*) '.definition)) \n(defun clear-abbrevs () (clrhash *abbrevs*)) \n(defun get-abbrev (symbol) (gethash symbol *abbrevs*)) \n\nWords are also stored in a hash table. Currently, words are symbols, but it might \nbea better idea to use strings for words, since then we could maintain capitalization \ninformation. The macro word or the function add-word adds a word to the lexicon. \nWhen used as an index into the hash table, each word returns a list of entries, where \nthe first element of each entry is the word's category, and the other elements depend \non the category. \n\n(defvar *words* (make-hash-table :size 500)) \n\n(defmacro word (word cat &rest info) \n\"Put word, with category and subcat info, into lexicon.\" \n'(add-word '.word '.cat ..(mapcar #'kwote info))) \n\n(defun add-word (word cat &rest info) \n\"Put word, with category and other info, into lexicon.\" \n(push (cons cat (mapcar #'expand-abbrevs-and-variables info)) \n\n(gethash word *words*)) \nword) \n\n(defun kwote (x) (list 'quote x)) \n\nThe function expand-abbrevs-and-variables expands abbreviations and substitutes \nvariable structures for symbols beginning with ?. This makes it easier to make \na copy of the structure, which will be needed later. \n\n(defun expand-abbrevs-and-variables (exp) \n\"Replace all variables in exp with vars, and expand abbrevs.\" \n(let ((bindings nil)) \n\n(labels \n((expand (exp) \n\n(cond \n((lookup exp bindings)) \n((eq exp '?) (?)) \n((variable-p exp) \n\n(let ((var (?))) \n(push (cons exp var) bindings) \nvar)) \n\n((consp exp) \n(reuse-cons (expand (first exp)) \n\n\f\n<a id='page-741'></a>\n(expand (rest exp)) \nexp)) \n(t (multiple-value-bind (expansion found?) \n(get-abbrev exp) \n\n(if found? \n(expand-abbrevs-and-variables expansion) \nexp)))))) \n\n(expand exp)))) \n\nNow we can store words in the lexicon, but we need some way of getting them out. \nThe function word/. takes a word (which must be instantiated to a symbol) and a \ncategory and optional additional information and finds the entries in the lexicon for \nthat word that unify with the category and additional information. For each match, \nit calls the supplied continuation. This means that word/. is a replacement for a long \nlist of word facts. There are three differences: word/n hashes, so it will be faster; it is \nincremental (you can add a word at a time without needing to recompile); and it can \nnot be used when the word is unbound. (It is not difficult to change it to handle an \nunbound word using maphash, but there are better ways of addressing that problem.) \n\n(defun word/n (word cat cont &rest info) \n\"Retrieve a word from the lexicon.\" \n(unless (unbound-var-p (deref word)) \n\n(let ((old-trail (fil 1-pointer nrail*))) \n(dolist (old-entry (gethash word *words*)) \n(let ((entry (deref-copy old-entry))) \n\n(when (and (consp entry) \n(unify! cat (first entry)) \n(unify! info (rest entry))) \n\n(funcall cont))) \n(undo-bindings! old-trail))))) \n\nNote that word/n does not follow our convention of putting the continuation last. \nTherefore, we will need the following additional functions: \n\n(defun word/2 (w cat cont) (word/n w cat cont)) \n(defun word/3 (w cat a cont) (word/n w cat cont a)) \n(defun word/4 (w cat a b cont) (word/n w cat cont a b)) \n(defun word/5 (w cat a b c cont) (word/n w cat cont a b c)) \n(defun word/6 (w cat a b c d cont) (word/n w cat cont a bed)) \n\nWe could create the whole lexicon with the macro word, but it is convenient to create \nspecific macros for some classes. The macro noun is used to generate two entries, one \nfor the singular and one for the plural. The arguments are the base noun, optionally \nfollowed by the plural (which defaults to the base plus \"s\"), the semantics (which \n\n\f\n<a id='page-742'></a>\n\ndefaults to the base), and a list of complements. Mass nouns, like \"furniture,\" have \nonly one entry, and are marked by an asterisk where the plural would otherwise be. \n\n(defmacro noun (base &rest args) \n\"Add a noun and its plural to the lexicon.\" \n*(add-noun-form '.base ,(mapcar #'kwote args))) \n\n(defun add-noun-form (base &optional (plural (symbol base 's)) \n(sem base) &rest slots) \n\n(if (eq plural '*) \n(add-word base 'noun *? slots sem) \n(progn \n\n(add-word base 'noun '3sing slots sem) \n(add-word plural 'noun '3plur slots sem)))) \n\nVerbs are more complex. Each verb has seven entries: the base or nonfinite, the \npresent tense singular and plural, the past tense, the past-participle, the present-\nparticiple, and the passive. The macro verb automatically generates all seven entries. \nVerbs that do not have all of them can be handled by individual calls to word. We \nautomatically handle the spelling for the simple cases of adding \"s,\" \"ing,\" and \"ed,\" \nand perhaps stripping a trailing vowel. More irregular spellings have to be specified \nexplicitly. Here are three examples of the use of verb: \n\n(verb (do did done doing does) (perform v/trans)) \n(verb (eat ate eaten) (eat v/trans)) \n\n(verb (trust) (trust v/trans ((agt 1 (NP ?)) (obj 2 (PP in ?))))) \n\nAnd here is the macro definition: \n\n(defmacro verb ((base &rest forms) &body senses) \n\"Enter a verb into the lexicon.\" \n\n'(add-verb '.senses '.base .(mapcar #'kwote (mklist forms)))) \n(defun add-verb (senses base &optional \n(past (symbol (strip-vowel base) 'ed)) \n(past-part past) \n(pres-part (symbol (strip-vowel base) 'ing)) \n(plural (symbol base 's))) \n\n\"Enter a verb into the lexicon.\" \n(add-word base 'verb 'nonfinite senses) \n(add-word base 'verb '(finite ~3sing present) senses) \n(add-word past 'verb '(finite ? past) senses) \n(add-word past-part 'verb '-en senses) \n(add-word pres-part 'verb '-ing senses) \n(add-word plural 'verb '(finite 3sing present) senses) \n(add-word past-part 'verb 'passive \n\n\f\n<a id='page-743'></a>\n(mapcar #'passivize-sense \n(expand-abbrevs-and-vari ables senses)))) \n\nThis uses a few auxiliary functions. First, stri p-vowel removes a vowel if it is the \nlast character of the given argument. The idea is that for a verb like \"fire,\" stripping \nthe vowel yields \"fir,\" from which we can get \"fired\" and \"firing\" automatically. \n\n(defun strip-vowel (word) \n\"Strip off a trailing vowel from a string.\" \n(let* ((str (string word)) \n\n(end (- (length str) 1))) \n\n(if (vowel-p (char str end)) \n(subseq str 0 end) \nstr))) \n\n(defun vowel-p (char) (find char \"aeiou\" :test #'char-equal)) \n\nWe also provide a function to generate automatically the passive sense with the \nproper complement list(s). The idea is that the subject slot of the active verb becomes \nan optional slot marked by the preposition \"by,\" and any slot that is marked with \nnumber 2 can be promoted to become the subject: \n\n(defun passivize-sense (sense) \nThe first element of sense is the semantics; rest are slots \n(cons (first sense) (mapcan #*passivize-subcat (rest sense)))) \n\n(defun passivize-subcat (slots) \n\n\"Return a list of passivizations of this subcat frame.\" \nWhenever the 1 slot is of the form (?any 1 (NP ?)), \ndemote the 1 to a (3), and promote any 2 to a 1. \n\n(when (and (eql (slot-number (first slots)) 1) \n(starts-with (third (first slots)) 'NP)) \n(let ((old-1 .(,(first (first slots)) (3) (PP by ?)))) \n\n(loop for slot in slots \nwhen (eql (slot-number slot) 2) \ncollect '((.(first slot) 1 .(third slot)) \n\n,@(remove slot (rest slots)) \n.old-1))))) \n\n(defun slot-number (slot) (first-or-self (second slot))) \n\nFinally, we provide a special function just to define the copula, \"be.\" \n\n\f\n<a id='page-744'></a>\n\n(defun copula (senses entries) \n\"Copula entries are both aux and main verb.\" \nThey also are used in passive verb phrases and aux-inv-S \n\n(dolist (entry entries) \n(add-word (first entry) 'aux (second entry) (third entry)) \n(add-word (first entry) 'verb (second entry) senses) \n(add-word (first entry) 'aux (second entry) 'passive) \n(add-word (first entry) 'be))) \n\nThe remaining functions are used for testing, debugging, and extending the grammar. \nFirst, we need functions to clear everything so that we can start over. These functions \ncan be placed at the top of the lexicon and grammar files, respectively: \n\n(defun clear-lexicon () \n(clrhash *words*) \n(clear-abbrevs)) \n\n(defun clear-grammar () \n(clear-examples) \n(clear-db)) \n\nTesting could be done with run-exampl es, but it is convenient to provide another \ninterface, the macro try (and its corresponding function, try-dcg). Both macro and \nfunction can be invoked three ways. With no argument, all the examples stored by \n: ex are run. When the name of a category is given, all the examples for that category \nalone are run. Finally, the user can supply both the name of a category and a list of \nwords to test whether those words can be parsed as that category. This option is only \navailable for categories that are listed in the definition: \n\n(defmacro try (&optional cat &rest words) \n\"Tries to parse WORDS as a constituent of category CAT. \nWith no words, runs all the :ex examples for category. \nWith no cat. runs all the examples.\" \n'(try-dcg '.cat '.words)) \n\n(defun try-dcg (&optional cat words) \n\"Tries to parse WORDS as a constituent of category CAT. \nWith no words, runs all the :ex examples for category. \nWith no cat. runs all the examples.\" \n(if (null words) \n\n(run-examples cat) \n\n(let ((args '((gap nil) (gap nil) ?sem .words ()))) \n(mapc #'test-unknown-word words) \n(top-level-prove \n\n(ecase cat \n(np '((np ? ? ?wh ?x .args))) \n\n\f\n<a id='page-745'></a>\n(vp '((vp ?infl ?x ?sl ?v ,@args))) \n(pp '((pp ?prep ?role ?wh ?x ,@args))) \n(xp *((xp ?slot ?constituent ?wh ?x .args))) \n(s *((s ? ?sem .words ()))) \n(rel-clause '((rel-clause ? ?x ?sem .words ()))) \n(clause '((clause ?infl ?x ?int-subj ?v ?gl ?g2 \n\n?sem .words ())))))))) \n\n(defun test-unknown-word (word) \n\"Print a warning message if this is an unknown word.\" \n(unless (or (gethash word *words*) (numberp word)) \n\n(warn \"\"&Unknown word: ~a\" word))) \n\n21.13 Other Primitives \nTo support the -.test predicates made in various grammar rules we need definitions \nof the Prolog predicates i f, member, =, numberp, and atom. They are repeated here: \n\n(<- (if ?test ?then) (if ?then ?else (fail))) \n(<- (if ?test ?then ?else) (call ?test) ! (call ?then)) \n(<- (if ?test ?then ?else) (call ?else)) \n\n(<- (member ?item (?item . ?rest))) \n\n(<- (member ?item (?x . ?rest)) (member ?item ?rest)) \n\n(<- (= ?x ?x)) \n\n(defun numberp/1 (x cont) \n(when (numberp (deref x)) \n(funcall cont))) \n\n(defun atom/1 (x cont) \n(when (atom (deref x)) \n(funcall cont))) \n\n(defun cal 1/1 (goal cont) \n\"Try to prove goal by calling it.\" \n(deref goal) \n(apply (make-predicate (first goal) \n\n(length (args goal))) \n(append (args goal) (list cont)))) \n\n\f\n<a id='page-746'></a>\n\n21.14 Examples \nHere are some examples of what the parser can handle. I have edited the output \nby changing variable names like ? 168 to more readable names like ?J. The first \ntwo examples show that nested clauses are supported and that we can extract a \nconstituent from a nested clause: \n\n> (try S John promised Kim to persuade Lee to sleep) \n\n?SEM = (AND (THE ?J (NAME JOHN ?J)) (AGT ?P ?J) \n(PAST ?P) (PROMISE ?P) \n(GOAL ?P ?K) (THE ?K (NAME KIM ?K)) \n(CON ?P ?PER) (PERSUADE ?PER) (GOAL ?PER ?L) \n(THE ?L (NAME LEE ?L)) (CON ?PER ?S) (SLEEP ?S)); \n\n> (try S Who did John promise Kim to persuade to sleep) \n\n?SEM = (AND (WH ?W (PERSON ?W)) (PAST ?P) \n(THE ?J (NAME JOHN ?J)) (AGT ?P ?J) \n(PROMISE ?P) (GOAL ?P ?K) \n(THE ?K (NAME KIM ?K)) (CON ?P ?PER) \n(PERSUADE ?PER) (GOAL ?PER ?W) \n(CON ?PER ?S) (SLEEP ?S)); \n\nIn the next example, the \"when\" can be interpreted as asking about the time of any of \nthe three events: the promising, the persuading, or the sleeping. The grammar finds \nall three. \n\n> (try S When did John promise Kim to persuade Lee to sleep) \n\n?SEM = (AND (WH ?W (TIME ?S ?W)) (PAST ?P) \n(THE ?J (NAME JOHN ?J)) (AGT ?P ?J) \n(PROMISE ?P) (GOAL ?P ?K) \n(THE ?K (NAME KIM ?K)) (CON ?P ?PER) \n(PERSUADE ?PER) (GOAL ?PER ?L) \n(THE ?L (NAME LEE ?L)) (CON ?PER ?S) \n(SLEEP ?S)); \n\n?SEM = (AND (WH ?W (TIME ?PER ?W)) (PAST ?P) \n(THE ?J (NAME JOHN ?J)) (AGT ?P ?J) \n(PROMISE ?P) (GOAL ?P ?K) \n(THE ?K (NAME KIM ?K)) (CON ?P ?PER) \n(PERSUADE ?PER) (GOAL ?PER ?L) \n(THE ?L (NAME LEE ?L)) (CON ?PER ?S) \n(SLEEP ?S)); \n\n\f\n<a id='page-747'></a>\n?SEM = (AND (WH ?W (TIME ?P ?W)) (PAST ?P) \n(THE ?J (NAME JOHN ?J)) (AGT ?P ?J) \n(PROMISE ?P) (GOAL ?P ?K) \n(THE ?K (NAME KIM ?K)) (CON ?P ?PER) \n(PERSUADE ?PER) (GOAL ?PER ?L) \n(THE ?L (NAME LEE ?L)) (CON ?PER ?S) \n(SLEEP ?S)). \n\nThe next example shows auxiliary verbs and negation. It is ambiguous between \nan interpretation where Kim is searching for Lee and one where Kim is looking at \nsomething unspecified, on Lee's behalf. \n\n> (try S Kim would not have been looking for Lee) \n\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?S ?K) \n(EXPECTED ?S) (NOT ?S) (PAST-PARTICIPLE ?S) \n(PROGRESSIVE ?S) (SEARCH ?S) (PAT ?S ?L) \n(PAT ?S ?L) (THE ?L (NAME LEE ?L))); \n\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?2 ?K) \n(EXPECTED ?2) (NOT ?2) (PAST-PARTICIPLE ?LOOK) \n(PROGRESSIVE ?LOOK) (LOOK ?LOOK) (FOR ?LOOK ?L) \n(THE ?L (NAME LEE ?L))); \n\nThe next two examples are unambiguous: \n\n> (try s It should not surprise you that Kim does not like Lee) \n\n?SEM = (AND (MANDATORY ?2) (NOT ?2) (SURPRISE ?2) (EXP ?2 ?YOU) \n(PRO ?YOU (LISTENER ?YOU)) (CON ?2 ?LIKE) \n(THE ?K (NAME KIM ?K)) (AGT ?LIKE ?K) \n(PRESENT ?LIKE) (NOT ?LIKE) (LIKE-1 ?LIKE) \n(OBJ ?LIKE ?L) (THE ?L (NAME LEE ?L))); \n\n> (try s Kim did not want Lee to know that the man knew her) \n\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?W ?K) (PAST ?W) \n(NOT ?W) (DESIRE ?W) (GOAL ?W ?L) \n(THE ?L (NAME LEE ?L)) (CON ?W ?KN) \n(KNOW-THAT ?KN) (CON ?KN ?KN2) \n(THE ?M (MAN ?M)) (AGT ?KN2 ?M) (PAST ?KN2) \n(KNOW-OF ?KN2) (OBJ ?KN2 ?HER) \n(PRO ?HER (FEMALE ?HER))). \n\nThe final example appears to be unambiguous, but the parser finds four separate \nparses. The first is the obvious interpretation where the looking up is done quickly, \nand the second has quickly modifying the surprise. The last two interpretations are \nthe same as the first two; they are artifacts of the search process. A disambiguation \nprocedure should be equipped to weed out such duplicates. \n\n\f\n<a id='page-748'></a>\n\n> (try s That Kim looked her up quickly surprised me) \n\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU1 ?K) (PAST ?LU1) \n(LOOK-UP ?LU1) (PAT ?LU1 ?H) (PRO ?H (FEMALE ?H)) \n(QUICKLY ?LU1) (CON ?S ?LU1) (PAST ?S) (SURPRISE ?S) \n(EXP ?S ?ME1) (PRO ?ME1 (SPEAKER ?ME1))); \n\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU2 ?K) (PAST ?LU2) \n(LOOK-UP ?LU2) (PAT ?LU2 ?H) (PRO ?H (FEMALE ?H)) \n(CON ?S ?LU2) (QUICKLY ?S) (PAST ?S) (SURPRISE ?S) \n(EXP ?S ?ME2) (PRO ?ME2 (SPEAKER ?ME2))); \n\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU3 ?K) (PAST ?LU3) \n(LOOK-UP ?LU3) (PAT ?LU3 ?H) (PRO ?H (FEMALE ?H)) \n(QUICKLY ?LU3) (CON ?S ?LU3) (PAST ?S) (SURPRISE ?S) \n(EXP ?S ?ME3) (PRO ?ME3 (SPEAKER ?ME3))); \n\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU4 ?K) (PAST ?LU4) \n(LOOK-UP ?LU4) (PAT ?LU4 ?H) (PRO ?H (FEMALE ?H)) \n(CON ?S ?LU4) (QUICKLY ?S) (PAST ?S) (SURPRISE ?S) \n(EXP ?S ?ME4) (PRO ?ME4 (SPEAKER ?ME4))): \n\n21.15 History and References \nChapter 20 provides some basic references on natural language. Here we will concentrate \non references that provide: \n\n1. A comprehensive grammar of English. \n2. A complete implementation. \nThere are a few good textbooks that partially address both issues. Both Winograd \n(1983) and Allen (1987) do a good job of presenting the major grammatical features of \nEnglish and discuss implementation techniques, but they do not provide actual code. \n\nThere are also a few textbooks that concentrate on the second issue. Ramsey and \nBarrett (1987) and Walker et al. (1990) provide chapter-length implementations at \nabout the same level of detail as this chapter. Both are recommended. Pereira and \nShieber 1987 and Gazdar and Mellish 1989 are book-length treatments, but because \nthey cover a variety of parsing techniques rather than concentrating on one in depth, \nthey are actually less comprehensive. \n\nSeveral linguists have made serious attempts at addressing the first issue. The \nlargest is the aptly namedA Comprehensive Grammar of Contemporary English by Quirk, \nGreenbaum, Leech and Svartik (1985). More manageable (although hardly concise) \nis their abridged edition, A Concise Grammar of Contemporary English. Both editions \ncontain a gold mine of examples and facts about the English langauge, but the authors \n\n\f\n<a id='page-749'></a>\ndo not attempt to write rigorous rules. Harris (1982) and Huddleston (1984) offer \nless complete grammars with greater linguistic rigor. \n\nNaomi Sager (1981) presents the most complete computerized grammar ever \npublished. The grammar is separated into a simple, neat, context-free component \nand a rather baroque augmentation that manipulates features. \n\n21.16 Exercises \n&#9635; Exercise 21.1 [m] Change the grammar to account better for mass nouns. The current \ngrammar treats mass nouns by making them vague between singular and plural, \nwhich is incorrect. They should be treated separately, since there are determiners \nsuch as \"much\" that work only with mass nouns, and other determiners such as \n\"these\" that work only with plural count nouns. \n\n&#9635; Exercise 21.2 [m] Change the grammar to make a distinction between attributive \nand predicative adjectives. Most adjectives fall into both classes, but some can be used \nonly attributively, as in \"an utter fool\" but not\" * the fool is utter.\" Other adjectives can \nonly be used predicatively, as in \"the woman was loath to admit it\" but not \"*a loath \n(to admit it) woman.\" \n\n&#9635; Exercise 21.3 Pi] Implement complement lists for adjectives, so that \"loath\" would \ntake an obligatory infinitive complement, and \"proud\" would take an optional (PP \nof) complement. In connection to the previous exercise, note that it is rare if not \nimpossible for attributive adjectives to take complements: \"he is proud,\" \"he is proud \nof his country\" and \"a proud citizen\" are all acceptable, but \"*a proud of his country \ncitizen\" is not. \n\n&#9635; Exercise 21.4 [m] Add rules to advp to allow for adverbs to modify other adverbs, \nas in \"extremely likely\" or \"very strongly.\" \n\n&#9635; Exercise 21.5 [h] Allow adverbs to modify adjectives, as in \"very good\" or \"really \ndelicious.\" The syntax will be easy, but it is harder to get a reasonable semantics. \nWhile you're at it, make sure that you can handle adjectives with so-called nonintersective \nsemantics. Some adjectives can be handled by intersective semantics: a red \ncircle is something that is red and is a circle. But for other adjectives, this model \ndoes not work: a former senator is not something that is former and is a senator - \nformer senator is not a senator at all. Similarly, a toy elephant is not an elephant. \n\n\f\n<a id='page-750'></a>\n\nThe semantics should be represented by something closer to ((toy elephant) ?x) \nrather than (and (toy ?x) (elephant ?x)). \n&#9635; Exercise 21.6 [m] Write a function that notices punctuation instead of ignoring it. \nIt should work something like this: \n> (string->words \"Who asked Lee. Kim and John?\") \n(WHO ASKED LEE I.I KIM AND JOHN l?l ) \n\n&#9635; Exercise 21.7 [m] Change the grammar to allow optional punctuation marks at the \nend of sentences and before relative clauses. \n\n&#9635; Exercise 21.8 [m] Change the grammar to allow conjunction with more than two \nelements, using commas. Can these rules be generated automatically by conj rule? \n\n&#9635; Exercise 21.9 [h] Make a distinction between restrictive and nonrestrictive relative \nclauses. In \"The truck that has 4-wheel drive costs $5000,\" the italicized relative clause \nis restrictive. It serves to identify the truck and thus would be part of the quantifier's \nrestriction. The complete sentence might be interpreted as: \n(and (the ?x (and (truck ?x) (4-wheel-drive ?x))) \n(costs ?x $5000)) \nContrast this to \"The truck, which has 4-wheel drive, costs $5000.\" Here the relative \nclause is nonrestrictive and thus belongs outside the quantifier's restriction: \n(and (the ?x (truck ?x)) \n(4-wheel-drive ?x)(cost s ?x $5000)) \n\n\f\n## Chapter 22\n<a id='page-753'></a>\n\nScheme: An Uncommon Lisp \n\nThe best laid schemes o' mice an' men \n\n-Robert Burns (1759-1796) \n\nr I 1 his chapter presents the Scheme dialect of Lisp and an interpreter for it. While it is not \n\nI likely that you would use this interpreter for any serious programming, understanding \n\nJL how the interpreter works can give you a better appreciation of how Lisp works, and \nthus make you a better programmer. A Scheme interpreter is used instead of a Common Lisp \none because Scheme is simpler, and also because Scheme is an important language that is worth \nknowing about. \n\nScheme is the only dialect of Lisp besides Common Lisp that is currently flourishing. Where \nCommon Lisp tries to standardize all the important features that are in current use by Lisp \nprogrammers. Scheme tries to give a minimal set of very powerful features that can be used to \nimplement the others. It is interesting that among all the programming languages in the world. \nScheme is one of the smallest, while Common Lisp is one of the largest. The Scheme manual \nis only 45 pages (only 38 if you omit the example, bibliography, and index), while Common Lisp \nthe Language, 2d edition, is 1029 pages. Here is a partial list of the ways Scheme is simpler than \nCommon Lisp: \n\n\f\n<a id='page-754'></a>\n\n1. Scheme has fewer buUt-in functions and special forms. \n2. Scheme has no special variables, only lexical variables. \n3. Scheme uses the same name space for functions and variables (and everything \nelse). \n4. Scheme evaluates the function part of a function call in exactly the same way \nas the arguments. \n5. Scheme functions can not have optional and keyword parameters. However, \nthey can have the equivalent of a &rest parameter. \n6. Scheme has no block, return, go, or throw; a single function (cal 1 /cc) replaces \nall of these (and does much more). \n7. Scheme has no packages. Lexical variables can be used to implement packagelike \nstructures. \n8. Scheme, as a standard, has no macros, although most implementations provide \nmacros as an extension. \n9. Scheme has no special forms for looping; instead it asks the user to use recursion \nand promises to implement the recursion efficiently. \nThe five main special forms in Scheme are quote and if, which are just as in \nCommon Lisp; begin and setl, which are just different spellings for progn and \nsetq; and 1 ambda, which is as in Common Lisp, except that it doesn't require a \n#' before it. In addition. Scheme allows variables, constants (numbers, strings, and \ncharacters), and function calls. The function call is different because the function \nitself is evaluated in the same way as the arguments. In Common Lisp, (fx) means \nto look up the function binding of f and apply that to the value of x. In Scheme, (fx) \nmeans to evaluate f (in this case by looking up the value of the variable f), evaluate \nX (by looking up the value of the variable in exactly the same way) and then apply \nthe function to the argument. Any expression can be in the function position, and \nit is evaluated just like the arguments. Another difference is that Scheme uses #t \nand #f for true and false, instead of t and nil. The empty list is denoted by (), and \nit is distinct from the false value, #f. There are also minor lexical differences in the \nconventions for complex numbers and numbers in different bases, but these can be \nignored for all the programs in this book. Also, in Scheme a single macro, def i ne, \nserves to define both variables and functions. \n\n\f\n<a id='page-755'></a>\n\nScheme Common Lisp \n\nvar var \n\nconstant constant \n\n(quotes) or *x (quotes) or 'x \n\n(beginx..) (progn X..) \n\n(set! varx) (setq varx) \n\n(ifpab) (ifpab) \n\n(lambda parms x...) #'( 1 ambda parmsx...) \n\n{fn arg.) (fnarg...) or (funcall fnarg...) \n\n#t t \n\n#f nil \n\n() nil \n\n(define varexp) (defparameter varexp) \n\n(define ifnparm...) body) (defun fniparm...) body) \n\n&#9635; Exercise 22.1 [s] What does the following expression evaluate to in Scheme? How \nmany errors does it have as a Common Lisp expression? \n\n((if (= (+ 2 2) 4) \n(lambda (x y) (+ (* . y) 12)) \ncons) \n\n5 \n\n6) \n\nA great many functions, such as car, cdr, cons, append, +, *, and list are \nthe same (or nearly the same) in both dialects. However, Scheme has some spelling \nconventions that are different from Common Lisp. Most Scheme mutators, like \nset!, end in'!'. Common Lisp has no consistent convention for this; some mutators \nstart with . (nreverse, nsubst, nintersection) while others have idiosyncratic \nnames (del ete versus remove). Scheme would use consistent names - reverse! and \nremove! - if these functions were defined at all (they are not defined in the standard). \nMost Scheme predicates end in '?', not 'p'. This makes predicates more obvious \nand eliminates the complicated conventions for adding a hyphen before the p.^ The \nonly problem with this convention is in spoken language: is equal ? pronounced \n\"equal-question-mark\" or \"equal-q\" or perhaps equal, with rising intonation? This \nwould make Scheme a tone language, like Chinese. \n\n^One writes numberp because there is no hyphen in number but random-state-. because \nthere is a hyphen in random-state. However, defstruct concatenates -p in all its predicates, \nregardless of the presence of a hyphen in the structure's name. \n\n\f\n<a id='page-756'></a>\n\nIn Scheme, it is an error to apply car or cdr to the empty list. Despite the fact that \nScheme has cons, it calls the result a pai r rather than a cons cell, so the predicate is \npair?, not consp. \n\nScheme recognizes not all lambda expressions will be \"functions\" according to \nthe mathematical definition of function, and so it uses the term \"procedure\" instead. \nHere is a partial list of correspondences between the two dialects: \n\nScheme Procedure Common Lisp Ftmction \n\nchar-ready? listen \nchar? characterp \neq? eq \nequal? equal \neqv? eql \neven? evenp \nfor-each mapc \ninteger? integerp \nlist->string coerce \nlist->vector coerce \nlist-ref nth \nlist-tail nthcdr \nmap mapcar \nnegative? minusp \npair? consp \nprocedure? functionp \nset! setq \nset-car! replaca \nvector-set! setf \nstring-set! setf \n\n22.1 A Scheme Interpreter \nAs we have seen, an interpreter takes a program (or expression) as input and returns \nthe value computed by that program. The Lisp function eval is thus an interpreter, \nand that is essentially the function we are trying to write in this section. We have \nto be careful, however, in that it is possible to confuse the notions of interpreter and \ncompiler. A compiler takes a program as input and produces as output a translation \nof that program into some other language - usually a language that can be directly \n(or more easily) executed on some machine. So it is also possible to write eval by \ncompiling the argument and then interpreting the resulting machine-level program. \nMost modern Lisp systems support both possibilities, although some only interpret \n\n\f\n<a id='page-757'></a>\ncode directly, and others compile all code before executing it. To make the distinction \nclear, we will not write a function called eval. Instead, we will write versions of two \nfunctions: interp, a Scheme interpreter, and, in the next chapter, comp, a Scheme \ncompiler. \n\nAn interpreter that handles the Scheme primitives is easy to write. In the interpreter \ninterp, the main conditional has eight cases, corresponding to the five \nspecial forms, symbols, other atoms, and procedure applications (otherwise known \nas function calls). For the moment we will stick with t and .i 1 instead of #t and \n#f. After developing a simple interpreter, we will add support for macros, then \ndevelop a tail-recursive interpreter, and finally a continuation-passing interpreter. \n(These terms will be defined when the time comes.). The glossary for i nterp is in \nfigure 22.1. \n\nscheme \ninterp \ndef-scheme-macro \n\n*scheme-procs* \n\nset-var! \nget-var \nset-global-var! \n\nget-global-var \nextend-env \ninit-scheme-interp \ninit-scheme-proc \nscheme-macro \nscheme-macro-expand \nmaybe-add \nprint-proc \n\nproc \n\ninterp-begin \ninterp-call \nmap-interp \ncall/cc \n\nlastl \nlength=1 \n\nTop-Level Fimctions \n\nA Scheme read-interp-print loop. \nInterpret (evaluate) an expression in an environment. \nDefine a Scheme macro. \n\nSpecial Variables \n\nSome procedures to store in the global environment. \n\nAuxiliary Functions \n\nSet a variable to a value. \nGet the value of a variable in an environment. \nSet a global variable to a value. \n\nGet the value of a variable fron the global environment. \nAdd some variables and values to an environment. \nInitialize some global variables. \nDefine a primitive Scheme procedure. \nRetrieve the Scheme macro for a symbol. \nMacro-expand a Scheme expression. \nAdd an element to the front of a non-singleton list. \nPrint a procedure. \n\nData Type (tail-recursive version only) \n\nA Scheme procedure. \n\nFunctions (continuation version only) \n\nInterpret a begi . expression. \nInterpret a function application. \nMap i nterp over a list. \ncall with current continuation. \n\nPreviously Defined Functions \n\nSelect the last element of a list. \nIs this a list of length1? \n\nFigure 22.1: Glossary for the Scheme Interpreter \n\n\f\n<a id='page-758'></a>\n\nThe simple interpreter has eight cases to worry about: (1) If the expression is a \nsymbol, look up its value in the environment. (2) If it is an atom that is not a symbol \n(such as a number), just return it. Otherwise, the expression must be a list. (3) If it \nstarts with quote, return the quoted expression. (4) If it starts with beg i ., interpret \neach subexpression, and return the last one. (5) If it starts with set 1, interpret the \nvalue and then set the variable to that value. (6) If it starts with i f, then interpret \nthe conditional, and depending on if it is true or not, interpret the then-part or the \nelse-part. (7) If it starts with 1 ambda, build a new procedure - a closure over the ctu*rent \nenvironment. (8) Otherwise, it must be a procedure application. Interpret the \nprocedure and all the arguments, and apply the procedure value to the argument \nvalues. \n\n(defun interp (x &optiona1 env) \n\n\"Interpret (evaluate) the expression . in the environment env.\" \n\n(cond \n\n((symbolp x) (get-var . env)) \n\n((atom x) x) \n\n((case (first x) \n\n(QUOTE (second x)) \n(BEGIN (lastl (mapcar #*(lambda (y) (interp y env)) \n(rest x)))) \n(SET! (set-var! (second x) (interp (third x) env) env)) \n(IF (if (interp (second x) env) \n(interp (third x) env) \n(interp (fourth x) env))) \n\n(LAMBDA (let ((parms (second x)) \n(code (maybe-add 'begin (rest2 x)))) \n#*(lambda (&rest args) \n(interp code (extend-env parms args env))))) \n(t ;; a procedure application \n(apply (interp (first x) env) \n(mapcar #'(lambda (v) (interp . env)) \n(rest x)))))))) \n\nAn environment is represented as an association list of variable/value pairs, except \nfor the global environment, which is represented by values on the gl obal - val \nproperty of symbols. It would be simpler to represent the global environment \nin the same way as local environments, but it is more efficient to use property \nlists than one big global a-list. Furthermore, the global environment is distinct \nin that every symbol is implicitly defined in the global environment, while local \nenvironments only contain variables that are explicitly mentioned (in a 1 ambda expression). \n\n\n\f\n<a id='page-759'></a>\nAs an example, suppose we interpret the function call (f 1 2 3), and that the \nfunctions f has been defined by the Scheme expression: \n\n(set! f (lambda (a b c) (+ a (g b c)))) \n\nThen we will interpret (f 1 2 3) by interpreting the body of f with the environment: \n\n((a 1) (b 2) (c 3)) \n\nScheme procedures are implemented as Common Lisp functions, and in fact all the \nScheme data types are implemented by the corresponding Common Lisp types. I \ninclude the function i .i t -s eherne - i . te rp to initialize a few global values and repeat \nthe definitions of last1 and length=1: \n\n(defun set-var! (var val env) \n\"Set a variable to a value, in the given or global environment.\" \n(if (assoc var env) \n\n(setf (second (assoc var env)) val) \n(set-global-var! var val)) \nval) \n\n(defun get-var (var env) \n\"Get the value of a variable, from the given or global environment, \n\n(if (assoc var env) \n(second (assoc var env)) \n(get-global-var var))) \n\n(defun set-global-var! (var val) \n(setf (get var 'global-val) val)) \n\n(defun get-global-var (var) \n(let* ((default \"unbound\") \n(val (get var 'global-val default))) \n\n(if (eq val default) \n(error \"Unbound scheme variable: '\"a\" var) \nval))) \n\n(defun extend-env (vars vals env) \n\"Add some variables and values to an environment.\" \n(nconc (mapcar #'list vars vals) env)) \n\n(defparameter *scheme-procs* \n\n.(+-'/=<><=>= cons car cdr not append list read member \n(null? null) (eq? eq) (equal? equal) (eqv? eql) \n(write prinl) (display princ) (newline terpri))) \n\n\f\n<a id='page-760'></a>\n\n(defun init-scheme-interp () \n\"Initialize the scheme interpreter with some global variables.\" \nDefine Scheme procedures as CL functions: \n(mapc #*init-scheme-proc *scheme-procs*) \n\nDefine the Boolean 'constants*. Unfortunately, this won't \n;; stop someone from saying: (setl t nil) \n(set-global-var! t t) \n(set-global-vari nil nil)) \n\n(defun init-scheme-proc (f) \n\"Define a Scheme procedure as a corresponding CL function.\" \n(if (listp f) \n\n(set-global-var! (first f) (symbol-function (second f))) \n(set-global-var! f (symbol-function f)))) \n\n(defun maybe-add (op exps &optional if-nil) \n\"For example, (maybe-add 'and exps t) returns \nt if exps is nil, exps if there is only one, \nand (and expl exp2...) if there are several exps.\" \n(cond ((null exps) if-nil) \n\n((length=1 exps) (first exps)) \n(t (cons op exps)))) \n\n(defun length=1 (x) \n\"Is X a list of length 1?\" \n(and (consp x) (null (cdr x)))) \n\n(defun lastl (list) \n\"Return the last element (not last cons cell) of list\" \n(first (last list))) \n\nTo test the interpreter, we add a simple read-eval-print loop: \n\n(defun scheme () \n\"A Scheme read-eval-print loop (using interp)\" \n(init-scheme-interp) \n(loop (format t \"\"&==> \") \n\n(print (interp (read) nil)))) \n\nAnd now we're ready to try out the interpreter. Note the Common Lisp prompt is \n\">,\" while the Scheme prompt is \"==>.\" \n\n> (scheme) \n==> (+ 2 2) \n4 \n\n==> ((if (= 1 2) * +) 3 4) \n7 \n\n\f\n<a id='page-761'></a>\n\n= => ((if (= 1 1) * +) 3 4) \n12 \n\n==> (setl fact (lambda (n) \n(if (= . 0) 1 \n(* . (fact (- . 1)))))) \n#<DTP-LEXICAL-CLOSURE 36722615> \n\n==> (fact 5) \n120 \n\n==> (setl table (lambda (f start end) \n(if (<= start end) \n\n(begin \n(write (list start (f start))) \n(newline) \n(table f (+ start 1) end))))) \n\n#<DTP-LEXICAL-CLOSURE 41072172> \n\n==> (table fact 1 10) \n(1 1) \n(2 2) \n(3 6) \n(4 24) \n(5 120) \n(6 720) \n(7 5040) \n(8 40320) \n(9 362880) \n\n(10 3628800) \n\nNIL \n\n==> (table (lambda (x) (* . . .)) 5 10) \n(5 125) \n\n(6 216) \n(7 343) \n(8 512) \n(9 729) \n\n(10 1000) \n\nNIL \n\n= => [ABORT] \n\n\f\n<a id='page-762'></a>\n\n22.2 Syntactic Extension with Macros \nScheme has a number of other special forms that were not listed above. Actually, \nScheme uses the term \"syntax\" where we have been using \"special form.\" The remaining \nsyntax can be defined as \"derived expressions\" in terms of the five primitives. \nThe Scheme standard does not recognize a concept of macros, but it is clear that a \n\"derived expression\" is like a macro, and we will implement them using macros. The \nfollowing forms are used (nearly) identically in Scheme and Common Lisp: \n\nlet let* and or do cond case \n\nOne difference is that Scheme is less lenient as to what counts as a binding in let, \nlet* and do. Every binding must be (var init); just (var) or var is not allowed. In do, \na binding can be either (var init step) or (var init). Notice there is no do*. The other \ndifference is in ca se and cond. Where Common Lisp uses the symbol t or otherwi se \nto mark the final case. Scheme uses el se. The final three syntactic extensions are \nunique to Scheme: \n\n(define var val) or (define (proc-name arg...) body...) \n\n(delay expression) \n\n(letrec {{varinit)...) body...) \n\ndefine is a combination of defun and defparameter. In its first form, it assigns a \nvalue to a variable. Since there are no special variables in Scheme, this is no different \nthan using set!. (There is a difference when the def i ne is nested inside another \ndefinition, but that is not yet considered.) In the second form, it defines a function, \ndel ay is used to delay evaluation, as described in section 9.3, [page 281](chapter9.md#page-281). letrec is \nsimilar to let. The difference is that all the init forms are evaluated in an environment \nthat includes all the pars. Thus, letrec can be used to define local recursive functions, \njust as 1 abel s does in Common Lisp. \n\nThe first step in implementing these syntactic extensions is to change i nterp to \nallow macros. Only one clause has to be added, but we'll repeat the whole definition: \n\n(defun interp (x &optional env) \n\n\"Interpret (evaluate) the expression . in the environment env. \n\nThis version handles macros.\" \n\n(cond \n\n((symbolp x) (get-var . env)) \n\n((atom x) x) \n\n((scheme-macro (first x)) ;*** \n\n(interp (scheme-macro-expand x) env)) ;*** \n\n((case (first x) \n\n(QUOTE (second x)) \n\n\f\n<a id='page-763'></a>\n(BEGIN (last l (mapcar #'(lambda (y) (interp y env)) \n(rest X))) ) \n(SET! (set-var ! (second x) (interp (third x) env) env)) \n(IF (if (interp (second x) env) \n(interp (third x) env) \n(interp (fourth x) env))) \n\n(LAMBDA (let ((parms (second x)) \n(code (maybe-add 'begin (rest2 x)))) \n#'(lambda (&rest args) \n(interp code (extend-env parms args env))))) \n(t ;; a procedure application \n(apply (interp (first x) env) \n(mapcar #*(lambda (v) (interp . env)) \n(rest X)))))))) \n\nNow we provide a mechanism for defining macros. The macro definitions can be in \nany convenient language; the easiest choices are Scheme itself or Common Lisp. I \nhave chosen the latter. This makes it clear that macros are not part of Scheme itself but \nrather are used to implement Scheme. If we wanted to offer the macro facility to the \nScheme programmer, we would make the other choice. (But then we would be sure to \nadd the backquote notation, which is so useful in writing macros.) def -s cheme - mac ro \n(which happens to be a macro itself) provides a way of adding new Scheme macros. \nIt does that by storing a Common Lisp function on the scheme-macro property of \na symbol. This^furiction, when given a list of ai-gumehts, returns the code that the \nmacro call should expand into. The function scheme-macro tests if a symbol has a \nmacro attached to it, and scheme-macro-expand does the actual macro-expansion: \n\n(defun scheme-macro (symbol) \n(and (symbolp symbol) (get symbol 'scheme-macro))) \n\n(defmacro def-scheme-macro (name parmlist &body body) \n\"Define a Scheme macro.\" \n'(setf (get '.name 'scheme-macro) \n\n#'(lambda .parmlist ..body))) \n\n(defun scheme-macro-expand (x) \n\"Macro-expand this Scheme expression.\" \n(if (and distp x) (scheme-macro (first x))) \n\n(scheme-macro-expand \n(apply (scheme-macro (first x)) (rest x))) \n\nX)) \n\n\f\n<a id='page-764'></a>\n\nHere are the definitions of nine important macros in Scheme: \n\n(def-scheme-macro let (bindings &rest body) \n'((lambda ,(mapcar #'first bindings) . .body) \n..(mapcar #*second bindings))) \n\n(def-scheme-macro let* (bindings &rest body) \n\n(if (null bindings) \n'(begin ..body) \n'(let (.(first bindings)) \n\n(let* .(rest bindings) . .body)))) \n\n(def-scheme-macro and (&rest args) \n\n(cond ((null args) *T) \n((length=1 args) (first args)) \n(t '(if .(first args) \n\n(and . .(rest args)))))) \n\n(def-scheme-macro or (&rest args) \n\n(cond ((null args) 'nil) \n((length=1 args) (first args)) \n(t (let ((var (gensym))) \n\n'(let ((.var .(first args))) \n(if ,var .var (or . .(rest args)))))))) \n(def-scheme-macro cond (&rest clauses) \n(cond ((null clauses) nil) \n((length=1 (first clauses)) \n'(or .(first clauses) (cond ..(rest clauses)))) \n((starts-with (first clauses) 'else) \n'(begin ..(rest (first clauses)))) \n\n(t '(if .(first (first clauses)) \n(begin ..(rest (first clauses))) \n(cond ..(rest clauses)))))) \n\n(def-scheme-macro case (key &rest clauses) \n(let ((key-val (gensym \"KEY\"))) \n'(let ((.key-val .key)) \n(cond .(mapcar \n#*(lambda (clause) \n\n(if (starts-with clause 'else) \nclause \n'((member ,key-val '.(first clause)) \n\n..(rest clause)))) \nclauses))))) \n\n(def-scheme-macro define (name &rest body) \n(if (atom name) \n'(begin (setl .name . .body) '.name) \n\n'(define .(first name) \n(lambda .(rest name) . .body)))) \n\f\n<a id='page-765'></a>\n(def-scheme-macro delay (computation) \n'(lambda () .computation)) \n\n(def-scheme-macro letrec (bindings &rest body) \n\n'(let .(mapcar #'(lambda (v) (list (first v) nil)) bindings) \n.(mapcar #*(lambda (v) '(set! ..v)) bindings) \n..body)) \n\nWe can test out the macro faciUty: \n\n> (scheme-macro-expand '(and . q)) (IF . (AND Q)) \n\n> (scheme-macro-expand '(and q)) => Q \n\n> (scheme-macro-expand '(let ((x 1) (y 2)) (+ . y))) \n((LAMBDA (X Y) (+ . Y)) 1 2) \n\n> (scheme-macro-expand \n'(letrec \n((even? (lambda (.) (or (= . 0) (odd? (-. 1))))) \n(odd? (lambda (.) (even? (-. 1))))) \n(even? .))) \n(LET ((EVEN? NIL) \n\n(ODD? NIL)) \n(SET! EVEN? (LAMBDA (X) (OR (= X 0) (ODD? (-X 1))))) \n(SET! ODD? (LAMBDA (X) (EVEN? (- X 1)))) \n(EVEN? Z)) \n\n> (scheme) \n==> (define (reverse 1) \n(if (null? 1) nil \n(append (reverse (cdr 1)) (list (car 1))))) \nREVERSE \n\n==> (reverse '(a b c d)) \n(D C . A) \n\n==> (let* ((X 5) (y (+ x x))) \n\n(if (or (= x 0) (and (< O y) (< y 20))) \n(list X y) \n(+ y .))) \n\n(5 10) \n\nThe macro def i ne is just like set !, except that it returns the symbol rather than the \nvalue assigned to the symbol. In addition, def i ne provides an optional syntax for \ndefining functions - it serves the purposes of both defun and defvar. The syntax \n\n(define {fn. args). >7ody) is an abbreviation for (define (lambda args. body)). \n\n\f\n<a id='page-766'></a>\n\nIn addition. Scheme provides a notation where def i ne can be used inside a function \ndefinition in a way that makes it work like let rather than set!. \n\nThe advantage of the macro-based approach to special forms is that we don't have \nto change the interpreter to add new special forms. The interpreter remains simple, \neven while the language grows. This also holds for the compiler, as we see in the next \nsection. \n\n22.3 A Properly Tail-Recursive Interpreter \nUnfortunately, the interpreter presented above can not lay claim to the name Scheme, \nbecause a true Scheme must be properly tail-recursive. Our interpreter is tail-\nrecursive only when run in a Common Lisp that is tail-recursive. To see the problem, \nconsider the following Scheme procedure: \n\n(define (traverse lyst) \n(if lyst (traverse (cdr lyst)))) \n\nTrace the function interp and execute (interp '(traverse '(a b c d))). The \nnested calls to i nterp go 16 levels deep. In general, the level of nesting is 4 plus 3 \ntimes the length of the hst. Each call to interp requires Common Lisp to allocate \nsome storage on the stack, so for very long lists, we will eventually run out of storage. \nTo earn the name Scheme, a language must guarantee that such a program does not \nrun out of storage. \n\nThe problem, in this example, lies in two places. Everytime we interpret an i f \nform or a procedure call, we descend another recursive level into i nterp. But that \nextra level is not necessary. Consider the i f form. It is certainly necessary to call \ni nterp recursively to decide if the test is true or not. For the sake of argument, let's \nsay the test is true. Thenwecall i nterp again on the i/zen part This recursive call will \nreturn a value, which will then be immediately returned as the value of the original \ncall as well. \n\nThe alternative is to replace the recursive call to interp with a renaming of \nvariables, followed by a goto statement. That is, instead of calling interp and thereby \nbinding a new instance of the variable . to the then part, we just assign the then part \nto X, and branch to the top of the i nterp routine. This works because we know we \nhave no more use for the old value of x. A similar technique is used to eliminate the \nrecursive call for the last expression in a beg i . form. (Many programmers have been \ntaught the \"structured programming\" party line that goto statements are harmful. In \nthis case, the goto is necessary to implement a low-level feature efficiently.) \n\n\f\n<a id='page-767'></a>\nThe final thing we need to do is explicitly manage Scheme procedures. Instead \nof implementing Scheme procedures as Common Lisp closures, we will define a \nstructure, . roc, to contain the code, environment, parameter list, and optionally the \nname of the procedure. Then when we are evaluating a procedure call, we can assign \nthe body of the procedure to x rather than recursively calling i nterp. \n\n(defstruct (proc (rprint-function print-proc)) \n\"Represent a Scheme procedure\" \ncode (env nil) (name nil) (parms nil)) \n\nThe following is a properly tail-recursive interpreter. The macro prog sets up a \ntagbody within which we can use go statements to branch to labels, and it also sets \nup a bl ock from which we can return a value. It can also bind variables like let, \nalthough in this usage, the variable list is empty. Any symbol within the body of a \nprog is considered a label. In this case, the label : INTERP is the target of the branch \nstatements (GO :I NTERP). I use uppercase to indicate that go-to statements are being \nused, but this convention has not been widely adopted. \n\n(defun interp (x &optional env) \n\"Evaluate the expression . in the environment env. \nThis version is properly tail-recursive.\" \n(prog () \n\n:INTERP \n(return \n\n(cond \n((symbolp x) (get-var . env)) \n((atom x) x) \n((scheme-macro (first x)) \n\n(setf X (scheme-macro-expand x)) (go :INTERP)) \n((case (first x) \n\n(QUOTE (second x)) \n(BEGIN (pop x) ; pop off the BEGIN to get at the args \nNow interpret all but the last expression \n(loop while (rest x) do (interp (pop x) env)) \nFinally, rename the last expression as . \n(setf X (firs t X)) \n(GO :INTERP)) \n(SETI (set-varl (second x) (interp (third x) env) env)) \n(IF (setf X (if (interp (second x) env) \n(third X) \n(fourth X))) \nThat is . rename the right expression as . \n(GO :INTERP)) \n\n(LAMBDA (make-proc :env env :parms (second x) \n:code (maybe-add 'begin (rest2 x)))) \n\n\f\n<a id='page-768'></a>\n\n(t a procedure application \n(let ((proc (interp (first x) env)) \n(args (mapcar #*(lambda (v) (interp . env)) \n(rest X)))) \n(if (proc-p proc) \nExecute procedure with rename+goto \n\n(progn \n(setf X (proc-code proc)) \n(setf env (extend-env (proc-parms proc) args \n\n(proc-env proc))) \n(GO :INTERP)) \nelse apply primitive procedure \n(apply proc args)))))))))) \n\n(defun print-proc (proc &optional (stream *standard-output*) depth) \n(declare (ignore depth)) \n(format stream \"{~a}\" (or (proc-name proc) '??))) \n\nBy tracing the tail-recursive version of interp, you can see that calls to traverse \ndescend only three recursive levels of interp, regardless of the length of the list \ntraversed. \n\nNote that we are not claiming that this interpreter allocates no storage when \nit makes tail-recursive calls. Indeed, it wastes quite a bit of storage in evaluating \narguments and building environments. The claim is that since the storage is allocated \non the heap rather than on the stack, it can be reclaimed by the garbage collector. So \neven if traverse is applied to an infinitely long list (i.e., a circular list), the interpreter \nwill never run out of space - it will always be able to garbage-collect and continue. \n\nThere are many improvements that could be made to this interpreter, but effort \nis better spent in improving a compiler rather than an interpreter. The next chapter \ndoes just that. \n\n22.4 Throw, Catch, and Call/cc \nTail-recursion is crucial to Scheme. The idea is that when the language is guaranteed \nto optimize tail-recursive calls, then there is no need for special forms to do iteration. \nAll loops can be written using recursion, without any worry of overflowing the nm-\ntime stack. This helps keep the language simple and rules out the goto statement, the \nscourge of the structured programming movement. However, there are cases where \nsome kind of nonlocal exit is the best alternative. Suppose that some unexpected \nevent happens deep inside your program. The best action is to print an error message \nand pop back up to the top level of your program. This could be done trivially with a \ngoto-like statement. Without it, every function along the calling path would have to \n\n\f\n<a id='page-769'></a>\nbe altered to accept either a valid result or an indication of the exceptional condition, \nwhich just gets passed up to the next level. \n\nIn Common Lisp, the functions throw and catch are provided for this kind of \nnonlocal exit. Scott Zimmerman, the perennial world Frisbee champion, is also \na programmer for a Southern California firm. He once told me, \"I'm starting to \nlearn Lisp, and it must be a good language because it's got throw and catch in it.\" \nUnfortunately for Scott, throw and catch don't refer to Frisbees but to transfer of \ncontrol. They are both special forms, with the following syntax: \n\n(catch tag body...) \n\n(throw tag value) \n\nThe first argument to catch is a tag, or label. The remaining arguments are evaluated \none at a time, and the last one is returned. Thus, catch is much like progn. The \ndifference is that if any code in the dynamic extent of the body of the catch evaluates \nthe special form throw, then control is immediately passed to the enclosing catch \nwith the same tag. \n\nFor example, the form \n\n(catch 'tag \n(print 1) (throw 'tag 2) (print 3)) \n\nprints 1 and returns 2, without going on to print 3. A more representative example \nis: \n\n(defun print-table (1) \n(catch 'not-a-number (mapcar #*print-sqrt-abs 1))) \n\n(defun print-sqrt-abs (x) \n(print (sqrt (abs (must-be-number x))))) \n\n(defun must-be-number (x) \n(if (numberp x) . \n(throw 'not-a-number \"huh?\"))) \n\n> (print-table '(1 4 -9 . 10 20)) \n\n1 \n\n2 \n\n3 \n\"huh?\" \n\nHere pri nt-tablecalls print-sqrt-abs, which callsmust-be-number. Thefirstthree \ntimes all is fine and the values 1,2,3 get printed. The next time . is not a number, so \nthe value \"huh?\" gets thrown to the tag not-a-number established by catch in f. The \n\n\f\n<a id='page-770'></a>\n\nthrow bypasses the pending calls to abs, sqrt, and print, as well as the rest of the \ncall to mapcar. \n\nThis kind of control is provided in Scheme with a very general and powerful \nprocedure, cal 1 -with-current-continuati on, which is often abbreviated cal 1 /cc. \ncal 1 /cc is a normal procedure (not a special form like throw and catch) that takes \na single argument. Let's call the argument computation, computation must be a \nprocedure of one argument. When cal 1 /cc is invoked, it calls computation, and \nwhatever computat i on returns is the value of the call to call /cc. The trick is that the \nprocedure computati on also takes an argument (which we'll call cc) that is another \nprocedure representing the current continuation point. If cc is applied to some value, \nthat value is returned as the value of the call to call / cc. Here are some examples: \n\n> (scheme) \n=> (+ 1 (call/cc (lambda (cc) (+ 20 300)))) \n321 \n\nThis example ignores cc and just computes (+ 1 (+ 20 300)). More precisely, it is \nequivalent to: \n\n((lambda (val) (+ 1 val)) \n(+ 20 300)) \n\nThe next example does make use of cc: \n\n=> (+ 1 (call/cc (lambda (cc) (+ 20 (cc 300))))) \n301 \n\nThis passes 300 to cc, thus bypassing the addition of 20. It effectively throws 300 out \nof the computation to the catch point estabUshed by cal 1 / cc. It is equivalent to: \n\n((lambda (val) (+ 1 val)) \n300) \n\nor to: \n\n((lambda (val) (+ 1 val)) \n(catch 'cc \n((lambda (v) (+ 20 v)) \n(throw 'cc 300)))) \n\n\f\n<a id='page-771'></a>\nHere's how the throw/catch mechanism would look in Scheme: \n\n(define (print-table 1) \n(call/cc \n\n(lambda (escape) \n(set! not-a-number escape) \n(map print-sqrt-abs 1)))) \n\n(define (print-sqrt-abs x) \n(write (sqrt (abs (must-be-number x))))) \n\n(define (must-be-number x) \n(if (numberp x) . \n(not-a-number \"huh?\"))) \n\n(define (map fn 1) \n(if (null? 1) \n.() \n\n(cons (fn (first D) \n(map fn (rest 1))))) \n\nThe ability to return to a pending point in the computation is useful for this kind of \nerror and interrupt handling. However, the truly amazing, wonderful thing about \ncal 1 /cc is the ability to return to a continuation point more than once. Consider a \nslight variation: \n\n=> (+ 1 (call/cc (lambda (cc) \n(set! old-cc cc) \n(+ 20 (cc 300))))) \n\n301 \n\n=> (old-cc 500) \n501 \n\nHere, we first computed 301, just as before, but along the way saved cc in the global \nvariable old-cc. Afterward, calling (old-cc 500) returns (for the second time) to the \npoint in the computation where 1 is added, this time returning 501. The equivalent \nCommon Lisp code leads to an error: \n\n> (+ 1 (catch 'tag (+ 20 (throw 'tag 300)))) \n301 \n\n> (throw 'tag 500) \n\nError: there was no pending CATCH for the tag TAG \n\nIn other words, cal 1 /cc's continuations have indefinite extent, while throw/catch \ntags only have dynamic extent. \n\n\f\n<a id='page-772'></a>\n\nWe can use cal 1 /cc to implement automatic backtracking (among other things). \nSuppose we had a special form, amb, the \"ambiguous\" operator, which returns one of \nits arguments, chosen at random. We could write: \n\n(define (integer) (amb 1 (+ 1 (integer)))) \n\nand a call to integer would return some random positive integer. In addition, \nsuppose we had a function, fail, which doesn't return at all but instead causes \nexecution to continue at a prior amb point, with the other choice taken. Then we could \nwrite succinct^ backtracking code like the following: \n\n(define (prime) \n(let ((n (integer))) \n(if (prime? n) . (fail)))) \n\nIf pri me? is a predicate that returns true only when its argument is a prime number, \nthen prime will always return some prime number, decided by generating random \nintegers. While this looks like a major change to the language - adding backtracking \nand nondeterminism - it turns out that amb and fa i 1 can be implemented quite easily \nwith cal 1 /cc. First, we need to make amb be a macro: \n\n(def-scheme-macro amb (x y) \n'(random-choice (lambda () ,x) (lambda () .y)))) \n\nThe rest is pure Scheme. We maintain a Ust of backtrack-points, which are implemented \nas functions of no arguments. To backtrack, we just call one of these \nfunctions. Thatis what fail does. The function choose-first takes two functions \nand pushes the second, along with the proper continuation, on backtrack-points, \nand then calls the first, returning that value. The function random-choi ce is what \namb expands into: it decides which choice is first, and which is second. (Note that \nthe convention in Scheme is to write global variables like backt rack- poi nts without \nasterisks.) \n\n(define backtrack-points nil) \n\n(define (fail) \n\n(let ((last-choice (car backtrack-points))) \n\n(setl backtrack-points (cdr backtrack-points)) \n\n(last-choice))) \n\nalthough inefficient \n\n\f\n<a id='page-773'></a>\n(define (random-choice f g) \n\n(if (= 1 (random 2)) \n(choose-first f g) \n(choose-first g f))) \n\n(define (choose-first f g) \n(call/cc \n(lambda (k) \n(set! backtrack-points \n(cons (lambda () (k (g))) backtrack-points)) \n(f)))) \n\nThis implements chronological backtracking, as in Prolog. However, we actually \nhave the freedom to do other kinds of backtracking as well. Instead of having f ai1 \ntake the first element of backtrack-points, we could choose a random element \ninstead. Or, we could do some more complex analysis to choose a good backtrack \npoint. \n\ncal 1 / cc can be used to implement a variety of control structures. As another \nexample, many Lisp implementations provide a re s et function that aborts the current \ncomputation and returns control to the top-level read-eval-print loop, reset can be \ndefined quite easily using cal 1 /cc. The trick is to capture a continuation that is at \nthe top level and save it away for future use. The following expression, evaluated at \nthe top level, saves the appropriate continuation in the value of reset: \n\n(call/cc (lambda (cc) (set! reset (lambda () \n(cc \"Back to top level\"))))) \n\n&#9635; Exercise 22.2 [m] Can you implement cal 1 /cc in Common Lisp? \n\n&#9635; Exercise 22.3 [s] Can you implement amb and fai1 in Common Lisp? \n\n&#9635; Exercise 22.4 [m] f ai 1 could be written \n(define (fail) ((pop backtrack-points))) if we had the pop macro in Scheme. \nWrite pop. \n\n22.5 An Interpreter Supporting Call/cc \nIt is interesting that the more a host language has to offer, the easier it is to write \nan interpreter. Perhaps the hardest part of writing a Lisp interpreter (or compiler) \nis garbage collection. By writing our interpreter in Lisp, we bypassed the problem \n\n\f\n<a id='page-774'></a>\n\nall together - the host language automatically collects garbage. Similarly, if we are \nusing a Common Lisp that is properly tail-recursive, then our interpreter will be too, \nwithout taking any special steps. If not, the interpreter must be rewritten to take care \nof tail-recursion, as we have seen above. \n\nIt is the same with cal 1 /cc. If our host language provides continuations with \nindefinite extent, then it is trivial to implement cal 1 /cc. If not, we have to rewrite \nthe whole interpreter, so that it explicitly handles continuations. The best way to do \nthis is to make i . te rp a function of three arguments: an expression, an environment, \nand a continuation. That means the top level will have to change too. Rather than \nhaving i nterp return a value that gets printed, we just pass it the function pri nt as \na continuation: \n\n(defun scheme () \n\"A Scheme read-eval-print loop (using interp). \nHandles call/cc by explicitly passing continuations.\" \n(init-scheme-interp) \n(loop (format t \"\"&==> \") \n\n(interp (read) nil #'print))) \n\nNowweareready to tackle i nterp. For clarity, we will base it on the non-tail-recursive \nversion. The cases for symbols, atoms, macros, and quote are almost the same as \nbefore. The difference is that the result of each computation gets passed to the \ncontinuation, cc, rather than just being returned. \n\nThe other cases are all more complex, because they all require explicit representation \nof continuations. That means that calls to i nterp cannot be nested. Instead, \nwe call i nterp with a continuation that includes another call to i nterp. For example, \nto interpret (If . . y), we first call interp on the second element of the form, \nthe predicate p. The continuation for this call is a function that tests the value of \n. and interprets either . or y accordingly, using the original continuation for the \nrecursive call to i nterp. The other cases are similar. One important change is that \nScheme procedures are implemented as Lisp functions where the first argument is \nthe continuation: \n\n(defun interp (x env cc) \n\"Evaluate the expression . in the environment env. \nand pass the result to the continuation cc.\" \n(cond \n\n((symbolp x) (funcall cc (get-var . env))) \n((atom x) (funcall cc x)) \n((scheme-macro (first x)) \n\n(interp (scheme-macro-expand x) env cc)) \n\n((case (first x) \n(QUOTE (funcall cc (second x))) \n(BEGIN (interp-begin (rest x) env cc)) \n\n\f\n<a id='page-775'></a>\n(SET! (interp (third x) env \n#*(lambda (val) \n(funcall cc (set-var! (second x) \nval env))))) \n(IF (interp (second x) env \n#.(lambda (pred) \n(interp (if pred (third x) (fourth x)) \nenv cc)))) \n(LAMBDA (let ((parms (second x)) \n(code (maybe-add 'begin (rest2 x)))) \n\n(funcall \ncc \n#*(lambda (cont &rest args) \n\n(interp code \n(extend-env parms args env) \ncont))))) \n\n(t (interp-call . env cc)))))) \n\nA few auxiliary functions are defined, in the same continuation-passing style: \n\n(defun interp-begin (body env cc) \n\"Interpret each element of BODY, passing the last to CC.\" \n(interp (first body) env \n\n#.(lambda (val) \n\n(if (null (rest body)) \n(funcall cc val) \n(interp-begin (rest body) env cc))))) \n\n(defun interp-call (call env cc) \n\"Interpret the call (f x...) and pass the result to CC.\" \n(map-interp call env \n\n#'(lambda (fn-and-args) \n\n(apply (first fn-and-args) \ncc \n(rest fn-and-args))))) \n\n(defun map-interp (list env cc) \n\"Interpret each element of LIST, and pass the list to CC.\" \n(if (null list) \n\n(funcall cc nil) \n(interp (first list) env \n#'(lambda (x) \n(map-interp (rest list) env \n#'(lambda (y) \n(funcall cc (cons . y)))))))) \n\n\f\n<a id='page-776'></a>\n\nBecause Scheme procedures expect a continuation as the first argument, we need to \nredefine init-scheme-proc to install procedures that accept and apply the \ncontinuation: \n\n(defun init-scheme-proc (f) \n\"Define a Scheme primitive procedure as a CL function.\" \n(if (listp f) \n\n(set-global-var! (first f) \n#'(lambda (cont &rest args) \n(funcall cont (apply (second f) args)))) \n(init-scheme-proc (list f f)))) \n\nWe also need to define cal 1 /cc. Think for a moment about what cal 1 /cc must do. \nLike all Scheme procedures, it takes the current continuation as its first argument. \nThe second argument is a procedure - computation to be performed, call/cc \nperforms the computation by calling the procedure. This is just a normal call, \nso it uses the current continuation. The tricky part is what call/cc passes the \ncomputation as its argument. It passes an escape procedure, which can be invoked \nto return to the same point that the original call to cal 1 / cc would have returned to. \nOnce the working of cal 1 /cc is understood, the implementation is obvious: \n\n(defun call/cc (cc computation) \n\"Make the continuation accessible to a Scheme procedure.\" \n(funcall computation cc \n\n;; Package up CC into a Scheme function: \n\n#.(lambda (cont val) \n(declare (ignore cont)) \n(funcall cc val)))) \n\nNow install call/cc in the global environment \n(set-global-var! 'call/cc #'can/cc) \n(set-global-var! 'call-with-current-continuation #'call/cc) \n\n22.6 History and References \nLisp interpreters and AI have a long history together. MIT AI Lab Memo No. 1 \n(McCarthy 1958) was the first paper on Lisp. McCarthy's students were working \non a Lisp compiler, had written certain routines - read, print, etc. - in assembly \n\n\f\n<a id='page-777'></a>\nlanguage, and were trying to develop a full Lisp interpreter in assembler. Sometime \naround the end of 1958, McCarthy wrote a theoretical paper showing that Lisp was \npowerful enough to write the universal function, eva 1. A programmer on the project, \nSteve Russell, saw the paper, and, according to McCarthy: \n\nSteve Russell said, look, lohy don't I program this eval and-you remember the \ninterpreter-and I said to him, ho, ho, you're confusing theory with practice, this \neval is intended for reading not for computing. But he went ahead and did it. \nThat is, he compiled the eval in my paper into 704 machine code fixing bugs \nand then advertised this as a Lisp interpreter, which it certainly was.^ \n\nSo the first Lisp interpreter was the result of a programmer ignoring his boss's \nadvice. The first compiler was for the Lisp 1.5 system (McCarthy et al. 1962). The \ncompiler was written in Lisp; it was probably the first compiler written in its own \nlanguage. \n\nAllen's Anatomy of Lisp (1978) was one of the first overviews of Lisp implementation \ntechniques, and it remains one of the best. However, it concentrates on the \ndynamic-scoping Lisp dialects that were in use at the time. The more modern view \nof a lexically scoped Lisp was documented in an influential pair of papers by Guy \nSteele (1976a,b). His papers \"Lambda: the ultimate goto\" and \"Compiler optimization \nbased on viewing lambda as rename plus goto\" describe properly tail-recursive \ninterpreters and compilers. \n\nThe Scheme dialect was invented by Gerald Sussman and Guy Steele around \n1975 (see their MIT AI Memo 349). The Revised^ Report on the Algorithmic Language \nScheme (dinger et al. 1991) is the definitive reference manual for the current version \nof Scheme. \n\nAbelson and Sussman (1985) is probably the best introduction to computer science \never written. It may or may not be a coincidence that it uses Scheme as the \nprogramming language. It includes a Scheme interpreter. Winston and Horn's Lisp \n(1989) also develops a Lisp interpreter. \n\nThe amb operator for nondeterministic choice was proposed by John McCarthy \n(1963) and used in SCHEMER (Zabih et al. 1987), a nondeterministic Lisp. Ruf \nand Weise (1990) present another implementation of backtracking in Scheme that \nincorporates all of logic programming. \n\n^McCarthy's words from a talk on the history of Lisp, 1974, recorded by Stoyan (1984). \n\n\f\n<a id='page-778'></a>\n\n22.7 Exercises \n&#9635; Exercise 22.5 [m] While Scheme does not provide full-blown support for optional \nand keyword arguments, it does support rest parameters. Modify the interpreter to \nsupport the Scheme syntax for rest parameters: \nScheme(lambda(lambda \n. body) \n(x y . .) body) \nCommon Lisp \n(lambda (&rest x) \n(lambda (x y &rest \nbody) \nz) body) \n\n&#9635; Exercise 22.6 [h] The representation of environments is somewhat wasteful. Currently \nit takes 3n cons cells to represent an environment with . variables. Change \nthe representation to take less space. \n\n&#9635; Exercise 22.7 [m] As we've implemented macros, they need to be expanded each \ntime they are encountered. This is not so bad for the compiler - you expand the \nsource code and compile it, and then never refer to the source code again. But for \nthe interpreter, this treatment of macros is most unsatisfactory: the work of macro-\nexpansion must be done again and again. How can you eliminate this duplicated \neffort? \n\n&#9635; Exercise 22.8 [m] It turns out Scheme allows some additional syntax in let and \ncond. First, there is the \"named-let\" expression, which binds initial values for variables \nbut also defines a local function that can be called within the body of the let. \nSecond, cond recognizes the symbol => when it is the second element of a cond clause, \nand treats it as a directive to pass the value of the test (when it is not false) to the \nthird element of the clause, which must be a function of one argument. Here are two \nexamples: \n(define (fact n) \nIterative factorial: does not grow the stack \n(let loop ((result 1) (i n)) \n(if (= i 0) result (loop (* result i) (-i 1))))) \n(define (lookup key alist) \n:: Find key's value in alist \n(cond ((assoc key alist) => cdr) \n(else #f))) \nThese are equivalent to: \n\n\f\n<a id='page-779'></a>\n\n(define (fact n) \n(letrec \n((loop (lambda (result i) \n\n(if (= i 0) \nresult \n(loop (* result i) (-i 1)))))) \n\n(loop 1 n))) \n\n(define (lookup key alist) \n(let ((g0030 (assoc key alist))) \n\n(if gOOSO \n(cdr g0030) \n#f))) \n\nWrite macro definitions for let and cond allowing these variations. \n\n&#9635; Exercise 22.9 Pi] Some Scheme implementations permit def i ne statements inside \nthe body of a 1 ambda (and thus of a def i ne, let, let*, or letrec as well). Here is an \nexample: \n\n(define (length 1) \n(define (len 1 n) \n(if (null? 1) . (len (cdr 1) (+ . 1)))) \n(len 1 0)) \n\nThe internal definition of len is interpreted not as defining a global name but rather \n\nas defining a local name as if with letrec. The above definition is equivalent to: \n\n(define (length 1) \n(letrec (den (lambda (1 n) \n(if (null? 1) . (len (cdr 1) (+ . 1)))))) \n(len 1 0))) \n\nMake changes to the interpreter to allow this kind of internal definition. \n\n&#9635; Exercise 22.10 Scheme programmers are often disdainful of the function or # ' \nnotation in Common Lisp. Is it possible (without changing the compiler) to make \nCommon Lisp accept (1 ambda () ...) instead of # ' (1 ambda () ...) and f . \ninstead of #'fn? \n\n&#9635; Exercise 22.11 [m] The top level of the continuation-passing version of scheme \nincludes the call: (i nterp (read) nil #' pr int). Will this always result in some \n\n\f\n<a id='page-780'></a>\n\nvalue being printed? Or is it possible that the expression read might call some escape \nfunction that ignores the value without printing anything? \n\n&#9635; Exercise 22.12 [h] What would have to be added or changed to turn the Scheme \ninterpreter into a Common Lisp interpreter? \n\n&#9635; Exercise 22.13 \\h] How would you change the interpreter to allow for multiple \nvalues? Explain how this would be done both for the first version of the interpreter \nand for the continuation-passing version. \n\n22.8 Answers \nAnswer 22.2 There is no way to implement a full ca . / cc to Common Lisp, but the \nfollowing works for cases where the continuation is only used with dynamic extent: \n\n(defun call/cc (computation) \n\"Call computation, passing it the current continuation. \nThe continuation has only dynamic extent.\" \n(funcall computation #'(lambda (x) (return-from call/cc x)))) \n\nAnswer 22.3 No. fail requires continuations with dynamic extent. \n\nAnswer 22.5 We need only modify extend - en . to know about an atomic vars list. \nWhile we're at it, we might as well add some error checking: \n\n(defun extend-env (vars vals env) \n\"Add some variables and values to an environment.\" \n(cond ((null vars) \n\n(assert (null vals) () \"Too many arguments supplied\") \nenv) \n((atom vars) \n(cons (list vars vals) env)) \n(t (assert (rest vals) () \"Too few arguments supplied\") \n(cons (list (first vars) (first vals)) \n(extend-env (rest vars) (rest vals) env))))) \n\n\f\n<a id='page-781'></a>\n\nAnswer 22.6 Storing the environment as an association list, {{var val),,.), makes \nit easy to look up variables with assoc. We could save one cons cell per variable \njust by changing to {{var . val)..,). But even better is to switch to a different \nrepresentation, one presented by Steele and Sussman in The Art of the Interpreter \n(1978). In this representation we switch from a single list of var/val pairs to a list of \nframes, where each frame is a var-list/val-list pair. It looks like this: \n\n{{{var...) . {val...)) \n{{var...) . {val...)) \n...) \n\nNow extend-env is trivial: \n\n(defun extend-env (vars vals env) \n\"Add some variables and values to an environment.\" \n(cons (cons vars vals) env)) \n\nThe advantage of this approach is that in most cases we already have a list of \nvariables (the procedure's parameter list) and values (from the mapcar of interp \nover the arguments). So it is cheaper to just cons these two lists together, rather than \narranging them into pairs. Of course, get - va r and set - va r! become more complex. \n\nAnswer 22.7 One answer is to destructively alter the source code as it is macro-\nexpanded, so that the next time the source code is interpreted, it will already be \nexpanded. The following code takes care of that: \n\n(defun scheme-macro-expand (x) \n(displace . (apply (scheme-macro (first x)) (rest x)))) \n\n(defun displace (old new) \n\"Destructively change old cons-cell to new value.\" \n(if (consp new) \n\n(progn (setf (car old) (car new)) \n(setf (cdr old) (cdr new)) \nold) \n\n(displace old '(begin .new)))) \n\nOne drawback to this approach is that the user's source code is actually changed, \n\nwhich may make debugging confusing. An alternative is to expand into something \n\nthat keeps both the original and macro-expanded code around: \n\n\f\n<a id='page-782'></a>\n\n(defun displace (old new) \n\"Destructively change old to a DISPLACED structure.\" \n(setf (car old) 'DISPLACED) \n(setf (cdr old) (list new old)) \nold) \n\nThis means that DISPLACED is a new special form, and we need a clause for it in the \ninterpreter. It would look something like this: \n\n(case (first x) \n\n(DISPLACED (interp (second x) env)) \n\nWe'd also need to modify the printing routines to print just ol d whenever they see \n(displaced old new). \n\nAnswer 22.8 \n\n(def-scheme-macro let (vars &rest body) \n(if (symbolp vars) \nnamed let \n(let ((f vars) (vars (first body)) (body (rest body))) \n'(letrec ((,f (lambda .(mapcar #'first vars) ..body))) \n(.f ..(mapcar #*second vars)))) \n\"regular\" let \n'((lambda .(mapcar #'first vars) . .body) \n. .(mapcar #*second vars))))) \n\n(def-scheme-macro cond (&rest clauses) \n(cond ((null clauses) nil) \n((length=1 (first clauses)) \n'(or .(first clauses) (cond ..(rest clauses)))) \n((starts-with (first clauses) 'else) \n\n'(begin..(rest (first clauses)))) \n((eq (second (first clauses)) *=>) \n(assert (= (length (first clauses)) 3)) \n(let ((var (gensym))) \n\n'(let ((.var .(first (first clauses)))) \n(if .var (.(third (first clauses)) .var) \n(cond ..(rest clauses)))))) \n(t '(if .(first (first clauses)) \n(begin ..(rest (first clauses))) \n(cond ..(rest clauses))))))) \n\n\f\n<a id='page-783'></a>\n\nAnswer 22.10 It is easy to define . ambda as a macro, eliminating the need for \n#.(lambda ...): \n\n(defmacro lambda (args &rest body) \n'(function (lambda ,args .body))) \n\nIf this were part of the Common Lisp standard, I would gladly use it. But because it \nis not, I have avoided it, on the grounds that it can be confusing. \nIt is also possible to write a new function-defining macro that would do the \nfollowing type of expansion: \n\n(defn double (x) (* 2 x)) \n(defparameter double (defun double (x) (* 2 x))) \n\nThis makes doubl e a special variable, so we can write doubl e instead of # 'doubl e. \nBut this approach is not recommended - it is dangerous to define special variables \nthat violate the asterisk convention, and the Common Lisp compiler may not be able \nto optimize special variable references the way it canfunction special forms. Also, \nthis approach would not interact properly with flet and 1 abel s. \n\n\f\n## Chapter 23\n<a id='page-784'></a>\n\nCompiling Lisp \n\nM\nM\nany textbooks show simple interpreters for Lisp, because they are simple to write, \nand because it is useful to know how an interpreter works. Unfortunately, not as \nmany textbooks show how to write a compiler, even though the same two reasons \nhold. The simplest compiler need not be much more complex than an interpreter. \n\nOne thing that makes a compiler more complex is that we have to describe the output of \nthe compiler: the instruction set of the machine we are compiling for. For the moment let's \nassume a stack-based machine. The calling sequence on this machine for a function call with \n. arguments is to push the . arguments onto the stack and then push the function to be called. \nA \"CALL n\" instruction saves the return point on the stack and goes to the first instruction of \nthe called function. By convention, the first instruction of a function will always be \"ARGS w\", \nwhich pops . arguments off the stack, putting them in the new function's environment, where \nthey can be accessed by LVAR and LSET instructions. The function should return with a RETURN \ninstruction, which resets the program counter and the environment to the point of the original \nCALL instruction. \n\nIn addition, our machine has three JUMP instructions; one that branches unconditionally, and \ntwo that branch depending on if the top of the stack is nil or non-nil. There is also an instruction \nfor popping unneeded values off the stack, and for accessing and altering global variables. The \ninstruction set is shown in figure 23.1. A glossary for the compiler program is given in figure 23.2. \nA summary of a more complex version of the compiler appears on [page 795](chapter23.md#page-795). \n\n\f\n<a id='page-785'></a>\n\nopcode args description \nCONST X push a constant on the stack \nLVAR push a local variable's value \nGVAR sym push a global variable's value \nLSET . store top-of-stack in a local variable \nGSET sym store top-of-stack in a global variable \nPOP pop the stack \nTJUMP label go to label if top-of-stack is non-nil; pop stack \nFJUMP label go to label if top-of-stack is nil; pop stack \nJUMP label go to label (don't pop stack) \nRETURN go to last return point \nARGS . move . arguments from stack to environment \nCALL . go to start of function, saving return point \n\n. is the number of arguments passed \nFN fn create a closure from argument and current environment \nand push it on the stack \n\nFigure 23.1: Instruction Set for Hypothetical Stack Machine \n\nAs an example, the procedure \n\n(lambda () (if (= . y) (f (g x)) (h . y (h 1 2)))) \n\nshould compile into the following instructions: \n\nARGS 0 \nGVAR X \nGVAR Y \nGVAR = \nCALL 2 \nFJUMP LI \nGVAR X \nGVAR G \nCALL 1 \nGVAR F \nCALL 1 \nJUMP L2 \n\nLI: GVAR X \nGVAR Y \nCONST 1 \nCONST 2 \nGVAR . \nCALL 2 \n\f\n<a id='page-786'></a>\n\nGVAR . \nCALL 3 \nL2: RETURN \n\nTop-Level Functions \n\ncomp-show Compile an expression and show the resulting code. \ncompiler Compile an expression as a parameterless function. \n\nSpecial Variables \n\n*1abel-num* Number for the next assembly language label. \n*primitive-fns * List of built-in Scheme functions. \n\nData Types \n\nfn A Scheme function. \n\nMajor Functions \n\ncomp Compile an expression into a list of instructions. \ncomp-begi . Compile a sequence of expressions. \ncomp-if Compile a conditional (i f) expression. \ncomp-lambda Compile a lambda expression. \n\nAuxiliary Functions \n\ngen Generate a single instruction. \nseq Generate a sequence of instructions. \ngen-label Generate an assembly language label. \ngen-var Generate an instruction to reference a variable. \ngen-set Generate an instruction to set a variable. \nnamel Set the name of a function to a given value. \nprint-fn Print a Scheme function (just the name). \nshow-fn Print the instructions in a Scheme function. \nlabel-p Is the argument a label? \nin-env-p Is the symbol in the environment? If so, where? \n\nFigure 23.2: Glossary for the Scheme Compiler \n\nThe first version of the Scheme compiler is quite simple. It mimics the structure \nof the Scheme evaluator. The difference is that each case generates code rather than \nevaluating a subexpression: \n\n(defun comp (. env) \n\"Compile the expression . into a list of instructions.\" \n(cond \n\n((symbolp x) (gen-var . env)) \n((atom X) (gen 'CONST x)) \n((scheme-macro (first x)) (comp (scheme-macro-expand x) env)) \n((case (first x) \n\n\f\n<a id='page-787'></a>\n\n(QUOTE (gen 'CONST (second x))) \n(BEGIN (comp-begin (rest x) env)) \n(SETI (seq (comp (third x) env) (gen-set (second x) env))) \n(IF (comp-if (second x) (third x) (fourth x) env)) \n(LAMBDA (gen 'FN (comp-lambda (second x) (rest (rest x)) env))) \n\nProcedure application: \n:: Compile args. then fn, then the call \n(t (seq (mappend #'(lambda (y) (comp y env)) (rest x)) \n\n(comp (first x) env) \n(gen 'call (length (rest x))))))))) \n\nThe compiler comp has the same nine cases - in fact the exact same structure - as \nthe interpreter i nterp from chapter 22. Each case is slightly more complex, so the \nthree main cases have been made into separate fimctions: comp - beg i ., comp - i f, and \ncomp-1 ambda. A begi . expression is compiled by compiling each argument in turn \nbut making sure to pop each value but the last off the stack after it is computed. The \nlast element in the begi. stays on the stack as the value of the whole expression. Note \nthat the function gen generates a single instruction (actually a list of one instruction), \nand seq makes a sequence of instructions out of two or more subsequences. \n\n(defun comp-begin (exps env) \n\"Compile a sequence of expressions, popping all but the last.\" \n(cond ((null exps) (gen 'CONST nil)) \n\n((length=1 exps) (comp (first exps) env)) \n\n(t (seq (comp (first exps) env) \n(gen 'POP) \n(comp-begin (rest exps) env))))) \n\nAn i f expression is compiled by compiling the predicate, then part, and else part, \nand by inserting appropriate branch instructions. \n\n(defun comp-if (pred then else env) \n\"Compile a conditional expression.\" \n(let ((LI (gen-label)) \n\n(L2 (gen-label))) \n\n(seq (comp pred env) (gen 'FJUMP LI) \n(comp then env) (gen 'JUMP L2) \n(list LI) (comp else env) \n(list L2)))) \n\nFinally, a 1 ambda expression is compiled by compiling the body, surrounding it with \none instruction to set up the arguments and another to return from the function, and \n\n\f\n<a id='page-788'></a>\n\nthen storing away the resulting compiled code, along with the environment. The \ndata type f . is implemented as a structure with slots for the body of the code, the \nargument list, and the name of the function (for printing purposes only). \n\n(defstruct (fn (:print-function print-fn)) \ncode (env nil)(name nil) (args nil)) \n\n(defun comp-1ambda (args body env) \n\"Compile a lambda form into a closure with compiled code.\" \n(assert (and distp args) (every #*symbolp args)) () \n\n\"Lambda arglist must be a list of symbols, not ~a\" args) \n;; For now, no &rest parameters. \nThe next version will support Scheme's version of &rest \n\n(make-fn \n:env env :args args \n:code (seq (gen 'ARGS (length args)) \n\n(comp-begin body (cons args env)) \n(gen 'RETURN)))) \n\nThe advantage of compiling over interpreting is that much can be decided at compile \ntime. For example, the compiler can determine if a variable reference is to a global \nor lexical variable, and if it is to a lexical variable, exactly where that lexical variable \nis stored. This computation is done only once by the compiler, but it has to be done \neach time the expression is encountered by the interpreter. Similarly, the compiler \ncan count up the number of arguments once and for all, while the interpreter must \ngo through a loop, counting up the number of arguments, and testing for the end of \nthe arguments after each one is interpreted. So it is clear that the compiler can be \nmore efficient than the interpreter. \n\nAnother advantage is that the compiler can be more robust. For example, in \ncomp-1 ambda, we check that the parameter list of a lambda expression is a list containing \nonly symbols. It would be too expensive to make such checks in an interpreter, \nbut in a compiler it is a worthwhile trade-off to check once at compile time for error \nconditions rather than checking repeatedly at run time. \n\nBefore we show the rest of the compiler, here's a useful top-level interface to comp: \n\n(defvar *1abel-num* 0) \n\n(defun compiler (x) \n\"Compile an expression as if it were in a parameterless lambda.\" \n(setf *label-num* 0) \n(comp-lambda '() (list x) nil)) \n\n\f\n<a id='page-789'></a>\n\n(defun comp-show (x) \n\"Compile an expression and show the resulting code\" \n(show-fn (compiler x)) \n(values)) \n\nNow here's the code to generate individual instructions and sequences of instructions. \nA sequence of instructions is just a list, but we provide the function seq rather \nthan using append directly for purposes of data abstraction. A label is just an atom. \n\n(defun gen (opcode &rest args) \n\"Return a one-element list of the specified instruction.' \n(list (cons opcode args))) \n\n(defun seq (&rest code) \n\"Return a sequence of instructions\" \n(apply #'append code)) \n\n(defun gen-label (&optional (label .)) \n\n\"Generate a label (a symbol of the form Lnnn)\" \n\n(intern (format nil \"^a^d\" label (incf *1abel-num*)))) \n\nEnvironments are now represented as lists of frames, where each frame is a sequence \nof variables. Local variables are referred to not by their name but by two integers: \nthe index into the list of frames and the index into the individual frame. As usual, \nthe indexes are zero-based. For example, given the code: \n\n(let ((a 2.0) \n(b 2.1)) \n(let ((c 1.0) \n(d l.D) \n(let ((e 0.0) \n(f O.D) \n(+ a b c d e f)))) \n\nthe innermost environment is((e f) (c d) (a b)). The function i.- en. - . tests \n\nif a variable appears in an environment. If this environment were called env, then \n\n(in-env-p ' f env) would return (2 1) and (in-env-p 'x env) would return nil. \n\n\f\n<a id='page-790'></a>\n\n(defun gen-var (var env) \n\"Generate an instruction to reference a variable's value.\" \n(let ((p (in-env-p var env))) \n\n(if . \n(gen 'LVAR (first p) (second p) \";\" var) \n(gen 'GVAR var)))) \n\n(defun gen-set (var env) \n\"Generate an instruction to set a variable to top-of-stack.' \n(let ((p (in-env-p var env))) \n\n(if . \n(gen 'LSET (first p) (second p) \";\" var) \n(gen 'GSET var)))) \n\nFinally, we have some auxiliary functions to print out the results, to distinguish \nbetween labels and instructions, and to determine the index of a variable in an \nenvironment. Scheme functions now are implemented as structures, which must \nhave a field for the code, and one for the environment. In addition, we provide \na field for the name of the function and for the argument list; these are used only \nfor debugging purposes. We'll adopt the convention that the def i ne macro sets the \nfunction's name field, by calling name! (which is not part of standard Scheme). \n\n(def-scheme-macro define (name &rest body) \n(if (atom name) \n\n'(name! (set! ,name . .body) '.name) \n(scheme-macro-expand \n'(define .(first name) \n(lambda .(rest name) . .body))))) \n\n(defun namel (fn name) \n\"Set the name field of fn. if it is an un-named fn.\" \n(when (and (fn-p fn) (null (fn-name fn))) \n\n(setf (fn-name fn) name)) \nname) \n\n;; This should also go in init-scheme-interp: \n(set-global-var! 'name! #'name!) \n\n(defun print-fn (fn &optional (stream *standard-output*) depth) \n(declare (ignore depth)) \n(format stream \"{~a}\" (or (fn-name fn) '??))) \n\n\f\n<a id='page-791'></a>\n\n(defun show-fn (fn &optional (stream *standard-output*) (depth 0)) \n\"Print all the instructions in a function. \nIf the argument is not a function, just princ it, \nbut in a column at least 8 spaces wide.\" \n(if (not (fn-p fn)) \n\n(format stream \"\"Ba\" fn) \n\n(progn \n(fresh-line) \n(incf depth 8) \n(dolist (instr (fn-code fn)) \n\n(if (label-p instr) \n(format stream \"~a:\" instr) \n(progn \n\n(format stream \"'^VT\" depth) \n(dolist (arg instr) \n(show-fn arg stream depth)) \n(fresh-line))))))) \n\n(defun label-p (x) \"Is . a label?\" (atom x)) \n\n(defun in-env-p (symbol env) \n\"If symbol is in the environment, return its index numbers.\" \n(let ((frame (find symbol env :test #'find))) \n\n(if frame (list (position frame env) (position symbol frame))))) \n\nNow we are ready to show the compiler at work: \n\n> (comp-show '(if (= . y) (f (g x)) (h . y (h 1 2)))) \n\nARGS 0 \nGVAR X \nGVAR Y \nGVAR = \nCALL 2 \nFJUMP LI \nGVAR X \nGVAR G \nCALL 1 \nGVAR F \nCALL 1 \nJUMP L2 \nLI: GVAR X \nGVAR Y \nCONST 1 \nCONST 2 \nGVAR . \nCALL 2 \nGVAR . \nCALL 3 \nL2: RETURN \n\n\f\n<a id='page-792'></a>\n\nThis example should give the reader a feeling for the code generated by the compiler. \nAnother reason a compiler has an advantage over an interpreter is that the compiler \ncan afford to spend some time trying to find a more efficient encoding of an \nexpression, v^hile for the interpreter, the overhead of searching for a more efficient \ninterpretation usually offsets any advantage gained. Here are some places where \na compiler could do better than an interpreter (although our compiler currently \ndoes not): \n\n> (comp-show '(begin \"doc\" (write x) y)) \nARGS 0 \nCONST doc \nPOP \nGVAR X \nGVAR WRITE \nCALL 1 \nPOP \nGVAR Y \nRETURN \n\nIn this example, code is generated to push the constant \"doc\" on the stack and then \nimmediately pop it off. If we have the compiler keep track of what expressions are \ncompiled \"for value\" - as y is the value of the expression above-and which are only \ncompiled \"for effect,\" then we can avoid generating any code at all for a reference to \na constant or variable for effect. Here's another example: \n\n> (comp-show '(begin (+ (* a x) (f x)) x)) \nARGS 0 \nGVAR A \nGVAR X \nGVAR * \nCALL 2 \nGVAR X \nGVAR F \nCALL 1 \nGVAR + \nCALL 2 \nPOP \nGVAR X \nRETURN \n\n\f\n<a id='page-793'></a>\n\nIn this expression, if we can be assured that + and * refer to the normal arithmetic \nfunctions, then we can compile this as if it were (begin (fx) .). Furthermore, it \nis reasonable to assume that + and * will be instructions in our machine that can be \ninvoked inline, rather than having to call out to a function. Many compilers spend \na significant portion of their time optimizing arithmetic operations, by taking into \naccount associativity, commutativity, distributivity, and other properties. \n\nBesides arithmetic, compilers often have expertise in conditional expressions. \nConsider the following: \n\n> (comp-show '(if (and . q) . y)) \nARGS 0 \nGVAR . \nFJUMP L3 \nGVAR Q \nJUMP L4 \n\nL3: GVAR NIL \n\nL4: FJUMP LI \nGVAR X \nJUMP L2 \n\nLI: GVAR Y \nL2: RETURN \nNote that (and . q) macro-expands to (i f . q nil ). The resulting compiled code \nis correct, but inefficient. First, there is an unconditional jump to L4, which labels \na conditional jump to LI. This could be replaced with a conditional jump to LI. \nSecond, at L3 we load NIL and then jump on nil to LI. These two instructions could \nbe replaced by an unconditional jump to LI. Third, the FJUMP to L3 could be replaced \nby an FJUMP to LI, since we now know that the code at L3 unconditionally goes to LI. \n\nFinally, some compilers, particularly Lisp compilers, have expertise in function \ncalling. Consider the following: \n\n> (comp-show '(f (g . y))) \nARGS 0 \nGVAR X \nGVAR Y \nGVAR G \nCALL 2 \nGVAR F \nCALL 1 \nRETURN \n\n\f\n<a id='page-794'></a>\n\nHere we call g and when g returns we call f, and when f returns we return from this \nfunction. But this last return is wasteful; we push a return address on the stack, and \nthen pop it off, and return to the next return address. An alternative function-calling \nprotocol involves pushing the return address before calling g, but then not pushing \na return address before calling f; when f returns, it returns directly to the calling \nfunction, whatever that is. \n\nSuch an optimization looks like a small gain; we basically eliminate a single \ninstruction. In fact, the implications of this new protocol are enormous: we can \nnow invoke a recursive function to an arbitrary depth without growing the stack at \nall - as long as the recursive call is the last statement in the function (or in a branch \nof the function when there are conditionals). A function that obeys this constraint \non its recursive calls is known as aproperly tail-recursive function. This subject was \ndiscussed in section 22.3. \n\nAll the examples so far have only dealt with global variables. Here's an example \nusing local variables: \n\n(comp-show '((lambda (x) ((lambda (y z) (f . y .)) 3 .)) 4)) \nARGS \nCONST \nFN \n\nARGS 1 \nCONST 3 \nLVAR 0 \nFN \n\nARGS \nLVAR \nLVAR \nLVAR \nGVAR \nCALL \nRETURN \n\nCALL 2 \n\nRETURN \nCALL 1 \nRETURN \n\nThe code is indented to show nested functions. The top-level function loads the \nconstant 4 and an anonymous function, and calls the function. This function loads \nthe constant 3 and the local variable x, which is the first (0th) element in the top \n(0th) frame. It then calls the double-nested function on these two arguments. This \nfunction loads x, y, and z: . is now the 0th element in the next-to-top (1st) frame, \nand y and . are the 0th and 1st elements of the top frame. With all the arguments in \n\n\f\n<a id='page-795'></a>\n\nplace, the function f is finally called. Note that no continuations are stored - f can \nreturn directly to the caller of this function. \nHowever, all this explicit manipulation of environments is inefficient; in this case \nwe could have compiled the whole thing by simply pushing 4, 3, and 4 on the stack \n\nand calling f. \n\nscheme \ncomp-go \nmachine \n\nprim \nret-addr \n\narg-count \ncomp-list \ncomp-const \ncomp-var \ncomp-funcal1 \nprimitive-. \ninit-scheme-comp \ngen-args \nmake-true-list \nnew-fn \nis \noptimize \ngeni \n\ntarget \nnext-instr \nquasi-q \n\nassemble \nasm-first-pass \nasm-second-pass \nopcode \nargs \nargi \n\nTop-Level Functions \n\nA read-compile-execute-print loop. \nCompile and execute an expression. \nRun the abstract machine. \n\nData Types \n\nA Scheme primitive function. \nA return address (function, program counter, environment). \n\nAuxiliary Functions \n\nReport an error for wrong number of arguments. \nCompile a list of expressions onto the stack. \nCompile a constant expression. \nCompile a variable reference. \nCompile a function application. \nIs this function a primitive? \nInitialize primitives used by compiler. \nGenerate code to load arguments to a function. \nConvert a dotted list to a nondotted one. \nBuild a new function. \nPredicate is true if instructions opcode matches. \nA peephole optimizer. \nGenerate a single instruction. \n\nThe place a branch instruction branches to. \nThe next instruction in a sequence. \nExpand a quasiquote form into append, cons, etc. \n\nFunctions for the Abstract Machine \n\nTurn a list of instructions into a vector. \nFind labels and length of code. \nPut code into the code vector. \nThe opcode of an instruction. \nThe arguments of an instruction. \nFor i = 1,2,3 - select zth argument of instruction. \n\nFigure 23.3: Glossary of the Scheme Compiler, Second Version \n\n\f\n<a id='page-796'></a>\n\n23.1 A Properly Tail-Recursive Lisp Compiler \nIn this section we describe a new version of the compiler, first by showing examples \nof its output, and then by examining the compiler itself, which is summarized in \nfigure 23.3. The new version of the compiler also makes use of a different function \ncalling sequence, using two new instructions, CALLJ and SAVE. As the name implies, \nSAVE saves a return address on the stack. The CALLJ instruction no longer saves \nanything; it can be seen as an unconditional jump - hence the J in its name. \n\nFirst, we see how nested function calls work: \n\n> (comp-show '(f (g x))) \nARGS 0 \nSAVE Kl \nGVAR X \nGVAR G \nCALLJ 1 \n\nKl: GVAR F \nCALLJ 1 \n\nThe continuation point Kl is saved so that g can return to it, but then no continuation \nis saved for f, so f returns to whatever continuation is on the stack. Thus, there is \nno need for an explicit RETURN instruction. The final CALL is like an unconditional \nbranch. \n\nThe following example shows that all functions but the last (f) need a continuation \npoint: \n\n> (comp-show '(f (g (h x) (h y)))) \n\nARGS 0 \nSAVE Kl \nSAVE K2 \nGVAR X \nGVAR . \nCALLJ 1 \nK2: SAVE K3 \nGVAR Y \nGVAR . \nCALLJ 1 \nK3: GVAR G \nCALLJ 2 \nKl: GVAR F \nCALLJ 1 \n\n\f\n<a id='page-797'></a>\n\nThis code first computes (h .) and returns to K2. Then it computes (h y) and returns \nto K3. Next it calls g on these two values, and returns to KI before transferring to f. \nSince whatever f returns will also be the final value of the function we are compiling, \nthere is no need to save a continuation point for f to return to. \n\nIn the next example we see that unneeded constants and variables in begin \nexpressions are ignored: \n\n> (comp-show '(begin \"doc\" . (f x) y)) \nARGS 0 \nSAVE KI \nGVAR X \nGVAR F \nCALLJ 1 \n\nKI: POP \nGVAR Y \nRETURN \n\nOne major flaw with the first version of the compiler is that it could pass data \naround, but it couldn't actually do anything to the data objects. We fix that problem \nby augmenting the machine with instructions to do arithmetic and other primitive \noperations. Unneeded primitive operations, like variables constants, and arithmetic \noperations are ignored when they are in the nonfinal position within begins. Contrast \nthe following two expressions: \n\n> (comp-show '(begin (+ (* a x) (f x)) x)) \nARGS 0 \nSAVE KI \nGVAR X \nGVAR F \nCALLJ 1 \n\nKI: POP \nGVAR X \nRETURN \n\n> (comp-show '(begin (+ (* a x) (f x)))) \nARGS 0 \nGVAR A \nGVAR X \n' \nSAVE KI \nGVAR X \nGVAR F \nCALLJ 1 \n\nKI: + \nRETURN \n\n\f\n<a id='page-798'></a>\n\nThe first version of the compiler was context-free, in that it compiled all equivalent expressions \nequivalently, regardless of where they appeared. A properly tail-recursive \ncompiler needs to be context-sensitive: it must compile a call that is the final value of \na function differently than a call that is used as an intermediate value, or one whose \nvalue is ignored. In the first version of the compiler, comp -1 ambda was responsible for \ngenerating the RETURN instruction, and all code eventually reached that instruction. \nTo make sure the RETURN was reached, the code for the two branches of i f expressions \nhad to rejoin at the end. \n\nIn the tail-recursive compiler, each piece of code is responsible for inserting its \nown RETURN instruction or implicitly returning by calling another function without \nsaving a continuation point. \n\nWe keep track of these possibilities with two flags. The parameter val ? is true \nwhen the expression we are compiling returns a value that is used elsewhere. The \nparameter more? is false when the expression represents the final value, and it is true \nwhen there is more to compute. In summary, there are three possibilities: \n\nval? more? example: the X in: \ntrue true (if X y z)or( f X y) \ntrue false (if . X .)or(begi n y X) \nfalse true (begin X y) \nfalse false impossible \n\nThe code for the compiler employing these conventions follows: \n\n(defun comp (. env val? more?) \n\"Compile the expression . into a list of instructions.\" \n\n(cond \n((member . '(t nil)) (comp-const . val? more?)) \n((symbolp x) (comp-var . env val? more?)) \n((atom x) (comp-const . val? more?)) \n\n((scheme-macro (first x)) (comp (scheme-macro-expand x) env val? more?)) \n((case (first x) \n(QUOTE (arg-count . 1) \n\n(comp-const (second x) val? more?)) \n(BEGIN (comp-begin (rest x) env val? more?)) \n(SET! (arg-count . 2) \n\n(assert (symbolp (second x)) (x) \n\"Only symbols can be set!, not ''a in ~a\" \n(second x) x) \n\n(seq (comp (third x) env t t) \n(gen-set (second x) env) \n(if (not val?) (gen 'POP)) \n(unless more? (gen 'RETURN)))) \n\n\f\n<a id='page-799'></a>\n(IF (arg-count . 2 3) \n(comp-if (second x) (third x) (fourth x) \nenv val? more?)) \n(LAMBDA (when val? \n(let ((f (comp-lambda (second x) (rest2 x) env))) \n(seq (gen 'FN f) (unless more? (gen 'RETURN)))))) \n(t (comp-funcall (first x) (rest x) env val? more?)))))) \n\nHere we've added one more case: t and .i 1 compile directly into primitive instructions, \nrather than relying on them being bound as global variables. (In real Scheme, \nthe Boolean values are #t and #f, which need not be quoted, the empty list is (), which \nmust be quoted, and t and .i 1 are ordinary symbols with no special significance.) \n\nI've also added some error checking for the number of arguments supplied to \nquote, set! and i f. Note that it is reasonable to do more error checking in a compiler \nthan in an interpreter, since the checking need be done only once, not each time \nthrough. The function to check arguments is as follows: \n\n(defun arg-count (form min &optional (max min)) \n\"Report an error if form has wrong number of args.\" \n(let ((n-args (length (rest form)))) \n\n(assert (<= min n-args max) (form) \n\"Wrong number of arguments for ~a in ~a: \n~d supplied, ~d~@[ to ~d~] expected\" \n(first form) form n-args min (if (/= min max) max)))) \n\n&#9635; Exercise 23.1 [m] Modify the compiler to check for additional compile-time errors \nsuggested by the following erroneous expression: \n\n(cdr (+ (list X y) 'y (3 x) (car 3 x))) \n\nThe tail-recursive compiler still has the familiar nine cases, but I have introduced \ncomp - var, comp - const, comp -i f, and comp -f un ca 11 to handle the increased complexity \nintroduced by the var? and more? parameters. \n\nLet's go through the comp- functions one at a time. First, comp-begin and \ncomp-1 ist just handle and pass on the additional parameters, comp-1 ist will be \nused in comp -funcall, a new function that will be introduced to compile a procedure \nappUcation. \n\n\f\n<a id='page-800'></a>\n\n(defun comp-begin (exps env val? more?) \n\"Compile a sequence of expressions, \nreturning the last one as the value.\" \n(cond ((null exps) (comp-const nil val? more?)) \n\n((length=1 exps) (comp (first exps) env val? more?)) \n(t (seq (comp (first exps) env nil t) \n(comp-begin (rest exps) env val? more?))))) \n\n(defun comp-list (exps env) \n\"Compile a list, leaving them all on the stack.\" \n(if (null exps) nil \n\n(seq (comp (first exps) env t t) \n(comp-list (rest exps) env)))) \n\nThen there are two trivial functions to compile variable access and constants. If the \nvalue is not needed, these produce no instructions at all. If there is no more to be \ndone, then these functions have to generate the return instruction. This is a change \nfrom the previous version of comp, where the caller generated the return instruction. \nNote I have extended the machine to include instructions for the most common \nconstants: t, nil, and some small integers. \n\n(defun comp-const (x val? more?) \n\"Compile a constant expression.\" \n(if val? (seq (if (member . '(t nil -1 0 1 2)) \n\n(gen x) \n(gen 'CONST x)) \n(unless more? (gen 'RETURN))))) \n\n(defun comp-var (x env val? more?) \n\"Compile a variable reference.\" \n(if val? (seq (gen-var . env) (unless more? (gen 'RETURN))))) \n\nThe remaining two functions are more complex. First consider comp - i f. Rather than \nblindly generating code for the predicate and both branches, we will consider some \nspecial cases. First, it is clear that (if t . y) can reduce to x and (if nil . y) \ncan reduce to y. It is perhaps not as obvious that (i f . . x) can reduce to (begi . \n. .), or that the comparison of equality between the two branches should be done \non the object code, not the source code. Once these trivial special cases have been \nconsidered, we're left with three more cases: (if . x nil), (if . nil y), and (if \n. . y). The pattern of labels and jumps is different for each. \n\n\f\n<a id='page-801'></a>\n(defun comp-if (pred then else env val? more?) \n\"Compile a conditional (IF) expression.\" \n(cond \n\n((null pred) ; (if nil . y) ==> y \n(comp else env val? more?)) \n((constantp pred) ; (if t . y) ==> . \n(comp then env val? more?)) \n\n((and distp pred) ; (if (not p) . y) ==> (if pyx) \n(length=1 (rest pred)) \n(primitive-p (first pred) env 1) \n(eq (prim-opcode (primitive-p (first pred) env 1)) *not)) \n\n(comp-if (second pred) else then env val? more?)) \n\n(t det ((pcode (comp pred env t t)) \n(tcode (comp then env val? more?)) \n(ecode (comp else env val? more?))) \n\n(cond \n((equal tcode ecode) ; (if . . x) ==> (begin . .) \n(seq (comp pred env nil t) ecode)) \n((null tcode) ; (if . nil y) ==> . (TJUMP L2) y L2: \ndet ((L2 (gen-label))) \n(seq pcode (gen 'TJUMP L2) ecode (list L2) \n(unless more? (gen 'RETURN))))) \n((null ecode) ; (if . .) ==> . (FJUMP LI) . LI: \ndet ((LI (gen-label))) \n(seq pcode (gen 'FJUMP LI) tcode (list LI) \n(unless more? (gen 'RETURN))))) \n(t ; (if . X y) ==> . (FJUMP LI) . LI: y \n; or . (FJUMP LI) . (JUMP L2) LI: y L2: \ndet ((LI (gen-label)) \n(L2 (if more? (gen-label)))) \n\n(seq pcode (gen 'FJUMP LI) tcode \n(if more? (gen 'JUMP L2)) \n(list LI) ecode (if more? (list L2)))))))))) \n\nHere are some examples of i f expressions. First, a very simple example: \n\n> (comp-show '(if . (+ . y) (* . y))) \nARGS O \nGVAR . \nFJUMP LI \nGVAR X \nGVAR Y \n+ \nRETURN \n\nLI: GVAR X \nGVAR Y \n' \nRETURN \n\n\f\n<a id='page-802'></a>\n\nEach branch has its own RETURN instruction. But note that the code generated is \nsensitive to its context. For example, if we put the same expression inside a beg i . \nexpression, we get something quite different: \n\n> (comp-show '(begin (if . (+ . y) (* . y)) .)) \n\nARGS O \nGVAR \nRETURN \n\nWhat happens here is that (+ . y)and(* . y), when compiled in a context where \nthe value is ignored, both result in no generated code. Thus, the if expression \nreduces to (if . nil nil), which is compiled like (begin . nil), which also \ngenerates no code when not evaluated for value, so the final code just references \n\nz. The compiler can only do this optimization because it knows that + and * are \nside-effect-free operations. Consider what happens when we replace + with f: \n> (comp-show '(begin (if . (f x) (* . .)) .)) \n\nARGS O \nGVAR . \nFJUMP L2 \nSAVE Kl \nGVAR X \nGVAR F \nCAL U 1 \nKl: POP \nL2: GVAR . \nRETURN \n\nHere we have to call (f .) if . is true (and then throw away the value returned), but \nwe don't have to compute (* . .) when . is false. \n\nThese examples have inadvertently revealed some of the structure of comp -funcall, \nwhich handles five cases. First, it knows some primitive functions that have corresponding \ninstructions and compiles these instructions inline when their values are \nneeded. If the values are not needed, then the function can be ignored, and just the \narguments can be compiled. This assumes true functions with no side effects. If \nthere are primitive operations with side effects, they too can be compiled inline, but \nthe operation can never be ignored. The next case is when the function is a lambda \nexpression of no arguments. We can just compile the body of the lambda expression \nas if it were a begin expression. Nonprimitive functions require a function call. \nThere are two cases: when there is more to compile we have to save a continuation \n\n\f\n<a id='page-803'></a>\npoint, and when we are compiling the final value of a function, we can just branch to \nthe called function. The whole thing looks like this: \n\n(defun comp-funcall (f args env val? more?) \n\"Compile an application of a function to arguments.\" \n(let ((prim (primitive-p f env (length args)))) \n\n(cond \n(prim ; function compilable to a primitive instruction \n(if (and (not val?) (not (prim-side-effects prim))) \nSide-effect free primitive when value unused \n(comp-begin args env nil more?) \nPrimitive with value or call needed \n\n(seq (comp-list args env) \n(gen (prim-opcode prim)) \n(unless val? (gen 'POP)) \n(unless more? (gen 'RETURN))))) \n\n((and (starts-with f 'lambda) (null (second f))) \n\n((lambda () body)) => (begin body) \n(assert (null args) () \"Too many arguments supplied\") \n(comp-begin (restZ f) env val? more?)) \n\n(more? ; Need to save the continuation point \n(let ((k (gen-label 'k))) \n\n(seq (gen 'SAVE k) \n(comp-list args env) \n(comp f env t t) \n(gen 'CALLJ (length args)) \n(list k) \n(if (not val?) (gen 'POP))))) \n\n(t ; function call as rename plus goto \n\n(seq (comp-list args env) \n(comp f env t t) \n(gen 'CALLJ (length args))))))) \n\nThe support for primitives is straightforward. The prim data type has five slots. The \n\nfirst holds the name of a symbol that is globally bound to a primitive operation. The \n\nsecond, .-a rgs, is the number of arguments that the primitive requires. We have to \n\ntake into account the number of arguments to each function because we want (->-. \n\ny) to compile into a primitive addition instruction, while (+ x y z) should not. It \nwill compile into a call to the function instead. The opcode slot gives the opcode \nthat is used to implement the primitive. The always field is true if the primitive \nalways returns non-nil, f al se if it always returns nil, and nil otherwise. It is used in \nexercise 23.6. Finally, the side- effects field says if the function has any side effects, \nlike doing I/O or changing the value of an object. \n\f\n<a id='page-804'></a>\n\n(defstruct (prim (:type list)) \nsymbol n-args opcode always side-effects) \n\n(defparameter *primitive-fns* \n\n'((+ 2 + true) (- 2 - true) (* 2 * true) (/ 2 / true) \n(< 2 <) (> 2 >) (<= 2 <=) (>= 2 >=) (/= 2 /=) (= 2 =) \n(eq? 2 eq) (equal? 2 equal) (eqv? 2 eql) \n(not 1 not) (null? 1 not) \n(car 1 car) (cdr 1 cdr) (cadr 1 cadr) (cons 2 cons true) \n(list 1 listl true) (list 2 list2 true) (list 3 lists true) \n(read 0 read nil t) (write 1 write nil t) (display 1 display nil t) \n(newline 0 newline nil t) (compiler 1 compiler t) \n(name! 2 name! true t) (random 1 random true nil))) \n\n(defun primitive-p (f env n-args) \n\"F is a primitive if it is in the table, and is not shadowed \nby something in the environment, and has the right number of args.\" \n(and (not (in-env-p f env)) \n\n(find f *primitive-fns* \n:test #*(lambda (f prim) \n\n(and (eq f (prim-symbol prim)) \n(= n-args (prim-n-args prim))))))) \n(defun list l (x) (list x)) \n\n(defun list2 (x y) (list . y)) \n(defun lista (. y .) (list . y .)) \n(defun display (.) (princ .)) \n(defun newline O (terpri)) \n\nThese optimizations only work if the symbols are permanently bound to the global \nvalues given here. We can enforce that by altering gen-set to preserve them as \nconstants: \n\n(defun gen-set (var env) \n\"Generate an instruction to set a variable to top-of-stack.\" \n(let ((p (in-env-p var env))) \n\n(if . \n(gen 'LSET (first p) (second p) \";\" var) \n(if (assoc var *primitive-fns*) \n\n(error \"Can't alter the constant ~a\" var) \n(gen 'GSET var))))) \n\n\f\n<a id='page-805'></a>\nNow an expression like (+ . 1) will be properly compiled using the + instruction \nrather than a subroutine call, and an expression like (set! + *) will be flagged as \nan error when + is a global variable, but allowed when it has been locally bound. \nHowever, we still need to be able to handle expressions like (set! add +) and then \n(add . y). Thus, we need some function object that + will be globally bound to, even \nif the compiler normally optimizes away references to that function. The function \ninit - scheme - comp takes care of this requirement: \n\n(defun i nit-scheme-comp () \n\"Initialize the primitive functions.\" \n(dolist (prim *primitive-fns*) \n\n(setf (get (prim-symbol prim) 'global-val) \n(new-fn :env nil :name (prim-symbol prim) \nicode (seq (gen 'PRIM (prim-symbol prim)) \n(gen 'RETURN)))))) \n\nThere is one more change to make - rewriting comp-1 ambda. We still need to get the \narguments off the stack, but we no longer generate a RETURN instruction, since that is \ndone by comp-begi n, if necessary. At this point we'll provide a hook for a peephole \noptimizer, which will be introduced in section 23.4, and for an assembler to convert \nthe assembly language to machine code, new-fn provides this interface, but for now, \nnew- f . acts just like make - f n. \n\nWe also need to account for the possibility of rest arguments in a lambda list. A \nnew function, gen-args, generates the single instruction to load the arguments of \nthe stack. It introduces a new instruction, ARGS., into the abstract machine. This \ninstruction works just like ARGS, except it also conses any remaining arguments on \nthe stack into a list and stores that list as the value of the rest argument. With this \ninnovation, the new version of comp -1ambda looks like this: \n\n\f\n<a id='page-806'></a>\n\n(defun comp-lambda (args body env) \n\"Compile a lambda form into a closure with compiled code.\" \n(new-fn :env env :args args \n\n:code (seq (gen-args args 0) \n\n(comp-begin body \n(cons (make-true-list args) env) \nt nil)))) \n\n(defun gen-args (args n-so-far) \n\"Generate an instruction to load the arguments.\" \n(cond ((null args) (gen 'ARGS n-so-far)) \n\n((symbolp args) (gen 'ARGS. n-so-far)) \n\n((and (consp args) (symbolp (first args))) \n(gen-args (rest args) (+ n-so-far 1))) \n\n(t (error \"Illegal argument list\")))) \n\n(defun make-true-list (dotted -1ist) \n\"Convert a possibly dotted list into a true, non-dotted list.\" \n(cond ((null dotted-list) nil) \n\n((atom dotted-list) (list dotted-list)) \n(t (cons (first dotted-list) \n(make-true-list (rest dotted-list)))))) \n\n(defun new-fn (&key code env name args) \n\"Build a new function.\" \n(assemble (make-fn :env env :name name :args args \n\n:code (optimize code)))) \n\nnew-fn includes calls to an assembler and an optimizer to generate actual machine \ncode. For the moment, both will be identity functions: \n\n(defun optimize (code) code) \n(defun assemble (fn) fn) \n\nHere are some more examples of the compiler at work: \n\n> (comp-show '(if (null? (car D) (f (+ (* a x) b)) \n\n(g (/ . 2)))) \nARGS 0 \nGVAR L \nCAR \nFJUMP LI \nGVAR X \n2 \n/ \nGVAR G \nCALLJ 1 \nLI: GVAR A \n\n\f\n<a id='page-807'></a>\nGVAR X \n\n' \n\nGVAR . \n\n+ \n\nGVAR F \n\nCALLJ 1 \n\nThere is no need to save any continuation points in this code, because the only calls to \nnonprimitive functions occur as the final values of the two branches of the function. \n\n> (comp-show '(define (last l 1) \n(if (null ? (cdr D ) (car 1) \n(last l (cdr 1))))) \nARGS 0 \nFN \nARGS 1 \nLVAR 0 0 : L \nCDR \nFJUMP LI \nLVAR 0 0 ; L \nCDR \nGVAR LASTl \nCALLJ 1 \nLI: LVAR 0 0 ; L \nCAR \nRETURN \nGSET LASTl \nCONST LASTl \nNAMEl \nRETURN \n\nThe top-level function just assigns the nested function to the global variable last1. \nSince last1 is tail-recursive, it has only one return point, for the termination case, \nand just calls itself without saving continuations until that case is executed. \n\nContrast that to the non-tail-recursive definition of length below. It is not tail-\nrecursive because before it calls length recursively, it must save a continuation point, \nKl, so that it will know where to return to to add 1. \n\n\f\n<a id='page-808'></a>\n\n> (comp-show '(define (length 1) \n\n(if (null? 1) 0 (+ 1 (length (cdr 1)))))) \nARGS 0 \nFN \n\nARGS 1 \nLVAR 0 0 ; L \nFJUMP L2 \n1 \nSAVE KI \nLVAR 0 0 ; L \nCDR \nGVAR LENGTH \nCALLJ 1 \n\nKI: + \nRETURN \nL2: 0 \n\nRETURN \nGSET LENGTH \nCONST LENGTH \nNAME! \nRETURN \n\nOf course, it is possible to write length in tail-recursive fashion: \n\n> (comp-show '(define (length 1) \n(letrec (den (lambda (1 n) \n(if (null? 1) . \n(len (rest 1) (+ . 1)))))) \n\n(len 1 0))) ) \nARGS 0 \nFN \nARGS 1 \nNIL \nFN \nARGS 1 \nFN \nARGS 2 \nLVAR 0 0 ; L \nFJUMP L2 \nSAVE KI \nLVAR 0 0 ; L \nGVAR REST \nCALLJ 1 \nKI: LVAR 0 1 : . \n1 \n+ \nLVAR 1 0 ; LEN \n\n\f\n<a id='page-809'></a>\n\nCALLJ \nL2: LVAR \n\nRETURN \nLSET 0 LEN \nPOP \nLVAR L \n0 \nLVAR LEN \nCALLJ \n\nCALLJ 1 \nGSET LENGTH \nCONST LENGTH \nNAME! \nRETURN \n\nLet's look once again at an example with nested conditionals: \n\n> (comp-show '(if (not (and . q (not r))) . y)) \nARGS 0 \nGVAR . \nFJUMP L3 \nGVAR Q \nFJUMP LI \nGVAR R \nNOT \nJUMP L2 \n\nLI: NIL \nL2: JUMP L4 \nL3: NIL \nL4: FJUMP L5 \nGVAR Y \nRETURN \nL5: GVAR X \nRETURN \n\nHere the problem is with multiple JUMPs and with not recognizing negation. If . is \nfalse, then the and expression is false, and the whole predicate is true, so we should \nreturn x. The code does in fact return x, but it first jumps to L3, loads NIL, and then \ndoes an FJUMP that will always jump to L5. Other branches have similar inefficiencies. \nA sufficiently clever compiler should be able to generate the following code: \n\n\f\n<a id='page-810'></a>\n\nARGS O \nGVAR . \nFJUMP LI \nGVAR Q \nFJUMP LI \nGVAR R \nTJUMP LI \nGVAR Y \nRETURN \n\nLI: GVAR X \nRETURN \n23.2 Introducing Call/cc \nNow that the basic compiler works, we can think about how to implement call /cc \nin our compiler. First, remember that call / cc is a normal function, not a special \nform. So we could define it as a primitive, in the manner of ca r and cons. However, \nprimitives as they have been defined only get to see their arguments, and cal 1 / cc \nwill need to see the run-time stack, in order to save away the current continuation. \nOne choice is to install cal 1 / cc as a normal Scheme nonprimitive function but to \nwrite its body in assembly code ourselves. We need to introduce one new instruction, \nCC, which places on the stack a function (to which we also have to write the assembly \ncode by hand) that saves the current continuation (the stack) in its environment, and, \nwhen called, fetches that continuation and installs it, by setting the stack back to that \nvalue. This requires one more instruction, SET-CC. The details of this, and of all the \nother instructions, are revealed in the next section. \n\n23.3 The Abstract Machine \nSo far we have defined the instruction set of a mythical abstract machine and generated \nassembly code for that instruction set. It's now time to actually execute the \nassembly code and hence have a useful compiler. There are several paths we could \npursue: we could implement the machine in hardware, software, or microcode, or \nwe could translate the assembly code for our abstract machine into the assembly \ncode of some existing machine. Each of these approaches has been taken in the past. \n\nHardware. If the abstract machine is simple enough, it can be implemented directly \nin hardware. The Scheme-79 and Scheme-81 Chips (Steele and Sussman 1980; \nBatali et al. 1982) were VLSI implementations of a machine designed specifically to \nrun Scheme. \n\n\f\n<a id='page-811'></a>\n\nMacro-Assembler. In the translation or macro-assembler approach, each instruction \nin the abstract machine language is translated into one or more instructions \nin the host computer's instruction set. This can be done either directly or by generating \nassembly code and passing it to the host computer's assembler. In general this \nwill lead to code expansion, because the host computer probably will not provide \ndirect support for Scheme's data types. Thus, whereas in our abstract machine we \ncould write a single instruction for addition, with native code we might have to execute \na series of instructions to check the type of the arguments, do an integer add if \nthey are both integers, a floating-point add if they are both floating-point numbers, \nand so on. We might also have to check the result for overflow, and perhaps convert \nto bignum representation. Compilers that generate native code often include more \nsophisticated data-flow analysis to know when such checks are required and when \nthey can be omitted. \n\nMicrocode. The MIT Lisp Machine project, unlike the Scheme Chip, actually \nresulted in working machines. One important decision was to go with microcode \ninstead of a single chip. This made it easy to change the system as experienced was \ngained, and as the host language was changed from ZetaLisp to Common Lisp. The \nmost important architectural feature of the Lisp Machine was the inclusion of tag \nbits on each word to specify data types. Also important was microcode to implement \ncertain frequently used generic operations. For example, in the Symbolics 3600 \nLisp Machine, the microcode for addition simultaneously did an integer add, a \nfloating-point add, and a check of the tag bits. If both arguments turned out to \nbe either integers or floating-point numbers, then the appropriate result was taken. \nOtherwise, a trap was signaled, and a converison routine was entered. This approach \nmakes the compiler relatively simple, but the trend in architecture is away from highly \nmicrocoded processors toward simpler (RISC) processors. \n\nSoftware. We can remove many of these problems with a technique known as \nbyte-code assembly. Here we translate the instructions into a vector of bytes and then \ninterpret the bytes with a byte-code interpreter. This gives us (almost) the machine \nwe want; it solves the code expansion problem, but it may be slower than native code \ncompilation, because the byte-code interpreter is written in software, not hardware \nor microcode. \n\nEach opcode is a single byte (we have less than 256 opcodes, so this will work). \nThe instructions with arguments take their arguments in the following bytes of the \ninstruction stream. So, for example, a CALL instruction occupies two bytes; one for \nthe opcode and one for the argument count. This means we have imposed a limit \nof 256 arguments to a function call. An LVAR instruction would take three bytes; \none for the opcode, one for the frame offset, and one for the offset within the frame. \nAgain, we have imposed 256 as the limit on nesting level and variables per frame. \nThese limits seem high enough for any code written by a human, but remember, \nnot only humans write code. It is possible that some complex macro may expand \ninto something with more than 256 variables, so a full implementation would have \n\n\f\n<a id='page-812'></a>\n\nsome way of accounting for this. The GVAR and CONST instructions have to refer to an \narbitrary object; either we can allocate enough bytes to fit a pointer to this object, or \nwe can add a constants field to the f . structure, and follow the instructions with a \nsingle-byte index into this vector of constants. This latter approach is more common. \n\nWe can now handle branches by changing the program counter to an index into \nthe code vector. (It seems severe to limit functions to 256 bytes of code; a two-byte \nlabel allows for 65536 bytes of code per function.) In summary, the code is more \ncompact, branching is efficient, and dispatching can be fast because the opcode is a \nsmall integer, and we can use a branch table to go to the right piece of code for each \ninstruction. \n\nAnother source of inefficiency is implementing the stack as a list, and consing up \nnew cells every time something is added to the stack. The alternative is to implement \nthe stack as a vector with a fill-pointer. That way a push requires no consing, only a \nchange to the pointer (and a check for overflow). The check is worthwhile, however, \nbecause it allows us to detect infinite loops in the user's code. \n\nHere follows an assembler that generates a sequence of instructions (as a vector). \nThis is a compromise between byte codes and the assembly language format. First, \nwe need some accessor functions to get at parts of an instruction: \n\n(defun opcode (instr) (if (label-p instr) ilabel (first instr))) \n(defun args (instr) (if (listp instr) (rest instr))) \n(defun argl (instr) (if (listp instr) (second instr))) \n(defun arg2 (instr) (if (listp instr) (third instr))) \n(defun arg3 (instr) (if (listp instr) (fourth instr))) \n\n(defsetf argl (instr) (val) '(setf (second .instr) ,val)) \n\nNow we write the assembler, which already is integrated into the compiler with a \nhook in new-fn. \n\n(defun assemble (fn) \n\"Turn a list of instructions into a vector.\" \n(multiple-value-bind (length labels) \n\n(asm-first-pass (fn-code fn)) \n(setf (fn-code fn) \n(asm-second-pass (fn-code fn) \nlength labels)) \nfn)) \n\n(defun asm-first-pass (code) \n\"Return the labels and the total code length.\" \n(let ((length 0) \n\n(labels nil)) \n(dolist (instr code) \n(if (label-p instr) \n\n\f\n<a id='page-813'></a>\n(push (cons instr length) labels) \n(incf length))) \n(values length labels))) \n\n(defun asm-second-pass (code length labels) \n\"Put code into code-vector, adjusting for labels.\" \n(let ((addr 0) \n\n(code-vector (make-array length))) \n(dolist (instr code) \n(unless (label-p instr) \n(if (is instr '(JUMP TJUMP FJUMP SAVE)) \n(setf (argl instr) \n\n(cdr (assoc (argl instr) labels)))) \n(setf (aref code-vector addr) instr) \n(incf addr))) \n\ncode-vector)) \n\nIf we want to be able to look at assembled code, we need a new printing function: \n\n(defun show-fn (fn &optional (stream *standard-output*) (indent 2)) \n\"Print all the instructions in a function. \nIf the argument is not a function, just princ it, \nbut in a column at least 8 spaces wide.\" \n\nThis version handles code that has been assembled into a vector \n\n(if (not (fn-p fn)) \n(format stream \"\"Sa\" fn) \n(progn \n\n(fresh-1ine) \n(dotimes (i (length (fn-code fn))) \n(let ((instr (elt (fn-code fn) i))) \n\n(if (label-p instr) \n(format stream \"\"a:\" instr) \n(progn \n\n(format stream \"~VT~2d: \" indent i) \n(dolist (arg instr) \n(show-fn arg stream (+ indent 8))) \n(fresh-line)))))))) \n\n(defstruct ret-addr fn pc env) \n\n(defun is (instr op) \n\"True if instr's opcode is OP, or one of OP when OP is a list.\" \n(if (listp op) \n\n(member (opcode instr) op) \n(eq (opcode instr) op))) \n\n(defun top (stack) (first stack)) \n\n\f\n<a id='page-814'></a>\n\n(defun machine (f) \n\"Run the abstract machine on the code for f.\" \n(let* ((code (fn-code f)) \n\n(pc 0) \n(env nil) \n(stack nil) \n(n-args 0) \n(instr)) \n\n(loop \n(setf instr (elt code pc)) \n(incf pc) \n(case (opcode instr) \n\nVariable/stack manipulation instructions: \n(LVAR (push (elt (elt env (argl instr)) (arg2 instr)) \nstack)) \n(LSET (setf (elt (elt env (argl instr)) (arg2 instr)) \n\n(top stack))) \n(GVAR (push (get (argl instr) 'global-val) stack)) \n(GSET (setf (get (argl instr) 'global-val) (top stack))) \n(POP (pop stack)) \n(CONST (push (argl instr) stack)) \n\nBranching instructions: \n(JUMP (setf pc (argl instr))) \n(FJUMP (if (null (pop stack)) (setf pc (argl instr)))) \n(TJUMP (if (pop stack) (setf pc (argl instr)))) \n\n;; Function call/return instructions: \n(SAVE (push (make-ret-addr :pc (argl instr) \n:fn f :env env) \nstack)) \n(RETURN return value is top of stack; ret-addr is second \n\n(setf f (ret-addr-fn (second stack)) \ncode (fn-code f) \nenv (ret-addr-env (second stack)) \npc (ret-addr-pc (second stack))) \n\n;; Get rid of the ret-addr. but keep the value \n(setf stack (cons (first stack) (rest2 stack)))) \n\n(CALLJ (pop env) : discard the top frame \n(setf f (pop stack) \ncode (fn-code f) \nenv (fn-env f) \npc 0 \nn-args (argl instr))) \n(ARGS (assert (= n-args (argl instr)) () \n\n\f\n<a id='page-815'></a>\n\"Wrong number of arguments:~ \n\"d expected, ~d supplied\" \n(argl instr) n-args) \n\n(push (make-array (argl instr)) env) \n\n(loop for i from (- n-args 1) downto 0 do \n(setf (elt (first env) i) (pop stack)))) \n\n(ARGS. (assert (>= n-args (argl instr)) () \n\"Wrong number of arguments:~ \n~d or more expected, ~d supplied\" \n(argl instr) n-args) \n\n(push (make-array (+ 1 (argl instr))) env) \n(loop repeat (- n-args (argl instr)) do \n(push (pop stack) (elt (first env) (argl instr)))) \n(loop for i from (- (argl instr) 1) downto 0 do \n(setf (elt (first env) i) (pop stack)))) \n(FN (push (make-fn :code (fn-code (argl instr)) \n:env env) stack)) \n(PRIM (push (apply (argl instr) \n\n(loop with args = nil repeat n-args \ndo (push (pop stack) args) \nfinally (return args))) \n\nstack)) \n\nContinuation instructions: \n(SET-CC (setf stack (top stack))) \n(CC (push (make-fn \n\n:env (list (vector stack)) \n:code '((ARGS 1) (LVAR 1 0 \";\" stack) (SET-CC) \n(LVAR 0 0) (RETURN))) \nstack)) \n\nNullary operations: \n((SCHEME-READ NEWLINE) \n(push (funcall (opcode instr)) stack)) \n\nUnary operations: \n((CAR CDR CADR NOT LISTl COMPILER DISPLAY WRITE RANDOM) \n(push (funcall (opcode instr) (pop stack)) stack)) \n\nBinary operations: \n((+.*/<><=>=/:. = CONS LIST2 NAME! EQ EQUAL EQL) \n(setf stack (cons (funcall (opcode instr) (second stack) \n(first stack)) \n(rest2 stack)))) \n\n\f\n<a id='page-816'></a>\n\nTernary operations: \n(LIST3 \n(setf stack (cons (funcall (opcode instr) (third stack) \n(second stack) (first stack)) \n(rests stack)))) \n\n;; Constants: \n((T NIL -10 12) \n(push (opcode instr) stack)) \n\nOther: \n((HALT) (RETURN (top stack))) \n(otherwise (error \"Unknown opcode: ~a\" instr)))))) \n\n(defun init-scheme-comp () \n\"Initialize values (including call/cc) for the Scheme compiler.\" \n(set-global-var! 'exit \n\n(new-fn :name 'exit :args '(val) :code '((HALT)))) \n(set-global-var! 'call/cc \n(new-fn :name 'call/cc :args '(f) \n:code '((ARGS 1) (CC) (LVAR 0 0 f) (CALLJ 1)))) \n(dolist (prim *primitive-fns*) \n(setf (get (prim-symbol prim) 'global-val) \n(new-fn :env nil :name (prim-symbol prim) \n:code (seq (gen 'PRIM (prim-symbol prim)) \n(gen 'RETURN)))))) \n\nHere's the Scheme top level. Note that it is written in Scheme itself; we compile \nthe definition of the read-eval-print loop/ load it into the machine, and then start \nexecuting it. There's also an interface to compile and execute a single expression, \ncomp-go. \n\n(defconstant scheme-top-level \n\n'(begin(define (scheme) \n(newline) \n(display \"=> \") \n(write ((compiler (read)))) \n(scheme)) \n\n(scheme))) \n\n(defun scheme () \n\"A compiled Scheme read-eval-print loop\" \n(init-scheme-comp) \n(machine (compiler scheme-top-1evel))) \n\n^Strictly speaking, this is a read-compile-funcall-vmte loop. \n\n\f\n<a id='page-817'></a>\n(defun comp-go (exp) \n\"Compile and execute the expression.\" \n(machine (compiler '(exit .exp)))) \n\n&#9635; Exercise 23.2 [m] This implementation of the machine is wasteful in its representation \nof environments. For example, consider what happens in a tail-recursive \nfunction. Each ARG instruction builds a new frame and pushes it on the environment. \nThen each CALL pops the latest frame off the environment. So, while the stack does \nnot grow with tail-recursive calls, the heap certainly does. Eventually, we will have \nto garbage-collect all those unused frames (and the cons cells used to make lists out \nof them). How could we avoid or limit this garbage collection? \n\n23.4 A Peephole Optimizer \nIn this section we investigate a simple technique that will generate slightly better \ncode in cases where the compiler gives inefficient sequences of instructions. The \nidea is to look at short sequences of instructions for prespecified patterns and replace \nthem with equivalent but more efficient instructions. \n\nIn the following example, comp - i f has already done some source-level optimization, \nsuch as eliminating the (fx) call, \n\n> (comp-show '(begin (if (if t 1 (f x)) (set! . 2)) .)) \n\nO:ARGS O \n1: 1 \n2: FJUMP 6 \n3: 2 \n4:GSET X \n5: POP \n6:GVAR X \n7:RETURN \nBut the generated code could be made much better. This could be done with more \nsource-level optimizations to transform the expression into (set! . 2). Alternatively, \nit could also be done by looking at the preceding instruction sequence and \ntransforming local inefficiencies. The optimizer presented in this section is capable \nof generating the following code: \n\n\f\n<a id='page-818'></a>\n\n> (comp-show '(begin (if (if t 1 (f x)) (set! . 2)) .)) \n\n0: ARGS O \n1: 2 \n2:GSET X \n3:RETURN \nThe function optimize is implemented as a data-driven function that looks at \nthe opcode of each instruction and makes optimizations based on the following \ninstructions. To be more specific, opti mi ze takes a hst of assembly language instructions \nand looks at each instruction in order, trying to apply an optimization. If any \nchanges at all are made, then opti mi ze will be called again on the whole instruction \nlist, because further changes might be triggered by the first round of changes. \n\n(defun optimize (code) \n\"Perform peephole optimization on assembly code.\" \n(let ((any-change nil)) \n\nOptimize each tail \n(loop for code-tail on code do \n(setf any-change (or (optimize-1 code-tail code) \n\nany-change))) \n;; If any changes were made, call optimize again \n(if any-change \n\n(optimize code) \ncode))) \n\nThe function optimize-1 is responsible for each individual attempt to optimize. It \nis passed two arguments: a list of instructions starting at the current one and going \nto the end of the list, and a list of all the instructions. The second argument is \nrarely used. The whole idea of a peephole optimizer is that it should look at only a \nfew instructions following the current one. opti mi ze -1 is data-driven, based on the \nopcode of the first instruction. Note that the optimizer functions do their work by \ndestructively modifying the instruction sequence, not by consing up and returning a \nnew sequence. \n\n(defun optimize-1 (code all-code) \n\"Perform peephole optimization on a tail of the assembly code. \nIf a change is made, return true.\" \n;; Data-driven by the opcode of the first instruction \n(let* ((instr (first code)) \n\n(optimizer (get-optimizer (opcode instr)))) \n(when optimizer \n(funcall optimizer instr code all-code)))) \n\n\f\n<a id='page-819'></a>\nWe need a table to associate the individual optimizer functions with the opcodes. \nSince opcodes include numbers as well as symbols, an eq 1 hash table is an appropriate \nchoice: \n\n(let ((optimizers (make-hash-table :test #'eql))) \n\n(defun get-optimizer (opcode) \n\"Get the assembly language optimizer for this opcode.\" \n(gethash opcode optimizers)) \n\n(defun put-optimizer (opcode fn) \n\"Store an assembly language optimizer for this opcode.\" \n(setf (gethash opcode optimizers) fn))) \n\nWe could now build a table with put-opt i mi zer, but it is worth defining a macro to \nmake this a Httle neater: \n\n(defmacro def-optimizer (opcodes args &body body) \n\"Define assembly language optimizers for these opcodes.\" \n(assert (and (listp opcodes) (listp args) (= (length args) 3))) \n'(dolist (op '.opcodes) \n\n(put-optimizer op #*(lambda .args ..body)))) \n\nBefore showing example optimizer functions, we will introduce three auxiliary functions, \ngeni generates a single instruction, target finds the code sequence that a \njump instruction branches to, and next-i nstr finds the next actual instruction in a \nsequence, skipping labels. \n\n(defun geni (&rest args) \"Generate a single instruction\" args) \n(defun target (instr code) (second (member (argl instr) code))) \n(defun next-instr (code) (find-if (complement #*label-p) code)) \n\nHere are six optimizer functions that implement a few important peephole optimizations. \n\n\n(def-optimizer (:LABEL) (instr code all-code) \n... L ... => ;if no reference to L \n(when (not (find instr all-code :key #'argl)) \n(setf (first code) (second code) \n(rest code) (rest2 code)) \nt)) \n\n\f\n<a id='page-820'></a>\n\n(def-optimizer (GSET LSET) (instr code all-code) \n;; ex: (begin (set! . y) (if . .)) \n(SET .) (POP) (VAR X) ==> (SET X) \n(when (and (is (second code) 'POP) \n(is (third code) '(GVAR LVAR)) \n(eq (argl instr) (argl (third code)))) \n(setf (rest code) (nthcdr 3 code)) \nt)) \n\n(def-optimizer (JUMP CALL CALLJ RETURN) (instr code all-code) \n(JUMP LI) ...dead code... L2 ==> (JUMP LI) L2 \n(setf (rest code) (member-if #'label-. (rest code))) \n(JUMP LI) ... LI (JUMP L2) ==> (JUMP L2) ... LI (JUMP L2) \n(when (and (is instr 'JUMP) \n(is (target instr code) '(JUMP RETURN)) \n(setf (first code) (copy-list (target instr code))) \nt))) \n\n(def-optimizer (TJUMP FJUMP) (instr code all-code) \n(FJUMP LI) .. . LI (JUMP L2) ==> (FJUMP L2) .. . LI (JUMP L2) \n(when (is (target instr code) 'JUMP) \n(setf (second instr) (argl (target instr code))) \nt)) \n\n(def-optimizer (T -1 0 1 2) (instr code all-code) \n(case (opcode (second code)) \n(NOT :; (T) (NOT) ==> NIL \n(setf (first code) (geni 'NID \n(rest code) (rest2 code)) \nt) \n(FJUMP (T) (FJUMP L) ... => .. . \n(setf (first code) (third code) \n(rest code) (rest3 code)) \nt) \n(TJUMP ;: (T) (TJUMP L) ... => (JUMP L) .. . \n(setf (first code) (geni 'JUMP (argl (next-instr code)))) \nt))) \n\n\f\n<a id='page-821'></a>\n(def-optimizer (NIL) (instr code all-code) \n(case (opcode (second code)) \n(NOT ;; (NIL) (NOT) ==> . \n(setf (first code) (geni '.) \n(rest code) (rest2 code)) \nt) \n(TJUMP (NIL) (TJUMP L) ... => .. . \n(setf (first code) (third code) \n(rest code) (rest3 code)) \nt) \n\n(FJUMP (NIL) (FJUMP L) ==> (JUMP L) \n(setf (first code) (geni 'JUMP (argl (next-instr code)))) \nt))) \n\n23.5 Languages with Different Lexical \nConventions \nThis chapter has shown how to evaluate a language with Lisp-like syntax, by writing \na read-eval-print loop where only the eval needs to be replaced. In this section we \nsee how to make the read part slightly more general. We still read Lisp-like syntax, \nbut the lexical conventions can be slightly different. \n\nThe Lisp function read is driven by an object called the readtable, which is stored \nin the special variable *readtabl e*. This table associates some action to take with \neach of the possible characters that can be read. The entry in the readtable for the \ncharacter #\\ (, for example, would be directions to read a list. The entry for # \\; would \nbe directions to ignore every character up to the end of the line. \n\nBecause the readtable is stored in a special variable, it is possible to alter completely \nthe way read works just by dynamically rebinding this variable. \n\nThe new function scheme - read temporarily changes the readtable to a new one, \nthe Scheme readtable. It also accepts an optional argument, the stream to read \nfrom, and it returns a special marker on end of file. This can be tested for with the \npredicate eof-object?. Note that once scheme- read is installed as the value of the \nScheme symbol read we need do no more-scheme- read will always be called when \nappropriate (by the top level of Scheme, and by any user Scheme program). \n\n(defconstant eof \"EoF\") \n(defun eof-object? (x) (eq . eof)) \n(defvar *scheme-readtable* (copy-readtable)) \n\n\f\n<a id='page-822'></a>\n\n(defun scheme-read (&optional (stream *standard-input*)) \n(let ((*readtable* *scheme-readtable*)) \n(read stream nil eof))) \n\nThe point of having a special eof constant is that it is unforgeable. The user cannot \ntype in a sequence of characters that will be read as something eq to eof. In Common \nLisp, but not Scheme, there is an escape mechanism that makes eof forgable. The \nuser can type #.eof to get the effect of an end of file. This is similar to the \"D \nconvention in UNIX systems, and it can be quite handy. \n\nSo far the Scheme readtable is just a copy of the standard readtable. The next step \nin implementing scheme-read is to alter *scheme- readtabl e*, adding read macros \nfor whatever characters are necessary. Here we define macros for #t and #f (the true \nand false values), for #d (decimal numbers) and for the backquote read macro (called \nquasiquote in Scheme). Note that the backquote and conruna characters are defined \nas read macros, but the @ in ,@ is processed by reading the next character, not by a \nread macro on @. \n\n(set-dispatch-macro-character #\\# #\\t \n#*(lambda (&rest ignore) t) \n*scheme-readtable*) \n\n(set-dispatch-macro-character #\\# #\\f \n#.(lambda (&rest ignore) nil) \n*scheme-readtable*) \n\n(set-dispatch-macro-character #\\# #\\d \nIn both Common Lisp and Scheme, \n;; #x, #0 and #b are hexidecimal, octal, and binary, \n\ne.g. #xff = #o377 = #bllllllll = 255 \nIn Scheme only, #d255 is decimal 255. \n#*(lambda (stream &rest ignore) \n(let ((*read-base* 10)) (scheme-read stream))) \n*scheme-readtable*) \n\n(set-macro-character #\\* \n#*(lambda (s ignore) (list 'quasiquote (scheme-read s))) \nnil *scheme-readtable*) \n\n(set-macro-character #\\, \n#'(lambda (stream ignore) \n(let ((ch (read-char stream))) \n\n(if (char= ch #\\@) \n(list 'unquote-splicing (read stream)) \n(progn (unread-char ch stream) \n\n(list 'unquote (read stream)))))) \nnil *scheme-readtable*) \n\nFinally, we install scheme- read and eof-object? as primitives: \n\n\f\n<a id='page-823'></a>\n(defparameter *primitive-fns* \n\n.((+ 2 + true nil) (-2 - true nil) (* 2 * true nil) (/ 2 / true nil) \n(< 2 < nil nil) (> 2 > nil nil) (<= 2 <= nil nil) (>= 2 >= nil nil) \n(/= 2 /= nil nil) (= 2 = nil nil) \n(eq? 2 eq nil nil) (equal? 2 equal nil nil) (eqv? 2 eql nil nil) \n(not 1 not nil nil) (null? 1 not nil nil) (cons 2 cons true nil) \n(car 1 car nil nil) (cdr 1 cdr nil nil) (cadr 1 cadr nil nil) \n(list 1 listl true nil) (list 2 list2 true nil) (list 3 list3 true nil) \n(read 0 read nil t) (write 1 write nil t) (display 1 display nil t) \n(newline 0 newline nil t) (compiler 1 compiler t nil) \n(name! 2 name! true t) (random 1 random true nil))) \n\nHere we test scheme -read. The characters in italics were typed as a response to the \nscheme-read. \n\n> (scheme-read) #f \n. \n\n> (scheme-read) #/ \nNIL \n\n> (scheme-read) '(a,b,@cd) \n(QUASIQUOTE (A (UNQUOTE B) (UNQUOTE-SPLICING C) D)) \n\nThe final step is to make quasi quote a macro that expands into the proper sequence \nof calls to cons, 1 i st, and append. The careful reader will keep track of the difference \nbetween the form returned by scheme-read (something starting with quasi quote), \nthe expansion of this form with the Scheme macro quasi quote (which is implemented \nwith the Common Lisp function qua si - q), and the eventual evaluation of the \nexpansion. In an environment where b is bound to the number 2 and c is bound to \nthe Ust (cl c2), we might have: \n\nTyped: '(a ,b .@c d) \nRead: (quasiquote (a (unquote b) (unquote-splicing c) d)) \nExpanded: (cons 'a (cons b (append c '(d)))) \nEvaluated: (a 2 cl c2 d) \n\nThe implementation of the quasi quote macro is modeled closely on the one given \nin Charniak et al.'s Artificial Intelligence Programming. I added support for vectors. In \ncombi ne - quas i quote I add the trick of reusing the old cons cell . rather than consing \ntogether 1 eft and ri ght when that is possible. However, the implementation still \nwastes cons cells - a more efficient version would pass back multiple values rather \nthan consing quote onto a list, only to strip it off again. \n\n\f\n<a id='page-824'></a>\n\n(setf (scheme-macro 'quasiquote) 'quasi-q) \n\n(defun quasi-q (x) \n\"Expand a quasi quote form into append, list, and cons calls. \" \n(cond \n((vectorp x) \n(list 'apply 'vector (quasi-q (coerce . 'list)))) \n((atom x) \n(if (constantp x) . (list 'quote x))) \n((starts-with . 'unquote) \n(assert (and (rest x) (null (rest2 x)))) \n(second x)) \n((starts-with . 'quasiquote) \n(assert (and (rest x) (null (rest2 x)))) \n(quasi-q (quasi-q (second x)))) \n((starts-with (first x) 'unquote-splicing) \n(if (null (rest x)) \n(second (first x)) \n(list 'append (second (first x)) (quasi-q (rest x))))) \n(t (combine-quasiquote (quasi-q (car x)) \n(quasi-q (cdr x)) \nx)))) \n\n(defun combine-quasiquote (left right x) \n\"Combine left and right (car and cdr), possibly re-using x.\" \n(cond ((and (constantp left) (constantp right)) \n(if (and (eql (eval left) (first x)) \n(eql (eval right) (rest x))) \n(list 'quote x) \n(list 'quote (cons (eval left) (eval right))))) \n((null right) (list 'list left)) \n((starts-with right 'list) \n(list* 'list left (rest right))) \n(t (list 'cons left right)))) \n\nActually, there is a major problem with the quasi quote macro, or more accurately, in \nthe entire approach to macro-expansion based on textual substitution. Suppose we \nwanted a function that acted like this: \n\n> (extrema '(3 1 10 5 20 2)) \n((max 20) (min D ) \n\n\f\n<a id='page-825'></a>\nWe could write the Scheme function: \n\n(define (extrema list) \nGiven a list of numbers, return an a-list \nwith max and min values \n\n'((max .(apply max list)) (min .(apply min list)))) \n\nAfter expansion of the quasiquote, the definition of extrema will be: \n\n(define extrema \n(lambda (list) \n(list (list 'max (apply max list)) \n(list 'min (apply min list))))) \n\nThe problem is that 1 i st is an argument to the function extrema, and the argument \nshadows the global definition of 1 i st as a function. Thus, the function will fail. One \nway around this dilemma is to have the macro-expansion use the global value of 1 is t \nrather than the symbol 1 i st itself. In other words, replace the 'list in quasi -q with \n(get - gl oba 1 - va r 'list). Then the expansion can be used even in an environment \nwhere 1 i st is locally bound. One has to be careful, though: if this tack is taken, then \ncomp - funcall should be changed to recognize function constants, and to do the right \nthing with respect to primitives. \n\nIt is problems like these that made the designers of Scheme admit that they \ndon't know the best way to specify macros, so there is no standard macro definition \nmechanism in Scheme. Such problems rarely come up in Common Lisp because \nfunctions and variables have different name spaces, and because local function \ndefinitions (with flet or 1 abel s) are not widely used. Those who do define local \nfunctions tend not to use already estabUshed names like 1 i st and append. \n\n23.6 History and References \nGuy Steele's 1978 MIT master's thesis on the language Scheme, rewritten as Steele \n1983, describes an innovative and influential compiler for Scheme, called RABBFI.^ \nA good article on an \"industrial-strength\" Scheme compiler based on this approach \nis described in Kranz et al.'s 1986 paper on ....., the compiler for the . dialect of \nScheme. \n\nAbelson and Sussman's Structure and Interpretation of Computer Programs (1985) \ncontains an excellent chapter on compilation, using slightly different techniques and \ncompiling into a somewhat more confusing machine language. Another good text \n\n^At the time, the MacLisp compiler dealt with something called \"lisp assembly code\" or \nLAP. The function to input LAP was called 1 api .. Those who know French will get the pun. \n\n\f\n<a id='page-826'></a>\n\nis John Allen's Anatomy of Lisp (1978). It presents a very clear, simple compiler, \nalthough it is for an older, dynamically scoped dialect of Lisp and it does not address \ntail-recursion or cal 1 / cc. \nThe peephole optimizer described here is based on the one in Masinter and \nDeutsch 1980. \n23.7 Exercises \n&#9635; Exercise 23.3 [h] Scheme's syntax for numbers is slightly different from Common \nLisp's. In particular, complex numbers are written like 3+4i rather than #c(3 4). \nHow could you make scheme - read account for this? \n\n&#9635; Exercise 23.4 [m] Is it possible to make the core Scheme language even smaller, \nby eliminating any of the five special forms (quote, begin, set! , if, lambda) and \nreplacing them with macros? \n\n&#9635; Exercise 23.5 [m] Add the ability to recognize internal defines (see [page 779](chapter22.md#page-779)). \n\n&#9635; Exercise 23.6 [h] In comp-if we included a special case for (i f t . y) and (i f \nnil X y). But there are other cases where we know the value of the predicate. For \nexample, (i f (* a b). y) can also reduce to x. Arrange for these optimizations to \nbe made. Note the prim -a 1 ways field of the prim structure has been provided for this \npurpose. \n\n&#9635; Exercise 23.7 [m] Consider the following version of the quicksort algorithm for \nsorting a vector: \n(define (sort-vector vector test) \n(define (sort lo hi) \n(if (>= lo hi) \nvector \n(let ((pivot (partition vector lo hi test))) \n(sort lo pivot) \n(sort (+ pivot 1) hi)))) \n(sort 0 (- (vector-length vector 1)))) \nHere the function parti ti on takes a vector, two indices into the vector, and a comparison \nfunction, test . It modifies the vector and returns an index, pi vot, such that \nall elements of the vector below pi vot are less than all elements at pi vot or above. \n\n\f\n<a id='page-827'></a>\nIt is well known that quicksort takes time proportional to . log . to sort a vector of \n. elements, if the pivots are chosen well. With poor pivot choices, it can take time \nproportional to TI?. \n\nThe question is, what is the space required by quicksort? Besides the vector itself, \nhow much additional storage must be temporarily allocated to sort a vector? \nNow consider the following modified version of quicksort. What time and space \ncomplexity does it have? \n\n(define (sort-vector vector test) \n(define (sort lo hi) \n\n(if (>= lo hi) \nvector \n(let ((pivot (partition vector lo hi))) \n\n(if (> (- hi pivot) (- pivot lo)) \n(begin (sort lo pivot) \n(sort (+ pivot 1) hi)) \n(begin (sort (+ pivot 1) hi) \n(sort lo pivot)))))) \n(sort 0 (- (vector-length vector 1)))) \n\nThe next three exercises describe extensions that are not part of the Scheme \nstandard. \n\n&#9635; Exercise 23.8 [h] The set! special form is defined only when its first argument is \na symbol. Extend setl to work like setf when the first argument is a hst. That is, \n(set! (car x) y) should expand into something like ((setter car) y .), where \n(setter car) evaluates to the primitive procedure set-car!. You will need to add \nsome new primitive functions, and you should also provide a way for the user to \ndefine new set! procedures. One way to do that would be with a setter function \nfor set!, for example: \n\n(set! (setter third) \n(lambda (val list) (set-car! (cdr (cdr list)) val))) \n\n&#9635; Exercise 23.9 [m] Itis a curious asymmetry of Scheme that there isa special notation \nfor lambda expressions within def i ne expressions, but not within let. Thus, we see \nthe following: \n\n(define square (lambda (x) (* . .))) listhesameas \n(define (square .) (* . .)) \n\n\f\n<a id='page-828'></a>\n\n(let ((square (lambda (x) (* . .)))) ...) ; is not the same as \n(let (((square x) (* . .))) ...) : <=illegal! \n\nDo you think this last expression should be legal? If so, modify the macros for \nlet, let*, and letrec to allow the new syntax. If not, explain why it should not be \nincluded in the language. \n\n&#9635; Exercise 23.10 [m] Scheme does not define funcall, because the normal function-\ncall syntax does the work of funcall. This suggests two problems. (1) Is it possible \nto define funcall in Scheme? Show a definition or explain why there can't be one. \nWould you ever have reason to use funcall in a Scheme program? (2) Scheme does \ndefine appl y, as there is no syntax for an application. One might want to extend the \nsyntax to make (+ . numbers) equivalent to (apply + numbers). Would this be a \ngood idea? \n\n&#9635; Exercise 23.11 [d] Write a compiler that translates Scheme to Common Lisp. This \nwill involve changing the names of some procedures and special forms, figuring out \na way to map Scheme's single name space into Common Lisp's distinct function and \nvariable name spaces, and dealing with Scheme's continuations. One possibility is \nto translate a cal 1 /cc into a catch and throw, and disallow dynamic continuations. \n\n23.8 Answers \nAnswer 23.2 We can save frames by making a resource for frames, as was done \non [page 337](chapter10.md#page-337). Unfortunately, we can't just use the def resource macro as is, because \nwe need a separate resource for each size frame. Thus, a two-dimensional array or \na vector of vectors is necessary. Furthermore, one must be careful in determining \nwhen a frame is no longer needed, and when it has been saved and may be used again. \nSome compilers will generate a special calling sequence for a tail-recursive call where \nthe environment can be used as is, without discarding and then creating a new frame \nfor the arguments. Some compilers have varied and advanced representations for \nenvironments. An environment may never be represented explicitly as a list of \nframes; instead it may be represented implicitly as a series of values in registers. \n\n\f\n<a id='page-829'></a>\nAnswer 23.3 We could read in Scheme expressions as before, and then convert any \nsymbols that looked Hke complex numbers into numbers. The following routines do \nthis without consing. \n\n(defun scheme-read (&optional (stream *standard-input*)) \n(let ((*readtable* *scheme-readtable*)) \n(convert-numbers (read stream nil eof)))) \n\n(defun convert-numbers (x) \n\"Replace symbols that look like Scheme numbers with their values.\" \nDon't copy structure, make changes in place, \n(typecase . \n(cons (setf (car x) (convert-numbers (car x))) \n(setf (cdr x) (convert-numbers (cdr x))) \n\nX) \n\n(symbol (or (convert-number x) x)) \n(vector (dotimes (i (length x)) \n(setf (aref . i) (convert-numbers (aref . i)))) \n.) \n(t .))) \n\n(defun convert-number (symbol) \n\"If str looks like a complex number, return the number.\" \n(let* ((str (symbol-name symbol)) \n\n(pos (position-if #'sign-p str)) \n(end (- (length str) 1))) \n(when (and pos (char-equal (char str end) #\\i)) \n(let ((re (read-from-string str nil nil istart 0 :end pos)) \n(im (read-from-string str nil nil :start pos :end end))) \n(when (and (numberp re) (numberp im)) \n(complex re im)))))) \n\n(defun sign-p (char) (find char \"+-\")) \n\nActually, that's not quite good enough, because a Scheme complex number can have \nmultiple signs in it, as in 3. 4e- 5+6. 7e->-8i, and it need not have two numbers, as in \n31 or 4+i or just +i. The other problem is that complex numbers can only have a \nlowercase i, but read does not distinguish between the symbols 3+4i and 3+41. \n\n\f\n<a id='page-830'></a>\n\nAnswer 23.4 Yes, it is possible to implement begi . as a macro: \n\n(setf (scheme-macro 'begin) \n#'(1ambda (&rest exps) '((lambda () .,exps)))) \n\nWith some work we could also eliminate quote. Instead of 'x, we could use \n(stri ng ->synibol \" X\"), and instead of ' (1 2), we could use something like (list 1 \n2). The problem is in knowing when to reuse the same list. Consider: \n\n=> (define (one-two) '(1 2)) \nONE-TWO \n\n=> (eq? (one-two) (one-two)) \n\n. \n\n=> (eq? '(1 2) '(1 2)) \nNIL \n\nA clever memoized macro for quote could handle this, but it would be less efficient \nthan having quote as a special form. In short, what's the point? \nIt is also (nearly) possible to replace i f with alternate code. The idea is to replace: \n\n(if test then-part else-part) \n\nwith \n\n(test (delay then-part) (delay else-part)) \n\nNow if we are assured that any test returns either #t or #f, then we can make the \nfollowing definitions: \n\n(define #t (lambda (then-part else-part) (force then-part))) \n(define #f (lambda (then-part else-part) (force else-part))) \n\nThe only problem with this is that any value, not just #t, counts as true. \n\nThis seems to be a common phenomenon in Scheme compilers: translating \neverything into a few very general constructs, and then recognizing special cases of \nthese constructs and compiling them specially. This has the disadvantage (compared \nto explicit use of many special forms) that compilation may be slower, because all \nmacros have to be expanded first, and then special cases have to be recognized. It \nhas the advantage that the optimizations will be applied even when the user did not \nhave a special construct in mind. Common Lisp attempts to get the advantages of \nboth by allowing implementations to play loose with what they implement as macros \nand as special forms. \n\n\f\n<a id='page-831'></a>\nAnswer 23.6 We define the predicate a 1 ways and install it in two places in comp - i f: \n\n(defun always (pred env) \n\"Does predicate always evaluate to true or false? \" \n(cond ((eq pred t) 'true) \n\n((eq pred nil) 'false) \n((symbolp pred) nil) \n((atom pred) 'true) \n((scheme-macro (first pred)) \n\n(always (scheme-macro-expand pred) env)) \n\n((case (first pred) \n(QUOTE (if (null (second pred)) 'false 'true)) \n(BEGIN (if (null (rest pred)) 'false \n\n(always (lastl pred) env))) \n(SET! (always (third pred) env)) \n(IF (let ((test (always (second pred)) env) \n\n(then (always (third pred)) env) \n(else (always (fourth pred)) env)) \n\n(cond ((eq test 'true) then) \n((eq test 'false) else) \n((eq then else) then)))) \n\n(LAMBDA 'true) \n(t (let ((prim (primitive-p (first pred) env \n(length (rest pred))))) \n(if prim (prim-always prim)))))))) \n\n(defun comp-if (pred then else env val? more?) \n(case (always pred env) \n\n(true ; (if nil . y) ==> y ; *** \n(comp then env val? more?)) ; *** \n(false ; (if t . y) ==> . ; *** \n(comp else env val? more?)) ; *** \n\n(otherwise \n\n(let ((pcode (comp pred env t t)) \n(tcode (comp then env val? more?)) \n(ecode (comp else env val? more?))) \n\n(cond \n\n((and (listp pred) ; (if (not p) . y) ==> (if pyx) \n(length=1 (rest pred)) \n(primitive-p (first pred) env 1) \n(eq (prim-opcode (primitive-p (first pred) env 1)) \n\n'not)) \n(comp-if (second pred) else then env val? more?)) \n((equal tcode ecode) ; (if . . x) ==> (begin . .) \n(seq (comp pred env nil t) ecode)) \n((null tcode) ; (if . nil y) ==> . (TJUMP L2) y L2: \n(let ((L2 (gen-label))) \n(seq pcode (gen 'TJUMP L2) ecode (list L2) \n\n\f\n<a id='page-832'></a>\n\n(unless more? (gen 'RETURN))))) \n((null ecode) ; (if . .) ==> . (FJUMP LI) . LI: \n(let ((LI (gen-label))) \n(seq pcode (gen TJUMP LI) tcode (list LI) \n(unless more? (gen 'RETURN))))) \n(t ; (if . X y) ==> . (FJUMP LI) . LI: y \n: or . (FJUMP LI) . (JUMP L2) LI: y L2: \n(let ((LI (gen-label)) \n(L2 (if more? (gen-label)))) \n\n(seq pcode (gen 'FJUMP LI) tcode \n(if more? (gen 'JUMP L2)) \n(list LI) ecode (if more? (list L2)))))))))) \n\nDevelopnient note: originally, I had coded a1 ways as a predicate that took a Boolean \nvalue as input and returned true if the expression always had that value. Thus, you \nhad to ask first if the predicate was always true, and then if it was always false. Then \nI realized this was duplicating much effort, and that the duplication was exponential, \nnot just linear: for a triply-nested conditional I would have to do eight times the \nwork, not tw^ice the work. Thus I switched to the above formulation, where always \nis a three-valued function, returning true, f al se, or ni 1 for none-of-the-above. But \nto demonstrate that the right solution doesn't always appear the first time, I give my \noriginal definition as well: \n\n(defun always (boolean pred env) \n\"Does predicate always evaluate to boolean in env?\" \n(if (atom pred) \n\n(and (constantp pred) (equiv boolean pred)) \n\n(case (first pred) \n(QUOTE (equiv boolean pred)) \n(BEGIN (if (null (rest pred)) (equiv boolean nil) \n\n(always boolean (lastl pred) env))) \n(SET! (always boolean (third pred) env)) \n(IF (or (and (always t (second pred) env) \n\n(always boolean (third pred) env)) \n(and (always nil (second pred) env) \n(always boolean (fourth pred) env)) \n(and (always boolean (third pred) env) \n\n(always boolean (fourth pred) env)))) \n(LAMBDA (equiv boolean t)) \n(t (let ((prim (primitive-p (first pred) env \n\n(length (rest pred))))) \n(and prim \n(eq (prim-always prim) \n(if boolean 'true 'false)))))))) \n\n(defun equiv (x y) \"Boolean equivalence\" (eq (not x) (not y))) \n\n\f\n<a id='page-833'></a>\n\nAnswer 23.7 The original version requires 0 (n) stack space for poorly chosen \npivots. Assuming a properly tail-recursive compiler, the modified version will never \nrequire more than O(logn) space, because at each step at least half of the vector is \nbeing sorted tail-recursively. \n\nAnswer 23.10 (1) (defun (funcall fn . args) (apply fn args)) \n\n(2) Suppose you changed the piece of code (+ . numbers) to (+ . (map sqrt \nnumbers)). The latter is the same expression as (+ map sqrt numbers), which is \nnot the intended result at all. So there would be an arbitrary restriction: the last \nargument in an apply form would have to be an atom. This kind of restriction goes \nagainst the grain of Scheme. \n\f\n## Chapter 24\n<a id='page-834'></a>\n\nANSI Common Lisp \n\nI 1 his chapter briefly covers some advanced features of Conunon Lisp that were not used \n\nin the rest of the book. The first topic, packages, is crucial in building large systems but \n\nwas not covered in this book, since the programs are concise. The next four topics-error \nhandling, pretty printing, series, and the loop macro - are covered in Common Lisp the Language, \n2d edition, but not in the first edition of the book. Thus, they may not be applicable to your Lisp \ncompiler. The final topic, sequence functions, shows how to write efficient functions that work \nfor either lists or vectors. \n\nI. \n\n24.1 Packages \nApackage is a symbol table that maps from strings to symbols named by those strings. When \nread is confronted with a sequence of characters like 1 i st, it uses the symbol table to determine \nthat this refers to the symbol 1 i st. The important point is that every use of the symbol name \n1 i st refers to the same symbol. That makes it easy to refer to predefined symbols, but it also \nmakes it easy to introduce unintended name conflicts. For example, if I wanted to hook up the \nemyci . expert system from chapter 16 with the parser from chapter 19, there would be a conflict \nbecause both programs use the symbol def rul e to mean different things. \n\n\f\n<a id='page-835'></a>\nCommon Lisp uses the package system to help resolve such conflicts. Instead of \na single symbol table. Common Lisp allows any number of packages. The function \nread always uses the current package, which is defined to be the value of the special \nvariable ^package*. By default. Lisp starts out in the common-1 i sp-user package.^ \nThat means that if we type a new symbol, like zxv@!?+qw, it will be entered into \nthat package. Converting a string to a symbol and placing it in a package is called \ninterning. It is done automatically by read, and can be done by the function i ntern \nif necessary. Name conflicts arise when there is contention for names within the \ncommon -1 i sp- user package. \n\nTo avoid name conflicts, simply create your new symbols in another package, one \nthat is specific to your program. The easiest way to implement this is to split each \nsystem into at least two files - one to define the package that the system resides in, and \nthe others for the system itself. For example, the emyci. system should start with a \nfile that defines the emyci . package. The following form defines the emyci . package \nto use the 1 i sp package. That means that when the current package is emyci n, you \ncan still refer to all the built-in Lisp symbols. \n\n(make-package \"EMYCIN\" :use '(\"LISP\")) \n\nThe file containing the package definition should always be loaded before the rest \nof the system. Those files should start with the following call, which insures that all \nnew symbols will be interned in the emyci . package: \n\n(in-package \"EMYCIN\") \n\nPackages are used for information-hiding purposes as well as for avoiding name \nclashes. A distinction is made between internal and external symbols. External \nsymbols are those that a user of a system would want to refer to, while internal \nsymbols are those that help implement the system but are not needed by a user of the \nsystem. The symbol rul e would probably be internal to both the emyci. and parser \npackage, but def rul e would be external, because a user of the emyci . system uses \ndef rul e to define new rules. The designer of a system is responsible for advertising \nwhich symbols are external. The proper call is: \n\n(export '(emycin defrule defcontext defparm yes/no yes no is)) \n\nNow the user who wants to refer to symbols in the emyci. package has four choices. \nFirst, he or she can use the package prefix notation. To refer to the symbol def rul e \nin the emycin package, type emycin: def rule. Second, the user can make emycin \nbe the current package with (in-package \"EMYCIN\"). Then, of course, we need \n\n^Or in the user package in non-ANSI systems. \n\n\f\n<a id='page-836'></a>\n\nonly type def rul e. Third, if we only need part of the functionahty of a system, we \ncan import specific symbols into the current package. For example, we could call \n(i mport ' emyci .: def rul e). From then on, typing def rul e (in the current package) \nwill refer to emyci .: def rul e. Fourth, if we want the full functionahty of the system, \nwe call (use-package \"EMYCIN\"). This makes all the external symbols of the emyci . \npackage accessible in the current package. \n\nWhile packages help eliminate name conflicts, import and use-package allow \nthem to reappear. The advantage is that there will only be conflicts between external \nsymbols. Since a carefully designed package should have far fewer external than \ninternal symbols, the problem has at least been reduced. But if two packages both \nhave an external def rul e symbol, then we cannot use- package both these packages, \nnor 1 mport both symbols without producing a genuine name conflict. Such conflicts \ncan be resolved by shadowing one symbol or the other; see Common Lisp the Language \nfor details. \n\nThe careful reader may be confused by the distinction between \"EMYCIN\" and \nemycin. In Common Lisp the Language, it was not made clear what the argument \nto package functions must be. Thus, some implementations signal an error when \ngiven a symbol whose print name is a package. In ANSI Common Lisp, all package \nfunctions are specified to take either a package, a package name (a string), or a \nsymbol whose print name is a package name. In addition, ANSI Common Lisp adds \nthe convenient def package macro. It can be used as a replacement for separate calls \nto make-package, use-package, import, and export. Also note that ANSI renames \nthe lisp package as common - lisp. \n\n(defpackage emycin \n(ruse common-lisp) \n(:export emycin defrule defcontext defparm yes/no yes no is)) \n\nFor more on packages and building systems, see section 25.16 or Common Lisp the \nLanguage. \n\nThe Seven Name Spaces \n\nOne important fact to remember about packages is that they deal with symbols, and \nonly indirectly deal with the uses those symbols might have. For example, you may \nthink of (export 'parse) as exporting the function parse, but really it is exporting \nthe symbol parse, which may happen to have a function definition associated with \nit. However, if the symbol is put to another use - perhaps as a variable or a data \ntype - then those uses are made accessible by the export statement as well. \n\nCommon Lisp has at least seven name spaces. The two we think of most often \nare (1) for functions and macros and (2) for variables. We have seen that Scheme \n\n\f\n<a id='page-837'></a>\nconflates these two name spaces, but Common Lisp keeps them separate, so that in \na function application like (f) the function/macro name space is consulted for the \nvalue of f, but in (+ f), f is treated as a variable name. Those who understand the \nscope and extent rules of Common Lisp know that (3) special variables form a distinct \nname space from lexical variables. So the f in (+ f) is treated as either a special or \nlexical variable, depending on if there is an applicable special declaration. There \nis also a name space (4) for data types. Even if f is defined as a function and/or a \nvariable, it can also be defined as a data type with defstruct, deftype, or def cl ass. \nIt can also be defined as (5) a label for go statements within a tagbody or (6) a block \nname for return-from statements within a bl ock. Finally, symbols inside a quoted \nexpression are treated as constants, and thus form name space (7). These symbols \nare often used as keys in user-defined tables, and in a sense each such table defines \na new name space. One example is the tag name space, used by catch and throw. \nAnother is the package name space. \n\nIt is a good idea to limit each symbol to only one name space. Common Lisp will \nnot be confused if a symbol is used in multiple ways, but the poor human reader \nprobably will be. \n\nIn the following example f, can you identify which of the twelve uses off refer to \nwhich name spaces? \n\n(defun f (f) \n(block f \n(tagbody \nf (catch 'f \n(if (typep f 'f) \n(throw *f (go f))) \n(funcall #'f (get (symbol-value *f) 'f)))))) \n\n24.2 Conditions and Error Handling \nAn extraordinary feature of ANSI Common Lisp is the facility for handling errors. \nIn most languages it is very difficult for the programmer to arrange to recover from \nan error. Although Ada and some implementations of C provide functions for error \nrecovery, they are not generally part of the repertoire of most programmers. Thus, \nwe find C programs that exit with the ungraceful message Segmentati on violation: \ncore dumped. \n\nCommon Lisp provides one of the most comprehensive and easy-to-use error-\nhandling mechanism of any programming language, which leads to more robust \nprograms. The process of error handling is divided into two parts: signaling an error, \nand handling it. \n\n\f\n<a id='page-838'></a>\n\nSignaling Errors \n\nAnenor is a condition that the program does not know how to handle. Since the \nprogram does not know what to do, its only recourse is to announce the occurrence of \nthe error, with the hope that some other program or user will know what to do. This \nannouncement is called signaling an error. An error can be signaled by a Common \nLisp built-in function, as when (/ 3 0) signals a divide-by-zero error. Errors can also \nbe signaled explicitly by the programmer, as in a call to (error \"111 egal val ue.\"). \n\nActually, it is a bit of a simplification to talk only of signaling errors. The precise \nterm is signaling a condition. Some conditions, like end-of-file, are not considered \nerrors, but nevertheless they are unusual conditions that must be dealt with. The \ncondition system in Conunon Lisp allows for the definition of all kinds of conditions, \nbut we will continue to talk about errors in this brief discussion, since most conditions \nare in fact error conditions. \n\nHandling Errors \n\nBy default, signaling an error invokes the debugger. In the following example, the > \nprompt means that the user is in the debugger rather than at the top level. \n\n> (/ 3 0) \nError: An attempt was made to divide by zero. \n> \n\nANSI Common Lisp provides ways of changing this default behavior. Conceptually, \nthis is done by setting up an error handler which handles the error in some way. Error \nhandlers are bound dynamically and are used to process signaled errors. An error \nhandler is much like a catch, and signaling an error is like a throw. In fact, in many \nsystems catch and throw are implemented with the error-condition system. \n\nThesimplestwayof handling an error is with the macro i gnore-errors. If noerror \noccurs, i gnore-errors is just like progn. But if an error does occur, i gnore-errors \nwill retiu-n nil as its first value and t as its second, to indicate that an error has \noccurred but without doing anything else: \n\n> (ignore-errors (/ 3 D) 3 NIL \n\n> (ignore-errors (/ 3 0)) ^ NIL . \n\ni gnore-errors isavery coarse-grain tool. Inaninteractiveinterpreter, i gnore-errors \ncan be used to recover from any and all errors in the response to one input and get \nback to the read-process-print loop for the next input. If the errors that are ignored \nare not serious ones, this can be a very effective way of transforming a buggy program \ninto a useful one. \n\n\f\n<a id='page-839'></a>\nBut some errors are too important to ignore. If the error is rurming out of memory, \nthen ignoring it will not help. Instead, we need to find some way of freeing up memory \nand continuing. \n\nThe condition-handling system can be used to handle only certain errors. The \nmacro handl er-case, is a convenient way to do this. Like case, its first argument is \nevaluated and used to determine what to do next. If no error is signaled, then the \nvalue of the expression is returned. But if an error does occtu:, the following clauses \nare searched for one that matches the type of the error. In the following example, \nhandl er - case is used to handle division by zero and other arithmetic errors (perhaps \nfloating-point underflow), but it allows all other errors to pass unhandled. \n\n(defun div (x y) \n\n(handler-case (/ . y) \n(division-by-zero () most-positive-fixnum) \n(arithmetic-error () 0))) \n\n> (div 8 2) 4 \n\n> (div 3 0)=^ 16777215 \n\n> (div 'xyzzy 1) \nError: The value of NUMBER, XYZZY, should be a number \n\nThrough judicious use of handl er - case, the programmer can create robust code that \nreacts well to unexpected situations. For more details, see chapter 29 of Common Lisp \nthe Language, 2d edition. \n\n24.3 Pretty Printing \nANSI Common Lisp adds a facility for user-controlled pretty printing. In general, \npretty printing refers to the process of printing complex expressions in a format that \nuses indentation to improve readability. The function ppr 1 nt was always available, \nbut before ANSI Common Lisp it was left unspecified, and it could not be extended \nby the user. Chapter 27 of Common Lisp the Language, 2d edition presents a pretty-\nprinting facility that gives the user fine-grained control over the printing of all types \nof objects. In addition, the facility is integrated with the format function. \n\n24.4 Series \nThe functional style of programming with higher-order functions is one of the at\n\n\ntractions of Lisp. The following expression to sum the square roots of the positive \nnumbers in the list nums is clear and concise: \n\n\f\n<a id='page-840'></a>\n\n(reduce #*+ (mapcar #'sqrt (find-all-if #*plusp nums))) \n\nUnfortunately, it is inefficient: both f i nd - a 11 -i f and ma pea r cons up intermediate \nHsts that are not needed in the final sum. The following two versions using 1 oop and \ndol i st are efficient but not as pretty: \n\n;; Using Loop ;; Using dolist \n\n(loop for num in nums (let ((sum 0)) \n\nwhen (plusp num) (dolist (num nums sum) \n\nsum (sqrt num)) (when (plusp num) \n\n(incf sum num)))) \n\nA compromise between the two approaches is provided by the series faciUty, defined \nin appendix A ofCommon Lisp the Language, 2d edition. The example using series \nwould look like: \n\n(collect-sum (#Msqrt (choose-if #'plusp nums))) \n\nThis looks very much like the functional version: only the names have been changed. \nHowever, it compiles into efficient iterative code very much like the dol i st version. \n\nLike pipes (see section 9.3), elements of a series are only evaluated when they \nare needed. So we can write (scan - range : from 0) to indicate the infinite series of \nintegers starting from 0, but if we only use, say, the first five elements of this series, \nthen only the first five elements will be generated. \n\nThe series facility offers a convenient and efficient alternative to iterative loops \nand sequence functions. Although the series proposal has not yet been adopted as an \nofficial part of ANSI Common Lisp, its inclusion in the reference manual has made \nit increasingly popular. \n\n24.5 The Loop Macro \nThe original specification of Common Lisp included a simple 1 oop macro. The body \nof the loop was executed repeatedly, until a return was encountered. ANSI Common \nLisp officially introduces a far more complex 1 oop macro, one that had been used in \nZetaLisp and its predecessors for some time. This book has occasionally used the \ncomplex 1 oop in place of alternatives such as do, dotimes, dol i st, and the mapping \nfunctions. \n\nIf your Lisp does not include the complex 1 oop macro, this chapter gives a definition \nthat will run all the examples in this book, although it does not support all the \nfeatures of 1 oop. This chapter also serves as an example of a complex macro. As with \n\n\f\n<a id='page-841'></a>\nany macro, the first thing to do is to look at some macro calls and what they might \nexpand into. Here are two examples: \n\n(loop for i from 1 to . do (print (sqrt i))) . \n(LET* ((I 1) \n(TEMP N)) \n(TAGBODY \nLOOP \n(IF (> I TEMP) \n\n(GO END)) \n(PRINT (SQRT I)) \n(SETF I (+ I D) \n(GO LOOP) \n\nEND)) \n\n(loop for V in list do (print v)) = \n(LET* ((IN LIST) \n(V (CAR IN))) \n(TAGBODY \nLOOP \n(IF (NULL IN) \n\n(GO END)) \n(PRINT V) \n(SETF IN (CDR IN)) \n(SETF V (CAR IN)) \n(GO LOOP) \n\nEND)) \n\nEach loop initializes some variables, then enters a loop with some exit tests and a \nbody. So the template is something like: \n\n(let* (variables...) \n(tagbody \nloop \n(if exit-tests \n(go end)) \n\nbody \n\n(go loop) \nend)) \n\nActually, there's more we might need in the general case. There may be a prologue \nthat appears before the loop but after the variable initialization, and similarly there \nmay be an epilogue after the loop. This epilogue may involve returning a value, and \nsince we want to be able to return from the loop in any case, we need to wrap a bl ock \naround it. So the complete template is: \n\n\f\n<a id='page-842'></a>\n\n(let* (variables.,.) \n(block name \nprologue \n\n(tagbody \nloop \n\nbody \n\n(go loop) \nend \n\nepilogue \n\n(return result)))) \n\nTo generate this template from the body of a 1 oop form, we will employ a structure \nwith fields for each of the parts of the template: \n\n(defstruct loop \n\"A structure to hold parts of a loop as it is built.\" \n(vars nil) (prologue nil) (body nil) (steps nil) \n(epilogue nil) (result nil) (name nil)) \n\nNow the 1 oop macro needs to do four things: (1) decide if this is a use of the simple, \nnon-keyword 1 oop or the complex ANSI 1 oop. If it is the latter, then (2) make an \ninstance of the 1 oop structure, (3) process the body of the loop, filling in apprpriate \nfields of the structure, and (4) place the filled fields into the template. Here is the \n1 oop macro: \n\n(defmacro loop (&rest exps) \n\"Supports both ANSI and simple LOOP. \nWarning: Not every loop keyword is supported.\" \n(if (every #'listp exps) \n\nNo keywords implies simple loop: \n'(block nil (tagbody loop ,@exps (go loop))) \n;; otherwise process loop keywords: \n(let ((1 (make-loop))) \n\n(parse-loop-body 1 exps) \n\n(fill-loop-template 1)))) \n\n(defun fill-loop-tempi ate (1) \n\"Use a loop-structure instance to fill the template.\" \n'(let* .(nreverse (loop-vars 1)) \n\n(block ,(loop-name 1) \n.(nreverse (loop-prologue 1)) \n(tagbody \n\nloop \n.(nreverse (loop-body 1)) \n.(nreverse (loop-steps D) \n(go loop) \n\n\f\n<a id='page-843'></a>\n\nend \n,(nreverse (loop-epilogue D) \n(return ,(loop-result 1)))))) \n\nMost of the work is in writing parse-1 oop-body, which takes a Ust of expressions \nand parses them into the proper fields of a loop structure. It will use the following \nauxiliary functions: \n\n(defun add-body (1 exp) (push exp (loop-body 1))) \n\n(defun add-test (1 test) \n\"Put in a test for loop termination.\" \n(push *(if .test (go end)) (loop-body 1))) \n\n(defun add-var (1 var init &optional (update nil update?)) \n\"Add a variable, maybe including an update step.\" \n(unless (assoc var (loop-vars 1)) \n\n(push (list var init) (loop-vars 1))) \n(when update? \n(push '(setq .var .update) (loop-steps 1)))) \n\nThere are a number of alternative ways of implementing this kind of processing. One \nwould be to use special variables: *prol ogue*, *body*, *epi 1 ogue*, and so on. This \nwould mean we wouldn't have to pass around the loop structure 1, but there would \nbe significant clutter in having seven new special variables. Another possibility is to \nuse local variables and close the definitions of 1 oop, along with the add- functions in \nthat local environment: \n\n(let (body prologue epilogue steps vars name result) \n(defmacro loop ...) \n(defun add-body ...) \n(defun add-test ...) \n(defun add-var ...)) \n\nThis is somewhat cleaner style, but some early Common Lisp compilers do not \nsupport embedded def uns, so I chose to write in a style that I knew would work in \nall implementations. Another design choice would be to return multiple values for \neach of the components and have parse-loop-body put them all together. This is in \nfact done in one of the Lisp Machine implementations of 1 oop, but I think it is a poor \ndecision: seven components are too many to keep track of by positional notation. \n\nAnatomy of a Loop \n\nAll this has just been to set up for the real work: parsing the expressions that make \nup the loop with the function pa rse -1 oop- body. Every loop consists of a sequence of \n\n\f\n<a id='page-844'></a>\n\nclauses, where the syntax of each clause is determined by the first expression of the \nclause, which should be a known symbol. These symbols are called loop keywords, \nalthough they are not in the keyword package. \n\nThe loop keywords will be defined in a data-driven fashion. Every keyword has \na function on its property list under the 1 oop-f . indicator. The function takes three \narguments: the 1 oop structure being built, the very next expression in the loop body, \nand a hst of the remaining expressions after that. The function is responsible for updating \nthe 1 oop structure (usually by making appropriate calls to the add - functions) \nand then returning the unparsed expressions. The three-argument calling convention \nis used because many of the keywords only look at one more expression. So \nthose functions see that expression as their first argument, and they can conveniently \nreturn their second argument as the unparsed remainder. Other functions will want \nto look more carefully at the second argument, parsing some of it and returning \nthe rest. \n\nThe macro def 1 oop is provided to add new loop keywords. This macro enforces \nthe three-argument calling convention. If the user supplies only two arguments, then \na third argument is automatically added and returned as the remainder. Also, if the \nuser specifies another symbol rather than a list of arguments, this is taken as an alias, \nand a function is constructed that calls the function for that keyword: \n\n(defun parse-loop-body (1 exps) \n\"Parse the exps based on the first exp being a keyword. \nContinue until all the exps are parsed.\" \n(unless (null exps) \n\n(parse-loop-body \n1 (call-loop-fn 1 (first exps) (rest exps))))) \n\n(defun call-loop-fn (1 key exps) \n\"Return the loop parsing function for this keyword.\" \n(if (and (symbolp key) (get key ....-fn)) \n\n(funcall (get key ....-fn) 1 (first exps) (rest exps)) \n(error \"Unknown loop key: ~a\" key))) \n\n(defmacro defloop (key args &rest body) \n\"Define a new LOOP keyword.\" \n;; If the args do not have a third arg. one is supplied. \n\nAlso, we can define an alias with (defloop key other-key) \n'(setf (get '.key ....-fn) \n.(cond ((and (symbolp args) (null body)) \n'#'(lambda (1 . y) \n(call-loop-fn 1 '.args (cons . y)))) \n((and (listp args) (= (length args) 2)) \n*#'(lambda (.@args -exps-) .@body -exps-)) \n(t '#'(lambda .args .body))))) \n\nNow we are ready to define some 1 oop keywords. Each of the following sections \n\n\f\n<a id='page-845'></a>\nrefers to (and implements the loop keywords in) a section of chapter 26 of Common \nLisp the Language, 2d edition. \n\nIteration Control (26.6) \n\nHere we define keywords for iterating over elements of a sequence and for stopping \nthe iteration. The following cases are covered, where uppercase words represent \nloop keywords: \n\n(LOOP REPEAT . ...) \n\n(LOOP FOR i FROM s TO e BY inc ...) \n\n(LOOP FOR V IN 1 ...) \n\n(LOOP FOR V ON1 ...) \n\n(LOOP FOR V = expr [THEN step] ...) \n\nThe implementation is straightforward, although somewhat tedious for complex \nkeywords like for. Take the simpler keyword, repeat. To handle it, we generate a \nnew variable that will count down the number of times to repeat. We call add - va r to \nadd that variable, with its initial value, to the loop structure. We also give this variable \nan update expression, which decrements the variable by one each time through the \nloop. Then all we need to do is call add-test to insert code that will exit the loop \nwhen the variable reaches zero: \n\n(defloop repeat (1 times) \n\"(LOOP REPEAT . ...) does loop body . times.\" \n(let ((i (gensym \"REPEAT\"))) \n\n(add-var 1 i times *(-J D) \n\n(add-test 1 '(<= ,i 0)))) \n\nThe loop keyword for is more compUcated, but each case can be analyzed in the \nsame way as repeat: \n\n(defloop as for) ;; AS is the same as FOR \n\n(defloop for (1 var exps) \n\"4 of the 7 cases for FOR are covered here: \n(LOOP FOR i FROM s TO e BY inc ...) does arithemtic iteration \n(LOOP FOR V IN 1 ...) iterates for each element of 1 \n(LOOP FOR V ON1 ...) iterates for each tail of 1 \n(LOOP FOR V = expr [THEN step]) initializes and iterates v\" \n(let ((key (first exps)) \n\n(source (second exps)) \n(rest (rest2 exps))) \n(ecase key \n\n\f\n<a id='page-846'></a>\n\n((from downfrom upfrom to downto upto by) \n(loop-for-arithmetic 1 var exps)) \n\n(in (let ((V (gensym \"IN\"))) \n(add-var 1 . source *(cdr .v)) \n(add-var 1 var '(car ,v) '(car ,v)) \n(add-test 1 '(null ,v)) \nrest)) \n\n(on (add-var 1 var source '(cdr .var)) \n(add-test 1 '(null .var)) \nrest) \n\n(= (if (eq (first rest) 'then) \n\n(progn \n(pop rest) \n(add-var 1 var source (pop rest))) \n\n(progn \n(add-var 1 var nil) \n(add-body 1 '(setq .var .source)))) \n\nrest) \n;; ACROSS. BEING clauses omitted \n))) \n\n(defun loop-for-arithmetic (1 var exps) \n\"Parse loop expressions of the form: \n(LOOP FOR var [FROMIDOWNFROMIUPFROM expl] [TOIDOWNTOIUPTO exp2] \n[BY exp3]\" \n;; The prepositions BELOW and ABOVE are omitted \n(let ((expl 0) \n(exp2 nil) \n(exp3 1) \n(down? nil)) \nParse the keywords: \n(when (member (first exps) '(from downfrom upfrom)) \n(setf expl (second exps) \ndown? (eq (first exps) 'downfrom) \nexps (rest2 exps))) \n(when (member (first exps) '(to downto upto)) \n(setf exp2 (second exps) \ndown? (or down? (eq (first exps) 'downto)) \nexps (rest2 exps))) \n(when (eq (first exps) 'by) \n(setf exp3 (second exps) \nexps (rest2 exps))) \n;; Add variables and tests: \n(add-var 1 var expl \n'(.(if down? '- '+) .var .(maybe-temp 1 exp3))) \n(when exp2 \n(add-test 1 '(.(if down? '< '>) .var .(maybe-temp 1 exp2)))) \nand return the remaining expressions: \n\n\f\n<a id='page-847'></a>\nexps)) \n\n(defun maybe-temp (1 exp) \n\"Generate a temporary variable, if needed.\" \n(if (constantp exp) \n\nexp \n\n(let ((temp (gensym \"TEMP\"))) \n(add-var 1 temp exp) \ntemp))) \n\nEnd-Test Control (26.7) \n\nIn this section we cover the following clauses: \n\n(LOOP UNTIL test ...) \n\n(LOOP WHILE test ...) \n\n(LOOP ALWAYS condition ...) \n\n(LOOP NEVER condition ...) \n\n(LOOP THEREIS condition ...) \n\n(LOOP ... (LOOP-FINISH) ...) \n\nEach keyword is quite simple: \n\n(defloop until (1 test) (add-test 1 test)) \n\n(defloop while (1 test) (add-test 1 '(not ,test))) \n\n(defloop always (1 test) \n(setf (loop-result 1) t) \n(add-body 1 '(if (not ,test) (return nil)))) \n\n(defloop never (1 test) \n(setf (loop-result 1) t) \n(add-body 1 '(if ,test (return nil)))) \n\n(defloop thereis (1 test) (add-body 1 '(return-if ,test))) \n\n(defmacro return-if (test) \n\"Return TEST if it is non-nil.\" \n(once-only (test) \n\n'(if ,test (return ,test)))) \n\n(defmacro loop-finish () '(go end)) \n\n\f\n<a id='page-848'></a>\n\nValue Accumulation (26.8) \n\nThe col 1 ect keyword poses another challenge. How do you collect a list of expressions \npresented one at a time? The answer is to view the expressions as a queue, one \nwhere we add items to the rear but never remove them from the front of the queue. \nThen we can use the queue functions defined in section 10.5. \n\nUnlike the other clauses, value accumulation clauses can communicate with each \nother. There can be, say, two col 1 ect and an append clause in the same loop, and \nthey all build onto the same list. Because of this, I use the same variable name for the \naccumulator, rather than gensyming a new variable for each use. The name chosen \nis stored in the global variable *acc*. In the official 1 oop standard it is possible for \nthe user to specify the variable with an i nto modifier, but I have not implemented \nthat option. The clauses covered are: \n\n(LOOP COLLECT item ...) \n(LOOP NCONC item ...) \n(LOOP APPEND item ...) \n(LOOP COUNT item ...) \n(LOOP SUM item ...) \n(LOOP MAXIMIZE item ...) \n(LOOP MINIMIZE item ...) \n\nThe implementation is: \n\n(defconstant *acc* (gensym \"ACC\") \n\"Variable used for value accumulation in LOOP.\") \n\n;;; INTO preposition is omitted \n\n(defloop collect (1 exp) \n(add-var 1 *acc* *(make-queue)) \n(add-body 1 '(enqueue ,exp ,*acc*)) \n(setf (loop-result 1) '(queue-contents ,*acc*))) \n\n(defloop nconc (1 exp) \n(add-var 1 *acc* '(make-queue)) \n(add-body 1 '(queue-nconc ,*acc* .exp)) \n(setf (loop-result 1) '(queue-contents ,*acc*))) \n\n(defloop append (1 exp exps) \n(call-loop-fn 1 'nconc '((copy-list .exp) ..exps))) \n\n(defloop count (1 exp) \n(add-var 1 *acc* 0) \n(add-body 1 '(when ,exp (incf ,*acc*))) \n(setf (loop-result 1) *acc*)) \n\n\f\n<a id='page-849'></a>\n(defloop sum (1 exp) \n(add-var 1 *acc* 0) \n(add-body 1 '(incf ,*acc* .exp)) \n(setf (loop-result 1) *acc*)) \n\n(defloop maximize (1 exp) \n(add-var 1 *acc* nil) \n(add-body 1 '(setf ,*acc* \n\n(if ,*acc* \n(max .*acc* ,exp) \n.exp))) \n\n(setf (loop-result 1) *acc*)) \n\n(defloop minimize (1 exp) \n(add-var 1 *acc* nil) \n(add-body 1 '(setf ,*acc* \n\n(if .*acc* \n(min .*acc* ,exp) \n.exp))) \n\n(setf (loop-result 1) *acc*)) \n\n(defloop collecting collect) \n\n(defloop nconcing nconc) \n\n(defloop appending append) \n\n(defloop counting count) \n\n(defloo sum)\n\n(derIoop\npp summin \nsumminsumming\ngg sum; \n\n(defloop maximizing maximize) \n\n(defloop minimizing minimize) \n\n&#9635; Exercise 24.1 1 ooplets us buildaggregates (lists, maximums, sums, etc.)over the \nbodyofthe loop. Sometimes itis inconvenientto be restrictedto a single-loop body. \nFor example, we mightwant a list ofallthe nonzero elements ofa two-dimensional \narray. One waytoimplementthisiswitha macro, with-col1 ecti on,thatsets up and \nreturns a queue structure thatis builtbycalls to the function col1 ect. For example: \n\n> (let ((A '#2a((l 0 0) (0 2 4) (0 0 3)))) \n(with-collection \n(loop for i from 0 to 2 do \n(loop for j from 0 to 2 do \n(if (> (aref a i j) 0) \n(collect (aref A i j))))))) \n(12 4 3) \n\nImplementwith-col1 ecti onand col1 ect. \n\n\f\n<a id='page-850'></a>\n\nVariable Initialization (26.9) \n\nThe with clause allows local variables - I have included it, but recommend using a \nlet instead. I have not included the and preposition, which allows the variables to \nnest at different levels. \n\n26.9. Variable Initializations (\"and\" omitted) \n(defloop with (1 var exps) \n(let ((init nil)) \n(when (eq (first exps) '=) \n(setf init (second exps) \n\nexps (rest2 exps))) \n(add-var 1 var init) \nexps)) \n\nConditional Execution (2610) \n\n1 oop also provides forms for conditional execution. These should be avoided whenever \npossible, as Lisp already has a set of perfectly good conditional macros. However, \nsometimes you want to make, say, a col 1 ect conditional on some test. In that \ncase, loop conditionals are acceptable. The clauses covered here are: \n\n(LOOP WHEN test ... [ELSE ...]) ; I Pis a synonym for WHEN \n(LOOP UNLESS test ... [ELSE ...]) \n\nHere is an example of when: \n\n> (loop for X from 1 to 10 \nwhen (oddp x) \ncollect X \nelse collect (- x)) \n(1 -23-45-67-89 -10) \n\nOf course, we could have said coll ect (if (oddp x) . (- .)) and done without \nthe conditional. There is one extra feature in loop's conditionals: the value of the test \nis stored in the variable i t for subsequent use in the THEN or ELSE parts. (This is \njust the kind of feature that makes some people love 1 oop and others throw up their \nhands in despair.) Here is an example: \n\n\f\n<a id='page-851'></a>\n\n> (loop for X from 1 to 10 \nwhen (second (assoc . '((1 one) (3 three) (5five)))) \ncollect it) \n\n(ONE THREE FIVE) \n\nThe conditional clauses are a little tricky to implement, since they involve parsing \nother clauses. The idea is that cal 1 -1 oop-f. parses the THEN and ELSE parts, \nadding whatever is necessary to the body and to other parts of the loop structure. \nThen add-body is used to add labels and go statements that branch to the labels as \nneeded. This is the same technique that is used to compile conditionals in chapter 23; \nsee the function comp - i f on [page 787](chapter23.md#page-787). Here is the code: \n\n(defloop when (1 test exps) \n(loop-unless 1 '(not ,(maybe-set-it test exps)) exps)) \n\n(defloop unless (1 test exps) \n(loop-unless 1 (maybe-set-it test exps) exps)) \n\n(defun maybe-set-it (test exps) \n\"Return value, but if the variable IT appears in exps, \nthen return code that sets IT to value.\" \n(if (find-anywhere 'it exps) \n\n'(setq it ,test) \n\ntest)) \n\n(defloop if when) \n\n(defun loop-unless (1 test exps) \n(let ((label (gensym \"L\"))) \n(add-var 1 'it nil) \n\nEmit code for the test and the THEN part \n(add-body 1 '(if ,test (go ,label))) \n(setf exps (call-loop-fn 1 (first exps) (rest exps))) \n;; Optionally emit code for the ELSE part \n(if (eq (first exps) 'else) \n\n(progn \n\n(let ((label2 (gensym \"L\"))) \n(add-body 1 '(go ,label2)) \n(add-body 1 label) \n(setf exps (call-loop-fn 1 (second exps) (rest2 exps))) \n(add-body 1 label2))) \n\n(add-body 1 label))) \nexps) \n\n\f\n<a id='page-852'></a>\n\nUnconditional Execution (26.11) \n\nThe unconditional execution keywords are do and return: \n\n(defloop do (1 exp exps) \n(add-body 1 exp) \n(loop (if (symbolp (first exps)) (RETURN exps)) \n\n(add-body 1 (pop exps)))) \n\n(defloop return (1 exp) (add-body 1 '(return ,exp))) \n\nMiscellaneous Features (26.12) \n\nFinally, the miscellaneous features include the keywords initially and finally, \nwhich define the loop prologue and epilogue, and the keyword named, which gives \na name to the loop for use by a return-from form. I have omitted the data-type \ndeclarations and destructuring capabilities. \n\n(defloop initially (1 exp exps) \n(push exp (loop-prologue 1)) \n(loop (if (symbolp (first exps)) (RETURN exps)) \n\n(push (pop exps) (loop-prologue 1)))) \n\n(defloop finally (1 exp exps) \n(push exp (loop-epilogue 1)) \n(loop (if (symbolp (first exps)) (RETURN exps)) \n\n(push (pop exps) (loop-epilogue 1)))) \n\n(defloop named (1 exp) (setf (loop-name 1) exp)) \n\n24.6 Sequence Functions \nCommon Lisp provides sequence functions to make the programmer's life easier: \nthe same function can be used for lists, vectors, and strings. However, this ease of \nuse comes at a cost. Sequence functions must be written very carefully to make sure \nthey are efficient. There are three main sources of indeterminacy that can lead to \ninefficiency: (1) the sequences can be of different types; (2) some functions have \nkeyword arguments; (3) some functions have a &rest argument. Careful coding \ncan limit or eliminate these sources of inefficiency, by making as many choices as \npossible at compile time and making the remaining choices outside of the main loop. \n\n\f\n<a id='page-853'></a>\nIn this section we see how to implement the new ANSI sequence function \nmap-into and the updated function reduce efficiently. This is essential for those \nwithout an ANSI compiler. Even those who do have access to an ANSI compiler will \nbenefit from seeing the efficiency techniques used here. \n\nBefore defining the sequence functions, the macro once - onl y is introduced. \n\nOnce-only: A Lesson in Macrology \n\nThe macro once - onl y has been around for a long time on various systems, although \nit didn't make it into the Common Lisp standard. I include it here for two reasons: \nfirst, it is used in the following funcall - i f macro, and second, if you can understand \nhow to write and when to use once-only, then you truly understand macro. \n\nFirst, you have to understand the problem that once-only addresses. Suppose \nwe wanted to have a macro that multiplies its input by itself:^ \n\n(defmacro square (x) *(* .x ,x)) \n\nThis definition works fine in the following case: \n\n> (macroexpand '(square z)) => (* . Z) \n\nBut it doesn't work as well here: \n\n> (macroexpand '(square (print (incf i)))) \n\n(* (PRINT (INCF I)) (PRINT (INCF I))) \n\nThe problem is that i will get incremented twice, not once, and two different values \nwill get printed, not one. We need to bind (print (incf i)) to a local variable before \ndoing the multiplication. On the other hand, it would be superfluous to bind . to a \nlocal variable in the previous example. This is where once-onl y comes in. It allows \nus to write macro definitions like this: \n\n(defmacro square (x) (once-only (x) *(* ,x .x))) \n\nand have the generated code be just what we want: \n\n> (macroexpand '(square z)) \n\n(* . .) \n\n^As was noted before, the proper way to do this is to proclaim squa re as an inline function, \nnot a macro, but please bear with the example. \n\n\f\n<a id='page-854'></a>\n\n> (macroexpand '(square (print (incf i)))) \n(LET ((G3811 (PRINT (INCF I)))) \n(* G3811 G3811)) \n\nYou have now learned lesson number one of once - on1 y: you know how macros differ \nfrom functions when it comes to arguments with side effects, and you now know how \nto handle this. Lesson number two comes when you try to write (or even understand) \na definition of once-only - only when you truly understand the nature of macros will \nyou be able to write a correct version. As always, the first thing to determine is what \na call to once-only should expand into. The generated code should test the variable \nto see if it is free of side effects, and if so, generate the body as is; otherwise it should \ngenerate code to bind a new variable, and use that variable in the body of the code. \nHere's roughly what we want: \n\n> (macroexpand '(once-only (x) *(* ,x .x))) \n(if (side-effect-free-p x) \n*(* .x .x) \n\n'(let ((gOOl .x)) \n.(let ((x 'gOOD) \n'(* .x .X)))) \n\nwhere gOOl is a new symbol, to avoid conflicts with the . or with symbols in the \nbody. Normally, we generate macro bodies using backquotes, but if the macro body \nitself has a backquote, then what? It is possible to nest backquotes (and appendix C of \nCommon Lisp the Language, 2d edition has a nice discussion of doubly and triply nested \nbackquotes), but it certainly is not trivial to understand. I recommend replacing the \ninner backquote with its equivalent using 1 i st and quote: \n\n(if (side-effect-free-p x) \n'(* .x .x) \n(list 'let (list (list 'gOOl x)) \n\n(let ((x 'gOOD) \n'(* ,x .x)))) \n\nNow we can write once - onl y. Note that we have to account for the case where there \nis more than one variable and where there is more than one expression in the body. \n\n(defmacro once-only (variables &rest body) \n\"Returns the code built by BODY. If any of VARIABLES \nmight have side effects, they are evaluated once and stored \nin temporary variables that are then passed to BODY.\" \n(assert (every #'symbolp variables)) \n(let ((temps (loop repeat (length variables) collect (gensym)))) \n\n'(if (every #'side-effect-free-p (list .,variables)) \n\n\f\n<a id='page-855'></a>\n(progn ..body) \n(list Met \n.'(list .(mapcar #'(lambda (tmp var) \n'(list '.tmp .var)) \ntemps variables)) \n(let .(mapcar #'(lambda (var tmp) '(.var '.tmp)) \nvariables temps) \n..body))))) \n\n(defun side-effect-free-p (exp) \n\"Is exp a constant, variable, or function, \nor of the form (THE type x) where . is side-effect-free?\" \n(or (constantp exp) (atom exp) (starts-with exp 'function) \n\n(and (starts-with exp 'the) \n(side-effect-free-p (third exp))))) \n\nHere we see the expansion of the call to once - on1y and a repeat of the expansions of \ntwo calls to square: \n\n> (macroexpand '(once-only (x) '(* .x .x))) \n(IF (EVERY #'SIDE-EFFECT-FREE-P (LIST X)) \n(PROGN \n'(* .X .X)) \n(LIST 'LET (LIST (LIST 'G3763 X)) \n(LET ((X 'G3763)) \n'(* .X .X)))) \n\n> (macroexpand '(square z)) \n(* . .) \n\n> (macroexpand '(square (print (incf i)))) \n(LET ((G3811 (PRINT (INCF I)))) \n(* G3811 G3811)) \n\nThis output was produced with *pri nt-gensym* set to ni 1. When this variable \nis non-nil, uninterned symbols are printed with a prefix #:,asin #:G3811. This \ninsures that the symbol will not be interned by a subsequent read. \n\nIt is worth noting that Common Lisp automatically handles problems related to \nmultiple evaluation of subforms in setf methods. See [page 884](chapter25.md#page-884) for an example. \n\nAvoid Overusing Macros \n\nA word to the wise: don't get carried away with macros. Use macros freely to \nrepresent your problem, but shy away from new macros in the implementation of \nyour solution, unless absolutely necessary. So, it is good style to introduce a macro. \n\n\f\n<a id='page-856'></a>\n\nsay, def rul e, which defines rules for your application, but adding macros to the \ncode itself may just make things harder for others to use. \n\nHere is a story. Before i f was a standard part of Lisp, I defined my own version of \ni f. Unlike the simple i f, my version took any number of test/result pairs, followed \nby an optional el se result. In general, the expansion was: \n\n(if abcd,.,x) => (cond iab) icd) ... iJx)) \n\nMy i f also had one more feature: the symbol 'that' could be used to refer to the value \nof the most recent test. For example, I could write: \n\n(if (assoc item a-list) \n(process (cdr that))) \n\nwhich would expand into: \n\n(LET (THAT) \n(COND \n((SETQ THAT (ASSOC ITEM A-LIST)) (PROCESS (CDR THAT))))) \n\nThis was a convenient feature (compare it to the => feature of Scheme's cond, as \ndiscussed on [page 778](chapter22.md#page-778)), but it backfired often enough that I eventually gave up on \nmy version of i f. Here's why. I would write code like this: \n\n(if (total-score x) \n(print (/ that number-of-trials)) \n(error \"No scores\")) \n\nand then make a small change: \n\n(if (total-score x) \n(if *print-scores* (print (/ that number-of-trials))) \n(error \"No scores\")) \n\nTheproblemis thatthevariablethatnowrefers to *print-scores*,not( total-score \nx), as it did before. My macro violates referential transparency. In general, that's \nthe whole point of macros, and it is why macros are sometimes convenient. But in \nthis case, violating referential transparency can lead to confusion. \n\n\f\n<a id='page-857'></a>\nMAP-INTO \n\nThe function map-i nto is used on [page 632](chapter18.md#page-632). This function, added for the ANSI \nversion of Common Lisp, is like map, except that instead of building a new sequence, \nthe first argument is changed to hold the results. This section describes how to write \na fairly efficient version of map-i nto, using techniques that are applicable to any \nsequence function. We'll start with a simple version: \n\n(defun map-into (result-sequence function &rest sequences) \n\"Destructively set elements of RESULT-SEQUENCE to the results \nof applying FUNCTION to respective elements of SEQUENCES.\" \n(replace result-sequence (apply #'map 'list function sequences))) \n\nThis does the job, but it defeats the purpose of ma . -i . to, which is to avoid generating \ngarbage. Here's a version that generates less garbage: \n\n(defun map-into (result-sequence function &rest sequences) \n\"Destructively set elements of RESULT-SEQUENCE to the results \nof applying FUNCTION to respective elements of SEQUENCES.\" \n(let ((n (loop for seq in (cons result-sequence sequences) \n\nminimize (length seq)))) \n(dotimes (i n) \n(setf (elt result-sequence i) \n(apply function \n(mapcar #*(lambda (seq) (elt seq i)) \nsequences)))))) \n\nThere are three problems with this definition. First, it wastes space: mapcar creates \na new argument list each time, only to have the list be discarded. Second, it wastes \ntime: doing a setf of the ith element of a list makes the algorithm O(n^) instead of \n0(n), where . is the length of the list. Third, it is subtly wrong: if result-sequence \nis a vector with a fill pointer, then map -i nto is supposed to ignore res ul t - sequence's \ncurrent length and extend the fill pointer as needed. The following version fixes \nthose problems: \n\n(defun map-into (result-sequence function &rest sequences) \n\"Destructively set elements of RESULT-SEQUENCE to the results \nof applying FUNCTION to respective elements of SEQUENCES.\" \n(let ((arglist (make-list (length sequences))) \n\n(n (if (listp result-sequence) \nmost-positive-fixnum \n(array-dimension result-sequence 0)))) \n\narglist is made into a list of args for each call \n. is the length of the longest vector \n\n\f\n<a id='page-858'></a>\n\n(when sequences \n(setf . (min . (loop for seq in sequences \nminimize (length seq))))) \nDefine some shared functions: \n(flet \n((do-one-call (i) \n\n(loop for seq on sequences \nfor arg on arglist \ndo (if (listp (first seq)) \n\n(setf (first arg) \n(pop (first seq))) \n(setf (first arg) \n(aref (first seq) i)))) \n(apply function arglist)) \n(do-result (i) \n(if (and (vectorp result-sequence) \n(array-has-fil1-pointer-p result-sequence)) \n(setf (fill-pointer result-sequence) \n(max i (fill-pointer result-sequence)))))) \n\n(declare (inline do-one-call)) \nDecide if the result is a list or vector, \nand loop through each element \n\n(if (listp result-sequence) \n\n(loop for i from 0 to (- . 1) \nfor r on result-sequence \ndo (setf (first r) \n\n(do-one-call i))) \n(loop for i from 0 to (- . 1) \ndo (setf (aref result-sequence i) \n(do-one-call i)) \nfinally (do-result n)))) \nresult-sequence)) \n\nThere are several things worth noticing here. First, I split the main loop into two \nversions, one where the result is a Hst, and the other where it is a vector. Rather \nthan duplicate code, the local functions do-one-call and do-result are defined. \nThe former is declared inline because it it called often, while the latter is not. The \narguments are computed by looking at each sequence in turn, taking the ith element \nif it is a vector, and popping the sequence if it is a list. The arguments are stored \ninto the Hst argl i st, which has been preallocated to the correct size. All in aH, we \ncompute the answer fairly efficiently, without generating unnecessary garbage. \n\nThe application could be done more efficiently, however. Think what apply \nmust do: scan down the argument list, and put each argument into the location \nexpected by the function-calling conventions, and then branch to the function. Some \nimplementations provide a better way of doing this. For example, the TI Lisp Machine \nprovides two low-level primitive functions, %pus h and %ca 11, that compile into single \n\n\f\n<a id='page-859'></a>\ninstructions to put the arguments into the right locations and branch to the function. \nWith these primitives, the body of do - one - ca 11 would be: \n\n(loop for seq on sequences \n\ndo (if distp (first seq)) \n(%push (pop (first seq))) \n(%push (aref (first seq) i)))) \n\n(%call function length-sequences) \n\nThere is a remaining inefficiency, though. Each sequence is type-checked each time \nthrough the loop, even though the type remains constant once it is determined the \nfirst time. Theoretically, we could code separate loops for each combination of types, \njust as we coded two loops depending on the type of the result sequence. But that \nwould mean 2^ loops for . sequences, and there is no limit on how large . can be. \n\nIt might be worth it to provide specialized functions for small values of n, and \ndispatch to the appropriate function. Here's a start at that approach: \n\n(defun map-into (result function &rest sequences) \n(apply \n\n(case (length sequences) \n(0 (if distp result) #'map-into-list-0 #'map-into-vect-0)) \n(1 (if distp result) \n\n(if distp (first sequences)) \n#'map-into-list -l-list #'map-into-list-l-vect) \n(if distp (first sequences)) \n#'map-into-vect-l-list #'map-into-vect-l-vect))) \n(2 (if distp result) \n(if distp (first sequences)) \n\n(if distp (second sequences)) \n#'map-into-list-2-list-list \n#'map-into-list-2-list-vect) \n\n...))) \n(t (if distp result) #'map-into-list-n #*map-into-vect-n))) \nresult function sequences)) \n\nThe individual functions are not shown. This approach is efficient in execution \ntime, but it takes up a lot of space, considering that map -i nto is a relatively obscure \nfunction. If map-i nto is declared i nl i ne and the compiler is reasonably good, then \nit will produce code that just calls the appropriate function. \n\nREDUCE with :key \n\nAnother change in the ANSI proposal is to add a : key keyword to reduce. This is a \nuseful addition-in fact, for years I had been using a r ed uce - by function that provided \n\n\f\n<a id='page-860'></a>\n\njust this functionahty. In this section we see how to add the : key keyword. \n\nAt the top level, I define reduce as an interface to the keywordless function \nreduce*. They are both proclaimed inline, so there will be no overhead for the \nkeywords in normal uses of reduce. \n\n(proclaim '(inline reduce reduce*)) \n\n(defun reduce* (fn seq from-end start end key init init-p) \n(funcall (if (listp seq) #'reduce-list #'reduce-vect) \nfn seq from-end (or start 0) end key init init-p)) \n\n(defun reduce (function sequence &key from-end start end key \n(initial-value nil initial-value-p)) \n(reduce* function sequence from-end start end \nkey initial-value initial-value-p)) \n\nThe easier case is when the sequence is a vector: \n\n(defun reduce-vect (fn seq from-end start end key init init-p) \n(when (null end) (setf end (length seq))) \n(assert (<= 0 start end (length seq)) (start end) \n\n\"Illegal subsequence of ~a --- istart ~d :end ~d\" \nseq start end) \n\n(case (- end start) \n(0 (if init-p init (funcall fn))) \n(1 (if init-p \n\n(funcall fn init (funcall-if key (aref seq start))) \n(funcall-if key (aref seq start)))) \n(t (if (not from-end) \n(let ((result \n(if init-p \n\n(funcall \nfn init \n(funcall-if key (aref seq start))) \n\n(funcall \nfn \n(funcall-if key (aref seq start)) \n(funcall-if key (aref seq (+ start 1))))))) \n\n(loop for i from (+ start (if init-p 1 2)) \nto (- end 1) \ndo (setf result \n\n(funcall \nfn result \n(funcall-if key (aref seq i))))) \n\nresult) \n(let ((result \n(if init-p \n\n\f\n<a id='page-861'></a>\n(funcall \nfn \n(funcall-if key (aref seq (- end 1))) \ninit) \n\n(funcall \nfn \n(funcall-if key (aref seq (- end 2))) \n(funcall-if key (aref seq (- end 1))))))) \n\n(loop for i from (- end (if init-p 2 3)) downto start \ndo (setf result \n\n(funcall \nfn \n(funcall-if key (aref seq i)) \nresult))) \n\nresult))))) \n\nWhen the sequence is a list, we go to some trouble to avoid computing the length, \nsince that is an 0{n) operation on lists. The hardest decision is what to do when the \nlist is to be traversed from the end. There are four choices: \n\n* recurse. We could recursively walk the list until we hit the end, and then \ncompute the results on the way back up from the recursions. However, some \nimplementations may have fairly small bounds on the depths of recursive calls, \nand a system function like reduce should never run afoul of such limitations. \nIn any event, the amount of stack space consumed by this approach would normally \nbe more than the amount of heap space consumed in the next approach. \n* reverse. Wecouldreversethelistandthenconsider from-end true. The only \ndrawback is the time and space needed to construct the reversed list. \n* nreverse. We could destructively reverse the list in place, do the reduce computation, \nand then destructively reverse the list back to its original state (perhaps \nwith an unwind-protect added). Unfortunately, this is just incorrect. The list \nmay be bound to some variable that is accessible to the function used in the \nreduction. If that is so, the function will see the reversed list, not the original \nHst. \n* coerce. We could convert the Ust to a vector, and then use reduce-vect. This \nhas an advantage over the reverse approach in that vectors generally take only \nhalf as much storage as lists. Therefore, this is the approach I adopt. \n(defmacro funcall-if (fn arg) \n(once-only (fn) \n\n'(if,fn (funcall .fn ,arg) ,arg))) \n\f\n<a id='page-862'></a>\n\n(defun reduce-list (fn seq from-end start end key init init-p) \n(when (null end) (setf end most-positive-fixnum)) \n(cond ((> start 0) \n\n(reduce-list fn (nthcdr start seq) from-end 0 \n(- end start) key init init-p)) \n((or (null seq) (eql start end)) \n(if init-p init (funcall fn))) \n((= (- end start) 1) \n\n(if init-p \n(funcall fn init (funcall-if key (first seq))) \n(funcall-if key (first seq)))) \n\n(from-end \n(reduce-vect fn (coerce seq 'vector) t start end \nkey init init-p)) \n((null (rest seq)) \n\n(if init-p \n(funcall fn init (funcall-if key (first seq))) \n(funcall-if key (first seq)))) \n\n(t (let ((result \n(if init-p \n\n(funcall \nfn init \n(funcall-if key (pop seq))) \n\n(funcall \nfn \n(funcall-if key (pop seq)) \n(funcall-if key (pop seq)))))) \n\n(if end \n(loop repeat (- end (if init-p 1 2)) while seq \ndo (setf result \n\n(funcall \nfn result \n(funcall-if key (pop seq))))) \n\n(loop while seq \ndo (setf result \n\n(funcall \nfn result \n(funcall-if key (pop seq))))) \n\nresult))))) \n\n\f\n<a id='page-863'></a>\n24.7 Exercises \n&#9635; Exercise 24.2 [m] The function reduce is a very useful one, especially with the key \nkeyword. Write nonrecursive definitions for append and length using reduce. What \nother common functions can be written with reduce? \n\n&#9635; Exercise 24.3 The so-called loop keywords are not symbols in the keyword package. \nThe preceding code assumes they are all in the current package, but this is not quite \nright. Change the definition of 1 oop so that any symbol with the same name as a loop \nkeyword acts as a keyword, regardless of the symbol's package. \n\n&#9635; Exercise 24.4 Can there be a value for exp for which the following expressions are \nnot equivalent? Either demonstrate such an exp or argue why none can exist. \n\n(loop for X in list collect exp) \n(mapcar #'(lambda (x) exp) list)) \n\n&#9635; Exercise 24.5 The object-oriented language Eiffel provides two interesting 1 oop \nkeywords: i nvari ant and vari ant. The former takes a Boolean-valued expression \nthat must remain true on every iteration of the loop, and the latter takes a integer-\nvalued expression that must decrease on every iteration, but never becomes negative. \nErrors are signaled if these conditions are violated. Use def 1 oop to implement these \ntwo keywords. Make them generate code conditionally, based on a global flag. \n\n24.8 Answers \nAnswer 24.1 \n\n(defvar *queue*) \n\n(defun collect (item) (enqueue item *queue*)) \n\n(defmacro with-collection (&body body) \n\n'(let ((*queue* (make-queue))) \n,@body \n(queue-contents *queue*))) \n\nHere's another version that allows the collection variable to be named. That way, \nmore than one collection can be going on at the same time. \n\n\f\n<a id='page-864'></a>\n\n(defun collect (item &optional (queue *queue*)) \n(enqueue item queue)) \n\n(defmacro with-collection ((&optional (queue '*queue*)) \n&body body) \n\n'(let ((.queue (make-queue))) \n.body \n(queue-contents .queue))) \n\nAnswer 24.2 \n\n(defun append-r (x y) \n(reduce #*cons . .-initial-value y :from-end t)) \n\n(defun length-r (list) \n(reduce #'+ list :key #'(lambda (x) 1))) \n\nAnswer 24.4 The difference between 1 oop and ma pea r is that the former uses only \none variable x, while the latter uses a different . each time. If x's extent is no bigger \nthan its scope (as it is in most expressions) then this makes no difference. But if any \nX is captured, giving it a longer extent, then a difference shows up. Consider exp = \n#'(lambda () x). \n\n> (mapcar #'funcall (loop for . in '(1 2 3) collect \n#'(lambda () x))) \n(3 3 3) \n\n> (mapcar #*funcal1 (mapcar #*(lambda (x) #*(lambda Ox)) \n'(1 2 3))) \n(1 2 3) \n\nAnswer 24.5 \n\n(defvar *check-invariants* t \n\"Should VARIANT and INVARIANT clauses in LOOP be checked?\") \n\n(defloop invariant (1 exp) \n(when *check-invariants* \n(add-body 1 '(assert .exp () \"Invariant violated.\")))) \n\n(defloop variant (1 exp) \n(when *check-invariants* \n\n(let ((var (gensym \"INV\"))) \n(add-var 1 var nil) \n(add-body 1 '(setf .var (update-variant .var .exp)))))) \n\n\f\n<a id='page-865'></a>\n\n(defun update-variant (old new) \n(assert (or (null old) (< new old)) () \n\n\"Variant is not monotonically decreasing\") \n(assert (> new 0) () \"Variant is no longer positive\") \nnew) \n\nHere's an example: \n\n(defun gcd2 (a b) \n\"Greatest common divisor. For two positive integer arguments.\" \n(check-type a (integer 1)) \n(check-type b (integer 1)) \n(loop with . = a with y = b \n\ninvariant (and (> . 0) (> y 0)) (= (gcd . y) (gcd a b)) \n\nvariant (max . y) \n\nuntil (= X y) \n\ndo (if (> X y) (decf . y) (decf y .)) \n\nfinally (return .))) \n\nHere the invariant is written semi-informally. We could include the calls to gcd, but \nthat seems to be defeating the purpose of gcd2, so that part is left as a comment. \nThe idea is that the comment should help the reader prove the correctness of the \ncode, and the executable part serves to notify the lazy reader when something is \ndemonstrably wrong at run time. \n\n\f\n## Chapter 25\n<a id='page-866'></a>\n\nTroubleshooting \n\nPerhaps if we wrote programs from childhood on, \nas adults we'd be able to read them. \n\n- Alan Peril's \n\nw \nw \nhen you buy a new appUance such as a television, it comes with an instruction \nbooklet that lists troubleshooting hints in the following form: \n\nPROBLEM: Nothing works. \n\nDiagnosis: Power is off. \n\nRemedy: Plug in outlet and turn on power switch. \n\nIf your Lisp compiler came without such a handy instruction booklet, this chapter may be of \nsome help. It lists some of the most common difficulties that Lisp programmers encounter. \n\n\f\n<a id='page-867'></a>\n\n25.1 Nothing Happens \nPROBLEM: You type an expression to Lisp's read-eval-print loop and get no response - \nno result, no prompt. \n\nDiagnosis: There are two likely reasons why output wasn't printed: either Lisp is still \ndoing read or it is still doing eval. These possibilities can be broken down further \ninto four cases: \n\nDiagnosis: If the expression you type is incomplete. Lisp will wait for more input \nto complete it. An expression can be incomplete because you have left off a right \nparenthesis (or inserted an extra left parenthesis). Or you may have started a string, \natom, or comment without finishing it. This is particularly hard to spot when the error \nspans multiple lines. A string begins and ends with double-quotes: \"string\"; an \natom containing unusual characters can be delimited by vertical bars: I AN ATOM I; \nand a comment can be of the form # I a comment I #. Here are four incomplete \nexpressions: \n\n(+ (* 3 (sqrt 5) 1) \n(format t \"~&X=''a, Y=~a. . y) \n(get .strange-atom 'prop) \n(if (= X 0) #1 test if X is zero \n\ny \n\nX) \n\nRemedy: Add a ), \", I, and I #, respectively. Or hit the interrupt key and type the \ninput again. \n\nDiagnosis: Your program may be waiting for input. \n\nRemedy: Never do a (read) without first printing a prompt of some kind. If the \nprompt does not end with a newline, a call to f i ni sh-output is also in order. In fact, \nit is a good idea to call a function that is at a higher level than read. Several systems \ndefine the function prompt-and- read. Here is one version: \n\n(defun prompt-and-read (ctl-string &rest args) \n\"Print a prompt and read a reply.\" \n(apply #'format t ctl-string args) \n(finish-output) \n(read)) \n\nDiagnosis: The program may be caught in an infinite loop, either in an explicit 1 oop \nor in a recursive function. \n\n\f\n<a id='page-868'></a>\n\nRemedy: Interrupt the computation, get a back trace, and see what functions are \nactive. Check the base case and loop variant on active functions and loops. \n\nDiagnosis: Even a simple expression like (mapc #'sqrt 1 ist) or (length list) \nwill cause an infinite loop if 1 i st is an infinite list - that is, a list that has some tail \nthat points back to itself. \n\nRemedy: Be very careful any time you modify a structure with nconc, del ete, setf, \nand so forth. \n\nPROBLEM: You get a new prompt from the read-eval-print loop, but no output was \nprinted. \n\nDiagnosis: The expression you evaluated must have returned no values at all, that \nis, the resuh (values). \n\n25.2 Change to Variable Has No Effect \nPROBLEM: You redefined a variable, but the new value was ignored. \n\nDiagnosis: Altering a variable by editing and re-evaluating a defvar form will not \nchange the variable's value, def va r only assigns an initial value when the variable is \nunbound. \n\nRemedy: Use setf to update the variable, or change the defvar to a defparameter. \n\nDiagnosis: Updating a locally bound variable will not affect a like-named variable \noutside that binding. For example, consider: \n\n(defun check-ops (*ops*) \n(if (null *ops*) \n(setf *ops* *default-ops*)) \n(mapcar #'check-op *ops*)) \n\nIf check - ops is called with a null argument, the *ops* that is a parameter of check - ops \nwill be updated, but the global *ops* will not be, even if it is declared special. \n\nRemedy: Don't shadow variables you want to update. Use a different name for the \nlocal variable. It is important to distinguish special and local variables. Stick to the \nnaming convention for special variables: they should begin and end with asterisks. \nDon't forget to introduce a binding for all local variables. The following excerpt from \na recent textbook is an example of this error: \n\n\f\n<a id='page-869'></a>\n(defun test () \n(setq X 'test-data) ; Warning! \n(solve-probl em x)) ; Don't do this. \n\nThis function should have been written: \n\n(defun test () \n(let ((x 'test-data)) ; Do this instead. \n(solve-problem x))) \n\n25.3 Change to Function Has No Effect \nPROBLEM: You redefined a function, but the change was ignored. \n\nDiagnosis: When you change a macro, or a function that has been declared inline, \nthe change will not necessarily be seen by users of the changed function. (It depends \non the implementation.) \n\nRemedy: Recompile after changing a macro. Don't use inline functions until everything \nis debugged. (Use (declare (not i nl i ne f)) to cancel an inline declaration). \n\nDiagnosis: If you change a normal (non-inline) function, that change will be seen by \ncode that refers to the function by name, but not by code that refers to the old value \nof the function itself. Consider: \n\n(defparameter *scorer* #'score-fn) \n\n(defparameter *printer* *print-fn) \n\n(defun show (values) \n\n(funcall Sprinter* \n(funcall *scorer* values) \n(reduce #'better values))) \n\nNow suppose that the definitions of score - fn, pri nt -f n, and better are all changed. \nDoes any of the prior code have to be recompiled? The variable *pri nter* can stay \nas is. When it is funcalled, the symbol pri nt-f . will be consulted for the current \nfunctional value. Within show, the expression # ' better is compiled into code that \nwill get the current version of bette r, so it too is safe. However, the variable *s co r e r* \nmust be changed. Its value is the old definition of score - fn. \n\nRemedy: Re-evaluate the definition of *scorer*. It is unfortunate, but this problem \nencourages many programmers to use symbols where they really mean functions. \nSymbols will be coerced to the global function they name when passed to funcall \n\n\f\n<a id='page-870'></a>\n\nor apply, but this can be the source of another error. In the following example, the \nsymbol local - fn will not refer to the locally bound function. One needs to use \n#'local - fn to refer to it. \n\n(flat (docal-fn (x) ...)) \n(mapcar *local-fn list)) \n\nDiagnosis: If you changed the name of a function, did you change the name everywhere? \nFor example, if you decide to change the name of pr 1 nt - f . to pr i nt - function \nbut forget to change the value of *pri nter*, then the old function will be called. \n\nRemedy: Use your editor's global replace command. To be even safer, redefine \nobsolete functions to call error. The following function is handy for this purpose: \n\n(defun make-obsolete (fn-name) \n\"Print an error if an obsolete function is called.\" \n(setf (symbol-function fn-name) \n\n#*(lambda (&rest args) \n(declare (ignore args)) \n(error \"Obsolete function.\")))) \n\nDiagnosis: Are you using 1 abel s and flet properly? Consider again the function \nrepl ace-?-vars, which was defined in section 11.3 to replace an anonymous logic \nvariable with a unique new variable. \n\n(defun replace-?-vars (exp) \n\"Replace any ? within exp with a var of the form ?123.\" \n(cond ((eq exp *?) (gensym \"?\")) \n\n((atom exp) exp) \n(t (cons (replace-?-vars (first exp)) \n(replace-?-vars (rest exp)))))) \n\nIt might occur to the reader that gensyming a different variable each time is wasteful. \nThe variables must be unique in each clause, but they can be shared across clauses. \nSo we could generate variables in the sequence ?1, ?2, intern them, and thus \nreuse these variables in the next clause (provided we warn the user never to use \nsuch variable names). One way to do that is to introduce a local variable to hold the \nvariable number, and then a local function to do the computation: \n\n\f\n<a id='page-871'></a>\n\n(defun replace-?-vars (exp) \n\"Replace any ? within exp with a var of the form ?123.\" \n.. Buggy Version *** \n(let ((n 0)) \n\n(flet \n((replace-?-vars (exp) \n\n(cond ((eq exp *?) (symbol '? (incf n))) \n((atom exp) exp) \n(t (cons (replace-?-vars (first exp)) \n\n(replace-?-vars (rest exp))))))) \n(replace-?-vars exp)))) \n\nThis version doesn't work. The problem is that flet, like let, defines a new function \nwithin the body of the flet but not within the new function's definition. So two \nlessons are learned here: use 1 abel s instead of flet to define recursive functions, \nand don't shadow a function definition with a local definition of the same name (this \nsecond lesson holds for variables as well). Let's fix the problem by changing 1 abel s \nto flet and naming the local function recurse: \n\n(defun replace-?-vars (exp) \n\"Replace any ? within exp with a var of the form ?123.\" \n.. Buggy Version *** \n(let ((n 0)) \n\n(labels \n((recurse (exp) \n\n(cond ((eq exp '?) (symbol '? (incf n))) \n((atom exp) exp) \n(t (cons (replace-?-vars (first exp)) \n\n(replace-?-vars (rest exp))))))) \n(recurse exp)))) \n\nAnnoyingly, this version still doesn't work! This time, the problem is carelessness; \nwe changed the repl ace-? - vars to recurse in two places, but not in the two calls in \nthe body of recurse. \n\nRemedy: In general, the lesson is to make sure you call the right function. If there \nare two functions with similar effects and you call the wrong one, it can be hard to \nsee. This is especially true if they have similar names. \n\nPROBLEM: Your closures don't seem to be working. \n\nDiagnosis: You may be erroneously creating a lambda expression by consing up \ncode. Here's an example from a recent textbook: \n\n\f\n<a id='page-872'></a>\n\n(defun make-specialization (c) \n(let (pred newc) \n\n(setf (get newc 'predicate) \n'(lambda (obj) ; Warning! \n(and ,(cons pred '(obj)) ; Don't do this. \n(apply '.(get c 'predicate) (list obj))))) \n\n...)) \n\nStrictly speaking, this is legal according to Common Lisp the Language, although in \nANSI Common Lisp it will not he legal to use a list beginning with 1 ambda as a function. \nBut in either version, it is a bad idea to do so. A list beginning with 1 ambda is just that: \na list, not a closure. Therefore, it cannot capture lexical variables the way a closure \ndoes. \n\nRemedy: The correct way to create a closure is to evaluate a call to the special form \nfunction, or its abbreviation, #'. Here is a replacement for the code beginning with \n\n*(1 ambda Note that it is a closure, closed over pred and c. Also note that it gets \nthe predi cate each time it is called; thus, it is safe to use even when predicates are \nbeing changed dynamically. The previous version would not work when a predicate \nis changed. \n#'(lambda (obj) ; Do this instead. \n(and (funcall pred obj) \n(funcall (get c 'predicate) obj))) \n\nIt is important to remember that function (and thus #') is a special form, and thus \nonly returns the right value when it is evaluated. A common error is to use # ' notation \nin positions that are not evaluated: \n\n(defvar *obscure-fns* '(#'cis #'cosh #'ash #'bit -orc2)) ; wrong \n\nThis does not create a list of four functions. Rather, it creates a list of four sublists; \nthe first subUst is (function eis). It is an error to funcall or apply such an object. \nThe two correct ways to create a Ust of functions are shown below. The first assures \nthat each function special form is evaluated, and the second uses function names \ninstead of functions, thus relying on funcall or apply to coerce the names to the \nactual functions. \n\n(defvar *obscure-fns* (list #'cis #'cosh #'ash #'bit -orc2)) \n(defvar *obscure-fns* '(eis cosh ash bit-orc2)) \n\nAnother common error is to expect # ' i f or # Or to return a function. This is an error \n\n\f\n<a id='page-873'></a>\nbecause special forms are just syntactic markers. There is no function named i f or \n\nor; they should be thought of as directives that tell the compiler what to do with a \n\npiece of code. \n\nBy the way, the function make - specialization above is bad not only for its lack of \nfunction but also for its use of backquote. The following is a better use of backquote: \n\n'(lambda (obj) \n(and (,pred obj) \n(,(get c 'predicate) obj))) \n\n25.4 Values Change \"by Themselves'' \nPROBLEM: You deleted/removed something, but it didn't take effect. For example: \n\n> (setf numbers '(1 2 3 4 5)) ^ (1 2 3 4 5) \n\n> (remove 4 numbers) (1 2 3 5) \n\n> numbers ^(12345) \n\n> (delete 1 numbers) =^(2 3 4 5) \n\n> numbers =^(12345) \n\nRemedy: Use (setf numbers (delete 1 numbers)). Note that remove is a nondestructive \nfunction, so it will never alter its arguments, del ete is destructive, but \nwhen asked to delete the first element of a list, it returns the rest of the list, and thus \ndoes not alter the list itself. That is why setf is necessary. Similar remarks hold for \nnconc, sort, and other destructive operations. \n\nPROBLEM: You created a hundred different structures and changed a field in one of \nthem. Suddenly, all the other ones magically changed! \n\nDiagnosis: Different structures may share identical subfields. For example, suppose \nyou had: \n\n(defstruct block \n(possible-colors '(red green blue)) \n...) \n\n\f\n<a id='page-874'></a>\n\n(setf bl (make-block)) \n(setf b2 (make-block)) \n\n(delete 'green (block-possible-colors bl)) \n\nBoth bl and b2 share the initial Hst of possible colors. The del ete function modifies \nthis shared list, so green is deleted from b2's possible colors Hst just as surely as it is \ndeleted from bl's. \n\nRemedy: Don't share pieces of data that you want to alter individually. In this case, \neither use remove instead of delete, or allocate a different copy of the Hst to each \ninstance: \n\n(defstruct block \n\n(possible-colors (list 'red 'green 'blue)) \n\n...) \n\nRemember that the initial value field of a defstruct is an expression that is evaluated \nanew each time make-bl ock is called. It is incorrect to think that the initial form is \nevaluated once when the defstruct is defined. \n\n25.5 Built-in Functions Don't Find Elements \nPROBLEM: You tried (find item 1 ist), and you know it is there, but it wasn't \nfound. \n\nDiagnosis: By default, many built-in functions use eql as an equality test, fi nd is \none of them. If i tern is, say, a list that is equal but not eql to one of the elements of \nlist, it will not be found. \n\nRemedy: Use (find Item list :test #'equal) \n\nDiagnosis: If the i tern is nil, then nil will be returned whether it is found or not. \n\nRemedy: Use member or posi ti on instead of f i nd whenever the item can be nil. \n\n25.6 Multiple Values Are Lost \nPROBLEM: You only get one of the multiple values you were expecting. \n\nDiagnosis: In certain contexts where a value must be tested by Lisp, multiple values \nare discarded. For example, consider: \n\n\f\n<a id='page-875'></a>\n(or (mv-1 x) (mv-2 x)) \n(and (mv-1 x) (mv-2 x)) \n(cond ((mv-1 x)) \n\n(t (mv-2 X))) \n\nIn each case, if mv -2 returns multiple values, they will all be passed on. But if mv -1 \nreturns multiple values, only the first value will be passed on. This is true even in \nthe last clause of a cond. So, while the final clause (t (mv-2 .)) passes on multiple \nvalues, the final clause ((mv -2 .)) would not. \n\nDiagnosis: Multiple values can be inadvertently lost in debugging as well. Suppose \nI had: \n\n(multiple-value-bind (a b c) \n(mv-1 x) \n...) \n\nNow, if I become curious as to what mv -1 returns, I might change this code to: \n\n(multiple-value-bind (a b c) \n(print (mv-1 x)) debugging output \n\n...) \n\nUnfortunately, print will see only the first value returned by mv-1, and will return \nonly that one value to be bound to the variable a. The other values will be discarded, \nand b and c will be bound to ni 1. \n\n25.7 Declarations Are Ignored \nPROBLEM: Your program uses 1024 . 1024 arrays of floating-point numbers. But \nyou find that it takes 15 seconds just to initialize such an array to zeros! Imagine how \ninefficient it is to actually do any computation! Here is your function that zeroes an \narray: \n\n(defun zero-array (arr) \n\"Set the 1024x1024 array to all zeros.\" \n(declare (type (array float) arr)) \n(dotimes (i 1024) \n\n(dotimes (j 1024) \n(setf (aref arr i j) 0.0)))) \n\nDiagnosis: The main problem here is an ineffective declaration. The type (array \n\n\f\n<a id='page-876'></a>\n\nf 1 oat) does not help the compiler, because the array could be displaced to an array \nof another type, and because f 1 oat encompasses both single- and double-precision \nfloating-point numbers. Thus, the compiler is forced to allocate storage for a new \ncopy of the number 0.0 for each of the million elements of the array. The function is \nslow mainly because it generates so much garbage. \n\nRemedy: The following version uses a much more effective type declaration: a \nsimple array of single-precision numbers. It also declares the size of the array and \nturns safety checks off. It runs in under a second on a SPARCstation, which is slower \nthan optimized C, but faster than unoptimized C. \n\n(defun zero-array (arr) \n\n\"Set the array to all zeros.\" \n\n(declare (type (simple-array single-float (1024 1024)) arr) \n\n(optimize (speed 3) (safety 0))) \n\n(dotimes (i 1024) \n\n(dotimes (j 1024) \n\n(setf (aref arr i j) 0.0)))) \n\nAnother common error is to use something like (simple-vector fixnum) asatype \nspecifier. It is a quirk of Common Lisp that the simpl e-vector type specifier only \naccepts a size, not a type, while the array, vector and simple-array specifiers all \naccept an optional type followed by an optional size or list of sizes. To specify a \nsimplevectoroffixnums,use (simple-array fixnum (*)). \n\nTo be precise, simple-vector means (simple-array t (*)). This means that \nsimple-vector cannot be used in conjunction with any other type specifier. A \ncommonmistakeis to think that the type (and simple-vector (vector fixnum)) \nis equivalent to (simple-array fixnum (*)), a simple, one-dimensional vector \nof fixnums. Actually, it is equivalent to (simple-array t (*)), a simple one-\ndimensional array of any type elements. To eliminate this problem, avoid simpl e-\nvector altogether. \n\n25.8 My Lisp Does the Wrong Thing \nWhen all else fails, it is tempting to shift the blame for an error away from your own \ncode and onto the Common Lisp implementation. It is certainly true that errors are \nfound in existing implementations. But it is also true that most of the time. Common \nLisp is merely doing something the user did not expect rather than something that is \nin error. \n\nFor example, a common \"bug report\" is to complain about read - from- str 1 ng. A \nuser might write: \n\n\f\n<a id='page-877'></a>\n(read-from-string \"a b c\" :start 2) \n\nexpecting the expression to start reading at position 2 and thus return b. In fact, this \nexpression returns a. The angry user thinks the implementation has erroneously \nignored the : start argument and files a bug report,^ only to get back the following \nexplanation: \n\nThe function read-from-string takes two optional arguments, eof-errorp and \neof-val ue, in addition to the keyword arguments. Thus, in the expression above, \n: start is taken as the value of eof-errorp, with 2 as the value of eof-val ue. The \ncorrect answer is in fact to read from the start of the string and return the very first \nform, a. \n\nThe functions read-from-string and parse-namestring are the only built-in \nfunctions that have this problem, because they are the only ones that have both \noptional and keyword arguments, with an even number of optional arguments. \nThe functions wr i te -1 i ne and write-string have keyword arguments and a single \noptional argument (the stream), so if the stream is accidently omitted, an error will \nbe signaled. (If you type (write-1 ine str :start 4), the system will complain \neither that: s ta rt is not a stream or that 4 is not a keyword.) \n\nThe moral is this: functions that have both optional and keyword arguments \n\nare confusing. Take care when using existing functions that have this problem, and \n\nabstain from using both in your own functions. \n\n25.9 How to Find the Function You Want \nVeteran Common Lisp programmers often experience a kind of software deja vu: \nthey believe that the code they are writing could be done by a built-in Common Lisp \nfunction, but they can't remember the name of the function. \n\nHere's an example: while coding up a problem I realized I needed a function that, \ngiven the lists (abed) and (cd), would return (a b), that is, the part of the first \nlist without the second list. I thought that this was the kind of function that might \nbe in the standard, but I didn't know what it would be called. The desired function \nis similar to set-difference, so I looked that up in the index of Common Lisp the \nLanguage and was directed to [page 429](chapter12.md#page-429). I browsed through the section on \"using lists \nas sets\" but found nothing appropriate. However, I was reminded of the function \nbut! ast, which is also similar to the desired function. The index directed me to \n[page 422](chapter12.md#page-422) for butl ast, and on the same page I found 1 di f f, which was exactly the \ndesired function. It might have been easier to find (and remember) if it were called \n1 i st-di ff erence, but the methodology of browsing near similar functions paid off. \n\n^This misunderstanding has shown up even in published articles, such as Baker 1991. \n\n\f\n<a id='page-878'></a>\n\nIf you think you know part of the name of the desired function, then you can \nuse apropos to find it. For example, suppose I thought there was a function to push \na new element onto the front of an array. Looking under array, push-array, and \narray- push in the index yields nothing. But I can turn to Lisp itself and ask: \n\n> (apropos \"push\") \nPUSH Macro (VALUE PLACE), pi ist \nPUSHNEW Macro (VALUE PLACE &KEY ...). pi ist \nVECTOR-PUSH function (NEW-ELEMENT VECTOR), pi is t \nVECTOR-PUSH-EXTEND function (DATA VECTOR &OPTIONAL ...), pi ist \n\nThis should be enough to remind me that vector-push is the answer. If not, I can get \nmore information from the manual or from the online functions documentati on or \ndescribe: \n\n> (documentation 'vector-push 'function) \n\"Add NEW-ELEMENT as an element at the end of VECTOR. \nThe fill pointer (leader element 0) is the index of the next \nelement to be added. If the array is full, VECTOR-PUSH returns \nNIL and the array is unaffected; use VECTOR-PUSH-EXTEND instead \nif you want the array to grow automatically.\" \n\nAnother possibility is to browse through existing code that performs a similar purpose. \nThat way, you may find the exact function you want, and you may get additional \nideas on how to do things differently. \n\n25.10 Syntax of LOOP \n1 oop by itself is a powerful programming language, one with a syntax quite different \nfrom the rest of Lisp. It is therefore important to exercise restraint in using 1 oop, lest \nthe reader of your program become lost. One simple rule for limiting the complexity \nof loops is to avoid the with and and keywords. This eliminates most problems \ndealing with binding and scope. \n\nWhen in doubt, macro-expand the loop to see what it actually does. But if you \nneed to macro-expand, then perhaps it would be clearer to rewrite the loop with more \nprimitive constructs. \n\n25.11 Syntax of COND \nFor many programmers, the special form cond is responsible for more syntax errors \nthan any other, with the possible exception of 1 oop. Because most cond-clause start \n\n\f\n<a id='page-879'></a>\nwith two left parentheses, beginners often come to the conclusion that every clause \nmust. This leads to errors like the following: \n\n(let ((entry (assoc item list))) \n(cond ((entry (process entry))) \n...)) \n\nHere entry is a variable, but the urge to put in an extra parenthesis means that the \ncond-clause attempts to call entry as a function rather than testing its value as a \nvariable. \n\nThe opposite problem, leaving out a parenthesis, is also a source of error: \n\n(cond (lookup item list) \n(t nil)) \n\nIn this case, 1 ookup is accessed as a variable, when the intent was to call it as a \nfunction. In Common Lisp this will usually lead to an unbound variable error, but in \nScheme this bug can be very difficult to pin down: the value of 1 ookup is the function \nitself, and since this is not null, the test will succeed, and the expression will return \nlist without complaining. \n\nThe moral is to be careful with cond, especially when using Scheme. Note that \ni f is much less error prone and looks just as nice when there are no more than two \nbranches. \n\n25.12 Syntax of CASE \nIn a case special form, each clause consists of a key or list of keys, followed by the \nvalue of that case. The thing to watch out for is when the key is t, otherwi se, or ni 1. \nFor example: \n\n(case letter \n(s ...) \n(t ...) \n(u ...)) \n\nHere the t is taken as the default clause; it will always succeed, and all subsequent \nclauses will be ignored. Similarly, using a () or ni 1 as a key will not have the desired \neffect: it will be interpreted as an empty key hst. If you want to be completely safe, \nyou can use a list of keys for every clause.^ This is a particularly good idea when you \n\n^Scheme requires a list of keys in each clause. Now you know why. \n\n\f\n<a id='page-880'></a>\n\nwrite a macro that expands into a case. The following code correctly tests for t and \nnil keys: \n\n(case letter \n((s) ...) \n((t) ...) \n((u) ...) \n((nil) ...)) \n\n25.13 Syntax of LET and LET* \nA common error is leaving off a layer of parentheses in let, just like in cond. Another \nerror is to refer to a variable that has not yet been bound in a let. To avoid this \nproblem, use let* whenever a variable's initial binding refers to a previous variable. \n\n25.14 Problems with Macros \nIn section 3.2 we describeda four-part approach to the design of macros: \n\n* Decide if the macro is really necessary. \n* Write down the syntax of the macro. \n* Figure out what the macro should expand into. \n* Use defmacro to implement the syntax/expansion correspondence. \nThis section shows the problems that can arise in each part, starting with the first: \n\n* Decide if the macro is really necessary. \nMacros extend the rules for evaluating an expression, while function calls obey the \nrules. Therefore, it can be a mistake to define too many macros, since they can make \nit more difficult to understand a program. A common mistake is to define macros \nthat do not violate the usual evaluation rules. One recent book on AI programming \nsuggests the following: \n\n(defmacro binding-of (binding) ; Warning! \n'(cadr .binding)) ; Don't do this. \n\nThe only possible reason for this macro is an unfounded desire for efficiency. Always \nuse an inl ine function instead of a macro for such cases. That way you get the \n\n\f\n<a id='page-881'></a>\nefficiency gain, you have not introduced a spurious macro, and you gain the ability to \napply or map the function #' bi ndi ng-of, something you could not do with a macro: \n\n(proclaim '(inline binding-of)) \n\n(defun binding-of (binding) ; Do this instead. \n(second binding)) \n\n* Write down the syntax of the macro. \nTry to make your macro follow conventions laid down by similar macros. For example, \nif your macro defines something, it should obey the conventions of defvar, \ndefstruct, def mac r o, and the rest: start with the letters def, take the name of the thing \nto be defined as the first argument, then a lambda-list if appropriate, then a value or \nbody. It would be nice to allow for optional declarations and documentation strings. \n\nIf your macro binds some variables or variablelike objects, use the conventions \n\nlaid down by let, let*, and 1 abel s: allow for a list of variable or (variable init-val) \n\npairs. If you are iterating over some kind of sequence, follow dotimes and dol i st. \n\nFor example, here is the syntax of a macro to iterate over the leaves of a tree of conses: \n\n(defmacro dotree ((var tree &optional result) &body body) \n\"Perform body with var bound to every leaf of tree, \nthen return result. Return and Go can be used in body.\" \n...) \n\n* Figure out what the macro should expand into. \n* Use defmacro to implement the syntax/expansion correspondence. \nThere are a number of things to watch out for in figuring out how to expand a macro. \n\nFirst, make sure you don't shadow local variables. Consider the following definition \n\nfor pop- end, a function to pop off and return the last element of a list, while updating \n\nthe list to no longer contain the last element. The definition uses last1, which was \n\ndefined on [page 305](chapter9.md#page-305) to return the last element of a list, and the built-in function \n\nnbutl ast returns all but the last element of a list, destructively altering the list. \n\n(defmacro pop-end (place) ; Warning!Buggy! \n\"Pop and return last element of the list in PLACE.\" \n'(let ((result (lastl .place))) \n\n(setf .place (nbutlast .place)) \n\nresult)) \n\nThis will do the wrong thing for (pop-end result), or for other expressions that \n\nmention the variable resul t. The solution is to use a brand new local variable that \n\ncould not possibly be used elsewhere: \n\n\f\n<a id='page-882'></a>\n\n(defmacro pop-end (place) ; Lessbuggy \n\"Pop and return last element of the list in PLACE.\" \n(let ((result (gensym))) \n\n'(let ((.result (lastl .place))) \n(setf .place (nbutlast .place)) \n.result))) \nThere is still the problem of shadowing local functions. For example, a user who \nwrites: \n\n(flet ((lastl (x) (sqrt x))) \n(pop-end list) \n...) \n\nwill be in for a surprise, pop-end will expand into code that calls last1, but since \nlastl has been locally defined to be something else, the code won't work. Thus, the \nexpansion of the macro violates referential transparency. To be perfectly safe, we \ncould try: \n\n(defmacro pop-end (place) ; Lessbuggy \n\"Pop and return last element of the list in PLACE.\" \n(let ((result (gensym))) \n\n'(let ((.result (funcall .#'lastl .place))) \n(setf .place (funcall .#'nbutlast .place)) \n.result))) \nThis approach is sometimes used by Scheme programmers, but Common Lisp programmers \nusually do not bother, since it is rarer to define local functions in Common \nLisp. Indeed, in Common Lisp the Language, 2d edition, it was explicitly stated (page \n\n260) that a user function cannot redefine or even bind any built-in function, variable, \nor macro. Even if it is not prohibited in your implementation, redefining or binding \na built-in function is confusing and should be avoided. \nCommon Lisp programmers expect that arguments will be evaluated in left-to-\nright order, and that no argument is evaluated more than once. Our definition of \npop-end violates the second of these expectations. Consider: \n\n(pop-end (aref lists (incf i))) = \n\n(LET ((#:G3096 (LASTl (AREF LISTS (INCF I))))) \n(SETF (AREF LISTS (INCF I)) (NBUTLAST (AREF LISTS (INCF I)))) \n#:G3096) \n\nThis increments i three times, when it should increment it only once. We could fix \nthis by introducing more local variables into the expansion: \n\n\f\n<a id='page-883'></a>\n(let* ((tempi (incf i)) \n(temp2 (AREF LISTS tempi)) \n(temp3 (LASTl temp2))) \n\n(setf (aref lists tempi) (nbutlast temp2)) \ntemp3) \n\nThis kind of left-to-right argument processing via local variables is done automatically \nby the Common Lisp setf mechanism. Fortunately, the mechanism is easy to use. \nWe can redefine pop-end to call pop directly: \n\n(defmacro pop-end (place) \n\"Pop and return last element of the list in PLACE.\" \n'(pop (last .place))) \n\nNow all we need to do is define the setf method for 1 as t. Here is a simple definition. \nIt makes use of the function last2, which returns the last two elements of a list. In \nANSI Common Lisp we could use (last list 2), but with a pre-ANSI compiler we \nneed to define last2: \n\n(defsetf last (place) (value) \n'(setf (cdr (last2 .place)) .value)) \n\n(defun last2 (list) \n\"Return the last two elements of a list. \" \n(if (null (rest2 list)) \n\nlist \n(last2 (rest list)))) \n\nHere are some macro-expansions of calls to pop-end and to the setf method for \nlast. Different compilers will produce different code, but they will always respect \nthe left-to-right, one-evaluation-only semantics: \n\n> (pop-end (aref (foo lists) (incf i))) = \n(LET ((G0128 (AREF (FOO LISTS) (SETQ I (+ I 1))))) \n\n(PR061 \n(CAR (LAST G0128)) \n(SYSiSETCDR (LAST2 G0128) (CDR (LAST G0128))))) \n\n> (setf (last (append . y)) 'end) = \n(SYSiSETCDR (LAST2 (APPEND X Y)) 'END) \n\nUnfortunately, there is an error in the setf method for last. It assumes that the \nlist will have at least two elements. If the Ust is empty, it is probably an error, but if \nalisthasexactlyoneelement, then (setf (last list) val) should have the same \neffect as (setf list val). But there is no way to do that with defsetf, because the \n\n\f\n<a id='page-884'></a>\n\nsetf method defined by def setf never sees list itself. Instead, it sees a local variable \nthat is automatically bound to the value of list. In other words, def setf evaluates the \nlist and val for you, so that you needn't worry about evaluating the arguments out of \norder, or more than once. \n\nTo solve the problem we need to go beyond the simple def setf macro and delve \ninto the complexities of def i ne-setf-method, one of the trickiest macros in all of \nCommon Lisp, def i ne-setf-method defines a setf method not by writing code \ndirectly but by specifying five values that will be used by Common Lisp to write the \ncode for a call to setf. The five values give more control over the exact order in \nwhich expressions are evaluated, variables are bound, and results are returned. The \nfive values are: (1) a list of temporary, local variables used in the code; (2) a list of \nvalues these variables should be bound to; (3) a list of one variable to hold the value \nspecified in the call to setf; (4) code that will store the value in the proper place; (5) \ncode that will access the value of the place. This is necessary for variations of setf \nlike i ncf and pop, which need to both access and store. \n\nIn the following setf method for last, then, we are defining the meaning of \n(setf (last place) value). We keep track of all the variables and values needed \nto evaluate pi ace, and add to that three more local variables: last2-var will hold \nthe last two elements of the list, last2-p will be true only if there are two or more \nelements in the list, and last - va r will hold the form to access the last element of the \nlist. We also make up a new variable, resul t, to hold the val ue. The code to store \nthe value either modifies the cdr of last2-var, if the list is long enough, or it stores \ndirectly into pi ace. The code to access the value just retrieves 1 diSt-\\/ar. \n\n(define-setf-method last (place) \n(multiple-value-bind (temps vals stores store-form access-form) \n(get-setf-method place) \n\n(let ((result (gensym)) \n(last2-var (gensym)) \n(last2-p (gensym)) \n(last-var (gensym))) \n\nReturn 5 vals: temps vals stores store-form access-form \n\n(values \n'(.temps Jast2-var .last2-p .last-var) \n'(.@vals (last2 .access-form) \n\n(= (length .last2-var) 2) \n\n(if .last2-p (rest .last2-var) .access-form)) \n(list result) \n'(if .last2-p \n\n(setf (cdr .last2-var) .result) \n(let ((.(first stores) .result)) \n.store-form)) \nlast-var)))) \n\n\f\n<a id='page-885'></a>\nIt should be mentioned that setf methods are very useful and powerful things. It \nis often better to provide a setf method for an arbitrary function, f, than to define \na special setting function, say, set-f. The advantage of the setf method is that it \ncan be used in idioms like incf and pop, in addition to setf itself. Also, in ANSI \nCommon Lisp, it is permissible to name a function with #' (setf f), so you can also \nuse map or apply the setf method. Most setf methods are for functions that just \naccess data, but it is permissible to define setf methods for functions that do any \ncomputation whatsoever. As a rather fanciful example, here is a setf method for the \nsquare-root function. It makes (setf (sqrt x) 5) be almost equivalent to (setf . \n(* 5 5)); the difference is that the first returns 5 while the second returns 25. \n\n(define-setf-method sqrt (num) \n(multiple-value-bind (temps vals stores store-form access-form) \n(get-setf-method num) \n(let ((store (gensym))) \n\n(values temps \nvals \n(list store) \n\n'(let ((.(first stores) (* .store .store))) \n.store-form \n.store) \n'(sqrt .access-form))))) \n\nTurning from setf methods back to macros, another hard part about writing portable \nmacros is anticipating what compilers might warn about. Let's go back to the dotree \nmacro. Its definition might look in part like this: \n\n(defmacro dotree ((var tree &optional result) &body body) \n\"Perform body with var bound to every leaf of tree, \nthen return result. Return and Go can be used in body.\" \n\n'(let ((.var)) \n.body)) \n\nNow suppose a user decides to count the leaves of a tree with: \n\n(let ((count 0)) \n(dotree (leaf tree count) \n(incf count))) \n\nThe problem is that the variable leaf is not used in the body of the macro, and \na compiler may well issue a warning to that effect. To make matters worse, a \nconscientious user might write: \n\n\f\n<a id='page-886'></a>\n\n(let ((count 0)) \n\n(dotree (leaf tree count) \n\n(declare (ignore leaf)) \n\n(incf count))) \n\nThe designer of a new macro must decide if declarations are allowed and must make \nsure that compiler warnings will not be generated unless they are warranted. \n\nMacros have the full power of Lisp at their disposal, but the macro designer must \nremember the purpose of a macro is to translate macro code into primitive code, \nand not to do any computations. Consider the following macro, which assumes that \ntranslate - rul e-body is defined elsewhere: \n\n(defmacro defrule (name &body body) ; Warning! buggy! \n\n\"Define a new rule with the given name.\" \n\n(setf (get name 'rule) \n\n*#*(lambda () ,(translate-rule-body body)))) \n\nThe idea is to store a function under the rul e property of the rule's name. But this \ndefinition is incorrect because the function is stored as a side effect of expanding the \nmacro, rather than as an effect of executing the expanded macro code. The correct \ndefinition is: \n\n(defmacro defrule (name &body body) \n\"Define a new rule with the given name.\" \n\n'(setf (get '.name 'rule) \n#'(lambda () .(translate-rule-body body)))) \nBeginners sometimes fail to see the difference between these two approaches, because \nthey both have the same result when interpreting a file that makes use of \ndef rul e. But when the file is compiled and later loaded into a different Lisp image, \nthe difference becomes clear: the first definition erroneously stores the function \nin the compiler's image, while the second produces code that correctly stores the \nfunction when the code is loaded. \n\nBeginning macro users have asked, \"How can I have a macro that expands into \ncode that does more than one thing? Can I splice in the results of a macro?\" \n\nIf by this the beginner wants a macro that just does two things, the answer is \nsimply to use a progn. There will be no efficiency problem, even if the progn forms \nare nested. That is, if macro-expansion results in code like: \n\n(progn (progn (progn a b) c) (progn d e)) \n\nthe compiler will treat it the same as (progn abode). \n\n\f\n<a id='page-887'></a>\nOn the other hand, if the beginner wants a macro that returns two values, the \nproper form is val ues, but it must be understood that the calling function needs to \narrange specially to see both values. There is no way around this limitation. That is, \nthere is no way to write a macro-or a function for that matter-that will \"splice in\" its \nresults to an arbitrary call. For example, the function f 1 oor returns two values (the \nquotient and remainder), as does i ntern (the symbol and whether or not the symbol \nalready existed). But we need a special form to capture these values. For example, \ncompare: \n\n> (list (floor 11 5) (intern ..))=^(2 X) \n\n> (multiple-value-call #*list \n(floor 11 5) (intern 'x))=^(2 1 X -.INTERNAL) \n\n25.15 A Style Guide to Lisp \nIn a sense, this whole book is a style guide to writing quality Lisp programs. But this \nsection attempts to distill some of the lessons into a set of guidelines. \n\nWhen to Define a Function \n\nLisp programs tend to consist of many short functions, in contrast to some languages \nthat prefer a style using fewer, longer functions. New functions should be introduced \nfor any of the following reasons: \n\n1. For a specific, easily stated purpose. \n2. To break up a function that is too long. \n3. When the name would be useful documentation. \n4. When it is used in several places. \nIn (2), it is interesting to consider what \"too long\" means. Charniak et al. (1987) \nsuggested that 20 lines is the limit. But now that large bit-map displays have replaced \n24-line terminals, function definitions have become longer. So perhaps one screenful \nis a better limit than 20 lines. The addition of f let and 1 abel s also contributes to \nlonger function definitions. \n\n\f\n<a id='page-888'></a>\n\nWhen to Define a Special Variable \n\nIn general, it is a good idea to minimize the use of special variables. Lexical variables \nare easier to understand, precisely because their scope is limited. Try to limit special \nvariables to one of the following uses: \n\n1. For parameters that are used in many functions spread throughout a program. \n2. For global, persistant, mutable data, such as a data base of facts. \n3. For infrequent but deeply nested use. \nAn example of (3) might be a variable like ^standard-output*, which is used by \nlow-level priniting functions. It would be confusing to have to pass this variable \naround among all your high-level functions just to make it available to pri nt. \n\nWhen to Bind a Lexical Variable \n\nIn contrast to special variables, lexical variables are encouraged. You should feel free \nto introduce a lexical variable (with a let, 1 ambda or defun) for any of the following \nreasons: \n\n1. To avoid typing in the same expression twice. \n2. To avoid computing the same expression twice. \n3. When the name would be useful documentation. \n4. To keep the indentation manageable. \nHow to Choose a Name \n\nYour choice of names for functions, variables, and other objects should be clear, \nmeaningful, and consistent. Some of the conventions are listed here: \n\n1. Use mostly letters and hyphens, and use full words: del ete -file . \n2. You can introduce an abbreviation if you are consistent: get-dtree, dtree-\nfetch. For example, this book uses f . consistently as the abbreviation for \n\"function.\" \n3. Predicates end in -p (or ? in Scheme), unless the name is already a predicate: \nvariable-p, occurs-in. \n4. Destructive functions start with . (or end in ! in Scheme): nreverse. \n\f\n<a id='page-889'></a>\n5. Generalized variable-setting macros end in f: setf, incf. (Push is an exception.) \n6. Slot selectors created by defstruct are of the form type-slot. Use this for \nnon-def s t r uct selectors as well: cha r- bi ts. \n7. Many functions have the form action-object: copy -1i st, del ete -f i1 e. \n8. Other functions have the form object-modifier: 1 ist-length, char-lessp. Be \nconsistent in your choice between these two forms. Don't have pri nt-edge \nand vertex-pri nt in the same system. \n9. A function of the form modulename-functionname is an indication that packages \nare needed. Use parser: pri nt-tree instead of parser-print-tree. \n10. Special variables have asterisks: *db*, *print-length*. \n11. Constants do not have asterisks: pi, most-positive-fixnum. \n12. Parameters are named by type: (defun length (sequence) ...) or by purpose: \n(defun subsetp (subset superset) ...) or both: (defun / (number \n&rest denominator-numbers) ...) \n13. Avoid ambiguity. A variable named last-node could have two meanings; use \nprevi ous - node or f i nal - node instead. \n14. A name like propagate-constraints-to-neighboring-vertexes is too long, \nwhile prp-con is too short. In deciding on length, consider how the name will \nbe used: propagate-constraints is just right, because a typical call will be \n(propagate-constrai nts vertex), so it will be obvious what the constraints \nare propagating to. \nDeciding on the Order of Parameters \n\nOnce you have decided to define a function, you must decide what parameters it will \ntake, and in what order. In general, \n\n1. Put important parameters first (and optional ones last). \n2. Make it read like prose if possible: (push element stack). \n3. Group similar parameters together. \nInterestingly, the choice of a parameter list for top-level functions (those that the \n\nuser is expected to call) depends on the environment in which the user will function. \n\nIn many systems the user can type a keystroke to get back the previous input to the top \n\n\f\n<a id='page-890'></a>\n\nlevel, and can then edit that input and re-execute it. In these systems it is preferable \nto have the parameters that are likely to change be at the end of the parameter list, so \nthat they can be easily edited. On systems that do not offer this kind of editing, it is \nbetter to either use ke3word parameters or make the highly variable parameters first \nin the list (with the others optional), so that the user will not have to type as much. \n\nMany users want to have required keyword parameters. It turns out that all \nkeyword parameters are optional, but the following trick is equivalent to a required \nkeyword parameter. First we define the function requi red to signal an error, and \nthen we use a call to requi red as the default value for any keyword that we want to \nmake required: \n\n(defun required () \n(error \"A required keyword argument was not supplied.\")) \n\n(defun fn (x &key (y (required))) \n...) \n\n25.16 Dealing with Files, Packages, and Systems \nWhile this book has covered topics that are more advanced than any other Lisp text \navailable, it is still concerned only with programming in the small: a single project at \na time, capable of being implemented by a single programmer. More challenging is \nthe problem of programming in the large: building multiproject, multiprogranuner \nsystems that interact well. \n\nThis section briefly outlines an approach to organizing a larger project into manageable \ncomponents, and how to place those components in files. \n\nEvery system should have a separate file that defines the other files that comprise \nthe system. I recommend defining any packages in that file, although others put \npackage definitions in separate files. \n\nThe following is a sample file for the mythical system Project-X. Each entry in the \nfile is discussed in turn. \n\n1. The first line is a comment known as the mode line. The text editor emacs will \nparse the characters between delimiters to discover that the file contains \nLisp code, and thus the Lisp editing commands should be made available. The \ndialect of Lisp and the package are also specified. This notation is becoming \nwidespread as other text editors emulate emacs's conventions. \n2. Each file should have a description of its contents, along with information on \nthe authors and what revisions have taken place. \n\f\n<a id='page-891'></a>\n3. Comments with four semicolons (;;;;) denote header lines. Many text editors \nsupply a command to print all such lines, thus achieving an outline of the major \nparts of a file. \n4. The first executable form in every file should be an i n-package. Here we use \nthe user package. We will soon create the proj ect-x package, and it will be \nused in all subsequent files. \n5. We want to define the Project-X system as a collection of files. Unfortunately, \nCommon Lisp provides no way to do that, so we have to load our own system-\ndefinition functions explicitly with a call to 1 oad. \n6. The call to def i ne - system specifies the files that make up Project-X. We provide \na name for the system, a directory for the source and object files, and a list of \nmodules that make up the system. Each module is a list consisting of the module \nname (a symbol) followed by a one or more files (strings or pathnames). We \nhave used keywords as the module names to eliminate any possible name \nconflicts, but any symbol could be used. \n7. The call to def package defines the package proj ect-x. For more on packages, \nsee section 24.1. \n8. The final form prints instructions on how to load and run the system. \nMode: Lisp; Syntax: Common-Lisp; Package: User \n\n(Brief description of system here.) \n\n;; Define the Project-X system, \n\n(in-package \"USER\") \n\n(load \"/usr/norvig/defsys.lisp\") ; load define-system \n\n(define-system ;; Define the system Project-X \n:naaje :project-x \n:source-dir \"/usr/norvig/project-x/*.lisp\" \n:object-dir \"/usr/norvig/project-x/*.bin\" \n:modules '((:macros \"header\" \"macros\") \n\n(:main \"parser\" \"transformer\" \"optimizer\" \n\"commands\" \"database\" \"output\") \n(:windows \"xwindows\" \"clx\" \"client\"))) \n\n(defpackage :project-x ;; Define the package Project-X \n(:export \"DEFINE-X\" \"DO-X\" \"RUN-X\") \n(:nicknames \"PX\") \n(:use common-lisp)) \n\n\f\n<a id='page-892'></a>\n\n(format *debug-io* \"~& To load the Project-X system, type \n(make-system :name :project-x) \nTo run the system, type \n(project-x:run-x)\") \n\nEach of the files that make up the system will start like this: \n\n;;: -*- Mode: Lisp; Syntax: Common-Lisp; Package: Project-X -*\n\n\n(in-package \"PROJECT-X\") \n\nNow we need to provide the system-definition functions, def ine-system \nand make-system. The idea is that def ine-system is used to define the files that \nmake up a system, the modules that the system is comprised of, and the files that \nmake up each module. It is necessary to group files into modules because some \nfiles may depend on others. For example, all macros, special variables, constants, \nand inline functions need to be both compiled and loaded before any other files that \nreference them are compiled. In Project-X, all defvar, defparameter, defconstant, \nand defstruct^ forms are put in the file header, and all defmacro forms are put in the \nfile macros. Together these two files form the first module, named : mac ros, which \nwill be loaded before the other two modules (: ma i . and : wi ndows) are compiled and \nloaded. \n\ndefine-system also provides a place to specify a directory where the source \nand object files will reside. For larger systems spread across multiple directories, \ndef i ne-system will not be adequate. \n\nHere is the first part of the file defsys.lisp, showing the definition of \ndef i ne-system and the structure sys. \n\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: User -*\n\n\n;;;; A Facility for Defining Systems and their Components \n\n(in-package \"USER\") \n\n(defvar ^systems* nil \"List of all systems defined.\") \n\n(defstruct sys \n\"A system containing a number of source and object files.\" \nname source-dir object-dir modules) \n\n^defstruct forms are put here because they may create inline functions. \n\n\f\n<a id='page-893'></a>\n(defun define-system (&key name source-dir object-dir modules) \n\"Define a new system.\" \n;; Delete any old system of this name, and add the new one. \n(setf *systems* (delete name *systems* :test #*string-equal \n\n:key #'sys-name)) \n\n(push (make-sys \n:name (string name) \n:source-dir (pathname source-dir) \n:object-dir (pathname object-dir) \n:modules *((:all (mapcar #'first modules)) ..modules)) \n\n*systems*) \nname) \n\nThe function make - sy s t em is used to compile and/or load a previously defined system. \nThe name supplied is used to look up the definition of a system, and one of three \nactions is taken on the system. The keyword : cl oad means to compile and then load \nfiles. :1 oad means to load files; if there is an object (compiled) file and it is newer than \nthe source file, then it will be loaded, otherwise the soiu-ce file will be loaded. Finally, \n: update means to compile just those source files that have been changed since their \ncorresponding source files were last altered, and to load the new compiled version. \n\n(defun make-system (&key (module :all) (action :cload) \n\n(name (sys-name (first *systems*)))) \n\"Compile and/or load a system or one of its modules.\" \n(let ((system (find name *systems* :key #'sys-name \n\n:test #'string-equal))) \n(check-type system (not null)) \n(check-type action (member :cload -.update -.load)) \n(with-compilation-unit () (sys-action module system action)) \n\n(defun sys-action (x system action) \n\"Perform the specified action to . in this system. \nX can be a module name (symbol), file name (string) \nor a list.\" \n(typecase . \n\n(symbol (let ((files (rest (assoc . (sys-modules system))))) \n\n(if (null files) \n(warn \"No files for module \"a\" x) \n(sys-action files system action)))) \n\n(list (dolist (file x) \n(sys-action file system action))) \n((string pathname) \n(let ((source (merge-pathnames \nX (sys-source-dir system))) \n(object (merge-pathnames \nX (sys-object-dir system)))) \n(case action \n\n\f\n<a id='page-894'></a>\n\n(reload (compile-file source) (load object)) \n(lupdate (unless (newer-file-p object source) \n\n(compile-file source)) \n(load object)) \n(.-load (if (newer-file-p object source) \n(load object) \n(load source)))))) \n(t (warn \"Don't know how to ~a \"a in system \"a\" \naction X system)))) \n\nTo support this, we need to be able to compare the write dates on files. This is not \nhard to do, since Common Lisp provides the function f i 1 e-wri te-date. \n\n(defun newer-file-p (filel file2) \n\n\"Is filel newer than (written later than) file2? \" \n\n(>-num (if (probe-file filel) (file-write-date filel)) \n\n(if (probe-file file2) (file-write-date file2)))) \n\n(defun >-num (x y) \n\"True if X and y are numbers, and . > y.\" \n(and (numberp x) (numberp y) (> . y))) \n\n25.17 Portability Problems \nProgramming is difficult. All programmers know the frustration of trpng to get a \nprogram to work according to the specification. But one thing that really defines the \nprofessional programmer is the ability to write portable programs that will work on \na variety of systems. A portable program not only must work on the computer it \nwas tested on but also must anticipate the difference between your computer and \nother ones. To do this, you must understand the Common Lisp specification in the \nabstract, not just how it is implemented on your particular machine. \n\nThere are three ways in which Common Lisp systems can vary: in the treatment \nof \"is an error\" situations, in the treatment of unspecified results, and in extensions \nto the language. \n\nCommon Lisp the Language specifies that it \"is an error\" to pass a non-number to \nan arithmetic function. For example, it is an error to evaluate (+ nil 1). However, \nit is not specified what should be done in this situation. Some implementations may \nsignal an error, but others may not. An implementation would be within its right to \nreturn 1, or any other number or non-number as the result. \n\nAn unsuspecting programmer may code an expression that is an error but still \ncomputes reasonable results in his or her implementation. A common example is \napplying get to a non-symbol. This is an error, but many implementations will \n\n\f\n<a id='page-895'></a>\njust return nil, so the programmer may write (get . * prop) when (if (symbol . \n.) (get . 'prop) nil) is actually needed for portable code. Another common \nproblem is with subseq and the sequence functions that take : end keywords. It is an \nerror if the : end parameter is not an integer less than the length of the sequence, but \nmany implementations will not complain if : end is nil or is an integer greater than \nthe length of the sequence. \n\nThe Common Lisp specification often places constraints on the result that a \nfunction must compute, without fully specifying the result. For example, both of the \nfollowing are valid results: \n\n> (union '(a b c) '(b c d)) =i> (A . C D) \n> (union *(a b c) '(b c d)) (D A . C) \n\nA program that relies on one order or the other will not be portable. The same warning \napplies to i ntersecti on and set-di ff erence. Many functions do not specify how \nmuch the result shares with the input. The following computation has only one \npossible printed result: \n\n> (remove 'x '(a b c d)) ^ (A . C D) \n\nHowever, it is not specified whether the output is eq or only equal to the second \n\ninput. \n\nInput/output is particularly prone to variation, as different operating systems \ncan have very different conceptions of how I/O and the file system works. Things \nto watch out for are whether read-char echoes its input or not, the need to include \nfinish-output, andvariationinwherenewlines are needed, particularly with respect \nto the top level. \n\nFinally, many implementations provide extensions to Common Lisp, either by \nadding entirely new functions or by modifying existing functions. The programmer \nmust be careful not to use such extensions in portable code. \n\n25.18 Exercises \n&#9635; Exercise 25.1 Pi] On your next programming project, keep a log of each bug you \ndetect and its eventual cause and remedy. Classify each one according to the taxonomy \ngiven in this chapter. What kind of mistakes do you make most often? How \ncould you correct that? \n\n&#9635; Exercise 25.2 [s-d] Take a Common Lisp program and get it to work with a different \ncompiler on a different computer. Make sure you use conditional compilation read \n\n\f\n<a id='page-896'></a>\n\nmacros (#+ and #-) so that the program will work on both systems. What did you \n\nhave to change? \n\n&#9635; Exercise 25.3 [m] Write a setf method for i f that works like this: \n\n(setf (if test (first x) y) (+ 2 3)) = \n(let ((temp (+ 2 3))) \n\n(if test \n(setf (first x) temp) \n(setf y temp))) \n\nYou will need to use def i ne-setf-method, not defsetf. (Why?) Make sure you \nhandle the case where there is no else part to the i f. \n\n&#9635; Exercise 25.4 [h] Write a setf method for 1 ookup, a function to get the value for a \nkey in an association list. \n\n(defun lookup (key alist) \n\"Get the cdr of key's entry in the association list.\" \n(cdr (assoc key alist))) \n\n25.19 Answers \nAnswer 25.4 Here is the setf method for 1 ookup. It looks for the key in the a-list, \nand if the key is there, it modifies the cdr of the pair containing the key; otherwise it \nadds a new key/value pair to the front of the a-list. \n\n(define-setf-method lookup (key alist-place) \n(multiple-value-bind (temps vals stores store-form access-form) \n(get-setf-method alist-place) \n\n(let ((key-var (gensym)) \n(pair-var (gensym)) \n(result (gensym))) \n\n(values \n'(.key-var .temps .pair-var) \n'(.key .vals (assoc .key-var .access-form)) \n'(.result) \n\n'(if.pair-var \n(setf (cdr .pair-var) .result) \n(let ((.(first stores) \n(aeons .key-var .result .access-form))) \n\n.store-form \n\n.result)) \n\n'(cdr .pair-var))))) \n\n\f\n## Appendix\n<a id='page-897'></a>\n\nObtaining the Code \nin this Book \n\nFTP: The File Transfer Protocol \n\nFTP is a ftle transfer protocol that is widely accepted by computers around the world. FTP \nmakes it easy to transfer hies between two computers on which you have accounts. But more \nimportantly, it also allows a user on one computer to access hies on a computer on which he or \nshe does not have an account, as long as both computers are connected to the Internet. This is \nknown as anonymous FTP. \n\nAll the code in this book is available for anonymous FTP from the computer mkp. com in files \nin the directory pub/norvi g. The ftle README in that directory gives further instructions on using \ntheftles. \n\nIn the session below, the user smith retrieves the ftles from mkp.com. Smith's input is in \nslanted font. The login name must be anonymous, and Smith's own mail address is used as the \npassword. The conunand cd pub/norvig changes to that directory, and the command Is lists \nall the ftles. The command mget * retrieves all ftles (the m stands for \"multiple\"). Normally, \nthere would be a prompt before each ftle asking if you do indeed want to copy it, but the prompt \ncommand disabled this. The command bye ends the FTP session. \n\n%ftpmkp.com i or ftp 199182.55.2) \nName (mkp.comismith): anonymous \n331 Guest login ok. send ident as password \nPassword: smith@cs.stateu.edu \n230 Guest login ok. access restrictions apply \nftp> cd pub/norvig \n\n\f\n<a id='page-898'></a>\n\n250 CWD command successful. \nftp> Is \n\nf tp> prompt \nInteractive mode off. \nftp> mget * \n\nftp> bye \n% \n\nAnonymous FTP is a privilege, not a right. The site administrators at mkp. com and \nat other sites below have made their systems available out of a spirit of sharing, but \nthere are real costs that must be paid for the cormections, storage, and processing \nthat makes this sharing possible. To avoid overloading these systems, do not FTP \nfrom 7:00 a.m. to 6:00 p.m. local time. This is especially true for sites not in yoiu: \ncountry. If you are using this book in a class, ask your professor for a particular piece \nof software before you try to FTP it; it would be wasteful if everybody in the class \ntransferred the same thing. Use common sense and be considerate: none of us want \nto see sites start to close down because a few are abusing their privileges. \n\nIf you do not have FTP access to the Internet, you can still obtain the nles from \nthis book by contacting Morgan Kaufmann at the following: \n\nMorgan Kaufmann Publishers, Inc. \n340 Pine Street, Sbcth Floor \nSan Francisco, CA 94104-3205 \nUSA \nTelephone 415/392-2665 \nFacsimile 415/982-2665 \nInternet mkp@mkp.com \n(800) 745-7323 \n\nMake sure to specify which format you want: \n\nMacintosh diskette ISBN 1-55860-227-5 \nDOS 5.25 diskette ISBN 1-55860-228-3 \nDOS 3.5 diskette ISBN 1-55860-229-1 \n\nAvailable Software \n\nIn addition to the program from this book, a good deal of other software is available. \nThe tables below list some of the relevant AI/Lisp programs. Each entry lists the \nname of the system, an address, and some comments. The address is either a \ncomputer from which you can FTP, or a mail address of a contact. Unless it is stated \nthat distribution is by email or Roppy or requires a license, then you can FTP from the \ncontact's home computer. In some cases the host computer and/or directory have \n\n\f\n<a id='page-899'></a>\n\nbeen provided in italics in the comments field. However, in most cases it should \nbe obvious what files to transfer. First do an 1 s command to see what files and \ndirectories are available. If there is a file called README, follow its advice: do a get \nREADME and then look at the file. If you still haven't found what you are looking for, \nbe aware that most hosts keep their public software in the directory pub. Do a cd pub \nand then another 1 s, and you should find the desired files. \n\nIf a file ends in the suffix . Z, then you should give the FTP command bi na ry before \ntransferring it, and then give the UNIX command uncompress to recover the original \nfile. Files with the suffix .tar contain several files that can be unpacked with the \ntar command. If you have problems, consult your local documentation or system \nadministrator. \n\nKnowledge Representation \nSystem Address Comments \nBabbler rsfl@ra.msstate.edu email; Markov chains/NLP \n\nBACK peltason@tubvm.cs.tu-berlin.de 3.5''floppy; KL-ONE family \n\nBelief almond@stat.washington.edu belief networks \nClassic dlm@research.att.com license; KL-ONE family \nFolGetfol fausto@irst.it tape; Weyrauch's FOL system \nFramekit ehn-^^cs.cmu.edu floppy; frames \n\nFrameWork mkant+@cs.cmu.edu a.gp.cs.cmu.edu:/usr/mkant/Public; irdimes \nFrobs kessler@cs.utah.edu frames \nKnowbel kramer@ai.toronto.edu sorted/temporal logic \nMVL ginsberg@t. stanford.edu multivalued logics \nOPS slisp-group@b.gp.cs.cmu.edu Forgy's OPS-5 language \nPARKA spector@cs.umd.edu frames (designed for connection machine) \nParmenides pshell@cs.cmu.edu frames \nRhetorical miller@cs.rochester.edu planning, time logic \nSB-ONE kobsa@cs.uni-sb.de license; in German; KL-ONE family \nSNePS shapiro@cs.buffalo.edu license; semantic net/NLP \nSPI cs.orst.edu Probabilistic inference \nYAK franconi@irst.it KL-ONE family \n\n\f\n<a id='page-900'></a>\n\nPlanning and Learning \n\nSystem Address Comments \nCOBWEB/3 cobweb@ptolemy.arc.nasa.gov email; concept formation \nMATS \nMICRO-xxx \nkautz@research.att.com \nwaander@cs.ume.edu \nlicense; temporal constraints \ncase-based reasoning \nNonlin nonlin-users-request@cs.umd.edu Tate's planner in Common Lisp \nProdigy prodigy@cs.cmu.edu license; planning and learning \nPROTOS porter@cs.utexas.edu knowledge acquisition \nSNLP \nSOAR \nweld@cs.washington.edu \nsoar-requests/@cs.cmu.edu \nnonlinear planner \nlicense; integrated architecture \nTHEO tom.mitchell@cs.cmu.edu frames, learning \nTileworld pollack@ai.sri.com planning testbed \nTileWorld tileworld@ptolemy.arc.nasa.gov planning testbed \n\nMathematics \n\nSystem Address Comments \nJACAL jaffer@altdorf.ai.mit.edu algebraic manipulation \nMaxima rascal.ics.utexas.edu version of Macsyma; also proof-checker, nqthm \nMMA f ateman@cs .berkeley.edu peoplesparc.berkeley.edu^ub/mma, *; algebra \nXLispStat umnstat.stat.umn.edu Statistics; also S Bayes \n\nCompilers and Utilities \n\nSystem Address Comments \nAKCL rascal.ics.utexas.edu Austin Koyoto Common Lisp \n\nCLX, CLUE export.lcs.mit.edu Common Lisp interface to X Windows \nGambit gambit@cs.brandeis.edu acorn.cs.brandeis.edu:dist/gambit*; Scheme compiler \nISI Grapher isi.edu Graph displayer; also NLP word lists \n\nPCL arisia.xerox.com Implementation of CLOS \nProlog aisunl.ai.uga.edu Prolog-based utilities and NLP programs \nPYTHON ram+@cs.cmu.edu a.gp.cs.cmu.edu: Common Lisp Compiler and tools \nSBProlog arizona.edu Stony Brook Prolog, Icon, Snobol \nScheme altdorf.ai.mit.edu Scheme utilities and compilers \nScheme scheme@nexus.yorku.ca Scheme utilities and programs \nSIOD bu.edu users/gjc; small scheme interpreter \nUtilities a.gp.cs.cmu.edu /usr/mkant/Public; profiling, def system, etc. \nXLisp cs.orst.edu Lisp interpreter \nXScheme tut.cis.ohio-state.edu Also mitscheme compiler; sbprolog \n\n\f\n## Bibliography\n<a id='page-901'></a>\n\nAbelson, Harold, and Gerald J. Sussman, with Juhe Sussman. (1985) Structure and \nInterpretation of Computer Programs. MIT Press. \nAho, A. v., and J. D. UUman. (1972) The Theory of Parsing, Translation, and Compiling. \nPrentice-Hall. \n\nAit-Kaci, Hassan. (1991) Warren's Abstract Machine: A Tutorial Reconstruction. MIT \nPress. An earlier version was published as \"The WAM: A (Real) Tutorial.\" \nDigital Equipment Corporation Paris Research Lab, Report no. 5. \n\nAit-Kaci, Hassan, Patrick Lincoln, and Roger Nasr. (1987) \"Le Fun: Logic, Equations \nand Functions.\" Proceedings of the IEEE, CH2472-9/87. \nAllen, James. (1987) Natural Language Understanding. Benjamin/Cummings. \nAllen, James, James Hendler, and Austin Tate. (1990) Readings in Planning. Morgan \nKaufmann. \nAllen, John. (1978) Anatomy of Lisp. McGraw-Hill. \nAmarel, Saul. (1968) \"On Representation of Problems of Reasoning about Actors.\" \nInMachine Intelligence 3, ed. Donald Michie. Edinburgh University Press. \nAnderson, James A. D. W. (1989) Pop-11 Comes of Age: the advancement of an AI \nprogramming language. Ellis Horwood. \nAnderson, John Robert. (1976) Language, Memory, and Thought. Lawrence Erlbaum. \nBaker, Henry G. (1991) \"Pragmatic Parsing in Common Lisp; or. Putting defmacro \non Steroids.\" Lisp Pointers 4, no. 2. \nBarr, Avron, and Edward A. Feigenbaum. (1981) The Handbook of Artificial Intelligence. \n3 vols. Morgan Kaufmann. \n\n\f\n<a id='page-902'></a>\n\nBatali, John, Edmund Goodhue, Chris Hanson, Howie Shrobe, Richard M. Stallman, \nand Gerald Jay Sussman. (1982) \"The Scheme-81 Architecture-System and \nChip.\" In Proceedings, Conference on Advanced Research in VLSI, 69-77. \n\nBennett, James S. (1985) \"Roget: A Knowledge-Based System for Acquiring the \nConceptual Structure of a Diagnostic Expert System.\" Journal of Automated \nReasoning 1'.9-74. \n\nBerlekamp, E. R., J. H. Conway, and R. K. Guy. (1982) Winning Ways. 2 vols. \nAcademic Press. \n\nBerUn, Andrew, and Daniel Weise. (1990) \"Compiling scientific code using partial \nevaluation.\" IEEE Computer, 25-37. \n\nBobrow, Daniel G. (1968) \"Natural Language Input for a Computer Problem-Solving \nSystem.\" In Minsky 1968. \n\nBobrow, DanielG. (1982) LOOPS: An Object-OrientedProgrammingSystemforlnterlisp. \nXerox PARC. \n\nBobrow, Daniel G. (1985) \"If Prolog is the Answer, What is the Question? or What \nIt Takes to Support AI Programming Paradigms.\" IEEE Transactions on Software \nEngineenng, SE-11. \n\nBobrow, Daniel G., Kenneth Kahn, Gregor Kiczales, Larry Masinter, Mark Stefik, \nand Frank Zdybel. (1986) \"Common Loops: Merging Lisp and Object-Oriented \nProgramming.\" Proceedings of the ACM Conference on Object-Oriented Systems, \nLanguages, and Applications. \n\nBoyer, R. S., and J. S. Moore. (1972) \"The Sharing of Structure in Theorem Proving \nPrograms.\" In Machine Intelligence 7, ed. B. Meitzerand D. Michie. Wiley. \n\nBrachman, Ronald J., and Hector J. Levesque. (1985) Readings in Knowledge Representation. \nMorgan Kaufmann. \n\nBrachman, Ronald J., Richard E. Pikes, and Hector J. Levesque. (1983) \"KRYPTON: A \nFunctional Approach to Knowledge Representation,\" FLAIR Technical Report \nno. 16, Fairchild Laboratory for Artificial Intelligence. Reprinted in Brachman \nand Levesque 1985. \n\nBratko, Ivan. (1990) PrologProgramming for Artificial Intelligence. Addison-Wesley. \n\nBromley, Hank, and Richard Lamson. (1987) A Guide to Programming the Lisp Machine. \n2ded. Kluwer Academic. \n\nBrooks, Rodney A. (1985) Programming in Common Lisp. Wiley. \n\n\f\n<a id='page-903'></a>\n\nBrownston, L., R. Farrell, E. Kant, and N. Martin. (1985) Programming Expert Systems \nin 0PS5, Addison-Wesley. \n\nBuchanan, Bruce G., and Edward Hance ShortUffe. (1984) Rule-based Expert Systems: \nThe MYCIN Experiments of the Stanford Heuristic Programming Project. Addison-\nWesley. \n\nBundy, Alan. (1984) Catalogue of Artificial Intelligence Tools. Springer-Verlag. \n\nCannon, Howard I. (1980) \"Flavors.\" AI Lab Technical Report, MIT. \n\nCarbonell, Jamie A. (1981) Subjective Understanding: Computer Models of Belief Systems. \nUMI Research Press. \n\nCardelli, Luca, and Peter Wegner. (1986) \"On Understanding Types, Data Abstraction \nand Polymorphism.\" ACM Computing Surveys 17. \n\nChapman, David. (1987) \"Planning for Conjunctive Goals.\" Artificial Intelligence \n32:333-377. Reprinted in Allen, Hendler, and Tate 1990. \n\nCharniak, Eugene, and Drew McDermott. (1985) Introduction to Artificial Intelligence. \nAddison-Wesley. \n\nCharniak, Eugene, Christopher Riesbeck, Drew McDermott, and James Meehan. \n(1987) Artificial Intelligence Programming. 2d ed. Lawrence Erlbaum. \n\nCheeseman, Peter. (1985) \"In Defense of Probability.\" InProceedings of the Ninth \n//CA/1002-1009. \nChomsky, Noam. (1972) Language and Mind. Harcourt Brace Jovanovich. \nChurch, Alonzo. (1941) \"The Calculi of Lambda-Conversion.\" Annals of Mathematical \nStudies. Vol. 6, Princeton University Press. \n\nChurch, Kenneth, and Ramesh Patil. (1982) \"Coping with Syntactic Ambiguity, or \nHow to Put the Block in the Box on the Table.\" American Journal of Computational \nLinguistics 8, nos. 3-4:139-149. \n\ndinger, William, and Jonathan Rees. (1991) Revised^ Report on the Algorithmic Language \nScheme. Unpublished document available online on cs.voregin.edu. \nClocksin, William F., and Christopher S. Mellish. (1987) Programming in Prolog \n3d ed. Springer-Verlag. \nClowes, Maxwell B. (1971) \"On Seeing Things.\" Artificial Intelligence 2:79-116. \nCoelho, Helder, and Jose C. Cotta. (1988) Prolog by Example. Springer-Verlag. \n\n\f\n<a id='page-904'></a>\n\nCohen, Jacques. (1985) \"Describing Prolog by its interpretation and compilation.\" \nCommunications of the ACM 28, no. 12:1311-1324. \n\nCohen, Jacques. (1990) \"Constraint Logic Programming Languages.\" Communications \nof the ACM 33, no. 7:52-68. \n\nColby, Kenneth. (1975) Artificial Paranoia, Pergamon. \n\nCollins, Allan. (1978) \"Fragments of a Theory of Human Plausible Reasoning. Theoretical \nIssues in Natural Language Processing, David Waltz, ed. ACM, Reprinted \nin Shafer and Pearl 1990. \n\nColmerauer, Alain. (1985) \"Prolog in 10 figures.\" Communications of the ACM 28, \nno. 12:1296-1310. \n\nColmerauer, Alain. (1990) \"An Introduction to Prolog III.\" Communications of the \nACM 33, no. 7:69-90. \n\nColmerauer, Alain, Henri Kanoui, Robert Pasero, and Phillipe Roussel. (1973) \nUn Systeme de Communication Homme-Machine en Frangais. Rapport, Croupe \nd'lntelligence Artificielle, Universit&eacute; d'Aix-Marseille II. \n\nCooper, Thomas .., and Nancy Wogrin. (1988) Rule-Based Programming with 0PS5 . \nMorgan Kaufmann. \n\nDahl, Ole-Johan, and Kristen Nygaard. (1966) \"SIMULA-An Algol-based Simulation \nLanguage.\" Communications of the ACM 9, no. 9:671-678. \n\nDavenport, J. H., Y. Siret, and E. Tournier. (1988) Computer Algebra: Systems and \nAlgorithms for Algebraic Computation. Academic Press. \n\nDavis, Ernest. (1990) Representations ofCommonsense Reasoning. Morgan Kaufmann. \n\nDavis, Lawrence. (1987) Genetic Algorithms and Simulated Annealing, Morgan Kaufmann. \n\n\nDavis, Lawrence. (1991) Handbook of Genetic Algorithms, van Nostrand Reinhold. \n\nDavis, Randall. (1977) \"Meta-Level Knowledge.\" Proceedings of the Fifth IJCAI, 920\n\n\n928. Reprinted in Buchanan and Shortliffe 1984. \nDavis, Randall. (1979) \"Interactive Transfer of Expertise.\" Artificial Intelligence \n12:121-157. Reprinted in Buchanan and Shortliffe 1984. \n\nDavis, Randall, and Douglas B. Lenat. (1982) Knowledge-Based Systems in Artificial \nIntelligence. McGraw-Hill. \n\nDeGroot, A. D. (1965) Thought and Choice in Chess. Mouton. (English translation, \nwith additions, of the Dutch edition, 1946.) \n\n\f\n<a id='page-905'></a>\n\nDeGroot, A. D., (1966) \"Perception and Memory versus Thought: Some Old Ideas \nand Recent Findings.\" In Problem Solving, ed. B. Kleinmuntz. Wiley. \n\nde Kleer, Johan. (1986a) \"An Assumption-Based Truth Maintenance System.\" Artificial \nIntelligence 28:127-162. Reprinted in Ginsberg 1987. \n\nde Kleer, Johan. (1986b) \"Extending the ATMS.\" Artificial Intelligence 28:163-196. \n\nde Kleer, Johan. (1986c) \"Problem-Solving with the ATMS.\" Artificial Intelligence \n28:197-224. \n\nde Kleer, Johan. (1988) \"A General Labelling Algorithm for Assumption-Based Truth \nMaintenance.\" Proceedings of theAAAI, 188-192. \n\nDowty, David R., Robert E. Wall, and Stanley Peters. (1981) Introduction to Montague \nSemantics. SyntheseLanguageLibrary, vol. 11. D. Reidel. \n\nDoyle, Jon. (1979) \"A Truth Maintenance System.\" Artificial Intelligence 12:231-272. \n\nDoyle, Jon. (1983) \"The Ins and Outs of Reason Maintenance.\" Proceedings of the \nEighth IJCAI3A9-351. \n\nDubois, Didier, and Henri Prade. (1988) \"An Introduction to Possibilistic and \nFuzzy Logics.\" Non-Standard Logics for Automated Reasoning. Academic Press. \nReprinted in Shafer and Pearl 1990. \n\nFarley, Jay. (1970) \"An Efficient Context-Free Parsing Algorithm.\" CACM6, no. 2:451\n\n\n455. Reprinted in Grosz et al. 1986. \nElcock, E. W., and . Hoddinott. (1986) \"Comments on Kornfeld's 'Equality for \nProlog': E-Unification as a Mechanism for Augmenting the Prolog Search \nStrategy.\" Proceedings oftheAAAI, 766-775. \n\nEmanuelson, P., and A. Haraldsson. (1980) \"On Compiling Embedded Languages \nin Lisp.\" Lisp Conference, Stanford, Calif., 208-215. \n\nErnst, G. W., and Newell, Alan. (1969) GPS: A Case Study in Generality and Problem \nSolving. Academic Press. \n\nFateman, Richard J. (1973) \"Reply to an Editorial.\" ACM SIGSAM Bulletin 25 \n(March):9-ll. \n\nFateman, Richard J. (1974) \"Polynomial Multiplication, Powers and Asymptotic \nAnalysis: Some Comments,\" SIAM Journal of Computation no. 3,3:196-213. \n\nFateman, Richard J. (1979) \"MACSYMA's general simplifier: philosophy and operation.\" \nIn Proceedings of the 1979 MACSYMA Users' Conference (MUC-79), ed. \n\nV. E. Lewis 563-582. Lab for Computer Science, MIT. \n\f\n<a id='page-906'></a>\n\nFateman, Richard J. (1991) \"FRPOLY: A Benchmark Revisited/' Lisp and Symbolic \nComputation 4:155-164. \nFeigenbaum, Edward A. and Julian Feldman. (1963) Computers and Thought. \nMcGraw-Hill. \nField, A.J., and P. G. Harrison. (1988) Functional Programming. Addison-Wesley. \n\nEikes, RichardE., andNilsJ. Nilsson. (1971)\"STRIPS: ANew Approach to the Application \nof Theorem Proving to Problem Solving,\" Artificial Intelligence 2:189-208. \nReprinted in Allen, Hendler, and Tate 1990. \n\nFodor, Jerry A. (1975) The Language of Thought. Harvard University Press. \nForgy, Charles L. (1981) 'OPS5 User's Manual.\" Report CMU-CS-81-135, Carnegie \nMellon University. \nForgy, Charles L. (1982) \"RETE: A Fast Algorithm for the Many Pattern/Many Object \nPattern Match Problem.\" Artificial Intelligence 19:17-37. \nFranz Inc. (1988) Common Lisp: the Reference. Addison-Wesley. \n\nGabriel, Richard P. (1985) Performance and evaluation of Lisp systems. MIT Press. \nGabriel, Richard P. (1990) \"Lisp.\" In Encyclopedia of Artificial Intelligence, ed. Stuart \n\nC. Shapiro. Wiley. \nGaller, B. .., and M. J. Fisher. (1964) \"An Improved Equivalence Algorithm.\" Communications \noftheACMl, no. 5:301-303. \n\nGazdar, Richard, and Chris Mellish. (1989) Natural Language Processing in Lisp. \nAddison-Wesley. Also published simultaneously: Natural Language Processing \nin Prolog. \n\nGenesereth, Michael R., and Matthew L. Ginsberg. (1985) \"Logic Programming.\" \nCommunications oftheACMl^, no. 9:933-941. \n\nGenesereth, Michael R., and Nils J. Nilsson. (1987) Logical Foundations of Artificial \nIntelligence. Morgan Kaufmann. \n\nGiannesini, Francis, H. Kanoui, R. Pasero, and M. van Caneghem. (1986) Prolog. \nAddison-Wesley. \n\nGinsberg, Matthew L. (1987) Readings in NonMonotonic Reasoning. Morgan Kaufmann. \n\n\nGinsberg, Matthew L., and William D. Harvey. (1990) \"Iterative Broadening.\" Proceedings, \nEighth National Conference on AI, 216-220. \n\n\f\n<a id='page-907'></a>\n\nGoldberg, Adele, and David Robinson. (1983) Smalltalk-80: The Language and its \nImplementation, Addison-Wesley. \n\nGoldberg, David E. (1989) Genetic Algorithms in Search, Optimization and Machine \nLearning. Addison-Wesley. \n\nGordon, Jean, and Edward H. Shortliffe. (1984) \"The Dempster-Shafer Theory of \nEvidence.\" In Buchanan and Shortliffe 1984. \n\nGreen, Cordell. (1968) \"Theorem-proving by resolution as a basis for question-\nanswering systems.\" InMachine Intelligence 4, ed. Bernard Meitzer and Donald \nMichie. 183-205. Edinburgh University Press. \n\nGrosz, Barbara J., Karen Sparck-Jones, and Bonnie Lynn Webber. (1986) Readings in \nNatural Language Processing. Morgan Kaufmann. \n\nGuzman, Adolfo. (1968) \"Computer Recognition of Three-Dimensional Objects in \na Visual Scene.\" Ph.D. thesis, MAC-TR-59, Project MAC, MIT. \n\nHafner, Carole, and Bruce Wilcox. (1974) LISP/MTS Programmer's Guide. Mental \nHealth Research Institute Communication no. 302, University of Michigan. \n\nHarris, Zellig S. (1982) A Grammar of English on Mathematical Principles. Wiley. \n\nHasemer, Tony, and John Domingue. (1989) Common Lisp Programming for Artificial \nIntelligence. Addison-Wesley. \n\nHayes, Patrick. \"Naive Physics I: Ontology for Liquids.\" In Hobbs and Moore 1985. \n\nHeckerman, David. (1986) \"Probabilistic Interpretations for Mycin's Certainty Factors.\" \nIn Uncertainty in Artificial Intelligence, ed. L. N. Kanal and J. F. Lemmer. \nElsevier (North-Holland). Reprinted in Shafer and Pearl 1990. \n\nHennessey, Wade L. (1989) Common Lisp. McGraw-Hill. \n\nHewitt, Carl. (1977) \"Viewing Control Structures as Patterns of Passing Messages.\" \nArtificial Intelligence 8, no. 3:323-384. \n\nHobbs, Jerry R., and Robert C. Moore. (1985) Formal Theories of the Commonsense \nWorld. Ablex. \n\nHofstader, Douglas R. (1979) Godel, Escher, Bach: An Eternal Golden Braid. Vintage. \n\nH&ouml;dobler, Steffen. (1987) Foundations ofEquational Logic Programming, Springer-\nVerlag Lecture Notes in Artificial Intelligence. \n\nHuddleston, Rodney. (1984) Introduction to the Grammar of English. Cambridge \nUniversity Press. \n\n\f\n<a id='page-908'></a>\n\nHuffman, David A. (1971) \"Impossible Objects as Nonsense Pictures.\" 295-323. \nInMachine Intelligence 6, ed. B. Meitzer and D. Michie. Edinburgh University \nPress. \n\nHughes, R. J. M. (1985) \"Lazy Memo Functions.\" In Proceedings of the Conference on \nFunctional Programming and Computer Architecture, Nancy, 129-146. Springer-\nVerlag. \n\nIngerman, Peter Z. (1961) \"Thunks.\" Communications of the ACM 4, no. 1:55-58. \nJaff ar, Joxan, Jean-Louis Lassez, and Michael J. Maher. (1984) \"A Theory of Complete \n\nLogic Programs with Equality.\" Journal of Logic Programming 3:211-223. \nJackson, Peter. (1990) Introduction to Expert Systems. 2d ed. Addison-Wesley. \nJames, Glenn, and Robert C. James. (1949) Mathematics Dictionary. Van Nostrand. \nKanal, L. N., and J. F. Lemmer. (1986) Uncertainty in Artificial Intelligence. North-\n\nHolland. \nKanal, L. N., and J. F. Lemmer. (1988) Uncertainty in Artificial Intelligence 2. North-\n\nHolland. \nKay, Alan. (1969) \"The Reactive Engine.\" Ph.D. thesis. University of Utah. \nKay, Martin. (1980) Algorithm schemata and data structures in syntactic processing. \n\nXerox Palo Alto Research Center Report CSL-80-12. Reprinted in Grosz et al. \n1986. \nKernighan, .. W., and P. J. Plauger. (1974) The Elements of Programming Style. \nMcGraw-Hill. \nKernighan, .. W., and P. J. Plauger. (1981) Software Tools in Pascal. Addison-Wesley. \nKeene, Sonya. (1989) Object-Oriented Programming in Common Lisp: A Programmer's \nGuide to CLOS. Addison-Wesley. \nKnight, K. (1989) \"Unification: A Multidisciplinary Survey.\" ACM Computing Surveys, \n21, no. 1:93-121. \nKnuth, Donald E., and Robert W. Moore. (1975) \"An Analysis of Alpha-Beta Pruning.\" \nArtificial Intelligence, 6, no. 4:293-326. \nKohlbecker, Eugene Edmund, Jr. (1986) \"Syntactic Extensions in the Programming \nLanguage Lisp.\" Ph.D. thesis, Indiana University. \nKorf, R. E. (1985) \"Depth-first Iterative Deepening: an Optimal Admissible Tree \nSearch.\" Artificial Intelligence 27:97-109. \n\n\f\n<a id='page-909'></a>\n\nKornfeld, W. .. (1983) \"Equality for Prolog.\" Proceedings of the Seventh IJCAl 514519. \n\n\nKoschman, Timothy. (1990) The Common Lisp Companion. Wiley. \n\nKowalski, Robert. (1974) \"Predicate logic as a programming language.\" In Proceedings \nof the IFIP-74 Congress, 569-574. North-Holland. \n\nKowalski, Robert. (1979) \"Algorithm = Logic + Control.\" Communications of the AC M \n22:424-436. \n\nKowalski, Robert. (1980) Logic for Problem Solving. North-Holland. \n\nKowalski, Robert. (1988) \"The Early Years of Logic Programming.\" Communications \no/f/ze ACM 31:38-43. \n\nKranz, David, Richard Kelsey, Jonathan Rees, Paul Hudak, James Philbin, and Norman \nAdams. (1986) \"ORBIT: An optimizing compiler for Scheme.\" SIGPLAN \nCompiler Construction Conference. \n\nKreutzer, Wolfgang, and Bruce McKenzie. (1990) Programming for Artificial Intelligence: \nMethods, Tools and Applications. Addison-Wesley. \n\nLakoff, George. (1987) Women, Fire and Dangerous Things: What Categories Reveal \nAbout the Mind. University of Chicago Press. \n\nLandin, Peter. (1965) \"A Correspondence Between Algol 60 and Church's Lambda \nNotation.\" Communications of the ACM S, no. 2:89-101. \n\nLang, Kevin J., and Barak A. Perlmutter. (1988) \"Oaklisp: An Object-Oriented \nDialect of Scheme.\" Lisp and Symbolic Computing 1:39-51. \n\nLangacker, Ronald W. (1967) Language and its Structure. Harcourt, Brace & World. \n\nLassez, J.-L., M. J. Maher, and K. Marriott. (1988) \"Unification Revisited.\" In Foundations \nof Deductive Databases and Logic Programming, ed. J. Minker, 587-625. \nMorgan Kaufmann. \n\nLee, Kai-Fu, and Sanjoy Mahajan. (1986) \"Bill: A Table-Based, Knowledge-Intensive \nOthello Program.\" Technical Report CMU-CS-86-141, Carnegie Mellon University. \n\n\nLee, Kai-Fu, and Sanjoy Mahajan. (1990) \"The Development of a World Class Othello \nProgram.\" Artificial Intelligence 43:21-36. \n\nLevesque, Hector. (1986) \"Making Believers out of Computers.\" Artificial Intelligence \n30:81-108. \n\n\f\n<a id='page-910'></a>\n\nLevy, David N. L. (1976) Computer Chess. Batsford. \nLevy, David N. L. (1988) Computer Games. Springer-Verlag. \nLevy, David N. L. (1988) Computer Chess Compendium. Springer-Verlag. \nLevy, David N. L. (1990) Heuristic Programming in Artificial Intelligence: the First \n\nComputer Olympiad. Ellis Horwood. \n\nLloyd, J. W. (1987) Foundations of Logic Programming. Springer-Verlag. \nLoomis, Lynn. (1974) Calculus. Addison-Wesley. \nLoveland, D. W. (1987) \"Near-Horn Prolog.\" Proceedings of the Fourth International \n\nConference on Logic Programming, 456-469. \nLuger, George F., and William A. Stubblefield, (1989) Artificial Intelligence and the \nDesign of Expert Systems. Benjamin/Cummings. \nMaier, David, and David S. Warren. (1988) Computing with Logic. Benjamin/Cummings \nMarsland, .. .. (1990) \"Computer Chess Methods.\" Entry in Encyclopedia of Artificial \nIntelligence, ed. Stuart C. Shapiro. Wiley. \nMartin, William .., and Richard J. Fateman. (1971) \"The MACSYMA System.\" \n\nProceedings of the Second Symposium on Symbolic and Algebraic Manipulation, \n\n59-75, ACM SIGSAM. \n\nMasinter, Larry, and Peter Deutsch, (1980) \"Local Optimization in a Compiler for \nStack-Based Lisp Machines.\" Proceedings of the Lisp and Functional Programming \nConference. \n\nMcAllester, David. (1982) \"Reasoning Utility Package User's Manual.\" AI Memo \n667, AI Lab, MIT. \n\nMcCarthy, John. (1958) \"An Algebraic Language for the Manipulation of Symbolic \nExpressions.\" AI Lab Memo no. 1, MIT. \n\nMcCarthy, John. (1960) \"Recursive functions of symbolic expressions and their \ncomputation by machine.\" Communications of the ACM 3, no 3:184-195. \n\nMcCarthy, John. (1963) \"A basis for a mathematical theory of computation.\" In \nComputer Programming and Formal Systems, ed. P. Braffort and D. Hirschberg. \nNorth-Holland. \n\nMcCarthy, John. (1968) \"Programs with Common Sense.\" In Minsky 1968. Reprinted \nin Brachman and Levesque 1985. \n\n\f\n<a id='page-911'></a>\n\nMcCarthy, John. (1978) \"History of Lisp.\" InHistory of Programming Languages, ed. \nRichard W. Wexelblat. Academic Press. Also in ACM SIGPLAN Notices 13, \nno. 8. \n\nMcCarthy, John, P. W. Abrahams, D. J. Edwards, P. A. Fox, T. P. Hart, and M. J. Levin. \n(1962) Lisp 1.5 Programmer's Manual. MIT Press. \n\nMcDermott, Drew. (1978) \"Tarskian Semantics, or No Notation without Denotation!\" \nCognitive Science, 2:277-282. Reprinted in Grosz, Sparck-Jones and \nWebber 1986. \n\nMcDermott, Drew. (1987) \"A Critique of Pure Reason.\" Computational Intelligence \n3:151-160. \n\nMeyer, Bertrand. (1988) Object-oriented Software Construction. Prentice-Hall. \n\nMichie, Donald. (1968) \"Memo Functions and Machine Learning.\" Nature 218:1922. \n\n\nMiller, Molly M., and Eric Benson. (1990) Lisp Style & Design. Digital Press. \n\nMinsky, Marvin. (1968) Semantic Information Processing. MIT Press. \n\nMiranker, Daniel. (1990) TREAT: A New and Efficient Match Algorithm for AI Production \nSystems. Pitman. \n\nMoon, David. (1986) \"Object-Oriented Programming with Flavors.\" Proceedings of \nthe ACM Conference on Object-Oriented Systems, Languages and Applications. \n\nMoon, David and Richard Stallman and Daniel Weinreb. (1983) The Lisp Machine \nManual. AILab, MIT. \n\nMoore, Robert C. (1982) \"The Role of Logic in Knowledge Representation and \nCommonsense Reasoning.\" Proceedings oftheAAAI-82. Reprinted in Brachman \nand Levesque 1985. \n\nMoses, Joel. (1967) \"Symbolic Integration.\" Report no. MAC-TR-47, Project MAC, \nMIT \n\nMoses, Joel. (1975) \"A MACSYMA Primer.\" Mathlab Memo no. 2, Computer Science \nLab, MIT. \n\nMueller, Robert .., and Rex L. Page. (1988) Symbolic Computing with Lisp and Prolog. \nWiley. \n\nMusser, David R., and Alexander A. Stepanov. (1989) The ADA Generic Library. \nSpringer-Verlag. \n\n\f\n<a id='page-912'></a>\n\nNaish, Lee. (1986) Negation and Control in Prolog. Springer-Verlag Lecture Notes in \nComputer Science 238. \n\nNewell, Alan, J. C. Shaw, and Herbert A. Simon. (1963) \"Chess-Playing Programs \nand the Problem of Complexity.\" In Feigenbaum and Feldman 1963,39-70. \n\nNewell, Alan, and Herbert A. Simon. (1963)\" GPS, A Program that Simulates Human \nThought.\" In Feigenbaum and Feldman 1963, 279-293. Reprinted in Allen, \nHendler, and Tate 1990. \n\nNewell, Alan, and Herbert A. Simon, (1972) Human Problem Solving. Prentice-Hall. \n\nNilsson, Nils. (1971) Problem-Solving Methods in Artificial Intelligence. McGraw-Hill. \n\nNorvig, Peter. (1991) \"Correcting a Widespread Error in Unification Algorithms.\" \nSoftware Practice and Experience 21, no. 2:231-233. \n\nNygaard, Kristen, and Ole-Johan Dahl. (1981) \"SIMULA 67.\" In History of Programming \nLanguages, ed. Richard W. Wexelblat. \n\nO'Keefe, Richard. (1990) The Craft of Prolog. MIT Press. \n\nPearl, Judea. (1984) Heuristics: Intelligent Search Strategies for Computer Problem Solving. \nAddison-Wesley. \n\nPearl, Judea. (1988) Probabilistic Reasoning in Intelligent Systems: Networks of Plausible \nInference. Morgan Kaufmann. \n\nPearl, Judea. (1989) \"Bayesian and Belief-Functions Formalisms for Evidential Reasoning: \nA Conceptual Analysis.\" Proceedings, Fifth Israeli Symposium on Artificial \nIntelligence. Reprinted in Shafer and Pearl 1990. \n\nPereira, Fernando C. N., and Stuart M. Shieber. (1987) Prolog and Natural-Language \nAnalysis. Center for the Study of Language and Information, Lecture Notes \nno. 10. \n\nPereira, Fernando C. N., and David H. D. Warren. (1980) \"Definite clause grammars \nfor language analysis - a survey of the formalism and a comparison with \naugmented transition networks.\" Artificial Intelligence 13:231-278. Reprinted \nin Grosz et al. 1986. \n\nPerils, Alan. (1982) \"Epigrams on Programming.\" ACM SIGPLAN Notices 17, no. 9. \n\nPlaisted, David A. (1988) \"Non-Horn Clause Logic Programming Without Contrapositives.\" \nJournal of Automated Reasoning 4:287-325. \n\nQuillian, M. Ross. (1967) \"Word Concepts: A Theory of Simulation of Some Basic \nSemantic Capabilities.\" Behavioral Science 12:410-430. Reprinted in Brachman \nand Levesque 1985. \n\n\f\n<a id='page-913'></a>\n\nQuirk, Randolph, Sidney Greenbaum, Geoffrey Leech, and Jan Svartik. (1985) A \nComprehensive Grammar of the English Language. Longman. \nRamsey, Allan, and Rosalind Barrett. (1987) AI in Practice: Examples in Pop-11. Hal-\nstead Press. \nRich, Elaine, and Kevin Knight. (1991) Artificial Intelligence. McGraw-Hill. \nRisch, R. H. (1969) 'The Problem of Integration in Finite Terms.\" Translations of the \nA.M.S. 139:167-189. \nRisch, R. H. (1979) \"Algebraic Properties of the Elementary Functions of Analysis.\" \nAmerican Journal of Mathematics 101:743-759. \nRobinson, J. A. (1965) \"A Machine-Oriented Logic Based on the Resolution Principle,\" \nJournal of the ACM 12, no. 1:23-41. \nRosenbloom, Paul S. (1982) \"A World-Championship-Level Othello Program.\" Artificial \nIntelligence 19:279-320. \nRoussel, Phillipe. (1975) Prolog: manual de reference et d'utilization. Groupe d'lntelligence \nArtificielle, Universit&eacute; d'Aix-Marseille. \nRowe, Neal. (1988) Artificial Intelligence Through Prolog. Prentice-Hall. \nRuf, Erik, and Daniel Weise. (1990) \"LogScheme: Integrating Logic Programming \ninto Scheme.\" Lisp and Symbolic Computation 3, no. 3:245-288. \nRussell, Stuart. (1985) \"The Compleat Guide to MRS.\" Computer Science Dept. \nReport no. STAN-CS-85-1080, Stanford University. \n\nRussell, Stuart, and Eric Wefald. (1989) \"On Optimal Game-Tree Search using \nRational Meta-Reasoning.\" Proceedings of the International Joint Conference on \nArtificial Intelligence, 334-340. \n\nSacerdoti, Earl. (1974) \"Planning in a Hierarchy of Abstraction Spaces.\" Artificial \nIntelligence 5:115-135. Reprinted in Allen, Hendler, and Tate 1990. \nSager, Naomi. (1981) Natural Language Information Processing. Addison-Wesley. \n\nSamuel, A. L. (1959) \"Some Studies in Machine Learning Using the Game of Checkers.\" \nIBM Journal of Research and Development 3:210-229. Reprinted in Feigenbaum \nand Feldman 1963. \n\nSangal, Rajeev. (1991) Programming Paradigms in Lisp. McGraw Hill. \nSchank, Roger C, and Kenneth Mark Colby. (1973) Computer Models of Thought and \nLanguage. Freeman. \n\n\f\n<a id='page-914'></a>\n\nSchank, Roger C, and Christopher Riesbeck. (1981) Inside Computer Understanding. \nLawrence Erlbaum. \n\nSchmolze, J. G., and T. A. Lipkis. (1983) \"Classification in the KL-ONE Knowledge \nRepresentation System.\" Proceedings of the Eighth IJCAL 330-332. \n\nSedgewick, Robert. {1988) Algorithms. Addison-Wesley. \n\nShannon, Claude E. (1950a) \"Programming a Digital Computer for Playing Chess.\" \nPhilosophy Magazine 41:356-375. \n\nShannon, Claude E. (1950b) \"Automatic Chess Player.\" Scientific American, Feb., \n182. \n\nShebs, Stan T., and Robert R. Kessler. (1987) \"Automatic Design and Implementation \nof Language Data Types.\" SIGPLAN 87 Symposium on Interpreters and \nInterpretive Techniques (ACM SIGPLAN Notices 22, no. 7:26-37. \n\nShapiro, Stuart C. (ed.). (1990) Encyclopedia of Artificial Intelligence. Wiley. \n\nShafer, Glenn, and Judea Pearl. (1990) Readings in Uncertain Reasoning. Morgan \nKaufmann. \n\nShell, B. A. (1983) \"Power Tools for Programmers.\" Datamation, Feb., 131-144. \n\nShortliffe, Edward H. (1976) Computer-Based Medical Consultation: MYCIN. American \nElsevier. \n\nShortliffe, Edward H., and Bruce G. Buchanan (1975) \"A Model of Inexact reasoning \nin Medicine.\" Mathematical Biosciences, 23:351-379. Reprinted in Shafer and \nPearl 1990. \n\nSlade, Richard. (1987) The . Programming Language: A Dialect of Lisp. Prentice Hall. \n\nSlagle, J. R. (1963) \"A heuristic program that solves symbolic integration problems in \nfreshman calculus.\" InComputers and Thought, ed. Feigenbaum and Feldman, \n191-203. Also in Journal of the ACM 10:507-520. \n\nSpiegelhalter, David J. (1986) \"A Statistical View of Uncertainty in Expert Systems.\" \nIn Artificial Intelligence and Statistics, ed. W. Gale. Addison-Wesley. Reprinted \nin Shafer and Pearl 1990. \n\nStaples, John, and Peter J. Robinson. (1988) \"Efficient Unification of Quantified \nTerms.\" Journal of Logic Programming 5:133-149. \n\nSteele, Guy L., Jr. (1976a) \"LAMBDA: The Ultimate Imperative.\" AI Lab Memo 353, \nMIT. \n\n\f\n<a id='page-915'></a>\n\nSteele, Guy L., Jr. (1976b) \"LAMBDA: The Ultimate Declarative.\" AI Lab Memo \n379, MIT \n\nSteele, Guy L., Jr. (1977) \"Debunking the 'Expensive Procedure Call' Myth or. Procedure \nCall Implementations Considered Harmful or, LAMBDA: The Ultimate \nGOTO.\" AI Lab Memo 443, MIT \n\nSteele, Guy L., Jr., (1978) \"Rabbit: a Compiler for Scheme (A Study in Compiler \nOptimization).\" AI Lab Technical Report 474, MIT. \n\nSteele, Guy L. Jr., (1983) \"Compiler optimization based on viewing lambda as \nRename Plus Goto.\" In AI: An MIT Perspective, vol. 2. MIT Press. \n\nSteele, Guy L. Jr., (1984) Common Lisp the Language. Digital Press. \n\nSteele, Guy L. Jr., (1990) Common Lisp the Language, 2d edition. Digital Press. \n\nSteele, Guy L., Jr., and Gerald J. Sussman. (1978) \"The revised report on Scheme, a \ndialect of Lisp.\" AI Lab Memo 452, MIT. \n\nSteele, Guy L., Jr., and Gerald J. Sussman. (1978) \"The art of the interpreter, or the \nmodularity complex (parts zero, one, and two).\" AI Lab Memo 453, MIT. \n\nSteele, Guy L., Jr., and Gerald Jay Sussman. (1979) \"Design of LISP-Based Processors \nor, SCHEME: A Dielectric LISP or. Finite Memories Considered Harmful or, \nLAMBDA: The Ultimate Opcode.\" AI Lab Memo 379, MIT. \n\nSteele, Guy L., Jr., and Gerald J. Sussman. (1980) \"Design of a Lisp-Based Processor.\" \nCommunications of the ACM 23, no. 11:628-645. \n\nStefik, Mark, and Daniel G. Bobrow. (1986) \"Object-Oriented Programming: Themes \nand Variations.\" AI Magazine 6, no. 4. \n\nSterling, Leon, and Ehud Shapiro. (1986) The Art of Prolog. MIT Press. \n\nSterling, L., A. Bundy, L. Byrd, R. O'Keefe and B. Silver. (1982) \"Solving Symbolic \nEquations with PRESS.\" In Computer Algebra, Lecture Notes in Computer Science \nNo. 144, ed. J. Calmet, 109-116. Springer-Verlag. Also in Journal of Symbolic \nComputation 7 (1989):71-84. \n\nStickel, Mark. (1988) \"A Prolog Technology Theorem Prover: Implementation by an \nExtended Prolog Compiler.\" Journal of Automated Reasoning 4:353-380. \n\nStoyan, Herbert. (1984) \"Early Lisp History.\" Proceedings of the Lisp and Functional \nProgramming Conference, 299-310. \n\nStroustrup, Bjarne. (1986) The C++ Programming Language. Addison-Wesley. \n\n\f\n<a id='page-916'></a>\n\nSussman, Gerald J. (1973) A Computer Model of Skill Acquisition, Elsevier. \n\nTanimoto, Steven. (1990) The Elements of Artificial Intelligence using Common Lisp, \nComputer Science Press. \n\nTate, Austin. (1977) \"Generating Project Networks.\" IJCAI-77, Boston. Reprinted \nin Allen, Hendler, and Tate 1990. \n\nTater, Deborah G. (1987) . Programmer's Guide to Common Lisp, Digital Press. \n\nThomason, Richmond. (1974) Formal Philosophy-Selected Papers of Richard Montague. \nYale University Press. \n\nTouretzky, David. (1989) Common Lisp: A Gentle Introduction to Symbolic Computation. \nBenj amin/Cummings. \n\nTversky, Amos, and Daniel Kahneman. (1974) \"Judgement Under Uncertainty: \nHeuristics and Biases.\" Science 185:1124-1131. Reprinted in Shafer and Pearl \n1990. \n\nTversky, Amos, and Daniel Kahneman. (1983) \"Extensional Versus Intuitive Reasoning: \nThe Conjunction Fallacy in Probability Judgement.\" Psychological Review \n90:29-315. \n\nTversky, Amos, and Daniel Kahneman. (1986) \"Rational Choices and the Framing \nof Decisions.\" Journal of Business 59:S251-S278. Reprinted in Shafer and Pearl \n1990. \n\nUngar, David. (1984) \"Generation Scavenging: A Non-Disruptive High Performance \nStorage Reclamation Algorithm.\" In Proceedings of the ACM SIGSOFT/ \nSIGPLAN Software Engineering Symposium on Practical Software Development Environments \n(Pittsburgh, Pa., April), 157-167. ACM SIGPLAN Notices 19, no. 5. \n\nvan Emden, Maarten H., and Keitaro Yukawa. (1987) \"Logic Programming with \nEquations.\" Journal of Logic Programming 4:265-288. \n\nvan Melle, W. J. (1980) System Aids in Constructing Consultation Programs. UMI \nResearch Press. \n\nVan Roy, Peter L., (1990) \"Can Logic Programming Execute as Fast as Imperative \nProgramming?\" Report UCB/CSD 90/600, University of California, Berkeley. \n\nVygotsky, Lev Semenovich. (1962) Thought and Language. MIT Press. \n\nWaibel, Alex, and Kai-Fu Lee (1991) Readings in Speech Understanding. Morgan \nKaufmann. \n\n\f\n<a id='page-917'></a>\n\nWaldinger, Richard. (1977) \"Achieving Several Goals Simultaneously.\" In Machine \nIntelligence 8. Ellis Horwood Limited. \n\nWalker, Adrian, Michael McCord, John F. Sowa, and Walter G. Wilson. (1990) \nKnowledge Systems and Prolog. Addison-Wesley. \n\nWaltz, David I. (1975) \"Understanding Line Drawings of Scenes with Shadows.\" In \nThe Psychology of Computer Vision, ed, Patrick H. Winston. McGraw-Hill. \n\nWaltz, David I. (1990) \"Waltz Filtering.\" InEncyclopedia of Artificial Intelligence, ed. \nStuart C. Shapiro. Wiley. \n\nWand, Mitchell. (1980) \"Continuation-Based Program Transformation Strategies.\" \nJournal of the ACM 27, no. 1:174-180. \n\nWarren, David H. D. (1974a) \"WARPLAN: A System for Generating Plans.\" Department \nof Computational Logic Memo 76, AI, Edinburgh University. \n\nWarren, DavidH. D. (1974b) \"ExtractfromAPIC Studies in Data Processing, No. 24.\" \nReprinted in Allen, Hendler, and Tate, 1990. \n\nWarren, David H. D. (1979) \"Prolog on the DECsystem-10.\" In Expert Systems in the \nMicro-Electronic Age, ed. Donald Michie. Edinburgh University Press. \n\nWarren, David H. D. (1983) An abstract Prolog instruction set. Technical Note 309, \nSRI International. \n\nWarren, David H. D., L. M. Pereira, and Fernando C. N. Pereira. (1977) \"Prolog-the \nLanguage and its Implementation Compared with Lisp.\" Proceedings of the \nACM SIGART-SIGPLAN Symposium on AI and Programming Languages. \n\nWarren, David H. D., and Fernando C. N. Pereira. (1982) \"An Efficient Easily Adaptable \nSystem for Interpreting Natural Language Queries.\" American Journal of \nComputational Linguistics, 8, nos.3-4:110-122. \n\nWaterman, David A. (1986) A Guide to Expert Systems. Addison-Wesley. \n\nWaters, Richard C. (1991) \"Supporting the Regression Testing of Lisp Programs.\" \nLisp Pointers 4, no. 2:47-53. \n\nWegner, Peter. (1987) \"Dimensions of object-based language design.\" ACM SIGPLAN \nNoHces, 168-182. \n\nWeinreb, Daniel, and David A. Moon (1980) \"Flavors: Message Passing in the Lisp \nMachine.\" AI Memo no. 602, Project MAC, MIT. \n\nWeiss, Sholom M., and Casimar A. Kulikowski. (1984) A Practical Guide to Designing \nExpert Systems. Rowman & Allanheld. \n\nWeissman, Clark. (1967) Lisp 1.5 Primer. Dickenson. \n\n\f\n<a id='page-918'></a>\n\nWeizenbaum, Joseph. (1966) \"ELIZA - A computer program for the study of natural \nlanguage communication between men and machines.\" Communications of the \nACM 9:36-45. \n\nWeizenbaum, Joseph. (1976) Computer Power and Human Reason. Freeman. \nWhorf, Benjamin Lee. (1956) Language, Thought, and Reality. MIT Press. \nWilensky, Robert. (1986) Common LISPcraft. Norton. \nWinograd, Terry. (1983) Language as a Cognitive Process. Addison-Wesley. \nWinston, Patrick H. (1975) The Psychology of Computer Vision. McGraw-Hill. \nWinston, Patrick H. {19M) Artificial Intelligence. Addison-Wesley. \nWinston, Patrick H., and Bertold .. P. Horn. (1988) Lisp, 3d ed. Addison-Wesley. \nWirth, N. (1976) Algorithms -f Data Structures = Programs. Prentice Hall. \nWong, Douglas. (1981) \"Language Comprehension in a Problem Solver.\" Proceed\n\n\nings of the International joint Conference on Artificial Intelligence, 7-12. \n\nWoods, William A. (1970) \"Transition Network Grammars for Natural Language \nAnalysis.\" Communications of the ACM 13:591-606. Reprinted in Grosz et al. \n1986. \n\nWoods, William A. (1975) \"What's in a Link: Foundations for Semantic Networks.\" \nIn Representation and Understanding, ed. D. G. Bobrow and A. M. Collins. \nAcademic Press. \n\nWoods, WilHam A. (1977) \"Lunar Rocks on Natural English: Explorations in Natural \nLanguage Question Answering.\" In Linguistic Structures Processing, ed. \n\nA. Zamponi. Elsevier-North-Holland. \nZabih, Ramin, David McAllester, and David Chapman. (1987) \"Non-Deterministic \nLisp with Dependency-Directed Backtracking.\" Proceedings oftheAAAI. \n\nZadeh, Lotfi. (1978) \"Fuzzy Sets as a Basis for a Theory of PossibiUty.\" Fuzzy Sets \nSystems, 1:3-28. \n\nZucker, S. W. (1990) \"Vision, Early.\" In Encyclopedia of Artificial Intelligence, ed. \nStuart C. Shapiro. Wiley. \n\n\f\n## Index\n<a id='page-919'></a>\n\n1,420 \n&al1ow-other-keys, 101 \n&aux,102 \n&body, 102 \n&key,98 \n&optional, 98 \n&rest,101 \n0,10 \n*abbrevs*,740 \n*acc*, 848 \n*bigger-grammar*, 43 \n^bindings*, 300 \n*board*, 623,624 \n*citiesM97 \n*clock*, 623,624 \n*db-predicates*,360,361 \n*dbg-ids*, 124 \n*debug-io*,124 \n*depth-incr*,484 \n*depth-max*,484 \n*depth-start*, 484 \n*edge-table*, 639 \n*examples*, 708 \n*grammar*, 657 \n*grammarl*, 657 \n*grammar3*, 657 \n*grammar4*, 661 \n*i nfi x->prefi X-rules*, 249 \n*1 abel-num*, 786,788 \n\n*maze-ops*, 134 \n*move-number*, 623,624 \n*occurs-check*, 356,361 \n*open-categories*,664 \n*ops*, 114,127 \n*package*, 835 \n*pl y-boards*, 623,634 \n*predicate*, 421 \n*primitive-fns*, 786,823 \n*primitives*,489 \n*print-gensym*, 855 \n*print-level*, 379 \n*profi 1ed-functi ons*, 290 \n*readtable*, 821 \n*rules-for*, 297 \n*scheme-procs*,757,759 \n*scheme-readtable*, 821 \n*school-ops*,117 \n*search-cut-off*, 483 \n*simple-grammar*, 39 \n*s i mpl i f i cat i on- rul es*, 243,247,249 \n*standa rd-output*, 124,888 \n*state*,114 \n*static-edge-table*,643 \n*student-rules*, 221 \n*systems*, 892 \n*trail*, 379,391 \n*uncompiled*, 408 \n*uniq-atom-table*, 334 \n\n\f\n<a id='page-920'></a>\n\n*un1q-cons-table*,334 \n*va.-counter*, 379 \n*vars*,340 \n*weights*,609 \n*world*,498,500 \n,, 68 \n.@, 68 \n-->,690 \n-if, 61 \n-if-not, 61 \n:-,690 \n: LABEL, 819 \nrafter, 447 \n: before, 447 \n: end keywords, 895 \n: ex, 708,744 \n: pass, 394 \nrprint-function, 379,499 \nr sem, 705 \nr test, 128 \nrtest-not,100 \n\n<-, 351,360,361,373,399 \n=,374,395,406,745 \n=/2,414 \n==>,705,707 \n>-num, 894 \n?,379 \n?*,183 \n?+,183 \n?-,361,363,364,373,391 \n??,183,494 \n?and,183 \n? if, 183 \n?is,183 \n?not, 183 \n?or, 183 \n#',14,92 \n#+, 292 \n#-,292 \n#.,340,645 \n#d,822 \n#f, 754,822 \n\n#t, 754,822 \n&rest, 754 \n\\+,415 \n^243 \n~&,84 \n-{...-}, 85,230 \n~^85 \n~a,84,230 \n~f,84 \n~r,84 \n~s,84 \n10*N+D,670 \n68000 assembler, 319 \n88->h8,622,623 \n\nA, 660 \na, 494 \na*-search, 209 \nA+, 660 \na-lists, 74 \nAit-Kaci, Hassan, 385,426,504 \nabbrev, 740 \nabbreviations, 732,739 \nAbelson, Harold, 213,307,367, \n\n383,511,777,825 \nabstract machine, 810 \nabstraction, 423 \nABSTRIPS, 147 \naccount, 436,445 \naccount-deposit,437 \naccount - i nterest,437 \naccount-wi thdraw,437 \naccumulator, 329,686,698 \naccumulators, 63 \naccusative case, 717 \nachi eve, 114,140 \nachieve-all, 120,128,139 \nachieve-each,139 \naeons, 50 \naction-p,136 \nActors, 457 \nAda, 27,459,837 \n\n\f\n<a id='page-921'></a>\n\nadd-body,843 \nadd-clause, 360,361,408 \nadd-examples, 709 \nadd-fact, 486,490 \nadd-noun-form, 742 \nadd-test,843 \nadd-var, 843 \nadd-verb, 742 \nadder, 92 \nAdj, 38 \nadj, 716,731 \nAdj*, 38 \nadjectives, 738 \nadjunct, 716, 719,720,723 \nadjuncts, 718 \nadverb, 716,732 \nadverbial phrase, 723 \nadverbs, 723, 738 \nadvp, 716 \nAho, A. v., 307 \n\nair-distance, 201 \nM, 60,678 \n\nall-directions,601,602 \nall-parses, 675 \nal 1- squares, 602,603,631 \nAllen, James, 748 \nAllen, John, 148, 777,825 \nalpha cutoff, 615 \nalpha-beta, 602,616 \nalpha-beta-searcher,602,616 \nalpha-beta -sea rcher2,623,631 \nalpha-beta-sea rcherS,623,636 \nalpha-beta2,623,631 \nalpha-betas, 623,635 \nalways, 832,847 \nAmarel, Saul, 132 \nambiguity, 669 \nambi guous-vertex-p,569,570 \nand, 53,415,429,485,764 \nand*/2,708 \nAnderson, John, 655 \nanon-vars-in,433 \n\nanonymous-va ri ables-i .,391, \n\n400,433 \nantecedent rules, 561 \nany-legal-move?, 602,606 \nappend, 11,69,848 \nappend-pi pes,285 \nappendl,659 \napplicable-ops,213 \napply, 18,91 \napply-op,115,129 \napply-scorer, 672 \napply-semantics, 668 \nappropriate-ops,141 \nappropriate-p,114,129 \napropos, 86,878 \narch, 587,589,590,593 \naref, 73 \narg-count,795,799 \nargl, 812 \narg2,674,812 \narg3,812 \narg/, 795 \nARGS, 785,805,814,815 \nargs, 390,391, 795,812 \nargs->prefix, 513,520 \nargument \n\nkeyword, 322,877 \noptional, 322,412,877 \nrest, 322,805 \n\nAristotle, 111, 147 \n\narrow (=^), 5 \n\nart, 716,731 \nArticle, 36 \narticles, 738 \nas, 845 \nask-vals,533,539 \nasm-first-pass,795,812 \nasm-second-pass,795,813 \nassemble, 795,812 \nassembler, 805 \nassert,88 \nassert-equal,295 \n\n\f\n<a id='page-922'></a>\n\nassoc, 73 \nasymptotic complexity, 274 \natom/1,745 \nattributive adjectives, 749 \naudited-account, 447 \naugmented transition network \n(ATN), 712 \nAutoLisp, ix \naux, 716,731 \naux-inv-S, 716,727 \nauxiliary verb, 735 \naverage, 87 \n\nbackquote, 68 \nbackquote, 822 \nbacktrack points, 420 \nbacktrack-points,772 \nbacktracking, 349,367,372, 772 \nautomatic, 349 \nchronological, 773 \nBackus-Naur Form (BNF), 678 \nbackward-chaining, 351,536,543 \nBacon, Francis, 460 \nbag, 416 \nbagof/3,416 \nbananas, 132 \nbank-account,92 \nBarrett, Rosalind, xv, 594, 748 \nBatali,John, 810 \nBayes's law, 557 \nBayesian classification, 652 \nbe, 735 \nbeam-problem, 452 \nbeam-search, 196 \nbegin, 754 \nbelief functions, 557 \nbenchmark, 295,411,522 \nBerkeley, California, 633 \nBerlin, Andrew, 267 \nbest-first-search, 194 \nbest-problem, 452 \nbeta cutoff, 615 \n\nbetter-path, 210 \nbfs-problem, 450 \nBill, 597,636,651 \nbinary-exp-p,229,242 \nbinary-tree,192 \nbinary-tree-eql-best-beam-problem, \n452 \nbi na ry-1 ree-problem, 451 \nbind-new-variables,391,405 \nbind-unbound-vars,391,398 \nbi nd- va r i abl es -1 ., 391,404 \nbinding-val,157,391 \nbinomial theorem, 524 \nbit, 73 \nbit sequence, 79 \nbit vector, 79 \nblack, 601,602 \nblock, 65 \nblock, 754,767 \nblocks world, 136,211 \nblood test, 558 \nBOA constructor, 221 \nboard, 601,602 \nBobrow, Daniel, 219,234,458 \nbody, 351 \nbound-p, 377 \nboundary line, 566 \nBoyer, R. S., 425 \nBrachman, Ronald J., 503 \nbracketing, 675 \nBratko, Ivan, 383 \nbreadth-first-search, 192 \nbreak, 87 \nbref, 601,602 \nBrooks, Rodney .., 259 \nBrown, Allen, 142 \nBuchanan, Bruce G., 557,558 \nbuild-cases,276 \nbuild-code, 276 \nbuild-exp, 302 \nbutlast, 877 \nButler, Nicholas Murray, 530 \n\n\f\n<a id='page-923'></a>\n\nbyte-code assembly, 811 \n\nC, ix, 837 \nC++, 459 \ncache, 536 \ncalculus, 252 \nCALL, 785,811,820 \ncall-loop-fn, 844 \ncall-next-method, 445 \ncall-with-current-continuation, \n372, 770 \ncal 1/1,414, 745 \ncal 1 /cc, 425, 754, 757, 776, 780,810 \nCALLJ, 814,820 \nCannon, Howard, 457 \ncanon, 513,521 \ncanon->prefi ., 513,520 \ncanon-si mpl if i er, 513,521 \ncanonical simpHfication, 510 \ncar, 14,69 \nCarbonell, Jamie, 167 \ncardinal, 716,732 \nCarlyle, Thomas, 175 \ncase, 53,764,879 \ncase sensitive, 8 \nCassio, 597 \nCatalan Numbers, 663 \ncatch, 623, 769,837 \ncatch point, 410 \ncategories, 485 \nclosed-class, 664 \nopen-class, 664 \ncategory names, 660 \nCC, 810,815 \ncease, 88 \ncdr, 14,69 \ncdr-coding, 522 \nCerf, Jonathan, 637 \ncerror, 87 \ncertainty factors, 532 \ncf->english,533,551 \ncf-and, 533,535 \n\ncf-cut-off, 533,536 \ncf-or, 533,535 \ncf-p, 533,536 \nchange a field, 873 \nChapman, David, 148 \nchar, 73 \nchar-ready?,756 \nchar?, 756 \nCharniak, Eugene, xiii, xv, 345, 383, \n504, 586,594,823,887 \nchart parsers, 679 \nChat-80, 711 \ncheck-condi ti ons,533,549 \ncheck-di agram, 569,588 \ncheck-reply,533,540 \ncheck-type,88 \ncheckers, 651 \nCheeseman, Peter, 558 \nchess, 652 \nchoice of names, 888 \nChomsky, Noam, 655 \nchoose-first,773 \nChurch, Alonzo, 20 \nChurch, Kenneth, 663 \ncity, 197,198 \nclass, 436 \nvariable, 436 \nclause, 350, 723 \nclause,361,716, 724 \nclause-body,360 \nclause-head,360 \ncl auses - wi th-ari ty, 390,391 \nclear-abbrevs,740 \nclear-db, 361,362,533,537 \nclear-dtrees,476 \nclear-examples, 708 \nclear-grammar, 744 \nclear-lexicon,744 \nclear-m-array, 318 \nclear-memoize, 275 \nclear-predi cate,361,362 \nclear-rul es, 533,545 \n\n\f\n<a id='page-924'></a>\n\ncliche, 60,176 \ndinger, William, 777 \nClocksin, William R, 382 \nCLOS, xii, 30, 435, 439, 445-446, 448, \n453-454,456,458-459 \nflaw in, 448 \nclosed world assumption, 466 \nclosure, 92,457 \nClowes, Maxwell B., 594 \nclrhash, 74 \nCMULisp, 327 \ncoef, 512-514 \ncoefficients of a polynomial, 510 \nCoelho, Helder, 147,383 \nCohen, Jacques, 426,504 \nColby, Kenneth, 153,167,655 \ncollect, 848,863 \ncollect-sems, 707 \ncollecting,849 \nCollins, Allan, 167 \nColmerauer, Alain, 382,504, 684, 711 \ncombine-a11,45 \ncombine-all-pi pes, 286 \ncombine-edge-moves, 642 \ncombine-quasi quote,824 \ncombine-rules, 304 \ncommand, 725 \ncomment, 6 \ncommon cases, 717 \nCommon Lisp, vii-xiv, 4, 7-9,12, 20, \n24, 25, 27, 29, 30, 48-51, 55, \n57, 62, 66, 68, 72, 74, 76, 78, \n79, 81, 82, 84, 85, 88, 91, 93, \n94,97,98,101-103,106,110, \n112, 113,115, 120, 122, 155, \n156, 161,165, 178, 182, 203, \n245, 246, 266-268, 278, 279, \n281, 292, 317, 318, 321, 322, \n330, 346, 372, 411, 419, 435, \n438, 439, 445, 504, 514, 522, \n574, 623, 632, 652, 666, 678, \n753-755, 759, 760, 762, 766, \n\n767, 769, 771, 774, 780, 783, \n811, 822, 823, 825, 826, 828, \n830, 834-840, 843, 852, 853, \n855, 857, 872, 876, 877, 879, \n882-885,891,894,895,900 \nCommonLoops, 458 \ncommutative-p, 229 \ncomp, 786,798 \ncomp-begin, 786,787,800 \ncomp-const, 795,800 \ncomp-funcall,795,803 \ncomp-go, 795 \ncomp-if, 786,787,801,831 \ncomp-lambda, 786,788 \ncomp-list,795,800 \ncomp-show, 786, 789 \ncomp-var, 795,800 \ncompact disc player, 665 \ncompilation, 526 \ncompi1e-a11 -rules - i ndexed,306 \ncompi 1 e-arg, 391,395,399,404 \ncompile-args,302 \ncompi 1 e-body, 391,394,405,422 \ncompile-call,391,394 \ncompi 1 e- cl ause, 391,394,397,406 \ncompile-exp,301 \ncompile-file,645 \ncompile-if, 391,403 \ncompi1e- i ndexed-rule, 304 \ncomp i 1 e - . red i ca te, 391,392,397,422 \ncompile-rule, 276,300 \ncompile-rule-set,304 \ncompi 1 e-uni fy, 391,395,402 \ncomp i 1 e - un ify- va r i a bl e, 391,403 \ncompiled \nfor effect, 792 \nfor value, 792 \ncompiler, 275,298 \ncontext-free, 798 \ncontext-sensitive, 798 \nversus interpreter, 277 \ncompiler, 786,788 \n\n\f\n<a id='page-925'></a>\n\ncomp! ement, 101,716,728 \ncomplements, 718 \ncomplete-parses, 658 \ncompose, 177,217 \ncomputation on lists, 6 \ncomputer vision, 565 \nconcat, 411,686 \nconcave line, 566 \nconcl ude, 533,547 \ncond, 53, 764,782,878 \nconj-category, 711 \nconj-rule, 710 \nconjuncts, 708 \ncons, 11,69,328 \ncons cells, 69 \nconsistency, 464 \nconsistency checker, 90 \nconsi stent-1abeli ngs,569,572 \nconsp, 69 \nCONST, 785,812,814 \nconstants, 889 \nconstraint propagation, 568 \nconstruct-di agram, 569,576 \nconstruct-vertex, 569,576 \ncontext, 533,542 \ncontexts, 538,541 \ncontinuation, 300,367 \ncontinue-p, 369 \nconvert-number, 829 \nconvert-numbers, 829 \nconvert-op,126 \nconvex line, 566 \nCooper, Thomas .., 266 \ncopula,735, 744 \ncopy-board, 602,603 \ncopy-poly,516 \ncopy-tree, 76 \ncorner-for, 642 \ncorner-p,642 \ncost-fn, 452,453 \nCotta, Jose, 147,383 \ncount, 62,848 \n\ncount-difference, 602,603 \ncount-edge-neighbors,643 \ncount-if,60 \ncounting, 849 \ncreate-list-of-equations,224 \ncross-product,622,623 \ncube, 575 \ncube-on-pi ate, 581 \ncurrent-state, 449 \ncut, 420 \n\nD, 660 \ndag, 345 \nDahl, Ole-Johan, 456 \ndata-driven dispatch, 394 \nDavenport, J. H., 259,260,528 \nDavis, Ernest, 503 \nDavis, Lawrence, 652 \nDavis, Randall, 549 \ndbg, 124 \ndbg-indent,124 \ndcg-normal-goal-p, 691 \ndcg-word-list-p, 691 \nde Moivre, 310 \ndebug,124 \ndebugging, 85 \ndecf,56 \ndecidability, 464 \ndeclaration, 875 \ndeclarative languages, 435 \ndeclared inline, 869 \ndef-attached-fn, 490 \ndef-cons-struct,347 \ndef-optimizer, 819 \ndef - prol og - compi 1 er -macro, 391,395 \ndef-scheme-macro,757,763 \ndefault rules, 561 \ndefclass,445 \ndefconstant,51,157 \ndefcontext, 533,542 \ndefdiagram, 569,575,588 \ndefine, 754,762,764,790 \n\n\f\n<a id='page-926'></a>\n\ndefine-class,440 \ndefi ne-enumerated-type,654 \ndefine-setf-method,514,884 \ndefine-system, 891,893 \ndefining enumerated, 652 \ndefinite clause grammar (DCG), \n690,711 \ndefinite integrals, 519 \ndefloop, 844,849 \ndefmacro, 51,66 \ndefmethod, 445,446 \ndef package, 836,891 \ndefparameter, 15,39,51 \ndefparm, 533,541 \ndefresource, 337 \ndefrule, 277,533,549,886 \ndefsetf, 514 \ndefstruct, 51 \ndefun, 12,51 \ndefun*, 327 \ndefun-memo, 273 \ndefvar, 39,51 \ndeg->radians,201 \ndegree, 512,513 \ndegree of a polynomial, 510 \nDeGroot, A. D., 652 \ndel ay, 281,762,765 \ndelay decisions, 25 \ndelegation, 436,442 \ndelete, 62 \ndel ete-trie, 344 \nDempster, 557 \ndense polynomials, 511 \ndepth-first-search, 191 \ndequeue,342 \nderef, 378 \nderef-copy, 417,430 \nderef-equal,414 \nderef-exp, 410 \nderiv, 257 \nderiv-divides, 257 \nderiv-poly,513,518 \n\nderivative-divides technique, 252 \ndescribe, 86,878 \ndestructive operations, 328 \nDet, 687-689,693,695,697,701, \n716, 721 \ndetermi ne-wi nner,57 \nDeutsch, Peter, 826 \ndeveloping an AI computer program, \n110 \ndfs-problem, 450 \ndiagram, 569,576 \ndiff, 194 \ndifference between relations and \nfunctions, 350 \ndifference list, 702 \ndiff erentiable field, 528 \ndifferentiation, 248 \ndirected acyclic graph (dag), 345,649 \ndisassemble,318 \ndisassembled code, 318 \ndiscrimination net, 345 \ndiscrimination tree, 472 \ndisjunction, 485 \ndisplace,781 \ndisplay, 804 \ndistance, 201 \ndistinguish unknown from false, 496 \nditransitive verbs, 712 \ndiv, 839 \ndivide-factors,255 \ndividing by zero, 233 \ndo, 59,852 \ndocumentation, 87,878 \ndocumentation string, 12 \ndol ist, 58 \ndotimes, 59 \ndotted pair notation, 69 \ndouble-float, 320 \nDowty, David R., 711 \nDoyle, Jon, 504 \nDrosophila melanogaster, 596 \ndtree, 476 \n\n\f\n<a id='page-927'></a>\n\ndtree-atom-fetch, 479 \ndtree-fetch, 479 \ndtree-index, 477,498 \nDubois, Didier, 558 \ndynamic extent, 771 \ndynamic typing, 27 \n\neach, 494 \nEarley,Jay,679 \nearth-diameter, 201 \neat-porridge, 89 \necase, 88 \necho question, 725 \nedge-and-x-1ists, 639 \nedge-index, 639 \nedge-move-probability,642 \nedge-stability, 639 \nEdinburgh Prolog, 425, 690 \nefficiency, 461 \nefficient-pat-match,332,333 \nEiffel, 455,459,863 \nElcock, E. W., 504 \nELIZA, xi, 151-154,159,163-166,168, \n\n169, 175, 178, 181, 184, 187, \n\n219-222, 234, 239, 240, 309, \n\n330,435 \nel iza, 164,177 \nelt, 73 \nElvis, 536 \nEmanuelson, P., 307 \nempty, 601,602 \nempty-pipe, 282 \nempty-queue-p, 342 \nEMYCIN, xii, 532-534, 536-538, 541, \n\n543,544,548-550,559-563 \nemycin, 533,548 \nencapsulate information, 448 \nend game, 649 \nend of file, 822 \nenqueue,342 \nensure-generic-fn,440 \nensure-generic-function,445 \n\nenumerate, 284 \nenumerated type, 599 \nenvironment, 758 \n\nglobal, 758 \neof, 821 \neof-object?, 821 \neq, 72 \neq?, 756 \neql, 72 \neql - problem,450 \nequal, 69,72 \nequal?, 756 \nequal p, 72 \nequiv, 832 \neqv?, 756 \nEratosthenes, 285 \nErnst, G.W., 147 \nerror, 838 \n\nhandler, 838 \n\nsignaling, 838 \nerror, 87 \nerror in transcribing, 588 \nerrors \n\nhandling, 837 \neval, 91,245 \neval - condition,533,546 \nevaluable,245 \nevaluation, 24 \n\nlazy, 307 \n\nrule for Lisp, 22 \neven?, 756 \nevery, 62 \nexamples of rules, 705 \nexecuting-p, 126 \nexercises \n\nlevel of difficulty, xv \nexistentials, 467 \nexit \n\nnonlocal, 768 \nexp, 242 \nexp-args,242 \nexp-p, 242 \n\n\f\n<a id='page-928'></a>\n\nexpand-pat-match-abbrev, 187 \nexpert system, 461,530 \nexpert-system shells, 531 \nexplanation, 531 \nexponent->prefi X, 513,520 \nexponentiation, 523 \nexpression, 5 \n\nderived, 762 \n\nlambda, 21 \n\nrational, 526 \n\nreading and evaluating, 24 \n\nspecial form, 9,22 \nexpressiveness, 461,464 \nextend-bindings,158,159,361 \nextend-env, 757,759 \nextend-parse, 659,668,671,681,682 \nextensibility, 29 \nextent, 93 \n\nfact-present-p,490 \nfactorize,254 \nfacts, 350 \nfail, 157,361,430,772 \nfailure continuations, 425 \nfalse, 532,533 \nfalse-p, 533,536 \nfast-time->seconds,292 \nf a st -1 i me-di f f erence, 292 \nFateman, Richard, 259, 265, 267, 511, \n\n522,524 \nFateman, Richard J., 528 \nFeigenbaum, Edward, 460 \nfetch, 478 \nfib, 269 \nFibonacci, 269 \nField, A. J., 307 \nFikes, Richard, 147,503 \nfill pointer, 330 \nfill-loop-template,842 \nfiller-gap dependency, 702 \nfilter, 285 \nfinal-value,602 \n\nfinally, 852 \nfind, 62 \nfind-all,101 \nfind-all-if, 100 \nfind-anywhere,255,391 \nfind-bracketing-piece,602,605 \nfind-if, 61 \nfind-labelings,569,586 \nfind-out, 533,545 \nfind-path,210 \nfind-trie,344 \nfind-vertex, 569,573 \nfinish-output,895 \nfinite verb, 722 \nfinite-binary-tree, 193 \nfirst, 10,69 \nfirst-class, 27 \nfirst-match-pos,185 \nfirst-name, 13,16 \nfirst-or -nil,658 \nFischer, Sylvia, 554 \nFisher, M.J., 504 \nFJUMP, 785,814,820 \nflatten, 165,329,347 \nflavors, 438,457 \nflet, 870 \n\nflexible flow of control, 531 \nfloat, 320 \nfloating-point numbers, 875 \nFN, 815 \nfn, 786,788,790 \nFodor, Jerry .., 655 \nfollow-arc, 344 \nfollow-binding,391,404 \nfor, 845 \nfor-each,756 \nforce, 281 \nformat, 84,230,739,839 \n\noption, 625 \nformat directives, 84 \nFORTRAN, 84,266,267,434,655 \nforward chaining, 351,485 \n\n\f\n<a id='page-929'></a>\n\nforward pruning, 647 \nfour semicolons, 891 \nfourth, 10 \nFowler, Henry Watson, 715 \nframes, 493 \nFrancis, 355 \nFRANZ LISP, ix \nfree-of, 255 \nfresh-line,84 \nFrisbee, 769 \nfront, 342 \nf rpoly, 522,528 \nfuncall, 91,693,828 \nfuncall-if,861 \nfunction, 79 \napplication, 23 \ndata-driven, 818 \ndestructive, 80,888 \nfirst-class, 27 \ngeneric, 322,436,439 \nhigher-order, 18,194,839 \nUst processing, 10 \nnew, 92,887 \nproperly tail-recursive, 794 \nproving correctness, 227 \nrecursive, 523 \nsequence, 852 \nshort, 887 \ntail-recursive, 63 \nfunction, 92,872 \nfunctional progranuning, 435 \nfunctionp, 283 \nfuzzy set theory, 461,558 \n\nGabriel, Richard, 522 \nGaller, B. .., 504 \ngame playing, 596 \ngarbage collector, 328 \nephemeral, 330,336 \ngenerational, 330 \nGazdar, Richard, 679,748 \ngen, 786,789 \n\ngen-args,795 \ngen-label,786,789 \ngen-set, 786,790,804 \ngen-var, 786,790 \ngeni, 795,819 \ngenerate, 40,41 \ngenerate-all,45,286 \ngenerate-tree,44 \ngeneration scavenging, 336 \ngeneric function, 436,439 \ngeneric operations, 811 \ngeneric-fn-p,440 \ngenetic learning, 651 \ngensym, 363 \nget, 894 \nget-abbrev, 740 \nget-binding, 157,361 \nget-cf,533,537 \nget-clauses,360,361 \nget-context-data,533,548 \nget-db, 533,537 \nget-dtree, 476 \nget-examples,708 \nget-fast-time, 292 \nget-gl obal - var, 757,759 \nget-method, 438 \nget-move, 602,607,625 \nget-optimizer, 819 \nget-parm, 533,541 \nget-rul es, 533,545 \nget-trie,344 \nget-vals,533,537 \nget-var, 757,759 \nget-world, 500 \ngethash,74 \nGinsberg, Matthew L., 214 \ngo, 754,837 \ngoal-p, 450 \nGoldberg, Adele, 457 \nGoldberg, David E., 652 \nGordon,, 558 \ngoto, 766,768 \n\n\f\n<a id='page-930'></a>\n\nGPS, xi, 109-121, 123, 125, 127, 129, \n130,132,133, 135,136,142, \n143, 145-147, 149, 175, 189, \n190,211,213,215,239,470 \nGPS, 114,127,130,135 \ngps, 367 \ngps-successors,212 \ngrammar \ncontext-free, 678 \ncontext-free phrase-structure, 35, \n686 \ndefinite clause (DCG), 690, 711 \nrule, 685 \nunification, 678 \ngrandfather, 385 \ngraph-search, 206 \nGreen, Cordell, 382 \nGreenbaum, Sidney, 748 \nground, 569,579 \ngrundy,312 \nGSET, 785,814,820 \nGuzman, Adolfo, 594 \nGVAR, 785,812,814 \n\nh8->88,622, 623 \nH&ouml;dobler, Steffen, 504 \nHafner, Carole, 30 \nHALT, 816 \nhalting problem, 511 \nhandle-conj, 711 handler-case, 178, \n839 \nHaraldsson, .., 307 \nHarrell, Steve, 457 \nHarris, Zellig S., 749 \nHarrison, P. G., 307 \nHarvey, Wilham D., 214 \nhas-variable-p,391,396 \nhash table, 74,296,477 \nHayes, Patrick, 469 \nhead, 351 \nhead, 282 \nHeckerman, David, 558 \n\nhelp-string,538 \nHendler, James, 148 \nHennessey, Wade L., xiv, 259,383 \nHewitt, Carl, 382,457 \nhigher-order predications, 485 \nHoare, C. A. R., 66 \nHockney, David, 509 \nHoddinott, P., 504 \nHorn clauses, 684 \nHorn, Bertold, xiv, 213,367,383,777 \nHuddleston, Rodney, 749 \nHuffman, David .., 594 \nHughes, R.J. M., 307 \nhuman, 602,607,622 \nhungry monkey, 132 \nhyphen before the p, 755 \n\nlago, 597,652 \nlago, 623,646 \nIago-eval,623,645 \nIBM 704,14 \nIdentity,669 \nidiom, 176 \nif, 16,424, 745, 754,851 \nignore,391 \nignore declaration, 410 \nignore-errors,838 \nimperative programming, 434 \nimport,836 \nimpossible diagram, 582 \n1mpossible-d1agram-p,570 \n1mposs i ble-vertex-p, 570 \nin-env-p, 786,791 \nin-exp, 228 \nin-integral-table?,258 \nin-package,835,891 \n1nc-profile-t1me, 294 \nincf, 56 \n1nd, 485,490 \nindefinite extent, 771 \ni ndex, 477,481,498 \nindex-new-fact, 492 \n\n\f\n<a id='page-931'></a>\n\ni ndex-rul es, 298 \nindexing, 297,335,526 \nindividuals, 485 \ninfectious blood disease, 552 \ninfinite set, 280 \ninfix notation, 240 \ninfix->prefix,240,241 \ninfix-funcall,667 \ninfix-scorer, 674 \ninflection, 722 \ninformation hiding, 436,454,835 \nIngalls, Daniel, 457 \nIngerman, Peter Z., 307 \ninheritance, 436,499 \ndata-driven, 443 \nfor classes, 444 \ngeneric, 443 \nmultiple, 436,457 \ninit-edge-table,640 \ninit-scheme-comp, 795,805,816 \ni .i t -s c heme-i. te rp, 757,760 \ni . i t - s c heme- . roc, 757,776 \ninitial-board,602,603 \ninitially,852 \ninline,293 \ninsert-path,210 \ninspect,87 \ninst-name,533,540 \ninstance, 436 \ninstance variable, 436 \ninstrument, 265 \ninstrumentation, 268 \ninteger,772 \ninteger?,756 \nintegers, 282,667,674 \nintegrals, 252 \nintegrate,256 \ni ntegrate-from-table, 258 \nintegrating polynomials, 519 \nintegration by parts, 260 \nintegration-table,257 \ninteractive environment, 28 \n\ni nteracti ve-i nterpreter,177, \n178,216 \n\nINTERLISP, ix \n\nintern,835 \ninternal definition, 779 \ninterning, 835 \ni nterp, 757,758,762,767,774 \ninterp-begin, 757,775 \ninterp-cal 1,757,775 \n\ninterpretation \ndeclarative, 351 \nprocedural, 351 \ninterpreter, 275 \ntail-recursive, 766 \nversus compiler, 277 \nintersperse, 520 \nintractable, 461 \nintransitive verbs, 693 \ninv-span, 674 \ninverse-op, 228 \nIPL,110 \ni rev, 412 \ni right, 374 \ni s, 192,203,533,547,795,813 \nis/2,418 \nisolate, 227 \niter-wide-search, 204 \n\niterative deepening, 205,482,646 \niterative widening, 204 \n\nJackson, Peter, 558 \nJaf far, Joxan, 504 \nJames, Glenn, 239 \nJames, Robert, 239 \n\nJUMP, 785,814,820 \n\nk*poly,513,517 \n\nk+poly, 513,516 \n\nKahneman, Daniel, 558 \nKay, Alan, 457 \n\nKay, Martin, 679 \n\nKCL, 428 \n\nKeene, Sonya, 458 \n\n\f\n<a id='page-932'></a>\n\nKernighan, .. W., viii \nkeyword, 98 \nkiller heuristic, 634 \nKinski, Natassja, 700 \nKL-ONE, 462,503 \nKleene star, 37 \nKleene, Stephen Cole, 38 \nKlier, Peter, 511 \nKnight, Kevin, 383,594 \nknowledge \ntechnical compendium, vii \nknowledge engineer, 548 \nknowledge representation, 461 \nknowledge-based system, 530 \nKnuth, Donald E., 652 \nKorf,R. E., 214 \nKornfeld, W. .., 504 \nKowalski, Robert, 382,465 \nKranz, David, 825 \nKreutzer, Wolfgang, xv, 213 \nKRYPTON, 503 \nKulikowski, Casimir .., 558 \n\nlabel-p, 786,791 \nlabel 8,762,870 \nlabels-for, 569,573 \nlambda, 20 \nlambda, 754,783 \nlambda expression, 21 \nLang, Kevin J., 458 \nLangacker, Ronand, 655 \nlanguage \ndeclarative, 435 \nframe, 462 \nhybrid representation, 462 \nnetwork-based, 462 \nobject-oriented, 462 \nprocedural, 462 \nLassez, Jean-Louis, 383,504 \nlast, 12,69,884 \nlast-name, 12 \nlastl,305, 757, 760 \n\nlast2,883 \nIdiff, 877 \nleaping before you look, 121 \nlearning, 651 \nLee, Kai-Fu, 636,637,651 \nLeech, Geoffrey, 748 \nleft-recursive rules, 681,705 \nlegal-moves, 602,607 \nlegal-nodes,623,632 \nlegal-p, 602,604 \nlen, 455 \nlength, 69,370 \nlength1, 58 \nlength1.1,58 \nlength1O, 63 \nlength11,63 \nlength12,64 \nlength2,58 \nlengths,59 \n1ength4,60 \nlengths,60 \nlengths,60 \nlength/,60 \nlengths, 61 \nlengthQ,62 \nlength=1, 255,276,496,757, 760 \nlet,41,764, 782 \nlet*,56, 764 \nletrec, 762,765 \nLevesque, Hector J., 503,504 \nLevy, David, 652 \nlexical closure, 92 \n1 exi ca1 - rul es, 658,664 \nlexicon, 732 \nlikes/2,389 \n1i mi ted -a ccount, 442,444,446 \nLincoln, Abraham, 75 \nline-diagram labeling problem, 565 \nlinear equations, 234 \nLipkis, T. .., 503 \nLIPS,376 \nLisp \n\n\f\n<a id='page-933'></a>\n\nevaluation rule for, 22 \n\nlexical rules for, 5 \nLisp 1.5, 777 \nlisp/2,418 \nlist \n\nassociation, 73,74,343,476 \ndifference, 702 \nprocessing function, 10 \nproperty, 74,476 \n\nlist, 11,69 \nlist*,67, 69 \nlist->string, 756 \nlist->vector, 756 \nlist-ref, 756 \nlist-tail,756 \nlistl, 804 \nlist2,804 \nlists, 804 \nlistp, 69 \n\nLloyd,]. W.,383,415 \nload, 645 \nlocal maximum, 197 \nlogic programming, 435 \nlogic puzzle, 373 \nlong-distance dependencies, 702 \nlookup, 157,361,896 \nloop, 842,864,878 \nLOOP FOR, 845 \nloop keywords, 844 \n\ndata-driven, 844 \n1 oop macro, 840 \nLOOP REPEAT, 845 \nloop-finish,847 \nloop-for-arithmetic, 846 \nloop-unless,851 \nlosing-value, 602,613 \nloss, 311,312 \nLoveland, D.W., 504 \nLSET, 785,814,820 \nLuger, George F., 558 \nLVAR, 785,811,814 \n\nmachine, 795,814 \nMacLachlan, Rob, 327 \nMACLISP, ix \nmacro, 66,853, 760 \n\nconditional read, 292 \n\ndefining, 763 \n\ndesign, 880 \nmacro-expansion, 778 \nMACSYMA, xi, xii, 151, 239, 259, 260, \n\n297,522,528 \nMahajan, Sanjoy, 636,651 \nMaher, Michael J., 504 \nMaier, David, 383 \nmain variable of a polynomial, 510 \nmain-op, 297 \nmain-var, 512-514 \nmaintenance, 177 \nmake-=, 391,394 \nmake-anonymous, 391,399 \nmake-a ugmented-dcg, 707 \nmake-block-ops, 137 \nmake-clause, 440 \nmake-copy-diagram, 569,577 \nmake-dcg, 691 \nmake-dcg-body, 692 \nmake-empty-nlist,476 \nmake-flips,602,605 \nmake-instance,445 \nmake-maze-op, 134 \nmake-maze-ops,134 \nmake-move, 602,604 \nmake-moves,312 \nmake-obsolete, 870 \nmake - pa rameters, 391,392 \nmake-pipe, 282,283 \nmake-poly, 513,514 \nmake-predi cate,391,392 \nmake-queue,342 \nmake-rat,526 \nmake-system, 893 \nmake-true-list,795 \nmake-variable, 225,340 \n\n\f\n<a id='page-934'></a>\n\nmap, 756,771 \nmap-edge-n-pieces,640 \nmap-i nterp, 757,775 \nmap-into,632,857 \nmap-path, 204 \nmap-pipe,285 \nmapc, 62 \nmapc- retri eve, 480,488 \nmapc-retri eve-i .-world, 501 \nmapcar, 14,62,864 \nmaphash, 74 \nmappend, 19,165,171 \nmappend-pipe, 286 \nMarsland, T. .., 652 \nMartin, William, 259,522,528 \nMasinter, Larry, 826 \nmass nouns, 749 \nmatch-and,184 \nmatch-if, 186 \nmatch-is,184 \nmatch-not,184 \nmatch-or,184 \nmatch-var, 332,333 \nmatch-variable,158 \nmatching-ifs,305 \nmath-quiz, 97,98 \nmatrix-transpose, 569,574 \nmax, 420 \nmaximize,849 maxi \nm1ze-di ffe rence,602,608 \nmaximizer, 602,608 \nmaximizing,849 \nmaybe-add, 496,757,760 \nmaybe-add-undo-bi ndi ngs,391,398 \nmaybe-set-it, 851 \nmaybe-temp, 847 \nMcAllester, Davie, 504 \nMcCarthy, John, 20,248,259,503,652, \n776, 777 \nMcCord, Michael, 711 \nMcDermott, Drew, xv, 147, 383, 503, \n586,594 \n\nMcKenzie, Bruce, xv, 213 \nmeaning,676 \nmeanings,669 \nMeehan, James, xv \nMellish, Chris, 382,679,748 \nmember, 16,62,327,358,374,745 \nmember-equal,129 \nmemo, 270,274 \nmemoization, 270,296,526,662 \nmemoi ze, 271,275,662 \nmessage, 436 \nmetamorphosis grammar, 711 \nmetareasoning, 650 \nmetavariable, 697 \nmethod, 436,438 \nmethod combinations, 458 \nMeyer, Bertrand, 455,459 \nMichie, Donald, 307,652 \nmicrocode for addition, 811 \nminimax, 612 \nminimax, 602,613 \nminimax-searcher,602,614 \nminimize,849 \nminimizing,849 \nMinsky, Marvin, 234 \nmix-ins, 457 \nmklist, 165 \nmobility, 623,629,637 \nmodal auxiliary verbs, 735 \nmod i f i ed- wei ghted - squa res, 602,621 \nmodifiers, 718 \nmodifiers, 716,719 \nModula, 27,459 \nmonitoring function, 599 \nmonotonicity, 464 \nMontague, Richard, 711 \nMoon, David .., 457 \nMoore, J.S., 425 \nMoore, Robert, 466,652 \nMoses, Joel, 239,259 \nmost-negati ve-fi xnum, 613 \nmost-positive-fixnum, 195 \n\n\f\n<a id='page-935'></a>\n\nmost-pos i ti ve-fi xnum, 613 \nmove-ons, 137 \nmove-op, 137 \nmoves, 311 \nMRS, 504 \nMU-Prolog,383 \nmultimethod, 436,458 \nmultiple goals, 145 \nmultiple values, 96,685 \nmul tiple-value-bind,96,875 \nmultiple-value-call,887 \nMusser, David R., 27 \nmust-be-number, 771 \nMYCIN, xii, 461,531,532,535,541,542, \n\n552,553,557-559,903 \nmycin, 533,552 \n\nN, 660 \nN,693 \nNaish, Lee, 383 \nnalist,498 \nnalist-push,499 \nName, 660 \nName, 694,701 \nname, 716,731 \nname clashes, 279 \nname!, 786 \nname-of, 601,602 \nnamed, 852 \nnames, 737 \nnconc, 80,848 \nnconcing, 849 \nnegate-node,623 \nnegate-value,632 \nnegated predicates, 496 \nnegation, 485 \nnegative?,756 \nnei ghbors, 198,602,621 \nneural nets, 651 \nnever, 847 \nNew Flavors, 458 \nnew-account,437 \n\nnew-fn, 795 \nnew-instance,533,543 \nnew-parm, 541 \nnew-states, 207 \nnew-symbol, 302,391 \nnew-tree, 658,666,671 \nNewell, Alan, 109,147,596 \nnewer-file-p,894 \nnewline, 804 \nnext-instr, 795,819 \nnext - to - pi ay, 602,606 \nnextto, 374 \nNIL, 821 \nnil,10 \nNilsson, Nils, 147,214,503 \nnim, 311 \nnintersection,80 \nnl/0,413 \nnlist, 475 \nnlist-list,476 \nnlist-n,476 \nnlist-push, 476 \nno-bindings, 157 \nno-states-p, 449 \nno-unknown, 228 \nnode, 623,631 \nnoise-word-p, 225 \nnominative case, 717 \nnon-Horn clauses, 504 \nNONLIN, 147 \nnonlocal exit, 768 \nnonrestrictive clauses, 750 \nnormalize, 518 \nnormalize-poly, 513,518 \nNorvig, Peter, 384 \n\nnot, 415,424 \nnot-numberp,246 \n\nnot/1,415 \n\nnotation \n\n0(/(n)),274 \n\ndotted pair, 69 \n\ninfix, 240 \n\n\f\n<a id='page-936'></a>\n\npackage prefix, 835 \nprefix, 228,240 \nNoun, 36,695,698,701 \nnoun, 716,731,742 \nnoun-phrase, 36,38 \nNP,660 \nNP, 687, 688, 692, 694, 698, 701, 703, \n716,717 \nNP-hard, 146,461 \nNP2,716, 718 \nnreverse,80 \nnset-difference, 80 \nnsubst, 80 \nnth, 69,73 \nNU-Prolog, 383 \nnull,69 \nnumber-and-negation,20 \nnumber-of-labelings,569,570 \nnumberp/1,745 \nnumbers-and-negations,20 \nnunion,80 \nNygaard, Krysten, 456 \n\nO'Keefe, Richard, 383,423 \nobject, 3,436 \nobject-oriented \nprogramming, 434 \nobjective case, 717 \noccurs check, 356,471 \noccurs - check, 356,361 \nomniscience, 464 \nonce-only, 854 \none-of, 36,275 \none-unknown, 229 \nop, 114,126,127 \nop?, 302 \nopcode, 795,812 \nopen, 83 \nopening book, 649 \noperator precedence, 240 \noperators -and- i nverses,228 \nopponent, 601,602 \n\nOPS5,266 \nopt-rel-pronoun,721 \nopt-word, 729 \noptimize, 795,818 \noptimize-1,818 \noptimizing arithmetic operations, 793 \nor, 53,415,429,764 \nORBFT, 825 \norderings,139 \nordinal, 716,732 \nOthello, 597 \nOthello \nbracketing piece, 605 \ncheat, 606 \ncorner squares, 608 \ncurrent mobility, 637 \nedge squares, 608 \nedge stability, 637 \nend game, 649 \nlegal move, 604 \nmobility, 637 \nplausible move generator, 647 \npotential mobility, 637 \nstable, 643 \nunstable, 643 \nvalid move, 604 \nothel 10,605,624 \nsemistable, 643 \nothel 10- seri es, 623,626,628 \nouter, 601,602 \n\nP,660 \np-add-into!,525 \np-lists, 74 \npackage, 754,834,889-890 \npackage prefix notation, 835 \npair?, 756 \nparameter \nkeyword, 98 \noptional, 98 \norder, 889 \nrest, 778 \n\n\f\n<a id='page-937'></a>\n\nparameter list, 12 \nparm, 533,541 \nparm-type, 533,541 \nPARRY, 153,154,167 \nparse, 658,659,668,671,680,681 \nparse-condition,547 \nparse-lhs, 658 \nparse-loop-body, 844 \nparse-namestring, 877 \nparse-reply,533,540 \nparser, 658,662,680,681 \npartial evaluation, 267 \npartition-if,256 \nPascal, ix, 26-29,51,55,57,66,98,176, \n266,434, 623 \npassivize-sense,743 \npassivize-subcat,743 \npassword-account,441 \npast participles, 720 \npast tense, 722 \npat-match, 155,156,158,160,181 \npat-match-1,332 \npat-match-abbrev,187 \npath, 200 \npath-states,210 \nPatil, Ramesh, 663 \npattern matcher, 509 \npattern matching and unification, 352 \nPearl, Judea, 558,559,648, 652 \npeephole optimizer, 805,818 \nPereira, Fernando, 383,426, 711, 748 \nPereira, Luis, 426 \nPerils, Alan, 3,265,348,866 \nPerlmutter, Barak .., 458 \npermutations, 150 \npermute, 675,680,682 \npermute-vector 1,682 \nPeters, Stanley, 711 \npiece, 601,602 \npiece-stability,644 \npipe, 281 \npipe-elt, 282 \n\npipes, 840 \nplace, 55 \nPlaisted, David .., 504 \nPLANNER, 382 \nPlauger, J., viii \nplay-game, 313 \npi ay-games, 312 \npoiuyt, 582 \npoly, 513,514 \npoly*poly, 513,517 \npoly*$ame, 513,517 \npol y+, 513,515 \npoly+poly, 513,516 \npoly+same, 513,516 \npoly-, 513,515 \npoly/poly, 529 \npoly^2,523 \npoly^n,513,518,523,524 \npolyhedra, 565 \npolynomial, 512,513 \npolynomials, 510 \npolysemous, 730 \nPOP, 785,814 \npop, 56 \npop-end,881,882 \npop-state,449 \nposition,62 \nposition-if, 60 \npossible worlds, 485,496,497 \npossi bl e-edge-move, 641 \npossi bl e-edge-moves-value,641 \npossible-labelings,569 \npostdeterminers, 721 \nPP,660 \nPP, 38, 716, 720 \nPP*, 38 \npprint, 839 \nPrade, Henri, 558 \npreconditions, 112 \nprecycling, 634 \npredeterminers, 721 \npredicate, 888 \n\n\f\n<a id='page-938'></a>\n\ncalculus, 463 \nequality, 70 \nrecognizer, 81 \npredi cate, 360,361 \npredicative adjectives, 749 \nprefer-disjoint, 674 \nprefer-not-si ngleton, 674 \nprefer-subset, 674 \nprefer<,674 \npreferences, 670 \nprefix notation, 4,228,240 \nprefix->canon, 513,515 \npref ix->inf ix, 229,242,519,520 \nPrep, 38 \nprep, 716,732 \nprepend,192 \nprepositional phrases, 720 \nprepositions, 739 \nprerequisite clobbers siblinggoal, 120, \n139 \npresent participles, 720 \npresent tense, 722 \npretty printing, 839 \nprice-is-right,195 \nPRIM, 815 \nprim, 795,804 \nprimitive operation, 803 \nprimitive-p, 795,804 \nprinl,83 \nprinc, 83 \npri nt-board, 602,603,625 \npri nt - condi ti on, 533,551 \npri nt-condi ti ons,533,551 \npri nt-equati ons, 228,236 \nprint-fn, 786,790 \nprint-labelings,569,571 \nprint-path, 203 \nprint-proc, 757,768 \nprint-rule, 533,545,551 \nprint-sqrt-abs, 771 \nprint-table, 771 \nprint-vari able,340 \n\nprint-vertex, 569,573 \npri nt-why, 533,552 \nprint-world,501 \npriority queue, 459 \nPro, 660 \nprobability theory, 557 \nproblem \n(find item list) failed,874 \nchange to function ignored, 869 \nclosures don't v^ork, 871 \ndeletion didn't take effect, 873 \nleaping before you look, 121 \nline-diagram labling, 565 \nmultiple values lost, 874 \nno response, 867 \nprerequisite clobbers siblinggoal, \n120,139 \nrecursive subgoal, 123 \nproblem, 449 \nproblem-combi ner, 450,452 \nproblem-combiner -.around,452 \nproblem-successors,451,453 \nproc, 757 \nprocedural attachment, 463 \nprocedure?, 756 \nprofile, 290 \nprofile-count,289 \nprofile-enter,293 \nprofile-exit,293 \nprofile-report, 289,294 \nprofile-time, 294 \nprofilel,289,291 \nprofiled-fn, 289,293 \nprofiling, 288 \nprog, 767 \nprogn, 64 \nprogramming \ndata-driven, 182 \nfunctional style, 435,839 \nidioms, 60 \nimperative style, 434 \nin the large, 890 \n\n\f\n<a id='page-939'></a>\n\nlogic, 435 \nobject-oriented style, 434 \nprocedural style, 434 \nrule-based, 435 \n\nProject MAC, 239 \n\nProlog, ix, xii, XV, 63, 144, 155, 287, \n348-351, 355, 356, 358-360, \n364, 366-368, 371-374, 376, \n378, 380-382, 384-386, 388, \n389, 391, 407, 408, 411-413, \n415-421, 423-428, 431, 435, \n455, 462, 464-472, 480-482, \n489, 497, 504, 505, 531, 532, \n536, 538, 541-544, 684, 685, \n690, 691, 693, 697, 708, 711713, \n732, 745 \n\nProlog II, 355 \nProlog III, 383 \npro! og- compi 1 e, 390,391 \nprol og- compi 1 e- symbol s, 391,409 \nprolog-compi1er-macro, 391,395 \nProlog-In-Lisp, 360,424 \nprompt, 4 \nprompt-and-read,867 \nprompt-and-read-vals,533,539 \nprompt-generator,178 \npronoun, 716,731 \npronouns, 736 \npropagate-constrai nts,569,571,590 \nproper-listp,391,396 \nproperty lists, 74 \nprototypes, 469 \nprove, 361,362,367,368,380,483 \nprove-al 1,361,362,367,380,483 \npunctuation-p,709 \npush, 56 \nput-db, 533,537 \nput-diagram, 576 \nput-first, 623,636 \nput-optimizer, 819 \nput-rule, 533,545 \nput-trie, 344 \n\nPygmalion, 152 \n\nquasi-q, 795,824 \nquasiquote, 822 \nQuayle, Dan, 735 \nquery-bind,482 \nquery-user, 677 \nquestions, 725, 726 \nqueue, 341 \nqueue-contents,342 \nqueue-nconc, 343 \nQuillian, M. Ross, 503 \nQuirk, Randolph, 748 \nquote, 427, 754 \nquote mark('), 6 \n\nrl5-test, 522 \nRabbit, 825 \nRamsey, Allan, xv, 594, 748 \nrandom-choice,773 \nrandom-el t, 36,166,276,322,602 \nrandom-mem, 322 \nrandom-ordering strategy, 630 \nrandom-othel1o-seri es,623,627 \nrandom-strategy,602,607 \nrapid-prototyping, 265 \nrat*rat, 513,529 \nrat+rat, 513,529 \nrat-denominator,513,527 \nrat-numerator,513,527 \nrat/rat, 513,529 \nrational number, 526 \nread, 83 \n\nread-char, 83,895 \nread-eval-print loop, 176,821 \nread-from-string,876 \n\nread-line,83 \n\nread-time-case, 313 \n\nread/1,413 \nreading, 24 \nreadtable, 712,821 \nreasoning with uncertainty, 531 \nrecursion, 62 \n\n\f\n<a id='page-940'></a>\n\nrecursive,17 \nrecursive subgoal, 123 \nREDUCE, 259 \nreduce, 62,860 \nreduce*, 860 \nreduce-list, 862 \nreduce-vect, 860 \nreferential transparency, 423,856 \nregression testing, 90 \nrej ect - premi se, 533,547 \nrel, 485,491 \nrel -cl ause, 698,701,703,716,720 \nrel-pro, 716 \nrelation-arity,390,391 \nrelations, 485 \nrelative clauses, 720 \nremhash, 74 \nremove, 61,62 \nremove-if, 61 \nremove - i f- not, 61,100 \nremove-punctuation,709 \nremq, 334 \nrename-vari abl es, 361,363 \nrepeat, 423,674,845 \nrepeat/0,423 \nrepeat/fail loop, 423 \nreplace, 624,634 \nrepl a ce -?- va rs, 373,496,870,871 \nreport-fi ndi ngs,533,550 \nrepresentation \nboxed, 317 \nknowledge, 461 \nprinted, 52 \nunboxed, 317 \nreset, 773 \nresource, 336 \nrest, 10,69 \nrestrictive clauses, 750 \nret-addr, 795,813 \nretrieve, 480,488 \nretrieve-bagof, 489 \nretrieve-bagof-in-world, 501 \n\nretri eve-conjuncti on,487 \nretrieve-fact,487 \nretri eve-i .-world, 501 \nretrieve-matches, 480 \nretrieve-setof,489 \nRETURN, 785,798,814,816,820 \nreturn, 65,754,852 \nreturn-from, 837 \nreturn-if,847 \nreuse-cons,333,361 \nrev, 411 \nrev-funcal1,674 \nrev-scorer,674 \nreverse, 69,411 \nreverse-1abel, 569,573 \nReversi, 597 \nRich, Elaine, 594 \nRiesbeck, Christopher, xv \nRISC, 811 \nRisch,R., 239,528,260 \nRobinson, J. .., 382 \nRobinson, Peter J., 504 \nrobotics, 564 \nRose, Brian, 637 \nRosenbloom, Paul, 637,645,652 \nround-robin, 623,628 \nRoussel, Jacqueline, 382 \nRuf, Erik, 777 \nrul e, 242,533,545,658,666,671,690 \nrule-based programming, 435 \nrule-based translation, 509 \nrule-based translator, 224 \n\nrule-based-translator,189 \nrule-Ihs, 275 \nrule-pattern,163 \nrule-responses, 163 \nrule-rhs, 275 \nrules, 350 \nexamples, 705 \nleft-recursive, 705 \nrul es-for, 298,682 \nrules-sta rti ng-wi th, 658 \n\n\f\n<a id='page-941'></a>\n\nrun-attached-fn, 490 \nrun-examples, 709 \nrun-prolog, 391,409 \nRussell, Bertrand, 20 \nRussell, Steve, 777 \nRussell, Stuart, 504,650 \n\nS, 660 \nS, 686-688,692,699,701,703,716,725, \n\n726 \nSacerdoti, Earl, 147 \nSager, Naomi, 749 \nSAINT, 239,259 \nsame-shape-tree, 76 \nSamuel, A. L., 651 \nSangal, Rajeev, xiv \nsatisficing, 146 \nsatisfy-premises,533,546 \nSAVE, 814 \nsbit, 73 \nSchank, Roger C, 655 \nScheme, ix, xii, 63, 91, 280, 372, 425, \n\n753, 755-757, 759-760, 763\n\n\n764, 766-768, 770-774, 776\n\n\n780, 790, 795, 799, 810-811, \n\n816, 821-830, 833, 836, 856, \n\n879,882,888 \n\nspelling conventions, 755 \n\n. dialect, 825 \nscheme, 757, 760, 774, 795 \nscheme-macro, 757,763 \nscheme-macro-expand,757,763 \nscheme-read, 822 \nscheme-top-level,816 \n\nSchmolze, J.G., 503 \nscope, 93 \nsearch, 140,572 \n\nA*, 208,459 \n\nahead, 610 \n\naspiration, 648 \n\nbeam, 195 \n\nbest-first, 194 \n\nbreadth-first, 192,544 \n\nbrute-force, 620 \n\ndegrades gracefully, 647 \n\ndepth-first, 191,544 \n\nheuristic, 204 \n\nhill-climbing, 197,651 \n\nply, 610 \n\ntools, 448 \n\nzero-window, 648 \nsearch-all,211 \nsearch-gps, 212 \nsearch-n,218 \nsearch-solutions, 569,572 \nsearcher, 449 \nsearcher :before,450 \nsecond, 10,69 \nsegment-match,161,162,185 \nsegment-match+, 186 \nsegment-match-fn,183 \nsegment-match?, 186 \nsegment-matcher, 183 \nsegment-pattern-p,183 \nself-and-double,19 \nsem, 674 \nsemantics, 656 \nsemipredicates, 127 \nsemi-stable,643 \nsend, 438 \nsentence,36 \nseq, 786, 789 \nseries facility, 840 \nset, 346 \nset, 95 \nset!, 754,756 \nset-bindingl,378,379 \nset-carl, 756 \nSET-CC, 810,815 \nset-diff, 670 \nset-difference, 895 \nset-global-var!,757,759 \nset-macro-character, 714 \nset-simp-fn, 252 \n\n\f\n<a id='page-942'></a>\n\nset-varl,757,759 \nset-worid-current, 500 \nsetf, 8,55,514 \nmethods, 514 \nsetof/3,417 \nseven name spaces, 836 \nshadow, 825,836 \nShafer, Glenn, 557,559 \nShakespeare, William, 597 \nShannon, Claude E., 652 \nShapiro, Ehud, 382 \nShapiro, Stuart, 213 \nShaw, George Bernard, 315 \nShaw,J. C, 596 \nShieber, Stuart, 383, 711,748 \nShortliffe, Edward H., 531,553, \n557,558 \nshow-city-path,203 \nshow-diagram, 569,574 \nshow-fn, 786,791,813 \nshow-prolog-soluti ons,361,365 \nshow-prolog-vars, 361,365,369,484 \nshow-prolog-vars/2,410 \nshow-vertex, 569,573 \nside effect, 802,886 \nside-effect-free-p,855 \nsieve, 285 \nSimon, Herbert, 109,146,147,596 \nsimp, 244 \nsimp-fn,252 \nsimp-rule, 246 \ns i mpl e- a r ray, 321,876 \nsimple-equal,155 \nsimple-vector, 321,876 \nsimplifier, 244 \nsimplify, 244 \nsimpl1fy-by-fn,252 \nsimpl i fy-exp, 244,252,297,306 \nSimula, 456 \nSIN, 239,259 \nsingle-float,320 \nsingle-matcher,183 \n\nsingle-pattern-p,183 \nSkolem constant, 467,485,493 \nSkolem function, 467 \nSkolem, Thoralf, 467 \nSlagle, James, 239,259 \nslot-constituent,728 \nslot-number, 743 \nSmalltalk, 457 \nSoftware Tools in Pascal viii \nsolve, 226 \nsolve-arithmetic,229 \nsome, 62 \nsort, 69 \nsort*, 312 \nsort-vector, 826 \nsorter, 194,217 \nspan-length,674 \nsparse polynomials, 511 \nspecial,837 \nspecial form, 9 \nexpression, 9,22 \noperator, 9 \nspelling corrector, 560 \nsqrt, 885 \nstack, 56 \nSTANDARD LISP, ix \nStaples, John, 504 \nstarts-with, 126,317 \nstate space, 190 \nstatements, 5 \nstatic-edge-stability,644 \nstatic-ordering strategy, 631 \nSteele, Guy L., Jr., xiii, 48, 457, 777, \n781,810,825 \nStefik, Mark, 458 \nstep, 85 \nstep-daughter, 385 \nStepanov, Alexander .., 27 \nSterling, Leon, 234,382 \nSteve's Ice Cream, 457 \nStickel, Mark, 426,504 \nstorage management, 25 \n\n\f\n<a id='page-943'></a>\n\nstrategy \ngenerate-and-test, 376 \nrandom-ordering, 630 \nstatic-ordering, 631 \n\nstream, 281 \nstring->list, 709 \nstring-set!,756 \nstrings, 22 \nstrip-vowel, 743 \nSTRIPS, 112 \nStroustrup, Bjarne, 459 \nstructure sharing, 425 \nStubblefield, William .., 558 \nstudent,224 \nsub, 485,491 \nsubcategories, 693 \nsubject, 716, 724 \nsubject-predicate agreement, 724 \nsubjective case, 717 \nsubl is, 156,356 \nsubseq, 69,895 \nsubst, 68, 76,333 \nsubst-bindings,357,361 \nsubstances, 469 \nsubstitute,62 \nsubtypep,82 \n\nsuccess continuation, 389,425 \nsuccessors,203 \nsum, 674,849 \nsum-squares,316 \nsumming, 849 \nSussman Anomaly, 142 \nSussman, Gerald, 142, 213, 307, 367, \n\n383,511, 777, 781,810,825 \nSvartik,Jan,748 \nsvref, 73,512 \nswitch-strategies,602,623,627 \nswi tch-vi ewpoi nt, 165 \nsymbol, 23 \n\nexternal, 835 \ninternal, 835 \nuninterned, 855 \n\nsymbol, 302,391,623 \nsymbol-pi ist, 75 \nsymbol-value, 94 \nsymbolic differentiation, 249 \nSymbolics, 458 \nsyntax, 656 \n\nframe-based, 485 \nuniform, 28 \nsys-action, 893 \n\nT, 820 \ntable, 343 \ntag bits, 811 \ntagbody, 767,837 \ntai 1,282,284 \ntail-recursive, 766 \ntail-recursive call, 323 \nTanimoto, Steven, 259,594 \ntarget, 795,819 \nTatar, Deborah G,, xiv \nTate, Austin, 147,148 \ntax-bracket,54 \ntconc, 341,342 \nTeiresias, 549 \ntense, 722 \ntense-sem, 731 \nterminal-tree-p,668 \nterpri,84 \ntest-bears,492 \ntest-ex, 90 \ntest-index, 477 \ntest-it,295 \ntest-unknown-word,745 \nthe, 512 \nthematic fronting, 725 \ntheorem proving, 460 \nthereis,847 \nthink-ahead, 649 \nthird, 10,69 \nThomason, Rich, 711 \nThoreau, Henry David, 238 \nthrow, 624, 754,769,837 \n\n\f\n<a id='page-944'></a>\n\nthunks, 307 \nTI Explorer Lisp Machine, 292,321 \nTI Lisp Machine, 858 \ntime, 90 \ntime-string, 623,626 \nTJUMP, 785,814,820 \ntone language, 755 \ntop, 813 \ntop-down parser, 679 \ntop-edge,640 \ntop-level - prove, 361, 364, 368, 391, \n409,484 \n\nTouretzky, David, x, xiv \ntower, 584 \ntrace, 16 \ntracing, 427 \ntracing, 16 \ntractability, 464 \ntransitive verbs, 693 \ntranslate-exp,495 \ntranslate-pair,224 \ntranslate-to-expression,224 \ntree, 76,649 \ntree, 666,671 \ntree -equal,76 \ntree -lhs,658 \ntree -rhs,658 \ntree-score-or-O, 673 \ntree -search, 191,217 \ntrie, 343,472 \ntrie, 344 \ntrie-deleted,344 \ntrihedral vertices, 565 \ntrip, 199,200 \ntrip-problem,453 \ntrue, 76,430,532,533 \ntrue-p, 533,536 \ntruly amazing, wonderful thing, 771 \ntruth maintenance system (TMS), \n\n497,504 \nassumption-based (ATMS), 504 \ntry, 744 \n\ntry-dcg,744 \nTversky, Amos, 558 \nTWEAK, 148 \nTwenty Questions, 80 \ntwo-dimensional array, 599 \ntype declaration, 876 \ntype-checking, 316 \ntype-of, 82 \ntypep, 82 \n\nuappend, 335 \nucons, 334 \nulist, 335 \nUllman,J. D., 307 \nunbound, 377 \nunbound-var-p,418 \nuncertainty, 464 \nundebug, 124 \nundo-bindings!, 379,397 \nunfactorize, 254 \nunification, 349,352, 684 \nand pattern matching, 352 \nunifier, 357 \nunify, 354,356,361 \nunify!, 378,391,397 \nunify- Var iab1 e, 354-356,361 \nunion*, 670 \nunique, 335,345 \nunique name assumption, 467 \nunique-cons,335 \nun i que-fi nd-anywhere-i f,361,363 \nunity path, 560 \nunknown, 532,533 \nunknown words, 664 \nunknown-p,228 \nunless, 53,851 \nunprofile, 290 \nunprofilel,289,291 \nuntrace,16 \nunwind-protect, 294 \nupdate-cf, 533,537 \nuse, 130,663,671 \n\n\f\n<a id='page-945'></a>\n\nuse-el i za - rul es, 164,188,189 \nuse-new-world, 500 \nuse-package,836 \nuse-rule, 533,546 \nuse-rul es, 533,545 \nuse-world, 500 \n\nV,660 \nv-d-neighbors,576 \nval, 485,491 \nvalid-p, 602,604 \nval ues, 364 \nvan Emden, Maarten H., 504 \nvar, 377-379,391 \nvar/1,418 \nvar=,513,515 \nvar>,513,515 \n\nvariable \nanonymous, 372 \nclass, 436 \ngeneralized, 55 \ninstance, 436 \nlexical, 93,888 \nlogic, 349,352,541 \nmeta-, 697 \nrenaming, 481 \nsegment, 159 \nspecial, 93,888,889 \nvariable, 340,361 \nvari able-p, 156,241,339,340,361 \nvariables-in, 361,363 \nvector -set!, 756 \nVerb, 36 \nverb, 716,730,734,742 \nverb-phrase,36 \nVerb/intr, 694,699,701 \nVerb/tr, 694,699,701 \nvertex, 569 \nvividness, 504 \nvowel-p, 743 \nVP, 660 \n\nVP, 687-689, 693, 694, 699, 701, 703, \n716, 722, 723 \nVygotsky, Lev Semenovich, 655 \n\nWaibel, Alex, 637 \nWaldinger, Richard, 142 \nwalk, 400 \nWalker, Adrian, 711,748 \nWall, Robert E., 711 \nWaltz filtering, 594 \nWaltz, David, 594 \nWARPLAN, 144,147,148 \nWarren Abstract Machine (WAM), \n407,426 \nWarren, David, 144, 147, 383, 425 426, \n711 \nWaterman, David .., 558 \nWefald, Eric, 637,650 \nWegner, Peter, 435 \nweighted-squares,602,609 \nWeinreb, Daniel, 457 \nWeise, Daniel, 267,777 \nWeiss, SholomM., 558 \nWeissman, Clark, 259 \nWeizenbaum, Joseph, 152,167 \nwhen, 53,851 \nwhile, 67,68,847 \nwhite, 601,602 \nWhitehead, Alfred, 20 \nWhorf, Benjamin Lee, 655 \nWilcox, Bruce, 30 \nWilensky, Robert, xiii, xiv, 213,383 \nwin, 311,312 \nwinning-value,602,613 \nWinograd, Terry, 679 \nWinston, Patrick, xiv, 213, 214, 367, \n383,564,594,777 \nWirth, N., 385 \nwith, 850 \nwith-col lection, 863 \nwi th-compi 1 atl on-uni t, 411,429,893 \nwith-open-stream, 83 \n\n\f\n<a id='page-946'></a>\n\nwith-profiling, 294 \nwith-resource, 338 \nwi th-undo-bi ndi ngs,415 \nwithdraw, 439,442,446 \nwithdraw :after, 447 \nwithdraw .-before,447 \nWogrin, Nancy, 266 \nWong, Douglas, 234 \n\nWoods, William .., 503 \nword/., 741 \nworld, 499 \nwould-flip?, 602,605 \nwrite/1,413 \nwriting an interpreter, 42 \n\nx-square-for, 642 \nx-square-p,642 \nXlisp, ix \nXP, 727 \nXP, 716, 725,729 \nxyz-coords,201 \n\nyes/no, 533,541 \nYukawa, Keitaro, 504 \n\nZabih, Ramin, 777 \nZadeh, Lofti, 558 \nzebra, 375 \nzebra puzzle, 373,411,502 \nzero -array, 875 \nZetaLisp, 811,840 \nZETALISP, be \nZimmerman, Scott, 769 \nZucker, S.W., 594 \n\n\f\n"
  },
  {
    "path": "README.md",
    "content": "\n<img src=\"paip-cover.png\" title=\"Paradigms of Artificial Intelligence Programming\" width=413>\n\nThis is an open-source repository for the book *Paradigms of Artificial\nIntelligence Programming: Case Studies in Common Lisp* by Peter Norvig (1992), and the code contained therein.  The copyright has reverted to the author, who has shared it here under MIT license. On the list of [most influential books for programmers](https://github.com/cs-books/influential-cs-books). As seen on [TV](https://norvig.com/paip-tv.html). See also: [errata](https://norvig.com/paip-errata.html), [comments](https://norvig.com/paip-comments.html),  [retrospective](https://norvig.com/Lisp-retro.html).\n\nThe book is available in these formats:\n\n* we're generating ebooks - epub and pdf - from the markdown files, see [Releases](https://github.com/norvig/paip-lisp/releases)\n* [scanned pdfs](https://github.com/norvig/paip-lisp/releases/tag/v1.3)\n  * 4th edition, 1998: higher resolution, better OCR, smaller file thanks to better compression\n  * 6th edition, 2001: newer printing\n* text: [PAIP.txt](https://github.com/norvig/paip-lisp/blob/master/PAIP.txt) (from OCR'ing the scanned pdf, containing many errors)\n* a source epub: [see releases](https://github.com/norvig/paip-lisp/releases/tag/1.1) for a cleaned up version downloaded from Safari (much cleaner than the scanned versions)\n* and `chapter?.md` markdown files:\n\n# Table of Contents\n\n- **Paradigms of Artificial Intelligence Programming**\n  * [Front matter](docs/frontmatter.md)\n  * [Preface](docs/preface.md)\n- **Part I:  Introduction to Common Lisp**\n  * 1  [Introduction to Lisp](docs/chapter1.md)\n  * 2  [A Simple Lisp Program](docs/chapter2.md)\n  * 3 [Overview of Lisp](docs/chapter3.md)\n- **Part II: Early AI Programs**\n  * 4  [GPS:  The General problem Solver](docs/chapter4.md)\n  * 5  [Eliza:  Dialog with a Machine](docs/chapter5.md)\n  * 6  [Building Software Tools](docs/chapter6.md)\n  * 7 [Student:  Solving Algebra Word Problems](docs/chapter7.md)\n  * 8 [Symbolic Mathematics:  A Simplification Program](docs/chapter8.md)\n- **Part III:  Tools and Techniques**\n  * 9  [Efficiency Issues](docs/chapter9.md)\n  * 10  [Low-Level Efficiency Issues](docs/chapter10.md)\n  * 11  [Logic Programming](docs/chapter11.md)\n  * 12  [Compiling Logic programs](docs/chapter12.md)\n  * 13  [Object-Oriented Programming](docs/chapter13.md)\n  * 14  [Knowledge Representation and Reasoning](docs/chapter14.md)\n- **Part IV:  Advanced AI Programs**\n  * 15  [Symbolic Mathematics with Canonical Forms](docs/chapter15.md)\n  * 16  [Expert Systems](docs/chapter16.md)\n  * 17  [Line-Diagram Labeling by Constraint Satisfaction](docs/chapter17.md)\n  * 18  [Search and the Game of Othello](docs/chapter18.md)\n  * 19  [Introduction to Natural Language](docs/chapter19.md)\n  * 20  [Unification Grammars](docs/chapter20.md)\n  * 21  [A Grammar of English](docs/chapter21.md)\n- **Part V:  The Rest of Lisp**\n  * 22  [Scheme:  An Uncommon Lisp](docs/chapter22.md)\n  * 23  [Compiling Lisp](docs/chapter23.md)\n  * 24  [ANSI Common Lisp](docs/chapter24.md)\n  * 25  [Troubleshooting](docs/chapter25.md)\n\n## The Lisp Files\n\nThe [Lisp code files](https://github.com/norvig/paip-lisp/tree/master/lisp) are listed here:\n\n| CH   | Filename                            | Description                                                            |\n|------|-------------------------------------|------------------------------------------------------------------------|\n| -    | [examples.lisp](lisp/examples.lisp) | A list of example inputs taken from the book                           |\n| -    | [tutor.lisp](lisp/tutor.lisp)       | An interpreter for running the examples                                |\n| -    | [auxfns.lisp](lisp/auxfns.lisp)     | Auxiliary functions; load this before anything else                    |\n| 1    | [intro.lisp](lisp/intro.lisp)       | A few simple definitions                                               |\n| 2    | [simple.lisp](lisp/simple.lisp)     | Random sentence generator (two versions)                               |\n| 3    | [overview.lisp](lisp/overview.lisp) | 14 versions of LENGTH and other examples                               |\n| 4    | [gps1.lisp](lisp/gps1.lisp)         | Simple version of General Problem Solver                               |\n| 4    | [gps.lisp](lisp/gps.lisp)           | Final version of General Problem Solver                                |\n| 5    | [eliza1.lisp](lisp/eliza1.lisp)     | Basic version of Eliza program                                         |\n| 5    | [eliza.lisp](lisp/eliza.lisp)       | Eliza with more rules; different reader                                |\n| 6    | [patmatch.lisp](lisp/patmatch.lisp) | Pattern Matching Utility                                               |\n| 6    | [eliza-pm.lisp](lisp/eliza-pm.lisp) | Version of Eliza using utilities                                       |\n| 6    | [search.lisp](lisp/search.lisp)     | Search Utility                                                         |\n| 6    | [gps-srch.lisp](lisp/gps-srch.lisp) | Version of GPS using the search utility                                |\n| 7    | [student.lisp](lisp/student.lisp)   | The Student Program                                                    |\n| 8    | [macsyma.lisp](lisp/macsyma.lisp)   | The Macsyma Program                                                    |\n| 8    | [macsymar.lisp](lisp/macsymar.lisp) | Simplification and integration rules for Macsyma                       |\n| 9-10 | [auxfns.lisp](lisp/auxfns.lisp)     | Auxiliary functions                                                    |\n| 11   | [unify.lisp](lisp/unify.lisp)       | Unification functions                                                  |\n| 11   | [prolog1.lisp](lisp/prolog1.lisp)   | First version of Prolog interpreter                                    |\n| 11   | [prolog.lisp](lisp/prolog.lisp)     | Final version of Prolog interpreter                                    |\n| 12   | [prologc1.lisp](lisp/prologc1.lisp) | First version of Prolog compiler                                       |\n| 12   | [prologc2.lisp](lisp/prologc2.lisp) | Second version of Prolog compiler                                      |\n| 12   | [prologc.lisp](lisp/prologc.lisp)   | Final version of Prolog compiler                                       |\n| 12   | [prologcp.lisp](lisp/prologcp.lisp) | Primitives for Prolog compiler                                         |\n| 13   | [clos.lisp](lisp/clos.lisp)         | Some object-oriented and CLOS code                                     |\n| 14   | [krep1.lisp](lisp/krep1.lisp)       | Knowledge Representation code: first version                           |\n| 14   | [krep2.lisp](lisp/krep2.lisp)       | Knowledge Representation code with conjunctions                        |\n| 14   | [krep.lisp](lisp/krep.lisp)         | Final KR code: worlds and attached functions                           |\n| 15   | [cmacsyma.lisp](lisp/cmacsyma.lisp) | Efficient Macsyma with canonical form                                  |\n| 16   | [mycin.lisp](lisp/mycin.lisp)       | The Emycin expert system shell                                         |\n| 16   | [mycin-r.lisp](lisp/mycin-r.lisp)   | Some rules for a medical application of emycin                         |\n| 17   | [waltz.lisp](lisp/waltz.lisp)       | A Line-Labeling program using the Waltz algorithm                      |\n| 18   | [othello.lisp](lisp/othello.lisp)   | The Othello playing program and some strategies                        |\n| 18   | [othello2.lisp](lisp/othello2.lisp) | Additional strategies for Othello                                      |\n| 18   | [edge-tab.lisp](lisp/edge-tab.lisp) | Edge table for Iago strategy                                           |\n| 19   | [syntax1.lisp](lisp/syntax1.lisp)   | Syntactic Parser                                                       |\n| 19   | [syntax2.lisp](lisp/syntax2.lisp)   | Syntactic Parser with semantics                                        |\n| 19   | [syntax3.lisp](lisp/syntax3.lisp)   | Syntactic Parser with semantics and preferences                        |\n| 20   | [unifgram.lisp](lisp/unifgram.lisp) | Unification Parser                                                     |\n| 21   | [grammar.lisp](lisp/grammar.lisp)   | Comprehensive grammar of English                                       |\n| 21   | [lexicon.lisp](lisp/lexicon.lisp)   | Sample Lexicon of English                                              |\n| 22   | [interp1.lisp](lisp/interp1.lisp)   | Scheme interpreter, including version with macros                      |\n| 22   | [interp2.lisp](lisp/interp2.lisp)   | A tail recursive Scheme interpreter                                    |\n| 22   | [interp3.lisp](lisp/interp3.lisp)   | A Scheme interpreter that handles call/cc                              |\n| 23   | [compile1.lisp](lisp/compile1.lisp) | Simple Scheme compiler                                                 |\n| 23   | [compile2.lisp](lisp/compile2.lisp) | Compiler with tail recursion and primitives                            |\n| 23   | [compile3.lisp](lisp/compile3.lisp) | Compiler with peephole optimizer                                       |\n| 23   | [compopt.lisp](lisp/compopt.lisp)   | Peephole optimizers for compile3.lisp                                  |\n\n# Running the Code\n\nThere is no single \"application\" to run. Rather, there is a collection of source code files,\nduplicating the code in the book. You can read and/or run whatever you like. Lisp is an interactive language,\nand you will need to interact with the code to get benefit from it. Some hints:\n\n* You will need a Common Lisp interpreter/compiler/environment. Here's a [discussion](https://www.reddit.com/r/lisp/comments/752wxe/what_is_the_best_common_lisp_interpreter_out_there/) of the options.\n* You will always need `(load \"auxfns.lisp\")`.\n* You will need `(requires \"`*file*`\")`, for the various\ninstances of *file* that you want to use. (If `requires` does not work properly on\nyour system you may have to alter its definition, in \n`auxfns.lisp`.  \n* The function `do-examples`, which takes as an argument either `:all`\nor a chapter number or a list of chapter numbers, can be used to see examples\nof the use of various functions.  For example, `(do-examples 1)` shows\nthe examples from chapter 1. Access this by doing `(requires \"examples\")`.\n\n# Other resources\n\n* I wrote a [retrospective](http://norvig.com/Lisp-retro.html) on the book in 2002.\n* There is a nice [Python version](https://github.com/dhconnelly/paip-python) of the code, by Daniel Connelly at Georgia Tech, supervised by Ashok Goel.\n"
  },
  {
    "path": "docs/.nojekyll",
    "content": ""
  },
  {
    "path": "docs/README.md",
    "content": "\n# *Paradigms of Artificial Intelligence Programming*\n\n![PAIP](https://norvig.com/paip-cover.gif)\n\n# Table of Contents\n\n- Preface\n  * Why Lisp?  Why Common Lisp?\n  * Outline of the Book\n  * How to use This Book\n  * Supplementary Texts and Reference Books\n  * A Note on Exercises\n  * Acknowledgments\n- **Part I  Introduction to Common Lisp**\n- **1  Introduction to Lisp**\n  * 1.1  Symbolic Computation\n  * 1.2  Variables\n  * 1.3  Special Forms\n  * 1.4  Lists\n  * 1.5  Defining New Functions\n  * 1.6  Using Functions\n  * 1.7  Higher-Order Functions\n  * 1.8  Other Data Types\n  * 1.9  Summary:  The Lisp Evaluation Rule\n  * 1.10  What Makes Lisp Different?\n  * 1.11  Exercises\n  * 1.12  Answers\n- **2  A Simple Lisp Program**\n  * 2.1  A Grammar for a Subset of English\n  * 2.2  A Straightforward Solution\n  * 2.3  A Rule-Based Solution\n  * 2.4  Two paths to Follow\n  * 2.5  Changing the Grammar without Changing the Program\n  * 2.6  Using the Same Data for Several Programs\n  * 2.7  Exercises\n  * 2.8  Answers\n- **3  Overview of Lisp**\n  * 3.1  A Guide to Lisp Style\n  * 3.2  Special Forms\n      * Special Forms for Definitions\n      * Special Forms for Conditionals\n      * Special Forms for Dealing with Variables and Places\n      * Functions and Special Forms for Repetition\n      * Repetition through Recursion\n      * Other Special Forms\n      * Macros\n      * Backquote Notation\n  * 3.3  Functions on Lists\n  * 3.4  Equality and Internal Representation\n  * 3.5  Functions on Sequences\n  * 3.6  Functions for Maintaining Tables\n  * 3.7  Functions on Trees\n  * 3.8  Functions on Numbers\n  * 3.9  Functions on Sets\n  * 3.10  Destructive Functions\n  * 3.11 Overview of Data types\n  * 3.12  Input/Output\n  * 3.13  Debugging tools\n  * 3.14  Antibugging Tools\n      * Timing Tools\n  * 3.15  Evaluation\n  * 3.16  Closures\n  * 3.17  Special Variables\n  * 3.18  Multiple Values\n  * 3.19  More about Parameters\n  * 3.20  The Rest of Lisp\n  * 3.21  Exercises\n  * 3.22  Answers\n- **Part II  Early AI Programs**\n- **4  GPS:  The General problem Solver**\n  * 4.1  Stage 1:  Description\n  * 4.2  Stage 2:  Specification\n  * 4.3  Stage 3:  Implementation\n  * 4.4  Stage 4:  Test\n  * 4.5  Stage 5:  Analysis, or &quot;We Lied about the G&quot;\n  * 4.6  The Running Around the Block Problem\n  * 4.7  The Clobbered Sibling Goal Problem\n  * 4.8  The Leaping before You Look Problem\n  * 4.9  The recursive Subgoal problem\n  * 4.10  The Lack of Intermediate Information Problem\n  * 4.11  GPS Version 2:  A More General problem Solver\n  * 4.12  The New Domain problem:  Monkey and Bananas\n  * 4.13  The Maze Searching Domain\n  * 4.14  The Blocks World Domain\n      * The Sussman Anomaly\n  * 4.15  Stage 5 Repeated:  Analysis of Version 2\n  * 4.16  The Not Looking after You Don&#39;t Leap Problem\n  * 4.17  The Lack of Descriptive Power Problem\n  * 4.18  The Perfect Information Problem\n  * 4.19  The Interacting Goals Problem\n  * 4.20  The End of GPS\n  * 4.21  History and References\n  * 4.22 Exercises\n  * 4.23  Answers\n- **5  Eliza:  Dialog with a Machine**\n  * 5.1  Describing and Specifying Eliza\n  * 5.2  Pattern Matching\n  * 5.3  Segment Pattern Matching\n  * 5.4  The Eliza Program:  A Rule-Based Translator\n  * 5.5  History and References\n  * 5.6  Exercises\n  * 5.7  Answers\n- **6  Building Software Tools**\n  * 6.1  An Interactive Interpreter Tool\n  * 6.2  A Pattern-Matching Tool\n  * 6.3  A Rule-Based Translator Tool\n  * 6.4  A Set of Searching Tools\n      * Searching Trees\n      * Guiding the Search\n      * Search Paths\n      * Guessing versus Guaranteeing a Good Solution\n      * Searching Graphs\n  * 6.5  GPS as Search\n  * 6.6  History and References\n  * 6.7  Exercises\n  * 6.8  Answers\n- **7  Student:  Solving Algebra Word Problems**\n  * 7.1  Translating English into Equations\n  * 7.2  Solving Algebraic Equations\n  * 7.3  Examples\n  * 7.4  History and References\n  * 7.5  Exercises\n  * 7.6  Answers\n- **8  Symbolic Mathematics:  A Simplification Program**\n  * 8.1  Converting Infix to Prefix Notation\n  * 8.2  Simplification Rules\n  * 8.3  Associativity and Commutativity\n  * 8.4  Logs, Trig, and Differentiation\n  * 8.5  Limits of Rule-Based Approaches\n  * 8.6  Integration\n  * 8.7  History and References\n  * 8.8. Exercises\n- **Part III  Tools and Techniques**\n- **9  Efficiency Issues**\n  * 9.1  Caching Results of Previous Computations:   Memoization\n  * 9.2  Compiling One Language into Another\n  * 9.3  Delaying Computation\n  * 9.4  Indexing Data\n  * 9.5  Instrumentation:  Deciding What to Optimize\n  * 9.6  A Case Study in Efficiency:  The SIMPLIFY Program\n      * Memoization\n      * Indexing\n      * Compilation\n      * The Single-Rule Compiler\n      * The Rule-Set Compiler\n  * 9.7  History and References\n  * 9.8  Exercises\n  * 9.9  Answers\n- **10  Low-Level Efficiency Issues**\n  * 10.1  use Declarations\n  * 10.2  Avoid Generic Functions\n  * 10.3  Avoid Complex Argument Lists\n  * 10.4  Avoid Unnecessary Consing\n      * Avoid Consing:  Unique Lists\n      * Avoid Consing:  Multiple Values\n      * Avoid Consing:  Resources\n  * 10.5  Use the Right Data Structures\n      * The Right Data Structure:  Variables\n      * The Right Data Structure:  Queues\n      * The Right Data Structure:  Tables\n  * 10.6  Exercises\n  * 10.7  Answers\n- **11  Logic Programming**\n  * 11.1  Idea 1:  A Uniform Data Base\n  * 11.2  Idea 2:  Unification of Logic Variables\n      * Programming with Prolog\n  * 11.3  Idea 3:  Automatic Backtracking\n      * Approaches to Backtracking\n      * Anonymous Variables\n  * 11.4  The Zebra Puzzle\n  * 11.5  The Synergy of Backtracking and Unification\n  * 11.6  Destructive Unification\n  * 11.7  Prolog in Prolog\n  * 11.8  Prolog Compared to Lisp\n  * 11.9  History and References\n  * 11.10  Exercises\n  * 11.11  Answers\n- **12  Compiling Logic programs**\n  * 12.1  A prolog Compiler\n  * 12.2  Fixing the Errors in the Compiler\n  * 12.3  Improving the Compiler\n  * 12.4  Improving the Compilation of Unification\n  * 12.5  Further Improvements to Unification\n  * 12.6  The User Interface to the Compiler\n  * 12.7  Benchmarking the Compiler\n  * 12.8  Adding More Primitives\n  * 12.9  The Cut\n  * 12.10  &quot;Real&quot; Prolog\n  * 12.11 History and References\n  * 12.12  Exercises\n  * 12.13  Answers\n- **13  Object-Oriented Programming**\n  * 13.1  Object-Oriented Programming\n  * 13.2  Objects\n  * 13.3  Generic Functions\n  * 13.4  Classes\n  * 13.5  Delegation\n  * 13.6  Inheritance\n  * 13.7  CLOS:  The Common Lisp Object System\n  * 13.8  A CLOS Example:  Searching Tools\n      * Best-First Search\n  * 13.9  Is CLOS Object-Oriented?\n  * 13.10  Advantages of Object-Oriented programming\n  * 13.11  History and References\n  * 13.12  Exercises\n- **14  Knowledge Representation and Reasoning**\n  * 14.1  A Taxonomy of Representation Languages\n  * 14.2  Predicate Calculus and its Problems\n  * 14.3  A Logical Language: Prolog\n  * 14.4  Problems with Prolog&#39;s Expressiveness\n  * 14.5  Problems with Predicate Calculus&#39;s Expressiveness\n  * 14.6  Problems with Completeness\n  * 14.7  Problems with Efficiency:  Indexing\n  * 14.8  A Solution to the Indexing Problem\n  * 14.9  A Solution to the Completeness Problem\n  * 14.10  Solutions to the Expressiveness Problems\n      * Higher-Order Predications\n      * Improvements\n      * A Frame Language\n      * Possible Worlds:  Truth, Negation, and Disjunction\n      * Unification, Equality, Types, and Skolem Constants\n  * 14.11  History and References\n  * 14.12  Exercises\n  * 14.13  Answers\n- **Part IV  Advanced AI Programs**\n- **15  Symbolic Mathematics with Canonical Forms**\n  * 15.1  A Canonical Form for Polynomials\n  * 15.2  Differentiating Polynomials\n  * 15.3  Converting between Infix and Prefix\n  * 15.4  Benchmarking the Polynomial Simplifier\n  * 15.5  A Canonical Form for Rational Expressions\n  * 15.6  Extending Rational Expressions\n  * 15.7  History and References\n  * 15.8  Exercises\n  * 15.9  Answers\n- **16  Expert Systems**\n  * 16.1  Dealing with Uncertainty\n  * 16.2  Caching Derived Facts\n  * 16.3  Asking Questions\n  * 16.4  Contexts Instead of Variables\n  * 16.5  Backward-Chaining Revisited\n  * 16.6  Interacting with the Expert\n  * 16.7  Interacting with the Client\n  * 16.8  MYCIN, A Medical Expert System\n  * 16.9  Alternatives to Certainty Factors\n  * 16.10  History and References\n  * 16.11  Exercises\n  * 16.12  Answers\n- **17  Line-Diagram Labeling by Constraint Satisfaction**\n  * 17.1  The Line-Labeling Problem\n  * 17.2  Combining Constraints and Searching\n  * 17.3  Labeling Diagrams\n  * 17.4  Checking Diagrams for Errors\n  * 17.5  History and References\n  * 17.6  Exercises\n- **18  Search and the Game of Othello**\n  * 18.1  The Rules of the Game\n  * 18.2  Representation Choices\n  * 18.3  Evaluating Positions\n  * 18.4  Searching Ahead:  Minimax\n  * 18.5  Smarter Searching:  Alpha-Beta Search\n  * 18.6  An Analysis of Some Games\n  * 18.7  The Tournament Version of Othello\n  * 18.8  Playing a Series of Games\n  * 18.9  More Efficient Searching\n  * 18.10  It Pays to Precycle\n  * 18.11  Killer Moves\n  * 18.12  Championship Programs:  Iago and Bill\n      * Mobility\n      * Edge Stability\n      * Combining the Factors\n  * 18.13  Other Techniques\n      * Interative Deepening\n      * Forward Pruning\n      * Nonspeculative Forward Pruning\n      * Aspiration Search\n      * Think-Ahead\n      * Hashing and Opening Book Moves\n      * The End Game\n      * Metareasoning\n      * Learning\n  * 18.14  History and References\n  * 18.15  Exercises\n  * 18.16  Answers\n- **19  Introduction to Natural Language**\n  * 19.1  Parsing with a Phrase-Structure Grammar\n  * 19.2  Extending the Grammar and Recognizing Ambiguity\n  * 19.3  More Efficient parsing\n  * 19.4  The Unknown-Word Problem\n  * 19.5  Parsing into a Semantic Representation\n  * 19.6  Parsing with Preferences\n  * 19.7  The Problem with Context-Free Phrase-Structure Rules\n  * 19.8  History and References\n  * 19.9  Exercises\n  * 19.10  Answers\n- **20  Unification Grammars**\n  * 20.1  Parsing as Deduction\n  * 20.2  Definite Clause Grammars\n  * 20.3  A Simple Grammar In DCG Format\n  * 20.4  A DCG Grammar with Quantifiers\n  * 20.5  Preserving Quantifier Scope Ambiguity\n  * 20.6  Long-Distance Dependencies\n  * 20.7  Augmenting DCG Rules\n  * 20.8  History and References\n  * 20.9  Exercises\n  * 20.10  Answers\n- **21  A Grammar of English**\n  * 21.1  Noun Phrases\n  * 21.2  Modifiers\n  * 21.3  Noun Modifiers\n  * 21.4  Determiners\n  * 21.5  Verb Phrases\n  * 21.6  Adverbs\n  * 21.7  Clauses\n  * 21.8  Sentences\n  * 21.9  XPs\n  * 21.10  Word Categories\n  * 21.11  The Lexicon\n      * Verbs\n      * Auxiliary Verbs\n      * Nouns\n      * Pronouns\n      * Names\n      * Adjectives\n      * Adverbs\n      * Articles\n      * Cardinal and Ordinal Numbers\n      * Prepositions\n  * 21.12  Supporting the Lexicon\n  * 21.13  Other Primitives\n  * 21.14  Examples\n  * 21.15  History and References\n  * 21.16  Exercises\n- **Part V  The Rest of Lisp**\n- **22  Scheme:  An Uncommon Lisp**\n  * 22.1  A Scheme Interpreter\n  * 22.2  Syntactic Extension with Macros\n  * 22.3  A Properly Tail-Recursive Interpreter\n  * 22.4  Throw, Catch, and Call/cc\n  * 22.5  An interpreter Supporting Call/cc\n  * 22.6  History and References\n  * 22.7  Exercises\n  * 22.8  Answers\n- **23  Compiling Lisp**\n  * 23.1  A Properly Tail-Recursive Lisp Compiler\n  * 23.2  Introducing Call/cc\n  * 23.3  The Abstract Machine\n  * 23.4  A Peephole Optimizer\n  * 23.5  Languages with Different Lexical Conventions\n  * 23.6  History and References\n  * 23.7  Exercises\n  * 23.8  Answers\n- **24  ANSI Common Lisp**\n  * 24.1  Packages\n  * The Seven Name Spaces\n  * 24.2  Conditions and Error Handling\n      * Signaling Errors\n      * Handling Errors\n  * 24.3  Pretty Printing\n  * 24.4  Series\n  * 24.5  The Loop Macro\n      * Anatomy of a Loop\n      * Iteration Control (26.6)\n      * End-Test Control (26.7)\n      * Value Accumulation (26.8)\n      * Variable Initialization (26.9)\n      * Conditional Execution (26.10)\n      * Unconditional Execution (26.11)\n      * Miscellaneous Features (26.12)\n  * 24.6  Sequence Functions\n      * Once-only:  A Lesson in Macrology\n      * Avoid Overusing Macros\n      * MAP-INTO\n      * REDUCE with :key\n  * 24.7  Exercises\n  * 24.8  Answers\n- **25  Troubleshooting**\n  * 25.1  Nothing Happens\n  * 25.2  Change to Variable Has No Effect\n  * 25.3  Change to Function Has No Effect\n  * 25.4  Values Change &quot;by Themselves&quot;\n  * 25.5  Built-In Functions Don&#39;t Find Elements\n  * 25.6  Multiple Values Are Lost\n  * 25.7  Declarations Are Ignored\n  * 25.8  My Lisp Does the Wrong Thing\n  * 25.9  How to Find the Function You Want\n  * 25.10  Syntax of LOOP\n  * 25.11  Syntax of COND\n  * 25.12  Syntax of CASE\n  * 25.13  Syntax of LET and LET*\n  * 25.14  Problems with Macros\n  * 25.15  A Style Guide to Lisp\n      * When to Define a Function\n      * When to Define a Special Variable\n      * When to Bind a Lexical Variable\n      * How to Choose a Name\n      * Deciding on the Order of Parameters\n  * 25.16  Dealing with Files, Packages, and Systems\n  * 25.17  Portability Problems\n  * 25.18  Exercises\n  * 25.19  Answers\n- Appendix\n- Bibliography\n- Index\n"
  },
  {
    "path": "docs/_coverpage.md",
    "content": "![logo](_media/paip-cover.gif)\n\n# Paradigms of Artificial Intelligence Programming\n\n> Case Studies in Common Lisp\n\n* Peter Norvig\n\n[GitHub](https://github.com/norvig/paip-lisp)\n[Get Started](#paradigms-of-artificial-intelligence-programming)"
  },
  {
    "path": "docs/_sidebar.md",
    "content": "<!-- book/_sidebar.md -->\n\n* [Home](/)\n* [Preface](preface.md)\n* [Chapter 01 - Introduction to Lisp](chapter1.md)\n* [Chapter 02 - A Simple Lisp Program](chapter2.md)\n* [Chapter 03 - Overview of Lisp](chapter3.md)\n* [Chapter 04 - GPS: The Genera Problem Solver](chapter4.md)\n* [Chapter 05 - ELIZA: Dialog with a Machine](chapter5.md)\n* [Chapter 06 - Building Software Tools](chapter6.md)\n* [Chapter 07 - STUDENT: Solving Algebra Word Problems](chapter7.md)\n* [Chapter 08 - Symbolic Mathematics: A Simplification Program](chapter8.md)\n* [Chapter 09 - Efficiency issues](chapter9.md)\n* [Chapter 10 - Low-Level Efficiency Issues](chapter10.md)\n* [Chapter 11 - Logic Programming](chapter11.md)\n* [Chapter 12 - Compiling Logic Programs](chapter12.md)\n* [Chapter 13 - Object-Oriented Programming](chapter13.md)\n* [Chapter 14 - Knowledge Representation and Reasoning](chapter14.md)\n* [Chapter 15 - Symbolic Mathematics with Canonical Forms](chapter15.md)\n* [Chapter 16 - Expert Systems](chapter16.md)\n* [Chapter 17 - Line-Diagram Labeling by Constraint Satisfaction](chapter17.md)\n* [Chapter 18 - Search and the Game of Othello](chapter18.md)\n* [Chapter 19 - Introduction to Natural Language](chapter19.md)\n* [Chapter 20 - Unification Grammars](chapter20.md)\n* [Chapter 21 - A Grammar of English](chapter21.md)\n* [Chapter 22 - Scheme: An Uncommon Lisp](chapter22.md)\n* [Chapter 23 - Compiling Lisp](chapter23.md)\n* [Chapter 24 - ANSI Common Lisp](chapter24.md)\n* [Chapter 25 - Troubleshooting](chapter25.md)\n* [Code Highlighting Test](code.md)"
  },
  {
    "path": "docs/about-scan.md",
    "content": "# About this book\n\nThis book, \"Paradigms of Artificial Intelligence Programming\", was first published in 1992.\nThe rights reverted to the author, Peter Norvig, who decided to share it under the MIT license; it's open source, but not public domain.\n\nThere's a collaborative effort to dust it off, fix it up, and bring it online.\nWe're working on this in public, together, at our Github repo, [https://github.com/norvig/paip-lisp](https://github.com/norvig/paip-lisp) .\nLook for updates and newer versions there.\nYou can send in corrections and issues there, or email them to \n[peter+paip@norvig.com with \"attn: PAIP correction\" in the subject line.](mailto:peter+paip@norvig.com?subject=attn%3a%20PAIP%20correction)\n\n\n## About this copy\n\nThis is a scanned copy of the 4th printing, 1998.\nIt's shared for reading, and for improving the Markdown copy in our Github repo.\n\n### How it was made\n@pronoiac had the spine / binding removed and fed the pages through a scanner.\nSteps and software used:\n\n* scanner gave 600dpi grayscale, as 3.6 gigabytes of png files\n* I used [Scantailor Advanced](https://github.com/4lex4/scantailor-advanced) ([in Docker](https://github.com/ryanfb/docker_scantailor)) to deskew the pages and render the pages as 300dpi black and white (1-bit) tiffs - 30 megabytes\n* [tiff2pdf](http://www.libtiff.org/man/tiff2pdf.1.html) and [pdfunite](https://manpages.debian.org/testing/poppler-utils/pdfunite.1.en.html): turn those many tiffs into one pdf\n* [OCRmyPDF](https://ocrmypdf.readthedocs.io/en/latest/): OCR with Tesseract, add title and author to the pdf, apply lossless JBIG2 compression - 24 megabytes\n"
  },
  {
    "path": "docs/about.md",
    "content": "# About this book\n\nThis book, \"Paradigms of Artificial Intelligence Programming\", was first published in 1992.\nThe rights reverted to the author, Peter Norvig, who decided to share it under the MIT license; it's open source, but not public domain.\n\nThere's a collaborative effort to dust it off, fix it up, and bring it online.\nWe're working on this in public, together, at our Github repo, [https://github.com/norvig/paip-lisp](https://github.com/norvig/paip-lisp) .\nLook for updates and newer versions there.\nYou can send in corrections and issues there, or email them to \n[peter+paip@norvig.com with \"attn: PAIP correction\" in the subject line.](mailto:peter+paip@norvig.com?subject=attn%3a%20PAIP%20correction)\n\n\n## About this copy\n\nThis is a snapshot of the text in the Github repo as of `2022-04-09`.\nThis is a work in progress.\n\nCopyright 2022.\n"
  },
  {
    "path": "docs/appendix.md",
    "content": "# Appendix\n## Obtaining the Code in this Book\n### FTP: The File Transfer Protocol\n\nFTP is a file transfer protocol that is widely accepted by computers around the world.\nFTP makes it easy to transfer files between two computers on which you have accounts.\nBut more importantly, it also allows a user on one computer to access files on a computer on which he or she does not have an account, as long as both computers are connected to the Internet.\nThis is known as *anonymous FTP.*\n\nAll the code in this book is available for anonymous FTP from the computer `mkp.com` in files in the directory `pub/norvig`.\nThe file `README` in that directory gives further instructions on using the files.\n\nIn the session below, the user `smith` retrieves the files from `mkp.com`.\nSmith's input is in *slanted font.* The login name must be *anonymous*, and Smith's own mail address is used as the password.\nThe command *cd pub/norvig* changes to that directory, and the command *ls* lists all the files.\nThe command *mget* \\* retrieves all files (the *m* stands for \"multiple\").\nNormally, there would be a prompt before each file asking if you do indeed want to copy it, but the *prompt* command disabled this.\nThe command *bye* ends the FTP session.\n\n`% *ftp mkp.com* (or *ftp 199.182.55.2*)`\n\n`Name (mkp.com:smith): *anonymous*`\n\n`331 Guest login ok, send ident as password`\n\n`Password: *smith@cs.stateu.edu*`\n\n`230 Guest login ok, access restrictions apply`\n\n`ftp>*cd pub/norvig*`\n\n`250 CWD command successful.`\n\n`ftp>*ls*`\n\n`...`\n\n`ftp>*prompt*`\n\n`Interactive mode off.`\n\n`ftp>*mget**`\n\n`...`\n\n`ftp> bye`\n\n`%`\n\nAnonymous FTP is a privilege, not a right.\nThe site administrators at `mkp.com` and at other sites below have made their systems available out of a spirit of sharing, but there are real costs that must be paid for the connections, storage, and processing that makes this sharing possible.\nTo avoid overloading these systems, do not FTP from 7:00 a.m.\nto 6:00 p.m.\nlocal time.\nThis is especially true for sites not in your country.\nIf you are using this book in a class, ask your professor for a particular piece of software before you try to FTP it; it would be wasteful if everybody in the class transferred the same thing.\nUse common sense and be considerate: none of us want to see sites start to close down because a few are abusing their privileges.\n\nIf you do not have FTP access to the Internet, you can still obtain the files from this book by contacting Morgan Kaufmann at the following:\n\nMorgan Kaufmann Publishers, Inc.\n\n340 Pine Street, Sixth Floor\n\nSan Francisco, CA 94104-3205\n\nUSA\n\nTelephone  415/392-2665\n\nFacsimile  415/982-2665\n\nInternet  mkp@mkp.com\n\n(800) 745-7323\n\nMake sure to specify which format you want:\n\nMacintosh diskette ISBN 1-55860-227-5\n\nDOS 5.25 diskette ISBN 1-55860-228-3\n\nDOS 3.5 diskette ISBN 1-55860-229-1\n\n### Available Software\n\nIn addition to the program from this book, a good deal of other software is available.\nThe tables below list some of the relevant AI/Lisp programs.\nEach entry lists the name of the system, an address, and some comments.\nThe address is either a computer from which you can FTP, or a mail address of a contact.\nUnless it is stated that distribution is by *email* or *Floppy* or requires a *license,* then you can FTP from the contact's home computer.\nIn some cases the host computer and/or directory have been provided in italics in the comments field.\nHowever, in most cases it should be obvious what files to transfer.\nFirst do an `ls` command to see what files and directories are available.\nIf there is a file called `README`, follow its advice: do a `get README` and then look at the file.\nIf you still haven't found what you are looking for, be aware that most hosts keep their public software in the directory `pub`.\nDo a `cd pub` and then another `ls`, and you should find the desired files.\n\nIf a file ends in the suffix `.Z`, then you should give the FTP command `binary` before transferring it, and then give the UNIX command `uncompress` to recover the original file.\nFiles with the suffix `.tar` contain several files that can be unpacked with the `tar` command.\nIf you have problems, consult your local documentation or system administrator.\n\n**Knowledge Representation**\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| Babbler | [rsfl@ra.msstate.edu](mailto:rsfl@ra.msstate.edu) | *email;*Markov chains/NLP |\n| BACK | [peltason@tubvm.cs.tu-berlin.de](mailto:peltason@tubvm.cs.tu-berlin.de) | *3.5\" floppy;* KL-ONE family |\n| Belief | [almond@stat.washington.edu](mailto:almond@stat.washington.edu) | belief networks |\n| Classic | [dlm@research.att.com](mailto:dlm@research.att.com) | *license;* KL-ONE family |\n| Fol Getfol | [fausto@irst.it](mailto:fausto@irst.it) | *tape;* Weyrauch's FOL system |\n| Framekit | [ehn+@cs.cmu.edu](mailto:ehn+@cs.cmu.edu) | *floppy;* frames |\n| Framework | [mkant+@cs.cmu.edu](mailto:mkant+@cs.cmu.edu) | *a.gp.cs.cmu.edu:/usr/mkant/Public;* frames |\n| Frobs | [kessler@cs.utah.edu](mailto:kessler@cs.utah.edu) | frames |\n| Knowbel | [kramer@ai.toronto.edu](mailto:kramer@ai.toronto.edu) | sorted/temporal logic |\n| MVL | [ginsberg@t.stanford.edu](mailto:ginsberg@t.stanford.edu) | multivalued logics |\n| OPS | [slisp-group@b.gp.cs.cmu.edu](mailto:slisp-group@b.gp.cs.cmu.edu) | Forgy's OPS-5 language |\n| PARKA | [spector@cs.umd.edu](mailto:spector@cs.umd.edu) | frames (designed for connection machine) |\n| Parmenides | [pshell@cs.cmu.edu](mailto:pshell@cs.cmu.edu) | frames |\n| Rhetorical | [miller@cs.rochester.edu](mailto:miller@cs.rochester.edu) | planning, time logic |\n| SB-ONE | [kobsa@cs.uni-sb.de](mailto:kobsa@cs.uni-sb.de) | *license;* in German; KL-ONE family |\n| SNePS | [shapiro@cs.buffalo.edu](mailto:shapiro@cs.buffalo.edu) | *license;* semantic net/NLP |\n| SPI | [cs.orst.edu](mailto:cs.orst.edu) | Probabilistic inference |\n| YAK | [franconi@irst.it](mailto:franconi@irst.it) | KL-ONE family |\n\n**Planning and Learning**\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| COBWEB/3 | [cobweb@ptolemy.arc.nasa.gov](mailto:cobweb@ptolemy.arc.nasa.gov) | *email;* concept formation |\n| MATS | [kautz@research.att.com](mailto:kautz@research.att.com) | *license;* temporal constraints |\n| MICRO-xxx | [waander@cs.ume.edu](mailto:waander@cs.ume.edu) | case-based reasoning |\n| Nonlin | [nonlin-users-request@cs.umd.edu](mailto:nonlin-users-request@cs.umd.edu) | Tate's planner in Common Lisp |\n| Prodigy | [prodigy@cs.cmu.edu](mailto:prodigy@cs.cmu.edu) | *license;* planning and learning |\n| PROTOS | [porter@cs.utexas.edu](mailto:porter@cs.utexas.edu) | knowledge acquisition |\n| SNLP | [weld@cs.washington.edu](mailto:weld@cs.washington.edu) | nonlinear planner |\n| SOAR | [soar-requests/@cs.cmu.edu](mailto:soar-requests/@cs.cmu.edu) | *license*; integrated architecture |\n| THEO | [tom.mitchell@cs.cmu.edu](mailto:tom.mitchell@cs.cmu.edu) | frames, learning |\n| Tileworld | [pollack@ai.sri.com](mailto:pollack@ai.sri.com) | planning testbed |\n| TileWorld | [tileworld@ptolemy.arc.nasa.gov](mailto:tileworld@ptolemy.arc.nasa.gov) | planning testbed |\n\n**Mathematics**\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| JACAL | [jaffer@altdorf.ai.mit.edu](mailto:jaffer@altdorf.ai.mit.edu) | algebraic manipulation |\n| Maxima | [rascal.ics.utexas.edu](mailto:rascal.ics.utexas.edu) | version of Macsyma; also proof-checker, nqthm |\n| MMA | [fateman@cs.berkeley.edu](mailto:fateman@cs.berkeley.edu) | *peoplesparc.berkeley.edu:pub/mma.\\**; algebra |\n| XLispStat | [umnstat.stat.umn.edu](mailto:umnstat.stat.umn.edu) | Statistics; also S Bayes |\n\n**Compilers and Utilities**\n\n| []() | | | | | | | | | |\n|---|---|---|---|---|---|---|---|---|---|\n| System | Address | Comments |\n| AKCL | [rascal.ics.utexas.edu](mailto:rascal.ics.utexas.edu) | Austin Koyoto Common Lisp |\n| CLX, CLUE | [export.lcs.mit.edu](mailto:export.lcs.mit.edu) | Common Lisp interface to X Windows |\n| Gambit | [gambit@cs.brandeis.edu](mailto:gambit@cs.brandeis.edu) | *acorn.cs.brandeis.edu:dist/gambit\\**; Scheme compiler |\n| ISI Grapher | [isi.edu](mailto:isi.edu) | Graph displayer; also NLP word lists |\n| PCL | [arisia.xerox.com](mailto:arisia.xerox.com) | Implementation of CLOS |\n| Prolog | [aisun1.ai.uga.edu](mailto:aisun1.ai.uga.edu) | Prolog-based utilities and NLP programs |\n| PYTHON | [ram+@cs.cmu.edu](mailto:ram+@cs.cmu.edu) | *a.gp.cs.cmu.edu:* Common Lisp Compiler and tools |\n| SBProlog | [arizona.edu](mailto:arizona.edu) | Stony Brook Prolog, Icon, Snobol |\n| Scheme | [altdorf.ai.mit.edu](mailto:altdorf.ai.mit.edu) | Scheme utilities and compilers |\n| Scheme | [scheme@nexus.yorku.ca](mailto:scheme@nexus.yorku.ca) | Scheme utilities and programs |\n| SIOD | [bu.edu](mailto:bu.edu) | *users/gjc;* small scheme interpreter |\n| Utilities | [a.gp.cs.cmu.edu](mailto:a.gp.cs.cmu.edu) | */usr/mkant/Public*; profiling, def system, etc. |\n| XLisp | [cs.orst.edu](mailto:cs.orst.edu) | Lisp interpreter |\n| XScheme | [tut.cis.ohio-state.edu](mailto:tut.cis.ohio-state.edu) | Also mitscheme compiler; sbprolog |\n\n\n\n"
  },
  {
    "path": "docs/bibliography.md",
    "content": "# Bibliography\n\nAbelson, Harold, Sussman Gerald J., Sussman Julie.\n*Structure and Interpretation of Computer Programs.* MIT Press; 1985.\n\nAho A.V., Ullman J.D.\n*The Theory of Parsing, Translation, and Compiling.* Prentice-Hall; 1972.\n\nA&iuml;t-Kaci Hassan.\n*Warren's Abstract Machine: A Tutorial Reconstruction.* MIT Press; 1991 An earlier version was published as \"The WAM: A (Real) Tutorial.\" Digital Equipment Corporation Paris Research Lab, Report no.\n5.\n\nA&iuml;t-Kaci Hassan, Lincoln Patrick, Nasr Roger.\nLe Fun: Logic, Equations and Functions.\n1987.\n*Proceedings of the IEEE.* CH2472-9/87.\n\nAllen James.\n*Natural Language Understanding.* Benjamin/Cummings; 1987.\n\nAllen James, Hendler James, Tate Austin.\n*Readings in Planning.* Morgan Kaufmann; 1990.\n\nAllen John.\n*Anatomy of Lisp.* McGraw-Hill; 1978.\n\nAmarel Saul.\nOn Representation of Problems of Reasoning about Actors.\nIn: Michie Donald, ed.\n*Machine Intelligence 3.* Edinburgh University Press; 1968.\n\nAnderson James A.D.W.\n*Pop-11 Comes of Age: the advancement of an AI programming language.* Ellis Horwood; 1989.\n\nAnderson John Robert.\n*Language, Memory, and Thought.* Lawrence Erlbaum; 1976.\n\nBaker Henry G.\nPragmatic Parsing in Common Lisp; or, Putting defmacro on Steroids.\n*Lisp Pointers.* 1991;4(no.\n2).\n\nBarr Avron, Feigenbaum Edward A.\nMorgan Kaufmann; . *The Handbook of Artificial Intelligence.* 1981;3 vols.\n\nBatali John, Goodhue Edmund, Hanson Chris, Shrobe Howie, Stallman Richard M., Sussman Gerald Jay.\n*The Scheme-81 Architecture-System and Chip.* In: Proceedings, Conference on Advanced Research in VLSI; 1982:69-77.\n\nBennett James S.\nRoget: A Knowledge-Based System for Acquiring the Conceptual Structure of a Diagnostic Expert System.\n*Journal of Automated Reasoning.* 1985;1:49-74.\n\nBerlekamp E.R., Conway J.H., Guy R.K.\nAcademic Press; . *Winning Ways.* 1982;2 vols.\n\nBerlin Andrew, Weise Daniel.\nCompiling scientific code using partial evaluation.\nIn: *IEEE Computer.* 1990:25-37.\n\nBobrow Daniel G.\n*Natural Language Input for a Computer Problem-Solving System.* 1968 In Minsky 1968.\n\nBobrow Daniel G.\n*LOOPS: An Object-Oriented Programming System for Interlisp.* Xerox PARC; 1982.\n\nBobrow Daniel G.\nIf Prolog is the Answer, What is the Question?\nor What It Takes to Support AI Programming Paradigms.\n*IEEE Transactions on Software Engineering.* 1985;SE-11:.\n\nBobrow Daniel G., Kahn Kenneth, Kiczales Gregor, Masinter Larry, Stefik Mark, Zdybel Frank.\n*Common Loops: Merging Lisp and Object-Oriented Programming.* In: Proceedings of the ACM Conference on Object-Oriented Systems, Languages, and Applications; 1986.\n\nBoyer R.S., Moore J.S.\nThe Sharing of Structure in Theorem Proving Programs.\nIn: Meltzer B., Michie D., eds.\n*Machine Intelligence 7.* Wiley; 1972.\n\nBrachman Ronald J., Levesque Hector J.\n*Readings in Knowledge Representation.* Morgan Kaufmann; 1985.\n\nBrachman Ronald J., Fikes Richard E., Levesque Hector J.\n*KRYPTON: A Functional Approach to Knowledge Representation.* 1983 FLAIR Technical Report no.\n16, Fairchild Laboratory for Artificial Intelligence.\nReprinted in Brachman and Levesque 1985.\n\nBratko Ivan.\n*Prolog Programming for Artificial Intelligence.* Addison-Wesley; 1990.\n\nBromley Hank, Lamson Richard.\n*A Guide to Programming the Lisp Machine.* 2d ed Kluwer Academic; 1987.\n\nBrooks Rodney A.\n*Programming in Common Lisp.* Wiley; 1985.\n\nBrownston L., Farrell R., Kant E., Martin N.\n*Programming Expert Systems in OPS5.* Addison-Wesley; 1985.\n\nBuchanan Bruce G., Shortliffe Edward Hance.\n*Rule-based Expert Systems: The Mycin Experiments of the Stanford Heuristic Programming Project.* Addison-Wesley; 1984.\n\nBundy Alan.\n*Catalogue of Artificial Intelligence Tools.* Springer-Verlag; 1984.\n\nCannon Howard I.\n*Flavors.* 1980 AI Lab Technical Report, MIT.\n\nCarbonell Jamie A.\n*Subjective Understanding: Computer Models of Belief Systems.* UMI Research Press; 1981.\n\nCardelli Luca, Wegner Peter.\nOn Understanding Types, Data Abstraction and Polymorphism.\n*ACM Computing Surveys.* 1986;17:.\n\nChapman David.\nPlanning for Conjunctive Goals.\n*Artificial Intelligence.* 1987;32:333-377 Reprinted in Allen, Hendler, and Tate 1990.\n\nCharniak Eugene, McDermott Drew.\n*Introduction to Artificial Intelligence.* Addison-Wesley; 1985.\n\nCharniak Eugene, Riesbeck Christopher, McDermott Drew, Meehan James.\n*Artificial Intelligence Programming.* 2d ed Lawrence Erlbaum; 1987.\n\nCheeseman Peter.\n*In Defense of Probability.* In: Proceedings of the Ninth IJCAI; 1985:1002-1009.\n\nChomsky Noam.\n*Language and Mind.* Harcourt Brace Jovanovich; 1972.\n\nChurch Alonzo.\nThe Calculi of Lambda-Conversion.\nIn: Princeton University Press; . *Annals of Mathematical Studies.* 1941;Vol.\n6.\n\nChurch Kenneth, Patil Ramesh.\nCoping with Syntactic Ambiguity, or How to Put the Block in the Box on the Table.\n*American Journal of Computational Linguistics.* 1982;8(nos.\n3-4):139-149.\n\nClinger William, Rees Jonathan.\n*Revised4 Report on the Algorithmic Language Scheme.* 1991 Unpublished document available online on cs.voregin.edu.\n\nClocksin William F., Mellish Christopher S.\n*Programming in Prolog.* 3d ed Springer-Verlag; 1987.\n\nClowes Maxwell B.\nOn Seeing Things.\n*Artificial Intelligence.* 1971;2:79-116.\n\nCoelho Helder, Cotta Jose C.\n*Prolog by Example.* Springer-Verlag; 1988.\n\nCohen Jacques.\nDescribing Prolog by its interpretation and compilation.\n*Communications of the ACM.* 1985;28(no.\n12):1311-1324.\n\nCohen Jacques.\nConstraint Logic Programming Languages.\n*Communications of the ACM.* 1990;33(no.\n7):52-68.\n\nColby Kenneth.\n*Artificial Paranoia.* Pergamon; 1975.\n\nCollins Allan.\nFragments of a Theory of Human Plausible Reasoning.\nIn: Waltz David, ed.\n*Theoretical Issues in Natural Language Processing.* ACM; 1978 Reprinted in Shafer and Pearl 1990.\n\nColmerauer Alain.\nProlog in 10 figures.\n*Communications of the ACM.* 1985;28(no.\n12):1296-1310.\n\nColmerauer Alain.\nAn Introduction to Prolog III.\n*Communications of the ACM.* 1990;33(no.\n7):69-90.\n\nColmerauer Alain, Kanoui Henri, Pasero Robert, Roussel Phillipe.\n*Un Syst&egrave;me de Communication Homme-Machine en Fran&ccedil;ais.* 1973 Rapport, Groupe d'Intelligence Artificielle, Universit&eacute; d'Aix-Marseille II.\n\nCooper Thomas A., Wogrin Nancy.\n*Rule-Based Programming with OPS5.* Morgan Kaufmann; 1988.\n\nDahl Ole-Johan, Nygaard Kristen.\nSIMULA-An Algol-based Simulation Language.\n*Communications of the ACM.* 1966;9(no.\n9):671-678.\n\nDavenport J.H., Siret Y., Tournier E.\n*Computer Algebra: Systems and Algorithms for Algebraic Computation.* Academic Press; 1988.\n\nDavis Ernest.\n*Representations of Commonsense Reasoning.* Morgan Kaufmann; 1990.\n\nDavis Lawrence.\n*Genetic Algorithms and Simulated Annealing.* Morgan Kaufmann; 1987.\n\nDavis Lawrence.\n*Handbook of Genetic Algorithms.* van Nostrand Reinhold; 1991.\n\nDavis Randall.\n*Meta-Level Knowledge.* In: Proceedings of the Fifth IJCAI; 1977:920-928 Reprinted in Buchanan and Shortliffe 1984.\n\nDavis Randall.\nInteractive Transfer of Expertise.\n*Artificial Intelligence.* 1979;12:121-157 Reprinted in Buchanan and Shortliffe 1984.\n\nDavis Randall, Lenat Douglas B.\n*Knowledge-Based Systems in Artificial Intelligence.* McGraw-Hill; 1982.\n\nDeGroot AD.\n*Thought and Choice in Chess.* Mouton; 1965 (English translation, with additions, of the Dutch edition, 1946.).\n\nDeGroot A.D.\nPerception and Memory versus Thought: Some Old Ideas and Recent Findings.\nIn: Kleinmuntz B., ed.\n*Problem Solving.* Wiley; 1966.\n\nde Kleer Johan.\nAn Assumption-Based Truth Maintenance System.\n*Artificial Intelligence.* 1986a;28:127-162 Reprinted in Ginsberg 1987.\n\nde Kleer Johan.\nExtending the ATMS.\n*Artificial Intelligence.* 1986b;28:163-196.\n\nde Kleer Johan.\nProblem-Solving with the ATMS.\n*Artificial Intelligence.* 1986c;28:197-224.\n\nde Kleer Johan.\nA General Labelling Algorithm for Assumption-Based Truth Maintenance.\nIn: *Proceedings of the AAAI.* 1988:188-192.\n\nDowty David R., Wall Robert E., Peters Stanley.\nIntroduction to Montague Semantics.\nIn: D.\nReidel; . *Synthese Language Library.* 1981;vol.\n11.\n\nDoyle Jon.\nA Truth Maintenance System.\n*Artificial Intelligence.* 1979;12:231-272.\n\nDoyle Jon.\n*The Ins and Outs of Reason Maintenance.* In: Proceedings of the Eighth IJCAI; 1983:349-351.\n\nDubois Didier, Prade Henri.\nAn Introduction to Possibilistic and Fuzzy Logics.\n*Non-Standard Logics for Automated Reasoning.* Academic Press; 1988 Reprinted in Shafer and Pearl 1990.\n\nEarley Jay.\nAn Efficient Context-Free Parsing Algorithm.\n*CACM.* 1970;6(no.\n2):451-455 Reprinted in Grosz et al.\n1986.\n\nElcock E.W., Hoddinott P.\n*Comments on Kornfeld's 'Equality for Prolog': E-Unification as a Mechanism for Augmenting the Prolog Search Strategy.* In: Proceedings of the AAAI; 1986:766-775.\n\nEmanuelson P., Haraldsson A.\n*On Compiling Embedded Languages in Lisp.* In: Lisp Conference, Stanford, Calif; 1980:208-215.\n\nErnst G.W., Newell Alan.\n*GPS: A Case Study in Generality and Problem Solving.* Academic Press; 1969.\n\nFateman Richard J.\nReply to an Editorial.\n*ACM SIGSAM Bulletin.* 1973;25(March):9-11.\n\nFateman Richard J.\nPolynomial Multiplication, Powers and Asymptotic Analysis: Some Comments.\n*SIAM Journal of Computation.* 1974;no.\n3(3):196-213.\n\nFateman Richard J.\n*MACSYMA's general simplifier: philosophy and operation.* In: Lewis VE, ed.\n*Proceedings of the 1979 MACSYMA Users' Conference* (MUC-79); MIT: Lab for Computer Science; 1979:563-582.\n\nFateman Richard J.\nFRPOLY: A Benchmark Revisited.\n*Lisp and Symbolic Computation.* 1991;4:155-164.\n\nFeigenbaum Edward A., Feldman Julian.\n*Computers and Thought.* McGraw-Hill; 1963.\n\nField A.J., Harrison P.G.\n*Functional Programming.* Addison-Wesley; 1988.\n\nFikes Richard E., Nilsson Nils J.\nSTRIPS: A New Approach to the Application of Theorem Proving to Problem Solving.\n*Artificial Intelligence.* 1971;2:189-208 Reprinted in Allen, Hendler, and Tate 1990.\n\nFodor Jerry A.\n*The Language of Thought.* Harvard University Press; 1975.\n\nForgy Charles L.\nOPS5 User's Manual.\n*Report CMU-CS-81-135.* Carnegie Mellon University; 1981.\n\nForgy Charles L.\nRETE: A Fast Algorithm for the Many Pattern/Many Object Pattern Match Problem.\n*Artificial Intelligence.* 1982;19:17-37.\n\nFranz Inc.\n*Common Lisp: the Reference.* Addison-Wesley; 1988.\n\nGabriel Richard P.\n*Performance and evaluation of Lisp systems.* MIT Press; 1985.\n\nGabriel Richard P.\nLisp.\nIn: Shapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n\nGaller B.A., Fisher M.J.\nAn Improved Equivalence Algorithm.\n*Communications of the ACM.* 1964;7(no.\n5):301-303.\n\nGazdar Richard, Mellish Chris.\n*Natural Language Processing in Lisp.* Addison-Wesley; 1989 Also published simultaneously: Natural Language Processing in Prolog.\n\nGenesereth Michael R., Ginsberg Matthew L.\nLogic Programming.\n*Communications of the ACM.* 1985;28(no.\n9):933-941.\n\nGenesereth Michael R., Nilsson Nils J.\n*Logical Foundations of Artificial Intelligence.* Morgan Kaufmann; 1987.\n\nGiannesini Francis, Kanoui H., Pasero R., van Caneghem M.\n*Prolog.* Addison-Wesley; 1986.\n\nGinsberg Matthew L.\n*Readings in NonMonotonic Reasoning.* Morgan Kaufmann; 1987.\n\nGinsberg Matthew L., Harvey William D.\n*Iterative Broadening.* In: Proceedings, Eighth National Conference on AI; 1990:216-220.\n\nGoldberg Adele, Robinson David.\n*Smalltalk-80: The Language and its Implementation.* Addison-Wesley; 1983.\n\nGoldberg David E.\n*Genetic Algorithms in Search, Optimization and Machine Learning.* Addison-Wesley; 1989.\n\nGordon Jean, Shortliffe Edward H.\n*The Dempster-Shafer Theory of Evidence.* 1984 In Buchanan and Shortliffe 1984.\n\nGreen Cordell.\nTheorem-proving by resolution as a basis for question-answering systems.\nIn: Meltzer Bernard, Michie Donald, eds.\n*Machine Intelligence 4.* Edinburgh University Press; 1968:183-205.\n\nGrosz Barbara J., Sparck-Jones Karen, Webber Bonnie Lynn.\n*Readings in Natural Language Processing.* Morgan Kaufmann; 1986.\n\nGuzman Adolfo.\n*Computer Recognition of Three-Dimensional Objects in a Visual Scene.* 1968 Ph.D.\nthesis, MAC-TR-59, Project MAC, MIT.\n\nHafner Carole, Wilcox Bruce.\n*LISP/MTS Programmer's Guide.* Mental Health Research Institute Communication no.\n302, University of Michigan; 1974.\n\nHarris Zellig S.\n*A Grammar of English on Mathematical Principles.* Wiley; 1982.\n\nHasemer Tony, Domingue John.\n*Common Lisp Programming for Artificial Intelligence.* Addison-Wesley; 1989.\n\nHayes, Patrick.\n\"Naive Physics I: Ontology for Liquids\".\nIn Hobbs and Moore 1985.\n\nHeckerman David.\nProbabilistic Interpretations for Mycin's Certainty Factors.\nIn: Kanal L.N., Lemmer J.F., eds.\n*Uncertainty in Artificial Intelligence.* North-Holland: Elsevier; 1986 Reprinted in Shafer and Pearl 1990.\n\nHennessey Wade L.\n*Common Lisp.* McGraw-Hill; 1989.\n\nHewitt Carl.\nViewing Control Structures as Patterns of Passing Messages.\n*Artificial Intelligence.* 1977;8(no.\n3):323-384.\n\nHobbs Jerry R., Moore Robert C.\n*Formal Theories of the Commonsense World.* Ablex; 1985.\n\nHofstader Douglas R.\n*Godel, Escher, Bach: An Eternal Golden Braid.* Vintage; 1979.\n\nH&ouml;lldobler Steffen.\n*Foundations of Equational Logic Programming.* Springer-Verlag; 1987 Lecture Notes in Artificial Intelligence.\n\nHuddleston Rodney.\n*Introduction to the Grammar of English.* Cambridge University Press; 1984.\n\nHuffman David A.\nImpossible Objects as Nonsense Pictures.\nIn: Meltzer B., Michie D., eds.\n*Machine Intelligence 6.* Edinburgh University Press; 1971:295-323.\n\nHughes R.J.M.\n*Lazy Memo Functions.* In: Proceedings of the Conference on Functional Programming and Computer Architecture, Nancy; Springer-Verlag; 1985:129-146.\n\nIngerman Peter Z.\nThunks.\n*Communications of the ACM.* 1961;4(no.\n1):55-58.\n\nJaffar Joxan, Lassez Jean-Louis, Maher Michael J.\nA Theory of Complete Logic Programs with Equality.\n*Journal of Logic Programming.* 1984;3:211-223.\n\nJackson Peter.\n*Introduction to Expert Systems.* 2d ed Addison-Wesley; 1990.\n\nJames Glenn, James Robert C.\n*Mathematics Dictionary.* Van Nostrand; 1949.\n\nKanal L.N., Lemmer J.F.\n*Uncertainty in Artificial Intelligence.* North-Holland; 1986.\n\nKanal L.N., Lemmer J.F.\n*Uncertainty in Artificial Intelligence 2.* North-Holland; 1988.\n\nKay Alan.\n*The Reactive Engine.* 1969 Ph.D.\nthesis, University of Utah.\n\nKay Martin.\n*Algorithm schemata and data structures in syntactic processing.* 1980 Xerox Palo Alto Research Center Report CSL-80-12.\nReprinted in Grosz et al.\n1986.\n\nKernighan B.W., Plauger P.J.\n*The Elements of Programming Style.* McGraw-Hill; 1974.\n\nKernighan B.W., Plauger P.J.\n*Software Tools in Pascal.* Addison-Wesley; 1981.\n\nKeene Sonya.\n*Object-Oriented Programming in Common Lisp: A Programmer's Guide to CLOS.* Addison-Wesley; 1989.\n\nKnight K.\nUnification: A Multidisciplinary Survey.\n*ACM Computing Surveys.* 1989;21(no.\n1):93-121.\n\nKnuth Donald E., Moore Robert W.\nAn Analysis of Alpha-Beta Pruning.\n*Artificial Intelligence.* 1975;6(no.\n4):293-326.\n\nKohlbecker Jr.\nEugene Edmund.\n*Syntactic Extensions in the Programming Language Lisp.* 1986 Ph.D.\nthesis, Indiana University.\n\nKorf RE.\nDepth-first Iterative Deepening: an Optimal Admissible Tree Search.\n*Artificial Intelligence.* 1985;27:97-109.\n\nKornfeld WA.\nEquality for Prolog.\nIn: 1983:514-519.\n*Proceedings of the Seventh IJCAI.*.\n\nKoschman Timothy.\n*The Common Lisp Companion.* Wiley; 1990.\n\nKowalski Robert.\n*Predicate logic as a programming language.* In: Proceedings of the IFIP-74 Congress; North-Holland; 1974:569-574.\n\nKowalski Robert.\nAlgorithm = Logic + Control.\n*Communications of the ACM.* 1979;22:424-436.\n\nKowalski Robert.\n*Logic for Problem Solving.* North-Holland; 1980.\n\nKowalski Robert.\nThe Early Years of Logic Programming.\n*Communications of the ACM.* 1988;31:38-43.\n\nKranz David, Kelsey Richard, Rees Jonathan, Hudak Paul, Philbin James, Adams Norman.\n*ORBIT: An optimizing compiler for Scheme.* In: SIGPLAN Compiler Construction Conference; 1986.\n\nKreutzer Wolfgang, McKenzie Bruce.\n*Programming for Artificial Intelligence: Methods, Tools and Applications.* Addison-Wesley; 1990.\n\nLakoff George.\n*Women, Fire and Dangerous Things: What Categories Reveal About the Mind.* University of Chicago Press; 1987.\n\nLandin Peter.\nA Correspondence Between Algol 60 and Church's Lambda Notation.\n*Communications of the ACM.* 1965;8(no.\n2):89-101.\n\nLang Kevin J., Perlmutter Barak A.\nOaklisp: An Object-Oriented Dialect of Scheme.\n*Lisp and Symbolic Computing.* 1988;1:39-51.\n\nLangacker Ronald W.\n*Language and its Structure.* Harcourt, Brace & World; 1967.\n\nLassez J.-L., Maher M.J., Marriott K.\nUnification Revisited.\nIn: Minker J., ed.\n*Foundations of Deductive Databases and Logic Programming.* Morgan Kaufmann; 1988:587-625.\n\nLee Kai-Fu, Mahajan Sanjoy.\n*Bill: A Table-Based, Knowledge-Intensive Othello Program.* 1986 Technical Report CMU-CS-86-141, Carnegie Mellon University.\n\nLee Kai-Fu., Mahajan Sanjoy.\nThe Development of a World Class Othello Program.\n*Artificial Intelligence.* 1990;43:21-36.\n\nLevesque Hector.\nMaking Believers out of Computers.\n*Artificial Intelligence.* 1986;30:81-108.\n\nLevy David N.L.\n*Computer Chess.* Batsford; 1976.\n\nLevy David N.L.\n*Computer Games.* Springer-Verlag; 1988a.\n\nLevy David N.L.\n*Computer Chess Compendium.* Springer-Verlag; 1988b.\n\nLevy David N.L.\n*Heuristic Programming in Artificial Intelligence: the First Computer Olympiad.* Ellis Horwood; 1990.\n\nLloyd JW.\n*Foundations of Logic Programming.* Springer-Verlag; 1987.\n\nLoomis Lynn.\n*Calculus.* Addison-Wesley; 1974.\n\nLoveland DW.\n*Near-Horn Prolog.* In: Proceedings of the Fourth International Conference on Logic Programming; 1987:456-469.\n\nLuger George F., Stubblefield William A.\n*Artificial Intelligence and the Design of Expert Systems.* Benjamin/Cummings; 1989.\n\nMaier David, Warren David S.\n*Computing with Logic.* Benjamin/Cummings; 1988.\n\nMarsland T.A.\nComputer Chess Methods.\nIn: Shapiro Stuart C., ed.\n*Entry in Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n\nMartin William A., Fateman Richard J.\n*The MACSYMA System.* In: Proceedings of the Second Symposium on Symbolic and Algebraic Manipulation; ACM SIGSAM; 1971:59-75.\n\nMasinter Larry, Deutsch Peter.\n*Local Optimization in a Compiler for Stack-Based Lisp Machines.* In: Proceedings of the Lisp and Functional Programming Conference; 1980.\n\nMcAllester David.\n*Reasoning Utility Package User's Manual.* 1982 AI Memo 667, AI Lab, MIT.\n\nMcCarthy John.\n*An Algebraic Language for the Manipulation of Symbolic Expressions.* 1958 AI Lab Memo no.\n1, MIT.\n\nMcCarthy John.\nRecursive functions of symbolic expressions and their computation by machine.\n*Communications of the ACM.* 1960;3(no.\n3):184-195.\n\nMcCarthy John.\nA basis for a mathematical theory of computation.\nIn: Braffort P., Hirschberg D., eds.\n*Computer Programming and Formal Systems.* North-Holland; 1963.\n\nMcCarthy John.\n*Programs with Common Sense.* 1968 In Minsky 1968.\nReprinted in Brachman and Levesque 1985.\n\nMcCarthy John.\nHistory of Lisp.\nIn: Wexelblat Richard W., ed.\n*History of Programming Languages.* Academic Press; 1978 Also in ACM SIGPLAN Notices 13, no.\n8.\n\nMcCarthy John, Abrahams P.W., Edwards D.J., Fox P.A., Hart T.P., Levin M.J.\n*Lisp 1.5 Programmer's Manual.* MIT Press; 1962.\n\nMcDermott Drew.\nTarskian Semantics, or No Notation without Denotation!.\n*Cognitive Science.* 1978;2:277-282 Reprinted in Grosz, Sparck-Jones and Webber 1986.\n\nMcDermott Drew.\nA Critique of Pure Reason.\n*Computational Intelligence.* 1987;3:151-160.\n\nMeyer Bertrand.\n*Object-oriented Software Construction.* Prentice-Hall; 1988.\n\nMichie Donald.\nMemo Functions and Machine Learning.\n*Nature.* 1968;218:19-22.\n\nMiller Molly M., Benson Eric.\n*Lisp Style & Design.* Digital Press; 1990.\n\nMinsky Marvin.\n*Semantic Information Processing.* MIT Press; 1968.\n\nMiranker Daniel.\n*TREAT: A New and Efficient Match Algorithm for AI Production Systems.* Pitman; 1990.\n\nMoon David.\n*Object-Oriented Programming with Flavors.* In: Proceedings of the ACM Conference on Object-Oriented Systems, Languages and Applications; 1986.\n\nMoon David, Stallman Richard, Weinreb Daniel.\n*The Lisp Machine Manual.* AI Lab, MIT; 1983.\n\nMoore Robert C.\nThe Role of Logic in Knowledge Representation and Commonsense Reasoning.\n*Proceedings of the AAAI-82.* 1982 Reprinted in Brachman and Levesque 1985.\n\nMoses Joel.\n*Symbolic Integration.* 1967 Report no.\nMAC-TR-47, Project MAC, MIT.\n\nMoses Joel.\n*A MACSYMA Primer.* 1975 Mathlab Memo no.\n2, Computer Science Lab, MIT.\n\nMueller Robert A., Page Rex L.\n*Symbolic Computing with Lisp and Prolog.* Wiley; 1988.\n\nMusser David R., Stepanov Alexander A.\n*The ADA Generic Library.* Springer-Verlag; 1989.\n\nNaish Lee.\n*Negation and Control in Prolog.* Springer-Verlag; 1986 Lecture Notes in Computer Science 238.\n\nNewell Alan, Shaw J.C., Simon Herbert A.\nChess-Playing Programs and the Problem of Complexity.\nIn: *In Feigenbaum and Feldman 1963.* 1963:39-70.\n\nNewell Alan, Simon Herbert A.\nGPS, A Program that Simulates Human Thought.\nIn: *In Feigenbaum and Feldman 1963.* 1963:279-293 Reprinted in Allen, Hendler, and Tate 1990.\n\nNewell Alan, Simon Herbert A.\n*Human Problem Solving.* Prentice-Hall; 1972.\n\nNilsson Nils.\n*Problem-Solving Methods in Artificial Intelligence.* McGraw-Hill; 1971.\n\nNorvig Peter.\nCorrecting a Widespread Error in Unification Algorithms.\n*Software Practice and Experience.* 1991;21(no.\n2):231-233.\n\nNygaard Kristen, Dahl Ole-Johan.\nSIMULA 67.\nIn: Wexelblat Richard W., ed.\n*History of Programming Languages.* 1981.\n\nO'Keefe Richard.\n*The Craft of Prolog.* MIT Press; 1990.\n\nPearl Judea.\n*Heuristics: Intelligent Search Strategies for Computer Problem Solving.* Addison-Wesley; 1984.\n\nPearl Judea.\n*Probabilistic Reasoning in Intelligent Systems: Networks of Plausible Inference.* Morgan Kaufmann; 1988.\n\nPearl Judea.\n*Bayesian and Belief-Functions Formalisms for Evidential Reasoning: A Conceptual Analysis.* In: Proceedings, Fifth Israeli Symposium on Artificial Intelligence; 1989 Reprinted in Shafer and Pearl 1990.\n\nPereira Fernando C.N., Shieber Stuart M.\n*Prolog and Natural-Language Analysis.* Center for the Study of Language and Information; 1987 Lecture Notes no.\n10.\n\nPereira Fernando C.N., Warren David H.D.\nDefinite clause grammars for language analysis-a survey of the formalism and a comparison with augmented transition networks.\n*Artificial Intelligence.* 1980;13:231-278 Reprinted in Grosz et al.\n1986.\n\nPerlis Alan.\nEpigrams on Programming.\n*ACM SIGPLAN Notices.* 1982;17(no.\n9).\n\nPlaisted David A.\nNon-Horn Clause Logic Programming Without Contra-positives.\n*Journal of Automated Reasoning.* 1988;4:287-325.\n\nQuillian M.\nRoss.\nWord Concepts: A Theory of Simulation of Some Basic Semantic Capabilities.\n*Behavioral Science.* 1967;12:410-430 Reprinted in Brachman and Levesque 1985.\n\nQuirk Randolph, Greenbaum Sidney, Leech Geoffrey, Svartik Jan.\n*A Comprehensive Grammar of the English Language.* Longman; 1985.\n\nRamsey Allan, Barrett Rosalind.\n*AI in Practice: Examples in Pop-11.* Halstead Press; 1987.\n\nRich Elaine, Knight Kevin.\n*Artificial Intelligence.* McGraw-Hill; 1991.\n\nRisch RH.\nThe Problem of Integration in Finite Terms.\n*Translations of the A.M.S.* 1969;139:167-189.\n\nRisch RH.\nAlgebraic Properties of the Elementary Functions of Analysis.\n*American Journal of Mathematics.* 1979;101:743-759.\n\nRobinson JA.\nA Machine-Oriented Logic Based on the Resolution Principle.\n*Journal of the ACM.* 1965;12(no.\n1):23-41.\n\nRosenbloom Paul S.\nA World-Championship-Level Othello Program.\n*Artificial Intelligence.* 1982;19:279-320.\n\nRoussel Phillipe.\n*Prolog: manual de reference et d'utilization.* Groupe d'Intelligence Artificielle, Universit&eacute; d'Aix-Marseille; 1975.\n\nRowe Neal.\n*Artificial Intelligence Through Prolog.* Prentice-Hall; 1988.\n\nRuf Erik, Weise Daniel.\nLogScheme: Integrating Logic Programming into Scheme.\n*Lisp and Symbolic Computation.* 1990;3(no.\n3):245-288.\n\nRussell Stuart.\n*The Compleat Guide to MRS.* Stanford University; 1985 Computer Science Dept.\nReport no.\nSTAN-CS-85-1080,\n\nRussell Stuart, Wefald Eric.\n*On Optimal Game-Tree Search using Rational Meta-Reasoning.* In: Proceedings of the International Joint Conference on Artificial Intelligence; 1989:334-340.\n\nSacerdoti Earl.\nPlanning in a Hierarchy of Abstraction Spaces.\n*Artificial Intelligence.* 1974;5:115-135 Reprinted in Allen, Hendler, and Tate 1990.\n\nSager Naomi.\n*Natural Language Information Processing.* Addison-Wesley; 1981.\n\nSamuel AL.\nSome Studies in Machine Learning Using the Game of Checkers.\n*IBM Journal of Research and Development.* 1959;3:210-229 Reprinted in Feigenbaum and Feldman 1963.\n\nSangal Rajeev.\n*Programming Paradigms in Lisp.* McGraw Hill; 1991.\n\nSchank Roger C., Colby Kenneth Mark.\n*Computer Models of Thought and Language.* Freeman; 1973.\n\nSchank Roger C., Riesbeck Christopher.\n*Inside Computer Understanding.* Lawrence Erlbaum; 1981.\n\nSchmolze J.G., Lipkis T.A.\n*Classification in the KL-ONE Knowledge Representation System.* In: Proceedings of the Eighth IJCAI; 1983:330-332.\n\nSedgewick Robert.\n*Algorithms.* Addison-Wesley; 1988.\n\nShannon Claude E.\nProgramming a Digital Computer for Playing Chess.\n*Philosophy Magazine.* 1950a;41:356-375.\n\nShannon Claude E.\nAutomatic Chess Player.\nIn: *Scientific American.* 1950b:182 Feb.,\n\nShebs Stan T., Kessler Robert R.\nAutomatic Design and Implementation of Language Data Types.\n*SIGPLAN 87 Symposium on Interpreters and Interpretive Techniques (ACM SIGPLAN Notices.* 1987;22(no.\n7):26-37.\n\nShapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n\nShafer Glenn, Pearl Judea.\n*Readings in Uncertain Reasoning.* Morgan Kaufmann; 1990.\n\nSheil BA.\nPower Tools for Programmers.\nIn: *Datamation.* 1983:131-144 Feb.,\n\nShortliffe Edward H.\n*Computer-Based Medical Consultation: MYCIN.* American Elsevier; 1976.\n\nShortliffe Edward H., Buchanan Bruce G.\nA Model of Inexact reasoning in Medicine.\n*Mathematical Biosciences.* 1975;23:351-379 Reprinted in Shafer and Pearl 1990.\n\nSlade Richard.\n*The T Programming Language: A Dialect of Lisp.* Prentice Hall; 1987.\n\nSlagle J.R.\nA heuristic program that solves symbolic integration problems in freshman calculus.\nIn: Feigenbaum and Feldman, eds.\n*Computers and Thought.* 1963:191-203 Also in journal of the ACM 10:507-520.\n\nSpiegelhalter David J.\nA Statistical View of Uncertainty in Expert Systems.\nIn: Gale W., ed.\nAddison-Wesley; 1986:.\n*Artificial Intelligence and Statistics.* Reprinted in Shafer and Pearl 1990.\n\nStaples John, Robinson Peter J.\nEfficient Unification of Quantified Terms.\n*Journal of Logic Programming.* 1988;5:133-149.\n\nSteele Jr.\nGuy L.\n*LAMBDA: The Ultimate Imperative.* 1976a AI Lab Memo 353, MIT.\n\nSteele Jr.\nGuy L.\n*LAMBDA: The Ultimate Declarative.* 1976b AI Lab Memo 379, MIT.\n\nSteele Jr.\nGuy L.\n*Debunking the 'Expensive Procedure Call' Myth or, Procedure Call Implementations Considered Harmful or, LAMBDA: The Ultimate GOTO.* 1977 AI Lab Memo 443, MIT.\n\nSteele Jr.\nGuy L.\n*Rabbit: a Compiler for Scheme (A Study in Compiler Optimization).* 1978 AI Lab Technical Report 474, MIT.\n\nSteele Jr.\nGuy L.\nCompiler optimization based on viewing lambda as Rename Plus Goto.\nIn: MIT Press; . *AI: An MIT Perspective.* 1983;vol.\n2.\n\nSteele Jr.\nGuy L.\n*Common Lisp the Language.* Digital Press; 1984.\n\nSteele Jr.\nGuy L.\n*Common Lisp the Language.* 2d edition Digital Press; 1990.\n\nSteele Jr.\nGuy L., Sussman Gerald J.\n*The revised report on Scheme, a dialect of Lisp.* 1978a AI Lab Memo 452, MIT.\n\nSteele Jr.\nGuy L., Sussman Gerald J.\n*The art of the interpreter, or the modularity complex (parts zero, one, and two).* 1978b AI Lab Memo 453, MIT.\n\nSteele Jr.\nGuy L., Jay Sussman Gerald.\n*Design of LISP-Based Processors or, SCHEME: A Dielectric LISP or, Finite Memories Considered Harmful or, LAMBDA: The Ultimate Opcode.* 1979 AI Lab Memo 379, MIT.\n\nSteele Jr.\nGuy L., Sussman Gerald J.\nDesign of a Lisp-Based Processor.\n*Communications of the ACM.* 1980;23(no.\n11):628-645.\n\nStefik Mark, Bobrow Daniel G.\nObject-Oriented Programming: Themes and Variations.\n*AI Magazine.* 1986;6(no.\n4).\n\nSterling Leon, Shapiro Ehud.\n*The Art of Prolog.* MIT Press; 1986.\n\nSterling L., Bundy A., Byrd L., O'Keefe R., Silver B.\nSolving Symbolic Equations with PRESS.\nIn: Calmet J., ed.\n*Computer Algebra, Lecture Notes in Computer Science No.\n144.* Springer-Verlag; 1982:109-116 Also in Journal of Symbolic Computation 7 (1989):71-84.\n\nStickel Mark.\nA Prolog Technology Theorem Prover: Implementation by an Extended Prolog Compiler.\n*Journal of Automated Reasoning.* 1988;4:353-380.\n\nStoyan Herbert.\n*Early Lisp History.* In: Proceedings of the Lisp and Functional Programming Conference; 1984:299-310.\n\nStroustrup Bjarne.\n*The C++ Programming Language.* Addison-Wesley; 1986.\n\nSussman Gerald J.\n*A Computer Model of Skill Acquisition.* Elsevier; 1973.\n\nTanimoto Steven.\n*The Elements of Artificial Intelligence using Common Lisp.* Computer Science Press; 1990.\n\nTate Austin.\nGenerating Project Networks.\n*IJCAI-77.* Boston; 1977 Reprinted in Allen, Hendler, and Tate 1990.\n\nTater Deborah G.\n*A Programmees Guide to Common Lisp.* Digital Press; 1987.\n\nThomason Richmond.\n*Formal Philosophy-Selected Papers of Richard Montague.* Yale University Press; 1974.\n\nTouretzky David.\n*Common Lisp: A Gentle Introduction to Symbolic Computation.* Benjamin/Cummings; 1989.\n\nTversky Amos, Kahneman Daniel.\nJudgement Under Uncertainty: Heuristics and Biases.\n*Science.* 1974;185:1124-1131 Reprinted in Shafer and Pearl 1990.\n\nTversky Amos, Kahneman Daniel.\nExtensional Versus Intuitive Reasoning: The Conjunction Fallacy in Probability Judgement.\n*Psychological Review.* 1983;90:29-315.\n\nTversky Amos, Kahneman Daniel.\nRational Choices and the Framing of Decisions.\n*Journal of Business.* 1986;59:S251-S278 Reprinted in Shafer and Pearl 1990.\n\nUngar David.\n*Generation Scavenging: A Non-Disruptive High Performance Storage Reclamation Algorithm.* In: Proceedings of the ACM SIGSOFT/ SIGPLAN Software Engineering Symposium on Practical Software Development En vironments (Pittsburgh, Pa., April); 1984:157-167 ACM SIGPLAN Notices 19, no.\n5.\n\nvan Emden Maarten H., Yukawa Keitaro.\nLogic Programming with Equations.\n*Journal of Logic Programming.* 1987;4:265-288.\n\nvan Melle WJ.\n*System Aids in Constructing Consultation Programs.* UMI Research Press; 1980.\n\nVan Roy, Peter L.\n*Can Logic Programming Execute as Fast as Imperative Programming?.* Report UCB/CSD 90/600 Berkeley: University of California; 1990.\n\nVygotsky Lev Semenovich.\n*Thought and Language.* MIT Press; 1962.\n\nWaibel Alex, Lee Kai-Fu.\n*Readings in Speech Understanding.* Morgan Kaufmann; 1991.\n\nWaldinger Richard.\nAchieving Several Goals Simultaneously.\nIn: *Machine Intelligence 8.* Ellis Horwood Limited; 1977.\n\nWalker Adrian, McCord Michael, Sowa John F., Wilson Walter G.\n*Knowledge Systems and Prolog.* Addison-Wesley; 1990.\n\nWaltz David I.\nUnderstanding Line Drawings of Scenes with Shadows.\nIn: Winston Patrick H., ed.\n*The Psychology of Computer Vision.* McGraw-Hill; 1975.\n\nWaltz David I.\nWaltz Filtering.\nIn: Shapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n\nWand Mitchell.\nContinuation-Based Program Transformation Strategies.\n*Journal of the ACM.* 1980;27(no.\n1):174-180.\n\nWarren David H.D.\n*WARPLAN: A System for Generating Plans.* 1974a Department of Computational Logic Memo 76, AI, Edinburgh University.\n\nWarren David H.D.\n*Extract from APIC Studies in Data Processing, No.\n24.* 1974b Reprinted in Allen, Hendler, and Tate, 1990.\n\nWarren David H.D.\nProlog on the DECsystem-10.\nIn: Michie Donald, ed.\n*Expert Systems in the Micro-Electronic Age.* Edinburgh University Press; 1979.\n\nWarren David H.D.\n*An abstract Prolog instruction set.* 1983 Technical Note 309, SRI International.\n\nWarren David H.D., Pereira L.M., Pereira Fernando C.N.\n*Prolog-the Language and its Implementation Compared with Lisp.* In: Proceedings of the ACM SIGART-SIGPLAN Symposium on AI and Programming Languages; 1977.\n\nWarren David H.D., Pereira Fernando C.N.\nAn Efficient Easily Adaptable System for Interpreting Natural Language Queries.\n*American Journal of Computational Linguistics.* 1982;8(nos.3-4):110-122.\n\nWaterman David A.\n*A Guide to Expert Systems.* Addison-Wesley; 1986.\n\nWaters Richard C.\nSupporting the Regression Testing of Lisp Programs.\n*Lisp Pointers.* 1991;4(no.\n2):47-53.\n\nWegner Peter.\nDimensions of object-based language design.\nIn: *ACM SIG-PLAN Notices.* 1987:168-182.\n\nWeinreb Daniel, Moon David A.\n*Flavors: Message Passing in the Lisp Machine.* 1980 AI Memo no.\n602, Project MAC, MIT.\n\nWeiss Sholom M., Kulikowski Casimar A.\n*A Practical Guide to Designing Expert Systems.* Rowman & Allanheld; 1984.\n\nWeissman Clark.\n*Lisp 1.5 Primer.* Dickenson; 1967.\n\nWeizenbaum Joseph.\nELIZA-A computer program for the study of natural language communication between men and machines.\n*Communications of the ACM.* 1966;9:36-45.\n\nWeizenbaum Joseph.\n*Computer Power and Human Reason.* Freeman; 1976.\n\nWhorf Benjamin Lee.\n*Language, Thought, and Reality.* MIT Press; 1956.\n\nWilensky Robert.\n*Common LISPcraft.* Norton; 1986.\n\nWinograd Terry.\n*Language as a Cognitive Process.* Addison-Wesley; 1983.\n\nWinston Patrick H.\n*The Psychology of Computer Vision.* McGraw-Hill; 1975.\n\nWinston Patrick H.\n*Artificial Intelligence.* Addison-Wesley; 1984.\n\nWinston Patrick H., Horn Bertold K.P.\n*Lisp.* 3d ed Addison-Wesley; 1988.\n\nWirth N.\n*Algorithms + Data Structures = Programs.* Prentice Hall; 1976.\n\nWong Douglas.\n*Language Comprehension in a Problem Solver.* In: Proceedings of the International Joint Conference on Artificial Intelligence; 1981:7-12.\n\nWoods William A.\nTransition Network Grammars for Natural Language Analysis.\n*Communications of the ACM.* 1970;13:591-606 Reprinted in Grosz et al.\n1986.\n\nWoods William A.\nWhat's in a Link: Foundations for Semantic Networks.\nIn: Bobrow D.G., Collins A.M., eds.\n*Representation and Understanding.* Academic Press; 1975.\n\nWoods William A.\nLunar Rocks on Natural English: Explorations in Natural Language Question Answering.\nIn: Zamponi A., ed.\n*Linguistic Structures Processing.* Elsevier-North-Holland; 1977.\n\nZabih Ramin, McAllester David, Chapman David.\n*Non-Deterministic Lisp with Dependency-Directed Backtracking.* In: Proceedings of the AAAI; 1987.\n\nZadeh Lotfi.\nFuzzy Sets as a Basis for a Theory of Possibility.\n*Fuzzy Sets Systems.* 1978;1:3-28.\n\nZucker S.W.\nVision, Early.\nIn: Shapiro Stuart C., ed.\n*Encyclopedia of Artificial Intelligence.* Wiley; 1990.\n\n\n\n"
  },
  {
    "path": "docs/chapter1.md",
    "content": "# Chapter 1\n## Introduction to Lisp\n\n> You think you know when you learn, are more sure when you can write, even more when you can teach, but certain when you can program.\n>\n> -Alan Perlis \\\n> Yale University computer scientist\n\nThis chapter is for people with little or no experience in Lisp.\nReaders who feel confident in their Lisp programming ability can quickly skim the chapter or skip it entirely.\nThis chapter necessarily moves quickly, so those with little programming experience, or any reader who finds this chapter tough going, should seek out a supplementary introductory text.\nMy recommendations are in the preface.\n\nComputers allow one to carry out computations.\nA word processing program deals with words while a calculator deals with numbers, but the principles are the same.\nIn both cases, you provide the input (words or numbers) and specify the operations (such as deleting a word or adding two numbers) to yield a result (a completed document or calculation).\n\nWe will refer to anything that can be represented in the memory of a computer as a *computational object,* or just an *object.*\nSo, words, paragraphs, and numbers can be objects.\nAnd because the operations (deleting and adding) must be represented somewhere in the computer's memory, they are objects, too.\n\nNormally, the distinction between a computer \"user\" and a computer \"programmer\" is that the user provides new input, or data (words or numbers), while the programmer defines new *operations*, or programs, as well as new *types* of data.\nEvery new object, be it datum or operation, must be defined in terms of previously defined objects.\nThe bad news is that it can be quite tedious to get these definitions right.\nThe good news is that each new object can in turn be used in the definition of future objects.\nThus, even complex programs can be built out of smaller, simpler objects.\nThis book covers a number of typical AI problems, showing how each problem can be broken down into manageable pieces, and also how each piece can be described in the programming language Common Lisp.\nIdeally, readers will learn enough through studying these examples to attack new AI problems with style, grace, and success.\n\nLet's consider a simple example of a computation: finding the sum of two numbers, let's say 2 and 2.\nIf we had a calculator handy, we would type \"2 + 2 =\" and see the answer displayed.\nOn a calculator using reverse Polish notation, we would have to type \"2 2 +\" to see the same answer.\nIn Lisp, as with the calculator, the user carries out an interactive dialog with the computer by typing in an expression and seeing the computer print the value of that expression.\nThis interactive mode is different from many other programming languages that only offer a batch mode, wherein an entire program is compiled and run before any output can be seen.\n\nWe start up a pocket calculator by flipping the on/off switch.\nThe Lisp program must also be started, but the details vary from one computer to another, so I can't explain how your Lisp will work.\nAssuming we have managed to start up Lisp, we are likely to see a *prompt* of some kind.\nOn my computer, Lisp types \"`>`\" to indicate it is ready to accept the next computation.\nSo we are faced with a screen that looks like this:\n\n```lisp\n>\n```\n\nWe may now type in our computation and see the result displayed.\nIt turns out that the Lisp convention for arithmetic expressions is slightly different: a computation consists of a parenthesized list with the operation name first, followed by any number of operands, or arguments.\nThis is called *prefix notation.*\n\n```lisp\n> (+ 2 2)\n4\n>\n```\n\nWe see that Lisp has printed the answer, 4, and then another prompt, >, to indicate it is ready for the next computation.\nThroughout this book, all Lisp expressions will be displayed in `typewriter` font.\nText on the same line as the \">\" prompt is input typed by the user, and text following it is output printed by the computer.\nUsually, input that is typed by the programmer will be in `lowercase` letters, while output that is printed back by the computer will be in `UPPERCASE` letters.\nOf course, with symbols like + and 4 there is no difference.\n\nTo save space on the page, the output will sometimes be shown on the same line as the input, separated by an arrow (=>), which can be read as \"evaluates to,\" and can also be thought of as standing for the return or enter key that the user presses to complete the input:\n\n```lisp\n> (+ 2 2) => 4\n```\n\nOne advantage of parenthesized prefix notation is that the parentheses clearly mark the beginning and end of an expression.\nIf we want, we can give + more than two arguments, and it will still add them all:\n\n```lisp\n> (+ 1 2 3 4 5 6 7 8 9 10) => 55\n```\n\nThis time we try (9000 + 900 + 90 + 9) - (5000 + 500 + 50 + 5):\n\n```lisp\n> (- (+ 9000 900 90 9) (+ 5000 500 50 5)) => 4444\n```\n\nThis example shows that expressions can be nested.\nThe arguments to the - function are parenthesized lists, while the arguments to each `+` are atoms.\nThe Lisp notation may look unusual compared to standard mathematical notation, but there are advantages to this notation; since Lisp expressions can consist of a function followed by any number of arguments, we don't have to keep repeating the \"`+`\". More important than the notation is the rule for evaluation.\nIn Lisp, lists are evaluated by first evaluating all the arguments, then applying the function to the arguments, thereby computing the result.\nThis rule is much simpler than the rule for evaluating normal mathematical expressions, where there are many conventions to remember, such as doing multiplications and divisions before sums and differences.\nWe will see below that the actual Lisp evaluation rule is a little more complicated, but not much.\n\nSometimes programmers who are familiar with other languages have preconceptions that make it difficult for them to learn Lisp.\nFor them, three points are worth stressing here.\nFirst, many other languages make a distinction between statements and expressions.\nAn expression, like `2 + 2`, has a value, but a statement, like `x = 2 + 2`, does not.\nStatements have effects, but they do not return values.\nIn Lisp, there is no such distinction: every expression returns a value.\nIt is true that some expressions have effects, but even those expressions also return values.\n\nSecond, the lexical rules for Lisp are much simpler than the rules for other languages.\nIn particular, there are fewer punctuation characters: only parentheses, quote marks (single, double, and backward), spaces, and the comma serve to separate symbols from each other.\nThus, while the statement `y=a*x+3` is analyzed as seven separate tokens in other languages, in Lisp it would be treated as a single symbol.\n<a id=\"tfn01-1\"></a>\nTo get a list of tokens, we would have to insert spaces: `(y = a * x + 3)`.<sup>[1](#fn01-1)</sup>\n\nThird, while many languages use semicolons to delimit statements, Lisp has no need of semicolons, since expressions are delimited by parentheses.\nLisp chooses to use semicolons for another purpose—to mark the beginning of a comment, which lasts until the end of the line:\n\n```lisp\n> (+ 2 2) ; this is a comment\n4\n```\n\n## 1.1 Symbolic Computation\n\nAll we've done so far is manipulate numbers in the same way a simple pocket calculator would.\nLisp is more useful than a calculator for two main reasons.\nFirst, it allows us to manipulate objects other than numbers, and second, it allows us to define new objects that might be useful in subsequent computations.\nWe will examine these two important properties in turn.\n\nBesides numbers, Lisp can represent characters (letters), strings of characters, and arbitrary symbols, where we are free to interpret these symbols as referring to things outside the world of mathematics.\nLisp can also build nonatomic objects by combining several objects into a list.\nThis capability is fundamental and well supported in the language; in fact, the name Lisp is short for LISt Processing.\n\nHere's an example of a computation on lists:\n\n```lisp\n> (append '(Pat Kim) '(Robin Sandy)) => (PAT KIM ROBIN SANDY)\n```\n\nThis expression appends together two lists of names.\nThe rule for evaluating this expression is the same as the rule for numeric calculations: apply the function (in this case append) to the value of the arguments.\n\nThe unusual part is the quote mark `(')`, which serves to block the evaluation of the following expression, returning it literally.\nIf we just had the expression `(Pat Kim)`, it would be evaluated by considering `Pat` as a function and applying it to the value of the expression `Kim`.\nThis is not what we had in mind.\nThe quote mark instructs Lisp to treat the list as a piece of data rather than as a function call:\n\n```lisp\n> '(Pat Kim) => (PAT KIM)\n```\n\nIn other computer languages (and in English), quotes usually come in pairs: one to mark the beginning, and one to mark the end.\nIn Lisp, a single quote is used to mark the beginning of an expression.\nSince we always know how long a single expression is—either to the end of an atom or to the matching parenthesis of a list—we don't need an explicit punctuation mark to tell us where the expression ends.\nQuotes can be used on lists, as in `'(Pat Kim)`, on symbols as in `'Robin`, and in fact on anything else.\nHere are some examples:\n\n```lisp\n> 'John => JOHN\n\n> '(John Q Public) => (JOHN Q PUBLIC)\n\n> '2 => 2\n\n> 2 => 2\n\n> '(+ 2 2) => (+ 2 2)\n\n> (+ 2 2) 4\n\n> John => *Error: JOHN is not a bound variable*\n\n> (John Q Public) => *Error: JOHN is not a function*\n```\n\nNote that `'2` evaluates to `2` because it is a quoted expression, and `2` evaluates to `2` because numbers evaluate to themselves.\nSame result, different reason.\nIn contrast, `'John` evaluates to `John` because it is a quoted expression, but evaluating `John` leads to an error, because evaluating a symbol means getting the value of the symbol, and no value has been assigned to `John`.\n\nSymbolic computations can be nested and even mixed with numeric computations.\nThe following expression builds a list of names in a slightly different way than we saw before, using the built-in function `list`.\nWe then see how to find the number of elements in the list, using the built-in function `length`:\n\n```lisp\n> (append '(Pat Kim) (list '(John Q Public) 'Sandy))\n(PAT KIM (JOHN Q PUBLIC) SANDY)\n\n> (length (append '(Pat Kim) (list '(John Q Public) 'Sandy)))\n4\n```\n\nThere are four important points to make about symbols:\n\n*   First, it is important to remember that Lisp does not attach any external significance to the objects it manipulates.\nFor example, we naturally think of (`Robin Sandy`) as a list of two first names, and (`John Q Public`) as a list of one person's first name, middle initial, and last name.\nLisp has no such preconceptions.\nTo Lisp, both `Robin` and `xyzzy` are perfectly good symbols.\n\n*   Second, to do the computations above, we had to know that `append`, `length`, and `+` are defined functions in Common Lisp.\nLearning a language involves remembering vocabulary items (or knowing where to look them up) as well as learning the basic rules for forming expressions and determining what they mean.\nCommon Lisp provides over 700 built-in functions.\nAt some point the reader should flip through a reference text to see what's there, but most of the important functions are presented in part I of this book.\n\n*   Third, note that symbols in Common Lisp are not case sensitive.\n<a id=\"tfn01-2\"></a>\nBy that I mean that the inputs `John`, `john`, and `jOhN` all refer to the same symbol, which is normally printed as `JOHN`.<sup>[2](#fn01-2)</sup>\n\n*   Fourth, note that a wide variety of characters are allowed in symbols: numbers, letters, and other punctuation marks like `'+'` or `'!'`\nThe exact rules for what constitutes a symbol are a little complicated, but the normal convention is to use symbols consisting mostly of letters, with words separated by a dash `(-)`, and perhaps with a number at the end.\nSome programmers are more liberal in naming variables, and include characters like `'?!$/<=>'`.\nFor example, a function to convert dollars to yen might be named with the symbol `$-to-yen` or `$->yen` in Lisp, while one would use something like `DollarsToYen, dollars_to_yen` or `dol2yen` in Pascal or C.\nThere are a few exceptions to these naming conventions, which will be dealt with as they come up.\n\n## 1.2 Variables\n\nWe have seen some of the basics of symbolic computation.\nNow we move on to perhaps the most important characteristic of a programming language: the ability to define new objects in terms of others, and to name these objects for future use.\nHere symbols again play an important role-they are used to name variables.\nA variable can take on a value, which can be any Lisp object.\nOne way to give a value to a variable is with `setf`:\n\n```lisp\n> (setf p '(John Q Public)) => (JOHN Q PUBLIC)\n> p => (JOHN Q PUBLIC)\n> (setf x 10) => 10\n> (+ x x) => 20\n> (+ x (length p)) => 13\n```\n\nAfter assigning the value (`John Q Public`) to the variable named `p`, we can refer to the value with the name `p`.\nSimilarly, after assigning a value to the variable named `x`, we can refer to both `x` and `p`.\n\nSymbols are also used to name functions in Common Lisp.\nEvery symbol can be used as the name of a variable or a function, or both, although it is rare (and potentially confusing) to have symbols name both.\nFor example, `append` and `length` are symbols that name functions but have no values as variables, and `pi` does not name a function but is a variable whose value is 3.1415926535897936 (or thereabout).\n\n## 1.3 Special Forms\n\nThe careful reader will note that `setf` violates the evaluation rule.\nWe said earlier that functions like `+`, `-` and `append` work by first evaluating all their arguments and then applying the function to the result.\nBut `setf` doesn't follow that rule, because `setf` is not a function at all.\nRather, it is part of the basic syntax of Lisp.\nBesides the syntax of atoms and function calls, Lisp has a small number of syntactic expressions.\nThey are known as *special forms.*\nThey serve the same purpose as statements in other programming languages, and indeed have some of the same syntactic markers, such as `if` and `loop`.\nThere are two main differences between Lisp's syntax and other languages.\nFirst, Lisp's syntactic forms are always lists in which the first element is one of a small number of privileged symbols.\n`setf` is one of these symbols, so (`setf x 10`) is a special form.\nSecond, special forms are expressions that return a value.\nThis is in contrast to statements in most languages, which have an effect but do not return a value.\n\nIn evaluating an expression like `(setf x (+ 1 2)`), we set the variable named by the symbol `x` to the value of `(+ 1 2)`, which is `3`.\nIf `setf` were a normal function, we would evaluate both the symbol `x` and the expression `(+ 1 2)` and do something with these two values, which is not what we want at all.\n`setf` is called a special form because it does something special: if it did not exist, it would be impossible to write a function that assigns a value to a variable.\nThe philosophy of Lisp is to provide a small number of special forms to do the things that could not otherwise be done, and then to expect the user to write everything else as functions.\n\nThe term *special form* is used confusingly to refer both to symbols like `setf` and expressions that start with them, like `(setf x 3)`.\nIn the book *Common LISPcraft,* Wilensky resolves the ambiguity by calling `setf` a *special function,* and reserving the term *special form* for (`setf x 3`).\nThis terminology implies that `setf` is just another function, but a special one in that its first argument is not evaluated.\nSuch a view made sense in the days when Lisp was primarily an interpreted language.\nThe modern view is that `setf` should not be considered some kind of abnormal function but rather a marker of special syntax that will be handled specially by the compiler.\nThus, the special form `(setf x (+ 2 1))` should be considered the equivalent of `x = 2 + 1` in `C`.\nWhen there is risk of confusion, we will call `setf` a *special form operator* and `(setf x 3)` a *special form expression.*\n\nIt turns out that the quote mark is just an abbreviation for another special form.\nThe expression '*x* is equivalent to `(quote` *x*`)`, a special form expression that evaluates to *x*.\nThe special form operators used in this chapter are:\n\n| []()            |                                              |\n|-----------------|----------------------------------------------|\n| `defun`         | define function                              |\n| `defparameter`  | define special variable                      |\n| `setf`          | set variable or field to new value           |\n| `let`           | bind local variable(s)                       |\n| `case`          | choose one of several alternatives           |\n| `if`            | do one thing or another, depending on a test |\n| `function (#')` | refer to a function                          |\n| `quote (')`     | introduce constant data                      |\n\n## 1.4 Lists\n\nSo far we have seen two functions that operate on lists: `append` and `length`. Since lists are important, let's look at some more list processing functions:\n\n```lisp\n> p => (JOHN Q PUBLIC)\n\n> (first p) JOHN\n\n> (rest p) => (Q PUBLIC)\n\n> (second p) => Q\n\n> (third p) => PUBLIC\n\n> (fourth p) => NIL\n\n> (length p) => 3\n```\n\nThe functions `first`, `second`, `third`, and `fourth` are aptly named: `first` returns the first element of a list, `second` gives you the second element, and so on.\nThe function `rest` is not as obvious; its name stands for \"the rest of the list after the first element.\" The symbol `nil` and the form `()` are completely synonymous; they are both representations of the empty list.\n`nil` is also used to denote the \"false\" value in Lisp.\nThus, `(fourth p)` is `nil` because there is no fourth element of `p`.\nNote that lists need not be composed only of atoms, but can contain sublists as elements:\n\n```lisp\n> (setf x '((1st element) 2 (element 3) ((4)) 5))\n((1ST ELEMENT) 2 (ELEMENT 3) ((4)) 5)\n\n> (length x) => 5\n\n> (first x) => (1ST ELEMENT)\n\n> (second x) => 2\n\n> (third x) => (ELEMENT 3)\n\n> (fourth x) => ((4))\n\n> (first (fourth x)) => (4)\n\n> (first (first (fourth x))) => 4\n\n> (fifth x) => 5\n\n> (first x) => (1ST ELEMENT)\n\n> (second (first x)) => ELEMENT\n```\n\nSo far we have seen how to access parts of lists.\nIt is also possible to build up new lists, as these examples show:\n\n```lisp\n> p => (JOHN Q PUBLIC)\n\n> (cons 'Mr p) => (MR JOHN Q PUBLIC)\n\n> (cons (first p) (rest p)) => (JOHN Q PUBLIC)\n\n> (setf town (list 'Anytown 'USA)) => (ANYTOWN USA)\n\n> (list p 'of town 'may 'have 'already 'won!) =>\n((JOHN Q PUBLIC) OF (ANYTOWN USA) MAY HAVE ALREADY WON!)\n\n> (append p '(of) town '(may have already won!)) =>\n(JOHN Q PUBLIC OF ANYTOWN USA MAY HAVE ALREADY WON!)\n\n> p => (JOHN Q PUBLIC)\n```\n\nThe function cons stands for \"construct.\"\n<a id=\"tfn01-3\"></a>\nIt takes as arguments an element and a list,<sup>[3](#fn01-3)</sup> and constructs a new list whose first is the element and whose rest is the original list.\n`list` takes any number of elements as arguments and returns a new list containing those elements in order.\nWe've already seen `append`, which is similar to `list`; it takes as arguments any number of lists and appends them all together, forming one big list.\nThus, the arguments to `append` must be lists, while the arguments to `list` may be lists or atoms.\nIt is important to note that these functions create new lists; they don't modify old ones.\nWhen we say `(append p q)`, the effect is to create a brand new list that starts with the same elements that were in `p`.\n`p` itself remains unchanged.\n\nNow let's move away from abstract functions on lists, and consider a simple problem: given a person's name in the form of a list, how might we extract the family name?\nFor `(JOHN Q PUBLIC)` we could just use the function `third`, but that wouldn't work for someone with no middle name.\nThere is a function called `last` in Common Lisp; perhaps that would work.\nWe can experiment:\n\n```lisp\n> (last p) => (PUBLIC)\n\n> (first (last p)) => PUBLIC\n```\n\n<a id=\"tfn01-4\"></a>\nIt turns out that `last` perversely returns a list of the last element, rather than the last element itself.<sup>[4](#fn01-4)</sup>\nThus we need to combine `first` and `last` to pick out the actual last element.\nWe would like to be able to save the work we've done, and give it a proper description, like `last-name`.\nWe could use `setf` to save the last name of `p`, but that wouldn't help determine any other last name.\nInstead we want to define a new function that computes the last name of *any* name that is represented as a list.\nThe next section does just that.\n\n## 1.5 Defining New Functions\n\nThe special form `defun` stands for \"define function.\"\nIt is used here to define a new function called `last-name`:\n\n```lisp\n(defun last-name (name)\n  \"Select the last name from a name represented as a list.\"\n  (first (last name)))\n```\n\nWe give our new function the name `last-name`. It has a *parameter list* consisting of a single parameter: (`name`).\nThis means that the function takes one argument, which we will refer to as `name`.\nIt also has a *documentation string* that states what the function does.\nThis is not used in any computation, but documentation strings are crucial tools for debugging and understanding large systems.\nThe body of the definition is `(first (last name))`, which is what we used before to pick out the last name of `p`.\nThe difference is that here we want to pick out the last name of any `name`, not just of the particular name `p`.\n\nIn general, a function definition takes the following form (where the documentation string is optional, and all other parts are required):\n\n`(defun` *function-name* (*parameter...*)\n&nbsp;&nbsp;&nbsp;&nbsp;\"*documentation string*\"\n&nbsp;&nbsp;&nbsp;&nbsp;*function-body...*)\n\nThe function name must be a symbol, the parameters are usually symbols (with some complications to be explained later), and the function body consists of one or more expressions that are evaluated when the function is called.\nThe last expression is returned as the value of the function call.\n\nOnce we have defined `last-name`, we can use it just like any other Lisp function:\n\n```lisp\n> (last-name p) => PUBLIC\n\n> (last-name '(Rear Admiral Grace Murray Hopper)) => HOPPER\n\n> (last-name '(Rex Morgan MD)) => MD\n\n> (last-name '(Spot)) => SPOT\n\n> (last-name '(Aristotle)) => ARISTOTLE\n```\n\nThe last three examples point out an inherent limitation of the programming enterprise.\nWhen we say `(defun last-name...)` we are not really defining what it means for a person to have a last name; we are just defining an operation on a representation of names in terms of lists.\nOur intuitions-that MD is a title, Spot is the first name of a dog, and Aristotle lived before the concept of last name was invented-are not represented in this operation.\nHowever, we could always change the definition of `last-name` to incorporate these problematic cases.\n\nWe can also define the function `first-name`.\nEven though the definition is trivial (it is the same as the function `first`), it is still good practice to define `first-name` explicitly.\nThen we can use the function `first-name` when we are dealing with names, and `first` when we are dealing with arbitrary lists.\nThe computer will perform the same operation in each case, but we as programmers (and readers of programs) will be less confused.\nAnother advantage of defining specific functions like `first-name` is that if we decide to change the representation of names we will only have to change the definition of `first-name`.\nThis is a much easier task than hunting through a large program and changing the uses of `first` that refer to names, while leaving other uses alone.\n\n```lisp\n(defun first-name (name)\n  \"Select the first name from a name represented as a list.\"\n  (first name))\n\n> p => (JOHN Q PUBLIC)\n\n> (first-name p) => JOHN\n\n> (first-name '(Wilma Flintstone)) => WILMA\n\n> (setf names '((John Q Public) (Malcolm X)\n              (Admiral Grace Murray Hopper) (Spot)\n              (Aristotle) (A A Milne) (Z Z Top)\n              (Sir Larry Olivier) (Miss Scarlet))) =>\n\n((JOHN Q PUBLIC) (MALCOLM X) (ADMIRAL GRACE MURRAY HOPPER)\n (SPOT) (ARISTOTLE) (A A MILNE) (Z Z TOP) (SIR LARRY OLIVIER)\n (MISS SCARLET))\n\n> (first-name (first names)) => JOHN\n```\n\nIn the last expression we used the function `first` to pick out the first element in a list of names, and then the function `first-name` to pick out the first name of that element.\nWe could also have said `(first (first names))` or even `(first (first-name names))` and still have gotten `JOHN`, but we would not be accurately representing what is being considered a name and what is being considered a list of names.\n\n## 1.6 Using Functions\n\nOne good thing about defining a list of names, as we did above, is that it makes it easier to test our functions.\nConsider the following expression, which can be used to test the `last-name` function:\n\n```lisp\n> (mapcar #'last-name names)\n(PUBLIC X HOPPER SPOT ARISTOTLE MILNE TOP OLIVIER SCARLET)\n```\n\nThe funny `#'` notation maps from the name of a function to the function itself.\nThis is analogous to `'x` notation.\nThe built-in function `mapcar` is passed two arguments, a function and a list.\nIt returns a list built by calling the function on every element of the input list.\nIn other words, the `mapcar` call above is equivalent to:\n\n```lisp\n(list (last-name (first names))\n      (last-name (second names))\n      (last-name (third names))\n      ...)\n```\n\n`mapcar`'s name comes from the fact that it \"maps\" the function across each of the arguments.\nThe `car` part of the name refers to the Lisp function `car`, an old name for `first`.\n`cdr` is the old name for `rest`.\nThe names stand for \"contents of the address register\" and \"contents of the decrement register,\" the instructions that were used in the first implementation of Lisp on the IBM 704.\nI'm sure you'll agree that `first` and `rest` are much better names, and they will be used instead of `car` and `cdr` whenever we are talking about lists.\nHowever, we will continue to use `car` and `cdr` on occasion when we are considering a pair of values that are not considered as a list.\nBeware that some programmers still use `car` and `cdr` for lists as well.\n\nHere are some more examples of `mapcar`:\n\n```lisp\n> (mapcar #'- '(1 2 3 4)) => (-1 -2 -3 -4)\n\n> (mapcar #'+ '(1 2 3 4) '(10 20 30 40)) => (11 22 33 44)\n```\n\nThis last example shows that `mapcar` can be passed three arguments, in which case the first argument should be a binary function, which will be applied to corresponding elements of the other two lists.\nIn general, `mapcar` expects an *n*-ary function as its first argument, followed by *n* lists.\nIt first applies the function to the argument list obtained by collecting the first element of each list.\nThen it applies the function to the second element of each list, and so on, until one of the lists is exhausted.\nIt returns a list of all the function values it has computed.\n\nNow that we understand `mapcar`, let's use it to test the `first-name` function:\n\n```lisp\n> (mapcar #'first-name names)\n(JOHN MALCOLM ADMIRAL SPOT ARISTOTLE A Z SIR MISS)\n```\n\nWe might be disappointed with these results.\nSuppose we wanted a version of `first-name` which ignored titles like Admiral and Miss, and got to the \"real\" first name.\nWe could proceed as follows:\n\n```lisp\n(defparameter *titles*\n  '(Mr Mrs Miss Ms Sir Madam Dr Admiral Major General)\n  \"A list of titles that can appear at the start of a name.\")\n```\n\nWe've introduced another new special form, `defparameter`, which defines a parameter-a variable that does not change over the course of a computation, but that might change when we think of new things to add (like the French Mme or the military Lt.).\nThe `defparameter` form both gives a value to the variable and makes it possible to use the variable in subsequent function definitions.\nIn this example we have exercised the option of providing a documentation string that describes the variable.\nIt is a widely used convention among Lisp programmers to mark special variables by spelling their names with asterisks on either end.\nThis is just a convention; in Lisp, the asterisk is just another character that has no particular meaning.\n\n<a id=\"tfn01-5\"></a>\nWe next give a new definition for `first-name`, which supersedes the previous definition.<sup>[5](#fn01-5)</sup>\nThis definition says that if the first word of the name is a member of the list of titles, then we want to ignore that word and return the `first-name` of the rest of the words in the name.\nOtherwise, we use the first word, just as before.\nAnother built-in function, `member`, tests to see if its first argument is an element of the list passed as the second argument.\n\nThe special form `if` has the form `(if` *test then-part else-part*).\nThere are many special forms for performing conditional tests in Lisp; `if` is the most appropriate for this example.\nAn `if` form is evaluated by first evaluating the *test* expression.\nIf it is true, the *then-part* is evaluated and returned as the value of the `if` form; otherwise the *else-part* is evaluated and returned.\nWhile some languages insist that the value of a conditional test must be either `true` or `false`, Lisp is much more forgiving.\nThe test may legally evaluate to any value at all.\nOnly the value `nil` is considered false; all other values are considered true.\nIn the definition of `first-name` below, the function `member` will return a non-nil (hence true) value if the first element of the name is in the list of titles, and will return `nil` (hence false) if it is not.\nAlthough all non-nil values are considered true, by convention the constant `t` is usually used to represent truth.\n\n```lisp\n(defun first-name (name)\n  \"Select the first name from a name represented as a list.\"\n  (if (member (first name) *titles*)\n      (first-name (rest name))\n      (first name)))\n```\n\nWhen we map the new `first-name` over the list of names, the results are more encouraging.\nIn addition, the function gets the \"right\" result for `'(Madam Major General Paula Jones)` by dropping off titles one at a time.\n\n```lisp\n> (mapcar #'first-name names)\n(JOHN MALCOLM GRACE SPOT ARISTOTLE A Z LARRY SCARLET)\n\n> (first-name '(Madam Major General Paula Jones))\nPAULA\n```\n\nWe can see how this works by *tracing* the execution of `first-name`, and seeing the values passed to and returned from the function.\nThe special forms `trace` and `untrace` are used for this purpose.\n\n```lisp\n> (trace first-name)\n(FIRST-NAME)\n\n> (first-name '(John Q Public))\n(1 ENTER FIRST-NAME: (JOHN Q PUBLIC))\n(1 EXIT FIRST-NAME: JOHN)\nJOHN\n```\n\nWhen `first-name` is called, the definition is entered with the single argument, `name`, taking on the value `(JOHN Q PUBLIC)`.\nThe value returned is `JOHN`.\nTrace prints two lines indicating entry and exit from the function, and then Lisp, as usual, prints the final result, `JOHN`.\n\nThe next example is more complicated.\nThe function `first-name` is used four times.\nFirst, it is entered with `name` bound to `(Madam Major General Paula Jones)`.\nThe first element of this list is `Madam`, and since this is a member of the list of titles, the result is computed by calling `first-name` again on the rest of the name-`(Major General Paula Jones)`.\nThis process repeats two more times, and we finally enter `first-name` with name bound to (`Paula Jones`).\nSince `Paula` is not a title, it becomes the result of this call to `first-name`, and thus the result of all four calls, as trace shows.\nOnce we are happy with the workings of `first-name`, the special form `untrace` turns off tracing.\n\n```lisp\n> (first-name '(Madam Major General Paula Jones)) =>\n(1 ENTER FIRST-NAME: (MADAM MAJOR GENERAL PAULA JONES))\n  (2 ENTER FIRST-NAME: (MAJOR GENERAL PAULA JONES))\n    (3 ENTER FIRST-NAME: (GENERAL PAULA JONES))\n      (4 ENTER FIRST-NAME: (PAULA JONES))\n      (4 EXIT FIRST-NAME: PAULA)\n    (3 EXIT FIRST-NAME: PAULA)\n  (2 EXIT FIRST-NAME: PAULA)\n(1 EXIT FIRST-NAME: PAULA)\nPAULA\n\n> (untrace first-name) => (FIRST-NAME)\n\n> (first-name '(Mr Blue Jeans)) => BLUE\n```\n\nThe function `first-name` is said to be *recursive* because its definition includes a call to itself.\nProgrammers who are new to the concept of recursion sometimes find it mysterious.\nBut recursive functions are really no different from nonrecursive ones.\nAny function is required to return the correct value for the given input(s).\nAnother way to look at this requirement is to break it into two parts: a function must return a value, and it must not return any incorrect values.\nThis two-part requirement is equivalent to the first one, but it makes it easier to think about and design function definitions.\n\nNext I show an abstract description of the `first-name` problem, to emphasize the design of the function and the fact that recursive solutions are not tied to Lisp in any way:\n\n`function first-name(name):`\n&nbsp;&nbsp;&nbsp;&nbsp;`if` *the first element of name is a title*\n&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;`then` *do something complicated to get the first-name*\n&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;`else` *return the first element of the name*\n\nThis breaks up the problem into two cases.\nIn the second case, we return an answer, and it is in fact the correct answer.\nWe have not yet specified what to do in the first case.\nBut we do know that it has something to do with the rest of the name after the first element, and that what we want is to extract the first name out of those elements.\nThe leap of faith is to go ahead and use `first-name`, even though it has not been fully defined yet:\n\n`function first-name(name):`\n&nbsp;&nbsp;&nbsp;&nbsp;`if` *the first element of name is a title*\n&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;`then` *return the* `first-name` *of the rest of the name*\n&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;`else` *return the first element of the name*\n\nNow the first case in `first-name` is recursive, and the second case remains unchanged.\nWe already agreed that the second case returns the correct answer, and the first case only returns what `first-name` returns.\nSo `first-name` as a whole can only return correct answers.\nThus, we're halfway to showing that the function is correct; the other half is to show that it eventually returns some answer.\nBut every recursive call chops off the first element and looks at the rest, so for an *n*-element list there can be at most *n* recursive calls.\nThis completes the demonstration that the function is correct.\nProgrammers who learn to think this way find recursion to be a valuable tool rather than a confusing mystery.\n\n## 1.7 Higher-Order Functions\n\nFunctions in Lisp can not only be \"called,\" or applied to arguments, they can also be manipulated just like any other kind of object.\nA function that takes another function as an argument is called a *higher-order function.*\n`mapcar` is an example.\nTo demonstrate the higher-order-function style of programming, we will define a new function called `mappend`. It takes two arguments, a function and a list.\n`mappend` maps the function over each element of the list and appends together all the results.\nThe first definition follows immediately from the description and the fact that the function `apply` can be used to apply a function to a list of arguments.\n\n```lisp\n(defun mappend (fn the-list)\n  \"Apply fn to each element of list and append the results.\"\n  (apply #'append (mapcar fn the-list)))\n```\n\nNow we experiment a little to see how `apply` and `mappend` work.\nThe first example applies the addition function to a list of four numbers.\n\n```lisp\n> (apply #'+ '(1 2 3 4)) => 10\n```\n\nThe next example applies append to a list of two arguments, where each argument is a list.\nIf the arguments were not lists, it would be an error.\n\n```lisp\n> (apply #'append '((1 2 3) (a b c))) => (1 2 3 A B C)\n```\n\nNow we define a new function, `self-and-double`, and apply it to a variety of arguments.\n\n```lisp\n> (defun self-and-double (x) (list x (+ x x)))\n\n> (self-and-double 3) => (3 6)\n\n> (apply #'self-and-double '(3)) => (3 6)\n```\n\nIf we had tried to apply `self-and-double` to a list of more than one argument, or to a list that did not contain a number, it would be an error, just as it would be an error to evaluate (`self-and-double 3 4`) or (`self-and-double 'Kim`).\nNow let's return to the mapping functions:\n\n```lisp\n> (mapcar #'self-and-double '(1 10 300)) => ((1 2) (10 20) (300 600))\n\n> (mappend #'self-and-double '(1 10 300)) => (1 2 10 20 300 600)\n```\n\nWhen `mapcar` is passed a function and a list of three arguments, it always returns a list of three values.\nEach value is the result of calling the function on the respective argument.\nIn contrast, when `mappend` is called, it returns one big list, which is equal to all the values that `mapcar` would generate appended together.\nIt would be an error to call `mappend` with a function that didn't return lists, because `append` expects to see lists as its arguments.\n\nNow consider the following problem: given a list of elements, return a list consisting of all the numbers in the original list and the negation of those numbers.\nFor example, given the list (`testing 1 2 3 test`), return (`1 -1 2 -2 3 -3`).\nThis problem can be solved very easily using `mappend` as a component:\n\n```lisp\n(defun numbers-and-negations (input)\n  \"Given a list, return only the numbers and their negations.\"\n  (mappend #'number-and-negation input))\n\n(defun number-and-negation (x)\n  \"If x is a number, return a list of x and -x.\"\n  (if (numberp x)\n      (list x (- x))\n      nil))\n\n> (numbers-and-negations '(testing 1 2 3 test)) => (1 -1 2 -2 3 -3)\n```\n\nThe alternate definition of `mappend` shown in the following doesn't make use of `mapcar;` instead it builds up the list one element at a time:\n\n```lisp\n(defun mappend (fn the-list)\n  \"Apply fn to each element of list and append the results.\"\n  (if (null the-list)\n      nil\n      (append (funcall fn (first the-list))\n              (mappend fn (rest the-list)))))\n```\n\n`funcall` is similar to `apply;` it too takes a function as its first argument and applies the function to a list of arguments, but in the case of `funcall`, the arguments are listed separately:\n\n```lisp\n> (funcall #'+ 2 3) => 5\n\n> (apply #'+ '(2 3)) => 5\n\n> (funcall #'+ '(2 3)) => *Error: (2 3) is not a number.*\n```\n\nThese are equivalent to `(+ 2 3)`, `(+ 2 3)`, and `(+ '(2 3))`, respectively.\n\nSo far, every function we have used has been either predefined in Common Lisp or introduced with a `defun`, which pairs a function with a name.\nIt is also possible to introduce a function without giving it a name, using the special syntax `lambda`.\n\nThe name *lambda* comes from the mathematician Alonzo Church's notation for functions (Church 1941).\nLisp usually prefers expressive names over terse Greek letters, but lambda is an exception.\nA better name would be `make-function`.\nLambda derives from the notation in Russell and Whitehead's *Principia Mathematica,* which used a caret over bound variables: *x&#x302;*(*x + x*).\n\nChurch wanted a one-dimensional string, so he moved the caret in front: *^x*(*x + x*).\nThe caret looked funny with nothing below it, so Church switched to the closest thing, an uppercase lambda, *&Lambda;x*(*x + x*).\nThe &Lambda; was easily confused with other symbols, so eventually the lowercase lambda was substituted: *&lambda;x*(*x + x*).\nJohn McCarthy was a student of Church's at Princeton, so when McCarthy invented Lisp in 1958, he adopted the lambda notation.\nThere were no Greek letters on the keypunches of that era, so McCarthy used (`lambda (x) (+ x x)`), and it has survived to this day.\nIn general, the form of a lambda expression is\n\n`(lambda` (*parameters...*) *body...*)\n\nA lambda expression is just a nonatomic *name* for a function, just as `append` is an atomic name for a built-in function.\nAs such, it is appropriate for use in the first position of a function call, but if we want to get at the actual function, rather than its name, we still have to use the `#'` notation.\nFor example:\n\n```lisp\n> ((lambda (x) (+ x 2)) 4) => 6\n\n> (funcall #'(lambda (x) (+ x 2)) 4) => 6\n```\n\nTo understand the distinction we have to be clear on how expressions are evaluated in Lisp.\nThe normal rule for evaluation states that symbols are evaluated by looking up the value of the variable that the symbol refers to.\nSo the `x` in `(+ x 2)` is evaluated by looking up the value of the variable named `x`.\nA list is evaluated in one of two ways.\nIf the first element of the list is a special form operator, then the list is evaluated according to the syntax rule for that special form.\nOtherwise, the list represents a function call.\nThe first element is evaluated in a unique way, as a function.\nThis means it can either be a symbol or a lambda expression.\nIn either case, the function named by the first element is applied to the values of the remaining elements in the list.\nThese values are determined by the normal evaluation rules.\nIf we want to refer to a function in a position other than the first element of a function call, we have to use the `#'` notation.\nOtherwise, the expressions will be evaluated by the normal evaluation rule, and will not be treated as functions.\nFor example:\n\n```lisp\n> append => *Error: APPEND is not a bound variable*\n\n> (lambda (x) (+ x 2)) => *Error: LAMBDA is not a function*\n```\n\nHere are some more examples of the correct use of functions:\n\n```lisp\n> (mapcar #'(lambda (x) (+ x x))\n         '(1 2 3 4 5)) =>\n(2 4 6 8 10)\n\n> (mappend #'(lambda (l) (list l (reverse l)))\n           '((1 2 3) (a b c))) =>\n((1 2 3) (3 2 1) (A B C) (C B A))\n```\n\nProgrammers who are used to other languages sometimes fail to see the point of lambda expressions.\nThere are two reasons why lambda expressions are very useful.\n\nFirst, it can be messy to clutter up a program with superfluous names.\nJust as it is clearer to write `(a+b)*(c+d)` rather than to invent variable names like `temp1` and `temp2` to hold `a+b` and `c+d`, so it can be clearer to define a function as a lambda expression rather than inventing a name for it.\n\nSecond, and more importantly, lambda expressions make it possible to create new functions at run time.\nThis is a powerful technique that is not possible in most programming languages.\nThese run-time functions, known as *closures,* will be covered in section 3.16.\n\n## 1.8 Other Data Types\n\nSo far we have seen just four kinds of Lisp objects: numbers, symbols, lists, and functions.\nLisp actually defines about 25 different types of objects: vectors, arrays, structures, characters, streams, hash tables, and others.\nAt this point we will introduce one more, the string.\nAs you can see in the following, strings, like numbers, evaluate to themselves.\nStrings are used mainly for printing out messages, while symbols are used for their relationships to other objects, and to name variables.\nThe printed representation of a string has a double quote mark `(\")` at each end.\n\n```lisp\n> \"a string\" => \"a string\"\n\n> (length \"a string\") => 8\n\n> (length \"\") => 0\n```\n\n## 1.9 Summary: The Lisp Evaluation Rule\n\nWe can now summarize the evaluation rule for Lisp.\n\n*   Every expression is either a *list* or an *atom.*\n\n*   Every list to be evaluated is either a *special form expression* or a *function application*.\n\n*   A *special form expression* is defined to be a list whose first element is a special form operator.\nThe expression is evaluated according to the operator's idiosyncratic evaluation rule.\nFor example, the evaluation rule for `setf` is to evaluate the second argument according to the normal evaluation rule, set the first argument to that value, and return the value as the result.\nThe rule for `defun` is to define a new function, and return the name of the function.\nThe rule for quote is to return the first argument unevaluated.\nThe notation `'x` is actually an abbreviation for the special form expression `(quote x)`.\nSimilarly, the notation `#'f` is an abbreviation for the special form expression `(function f)`.\n\n```lisp\n'John ≡ (quote John) => JOHN\n\n(setf p 'John) => JOHN\n\n(defun twice (x) (+ x x)) => TWICE\n\n(if (= 2 3) (error) (+ 5 6)) => 11\n```\n\n*   A *function application* is evaluated by first evaluating the arguments (the rest of the list) and then finding the function named by the first element of the list and applying it to the list of evaluated arguments.\n\n```lisp\n(+ 2 3) => 5\n(- (+ 90 9) (+ 50 5 (length '(Pat Kim)))) => 42\n```\n\nNote that if `'(Pat Kim)` did not have the quote, it would be treated as a function application of the function `pat` to the value of the variable `kim`.\n\n*   Every atom is either a *symbol* or a *nonsymbol.*\n\n*   A *symbol* evaluates to the most recent value that has been assigned to the variable named by that symbol.\nSymbols are composed of letters, and possibly digits and, rarely, punctuation characters.\n<a id=\"tfn01-6\"></a>\nTo avoid confusion, we will use symbols composed mostly of the letters `a-z` and the `'-'` character, with a few exceptions.<sup>[6](#fn01-6)</sup>\n\n```lisp\nnames\np\n*print-pretty*\n```\n\n*   A *nonsymbol atom* evaluates to itself.\nFor now, numbers and strings are the only such non-symbol atoms we know of.\nNumbers are composed of digits, and possibly a decimal point and sign.\nThere are also provisions for scientific notation, rational and complex numbers, and numbers with different bases, but we won't describe the details here.\nStrings are delimited by double quote marks on both sides.\n\n```lisp\n42 => 42\n-273.15 => -273.15\n\"a string\" => \"a string\"\n```\n\nThere are some minor details of Common Lisp that complicate the evaluation rules, but this definition will suffice for now.\n\nOne complication that causes confusion for beginning Lispers is the difference between *reading* and *evaluating* an expression.\nBeginners often imagine that when they type an expression, such as\n\n```lisp\n> (+ (* 3 4) (* 5 6))\n```\n\nthe Lisp system first reads the (`+`, then fetches the addition function, then reads `(* 3 4)` and computes `12`, then reads `(* 5 6)` and computes 30, and finally computes 42.\nIn fact, what actually happens is that the system first reads the entire expression, the list `(+ (* 3 4) (* 5 6))`.\nOnly after it has been read does the system begin to evaluate it.\nThis evaluation can be done by an interpreter that looks at the list directly, or it can be done by a compiler that translates the list into machine language instructions and then executes those instructions.\n\nWe can see now that it was a little imprecise to say, \"Numbers are composed of digits, and possibly a decimal point and sign.\" It would be more precise to say that the printed representation of a number, as expected by the function read and as produced by the function print, is composed of digits, and possibly a decimal point and sign.\nThe internal representation of a number varies from one computer to another, but you can be sure that it will be a bit pattern in a particular memory location, and it will no longer contain the original characters used to represent the number in decimal notation.\nSimilarly, it is the printed representation of a string that is surrounded by double quote marks; the internal representation is a memory location marking the beginning of a vector of characters.\n\nBeginners who fail to grasp the distinction between reading and evaluating may have a good model of what expressions evaluate to, but they usually have a terrible model of the efficiency of evaluating expressions.\nOne student used only one-letter variable names, because he felt that it would be faster for the computer to look up a one-letter name than a multiletter name.\nWhile it may be true that shorter names can save a microsecond at read time, this makes no difference at all at evaluation time.\nEvery variable, regardless of its name, is just a memory location, and the time to access the location does not depend on the name of the variable.\n\n## 1.10 What Makes Lisp Different?\n\nWhat is it that sets Lisp apart from other languages?\nWhy is it a good language for AI applications?\nThere are at least eight important factors:\n\n*   Built-in Support for Lists\n*   Automatic Storage Management\n*   Dynamic Typing\n*   First-Class Functions\n*   Uniform Syntax\n*   Interactive Environment\n*   Extensibility\n*   History\n\nIn sum, these factors allow a programmer to delay making decisions.\nIn the example dealing with names, we were able to use the built-in list functions to construct and manipulate names without making a lot of explicit decisions about their representation.\nIf we decided to change the representation, it would be easy to go back and alter parts of the program, leaving other parts unchanged.\n\nThis ability to delay decisions-or more accurately, to make temporary, nonbinding decisions-is usually a good thing, because it means that irrelevant details can be ignored.\nThere are also some negative points of delaying decisions.\nFirst, the less we tell the compiler, the greater the chance that it may have to produce inefficient code.\nSecond, the less we tell the compiler, the less chance it has of noticing inconsistencies and warning us.\nErrors may not be detected until the program is run.\nLet's consider each factor in more depth, weighing the advantages and disadvantages:\n\n*   *Built-in Support for Lists.*\nThe list is a very versatile data structure, and while lists can be implemented in any language, Lisp makes it easy to use them.\nMany AI applications involve lists of constantly changing size, making fixed-length data structures like vectors harder to use.\nEarly versions of Lisp used lists as their only aggregate data structure.\nCommon Lisp provides other types as well, because lists are not always the most efficient choice.\n\n*   *Automatic Storage Management.*\nThe Lisp programmer needn't keep track of memory allocation; it is all done automatically.\nThis frees the programmer of a lot of effort, and makes it easy to use the functional style of programming.\nOther languages present programmers with a choice.\nVariables can be allocated on the stack, meaning that they are created when a procedure is entered, and disappear when the procedure is done.\nThis is an efficient use of storage, but it rules out functions that return complex values.\nThe other choice is for the programmer to explicitly allocate and free storage.\nThis makes the functional style possible but can lead to errors.\n\nFor example, consider the trivial problem of computing the expression *a* x (b + c), where *a*, *b*, and *c* are numbers.\nThe code is trivial in any language; here it is in Pascal and in Lisp:\n\n```pascal\n/* Pascal */\na * (b + c)\n```\n\n```lisp\n;;; Lisp\n(* a (+ b c))\n```\n\nThe only difference is that Pascal uses infix notation and Lisp uses prefix.\nNow consider computing *a \\* (b + c)* when *a*, *b*, and *c* are matrices.\nAssume we have procedures for matrix multiplication and addition.\nIn Lisp the form is exactly the same; only the names of the functions are changed.\nIn Pascal we have the choice of approaches mentioned before.\nWe could declare temporary variables to hold intermediate results on the stack, and replace the functional expression with a series of procedure calls:\n\n```pascal\n/* Pascal */\nvar temp, result: matrix;\nadd(b,c,temp);\nmult(a,temp,result);\nreturn(result);\n```\n\n```lisp\n;;; Lisp\n(mult a (add b c))\n```\n\nThe other choice is to write Pascal functions that allocate new matrices on the heap.\nThen one can write nice functional expressions like `mult(a,add(b,c))` even in Pascal.\nHowever, in practice it rarely works this nicely, because of the need to manage storage explicitly:\n\n```pascal\n/* Pascal */\nvar a,b,c,x,y: matrix;\nx := add(b.c);\ny := mult(a,x);\nfree(x);\nreturn(y);\n```\n\n```lisp\n;;; Lisp\n(mult a (add b c))\n```\n\nIn general, deciding which structures to free is a difficult task for the Pascal programmer.\nIf the programmer misses some, then the program may run out of memory.\nWorse, if the programmer frees a structure that is still being used, then strange errors can occur when that piece of memory is reallocated.\nLisp automatically allocates and frees structures, so these two types of errors can *never* occur.\n\n*   *Dynamic Typing.*\nLisp programmers don't have to provide type declarations, because the language keeps track of the type of each object at run time, rather than figuring out all types at compile time.\nThis makes Lisp programs shorter and hence faster to develop, and it also means that functions can often be extended to work for objects to which they were not originally intended to apply.\nIn Pascal, we can write a procedure to sort an array of 100 integers, but we can't use that same procedure to sort 200 integers, or 100 strings.\nIn Lisp, one `sort` fits all.\nOne way to appreciate this kind of flexibility is to see how hard it is to achieve in other languages.\nIt is impossible in Pascal; in fact, the language Modula was invented primarily to fix this problem in Pascal.\nThe language Ada was designed to allow flexible generic functions, and a book by Musser and Stepanov (1989) describes an Ada package that gives some of the functionality of Common Lisp's sequence functions.\nBut the Ada solution is less than ideal: it takes a 264-page book to duplicate only part of the functionality of the 20-page chapter 14 from [Steele (1990)](bibliography.md#bb1160), and Musser and Stepanov went through five Ada compilers before they found one that would correctly compile their package.\nAlso, their package is considerably less powerful, since it does not handle vectors or optional keyword parameters.\nIn Common Lisp, all this functionality comes for free, and it is easy to add more.\nOn the other hand, dynamic typing means that some errors will go undetected until run time.\nThe great advantage of strongly typed languages is that they are able to give error messages at compile time.\nThe great frustration with strongly typed languages is that they are only able to warn about a small class of errors.\nThey can tell you that you are mistakenly passing a string to a function that expects an integer, but they can't tell you that you are passing an odd number to a function that expects an even number.\n\n*   *First-Class Functions.*\nA *first-class* object is one that can be used anywhere and can be manipulated in the same ways as any other kind of object.\nIn Pascal or C, for example, functions can be passed as arguments to other functions, but they are not first-class, because it is not possible to create new functions while the program is running, nor is it possible to create an anonymous function without giving it a name.\nIn Lisp we can do both those things using `lambda`.\nThis is explained in section 3.16, page 92.\n\n*   *Uniform Syntax.*\nThe syntax of Lisp programs is simple.\nThis makes the language easy to learn, and very little time is wasted correcting typos.\nIn addition, it is easy to write programs that manipulate other programs or define whole new languages-a very powerful technique.\nThe simple syntax also makes it easy for text editing programs to parse Lisp.\nYour editor program should be able to indent expressions automatically and to show matching parentheses.\nThis is harder to do for languages with complex syntax.\nOn the other hand, some people object to all the parentheses.\nThere are two answers to this objection.\nFirst, consider the alternative: in a language with \"conventional\" syntax, Lisp's parentheses pairs would be replaced either by an implicit operator precedence rule (in the case of arithmetic and logical expressions) or by a `begin/end` pair (in the case of control structures).\nBut neither of these is necessarily an advantage.\nImplicit precedence is notoriously error-prone, and `begin/end` pairs clutter up the page without adding any content.\nMany languages are moving away from `begin/end`: `C` uses `{` and `}`, which are equivalent to parentheses, and several modern functional languages (such as Haskell) use horizontal blank space, with no explicit grouping at all.\nSecond, many Lisp programmers *have* considered the alternative.\nThere have been a number of preprocessors that translate from \"conventional\" syntax into Lisp.\nNone of these has caught on.\nIt is not that Lisp programmers find it *tolerable* to use all those parentheses, rather, they find it *advantageous.*\nWith a little experience, you may too.\nIt is also important that the syntax of Lisp data is the same as the syntax of programs.\nObviously, this makes it easy to convert data to program.\nLess obvious is the time saved by having universal functions to handle input and output.\nThe Lisp functions `read` and `print` will automatically handle any list, structure, string, or number.\nThis makes it trivial to test individual functions while developing your program.\nIn a traditional language like C or Pascal, you would have to write special-purpose functions to read and print each data type you wanted to debug, as well as a special-purpose driver to call the routines.\nBecause this is time-consuming and error-prone, the temptation is to avoid testing altogether.\nThus, Lisp encourages better-tested programs, and makes it easier to develop them faster.\n\n*   *Interactive Environment.*\nTraditionally, a programmer would write a complete program, compile it, correct any errors detected by the compiler, and then run and debug it.\nThis is known as the *batch* mode of interaction.\nFor long programs, waiting for the compiler occupied a large portion of the debugging time.\nIn Lisp one normally writes a few small functions at a time, getting feedback from the Lisp system after evaluating each one.\nThis is known as an *interactive* environment.\nWhen it comes time to make a change, only the changed functions need to be recompiled, so the wait is much shorter.\nIn addition, the Lisp programmer can debug by typing in arbitrary expressions at any time.\nThis is a big improvement over editing the program to introduce print statements and recompiling.\nNotice that the distinction between *interactive* and a *batch* languages is separate from the distinction between *interpreted* and *compiled* languages.\nIt has often been stated, incorrectly, that Lisp has an advantage by virtue of being an interpreted language.\nActually, experienced Common Lisp programmers tend to use the compiler almost exclusively.\nThe important point is interaction, not interpretation.\nThe idea of an interactive environment is such a good one that even traditional languages like C and Pascal are starting to offer interactive versions, so this is not an exclusive advantage of Lisp.\nHowever, Lisp still provides much better access to the interactive features.\nA C interpreter may allow the programmer to type in an expression and have it evaluated immediately, but it will not allow the programmer to write a program that, say, goes through the symbol table and finds all the user-defined functions and prints information on them.\nIn C-even interpreted C-the symbol table is just a Cheshire-cat-like invention of the interpreter's imagination that disappears when the program is run.\n<a id=\"tfn01-7\"></a>\nIn Lisp, the symbol table is a first-class object<sup>[7](#fn01-7)</sup> that can be accessed and modified with functions like `read, intern` and `do-symbols`.\nCommon Lisp offers an unusually rich set of useful tools, including over 700 built-in functions (ANSI Common Lisp has over 900).\nThus, writing a new program involves more gathering of existing pieces of code and less writing of new code from scratch.\nIn addition to the standard functions, Common Lisp implementations usually provide extensions for interacting with the editor, debugger, and window system.\n\n*   *Extensibility*.\nWhen Lisp was invented in 1958, nobody could have foreseen the advances in programming theory and language design that have taken place in the last thirty years.\nOther early languages have been discarded, replaced by ones based on newer ideas.\nHowever, Lisp has been able to survive, because it has been able to adapt.\nBecause Lisp is extensible, it has been changed to incorporate the newest features as they become popular.\nThe easiest way to extend the language is with macros.\nWhen so-called structured programming constructs such as *case* and *if-then-else* arose, they were incorporated into Lisp as macros.\nBut the flexibility of Lisp goes beyond adding individual constructs.\nBrand new styles of programming can easily be implemented.\nMany AI applications are based on the idea of *rule-based* programming.\n<a id=\"tfn01-8\"></a>\nAnother new style is *object-oriented* programming, which has been incorporated with the Common Lisp Object System (CLOS),<sup>[8](#fn01-8)</sup> a set of macros, functions, and data types that have been integrated into ANSI Common Lisp.\n\nTo show how far Lisp has come, here's the only sample program given in the *Lisp/MTS Programmer's Guide* (Hafner and Wilcox 1974):\n\n```lisp\n(PROG (LIST DEPTH TEMP RESTLIST)\n(SETQ RESTLIST (LIST (CONS (READ) O)))\nA (COND\n((NOT RESTLIST) (RETURN 'DONE))\n(T (SETQ LIST (UNCONS (UNCONS RESTLIST\n     RESTLIST) DEPTH))\n(COND ((ATOM LIST)\n(MAPC 'PRIN1 (LIST '\"ATOM:\" LIST '\",\" 'DEPTH DEPTH))\n(TERPRI))\n(T (SETQ TEMP (UNCONS LIST LIST))\n(COND (LIST\n(SETQ RESTLIST (CONS(CONS LIST DEPTH) RESTLIST))))\n(SETQ RESTLIST (CONS (CONS TEMP\n     (ADD1 DEPTH)) RESTLIST))\n))))\n(GO A))\n```\n\nNote the use of the now-deprecated goto `(GO)` statement, and the lack of consistent indentation conventions.\nThe manual also gives a recursive version of the same program:\n\n```lisp\n(PROG NIL (\n(LABEL ATOMPRINT (LAMBDA (RESTLIST)\n(COND ((NOT RESTLIST) (RETURN 'DONE))\n((ATOM (CAAR RESTLIST)) (MAPC 'PRIN1\n     (LIST '\"ATOM:\" (CAAR RESTLIST)\n          '\",\" 'DEPTH (CDAR RESTLIST)))\n(TERPRI)\n(ATOMPRINT (CDR RESTLIST)))\n( T (ATOMPRINT (GRAFT\n(LIST (CONS (CAAAR RESTLIST) (ADD1 (CDAR RESTLIST))))\n(AND (CDAAR RESTLIST) (LIST (CONS (CDAAR RESTLIST)\n     (CDAR RESTLIST))))\n           (CDR RESTLIST)))))))\n(LIST (CONS (READ) 0))))\n```\n\nBoth versions are very difficult to read.\nWith our modern insight (and text editors that automatically indent), a much simpler program is possible:\n\n```lisp\n(defun atomprint (exp &optional (depth 0))\n  \"Print each atom in exp, along with its depth of nesting.\"\n  (if (atom exp)\n      (format t \"~&ATOM: ~a, DEPTH ~d\" exp depth)\n      (dolist (element exp)\n        (atomprint element (+ depth 1)))))\n```\n\n## 1.11 Exercises\n\n&#9635; **Exercise  1.1 [m]** Define a version of `last-name` that handles \"Rex Morgan MD,\" \"Morton Downey, Jr.,\" and whatever other cases you can think of.\n\n&#9635; **Exercise  1.2 [m]** Write a function to exponentiate, or raise a number to an integer power.\nFor example: `(power 3 2)` = 3<sup>2</sup> = 9.\n\n&#9635; **Exercise  1.3 [m]** Write a function that counts the number of atoms in an expression.\nFor example: `(count-atoms '(a (b) c)) = 3`.\nNotice that there is something of an ambiguity in this: should (`a nil c`) count as three atoms, or as two, because it is equivalent to (`a () c`)?\n\n&#9635; **Exercise  1.4 [m]** Write a function that counts the number of times an expression occurs anywhere within another expression.\nExample: `(count-anywhere 'a '(a ((a) b) a)) => 3`.\n\n&#9635; **Exercise  1.5 [m]** Write a function to compute the dot product of two sequences of numbers, represented as lists.\nThe dot product is computed by multiplying corresponding elements and then adding up the resulting products.\nExample:\n\n```lisp\n(dot-product '(10 20) '(3 4)) = 10 x 3 + 20 x 4 = 110\n```\n\n## 1.12 Answers\n\n### Answer 1.2\n```lisp\n(defun power (x n)\n  \"Power raises x to the nth power.  N must be an integer >= 0.\n   This executes in log n time, because of the check for even n.\"\n  (cond ((= n 0) 1)\n        ((evenp n) (expt (power x (/ n 2)) 2))\n        (t (* x (power x (- n 1))))))\n```\n\n### Answer 1.3\n\n```lisp\n(defun count-atoms (exp)\n  \"Return the total number of non-nil atoms in the expression.\"\n  (cond ((null exp) 0)\n        ((atom exp) 1)\n        (t (+ (count-atoms (first exp))\n              (count-atoms (rest exp))))))\n\n(defun count-all-atoms (exp &optional (if-null 1))\n  \"Return the total number of atoms in the expression,\n  counting nil as an atom only in non-tail position.\"\n  (cond ((null exp) if-null)\n        ((atom exp) 1)\n        (t (+ (count-all-atoms (first exp) 1)\n              (count-all-atoms (rest exp) 0)))))\n```\n\n### Answer 1.4\n\n```lisp\n(defun count-anywhere (item tree)\n  \"Count the times item appears anywhere within tree.\"\n  (cond ((eql item tree) 1)\n        ((atom tree) 0)\n        (t (+ (count-anywhere item (first tree))\n              (count-anywhere item (rest tree))))))\n```\n\n### Answer 1.5\nHere are three versions:\n\n\n```lisp\n(defun dot-product (a b)\n  \"Compute the mathematical dot product of two vectors.\"\n  (if (or (null a) (null b))\n      0\n      (+ (* (first a) (first b))\n         (dot-product (rest a) (rest b)))))\n\n(defun dot-product (a b)\n  \"Compute the mathematical dot product of two vectors.\"\n  (let ((sum 0))\n    (dotimes (i (length a))\n      (incf sum (* (elt a i) (elt b i))))\n    sum))\n\n(defun dot-product (a b)\n  \"Compute the mathematical dot product of two vectors.\"\n  (apply #'+ (mapcar #'* a b)))\n```\n\n----------------------\n\n<a id=\"fn01-1\"></a><sup>[1](#tfn01-1)</sup>\nThis list of symbols is not a legal Lisp assignment statement, but it is a Lisp data object.\n\n<a id=\"fn01-2\"></a><sup>[2](#tfn01-2)</sup>\nThe variable `*print-case*` controls how symbols will be printed.\nBy default, the value of this variable is `:upcase`, but it can be changed to `:downcase` or `:capitalize`.\n\n<a id=\"fn01-3\"></a><sup>[3](#tfn01-3)</sup>\nLater we will see what happens when the second argument is not a list.\n\n<a id=\"fn01-4\"></a><sup>[4](#tfn01-4)</sup>\nIn ANSI Common Lisp, `last` is defined to return a list of the last *n* elements, where n defaults to 1.\nThus `(last p) = (last p 1) = (PUBLIC)`,and `(last p 2) = (Q PUBLIC)`.\nThis may make the definition of `last` seem less perverse.\n\n<a id=\"fn01-5\"></a><sup>[5](#tfn01-5)</sup>\nJust as we can change the value of a variable, we can also change the value of a function in Lisp.\nIt is not necessary to recompile everything when a change is made, as it would be in other languages.\n\n<a id=\"fn01-6\"></a><sup>[6](#tfn01-6)</sup>\nFor example, symbols that denote so-called *special* variables usually begin and end in asterisks.\nAlso, note that I did not hesitate to use the symbol `won!` on page 11.\n\n<a id=\"fn01-7\"></a><sup>[7](#tfn01-7)</sup>\nActually, there can be several symbol tables.\nThey are known as *packages* in Common Lisp.\n\n<a id=\"fn01-8\"></a><sup>[8](#tfn01-8)</sup>\nPronounced \"see-loss.\" An alternate pronunciation, \"klaus,\" seems to be losing favor.\n"
  },
  {
    "path": "docs/chapter10.md",
    "content": "# Chapter 10\n## Low-Level Efficiency Issues\n\n> There are only two qualities in the world: efficiency and inefficiency; and only two sorts of people: the efficient and the inefficient.\n>\n> -George Bernard Shaw \\\n> John Bull's Other Island (1904)\n\nThe efficiency techniques of the previous chapter all involved fairly significant changes to an algorithm.\nBut what happens when you already are using the best imaginable algorithms, and performance is still a problem?\nOne answer is to find what parts of the program are used most frequently and make micro-optimizations to those parts.\nThis chapter covers the following six optimization techniques.\nIf your programs all run quickly enough, then feel free to skip this chapter.\nBut if you would like your programs to run faster, the techniques described here can lead to speed-ups of 40 times or more.\n\n*   Use declarations.\n\n*   Avoid generic functions.\n\n*   Avoid complex argument lists.\n\n*   Provide compiler macros.\n\n*   Avoid unnecessary consing.\n\n*   Use the right data structure.\n\n## 10.1 Use Declarations\n\nOn general-purpose computers running Lisp, much time is spent on type-checking.\nYou can gain efficiency at the cost of robustness by declaring, or promising, that certain variables will always be of a given type.\nFor example, consider the following function to compute the sum of the squares of a sequence of numbers:\n\n```lisp\n(defun sum-squares (seq)\n (let ((sum 0))\n  (dotimes (i (length seq))\n   (incf sum (square (elt seq i))))\n  sum))\n(defun square (x) (* x x))\n```\n\nIf this function will only be used to sum vectors of fixnums, we can make it a lot faster by adding declarations:\n\n```lisp\n(defun sum-squares (vect)\n (declare (type (simple-array fixnum *) vect)\n    (inline square) (optimize speed (safety 0)))\n (let ((sum 0))\n  (declare (fixnum sum))\n  (dotimes (i (length vect))\n   (declare (fixnum i))\n   (incf sum (the fixnum (square (svref vect i)))))))\n  sum))\n```\n\nThe fixnum declarations let the compiler use integer arithmetic directly, rather than checking the type of each addend.\nThe (`the fixnum`... ) special form is a promise that the argument is a fixnum.\nThe (`optimize speed (safety 0))` declaration tells the compiler to make the function run as fast as possible, at the possible expense of making the code less safe (by ignoring type checks and so on).\nOther quantities that can be optimized are `compilation-speed, space` and in ANSI Common Lisp only, `debug` (ease of debugging).\nQuantities can be given a number from 0 to 3 indicating how important they are; 3 is most important and is the default if the number is left out.\n\nThe (`inline square`) declaration allows the compiler to generate the multiplication specified by `square` right in the loop, without explicitly making a function call to square.\nThe compiler will create a local variable for (`svref vect i`) and will not execute the reference twice-inline functions do not have any of the problems associated with macros as discussed on [page 853](chapter24.md#p853).\nHowever, there is one drawback: when you redefine an inline function, you may need to recompile all the functions that call it.\n\nYou should declare a function `inline` when it is short and the function-calling overhead will thus be a significant part of the total execution time.\nYou should not declare a function `inline` when the function is recursive, when its definition is likely to change, or when the function's definition is long and it is called from many places.\n\nIn the example at hand, declaring the function inline saves the overhead of a function call.\nIn some cases, further optimizations are possible.\nConsider the predicate `starts-with`:\n\n```lisp\n(defun starts-with (list x)\n \"Is this a list whose first element is x?\"\n (and (consp list) (eql (first list) x)))\n```\n\nSuppose we have a code fragment like the following:\n\n```lisp\n(if (consp list) (starts-with list x) ...)\n```\n\nIf `starts-with` is declared `inline` this will expand to:\n\n```lisp\n(if (consp list) (and (consp list) (eql (first list) x)) ...)\n```\n\nwhich many compilers will simplify to:\n\n```lisp\n(if (consp list) (eql (first list) x) ...)\n```\n\nVery few compilers do this kind of simplification across functions without the hint provided by `inline`.\n\nBesides eliminating run-time type checks, declarations also allow the compiler to choose the most efficient representation of data objects.\nMany compilers support both *boxed* and *unboxed* representations of data objects.\nA boxed representation includes enough information to determine the type of the object.\nAn unboxed representation is just the \"raw bits\" that the computer can deal with directly.\nConsider the following function, which is used to clear a 1024 x 1024 array of floating point numbers, setting each one to zero:\n\n```lisp\n(defun clear-m-array (array)\n  (declare (optimize (speed 3) (safety 0)))\n  (declare (type (simple-array single-float (1024 1024)) array))\n  (dotimes (i 1024)\n    (dotimes (j 1024)\n      (setf (aref array i j) 0.0))))\n```\n\nIn Allegro Common Lisp on a Sun SPARCstation, this compiles into quite good code, comparable to that produced by the C compiler for an equivalent C program.\nIf the declarations are omitted, however, the performance is about 40 times worse.\n\nThe problem is that without the declarations, it is not safe to store the raw floating point representation of `0.0` in each location of the array.\nInstead, the program has to box the `0.0`, allocating storage for a typed pointer to the raw bits.\nThis is done inside the nested loops, so the result is that each call to the version of `clear-m-array` without declarations calls the floating-point-boxing function 1048567 times, allocating a megaword of storage.\nNeedless to say, this is to be avoided.\n\nNot all compilers heed all declarations; you should check before wasting time with declarations your compiler may ignore.\nThe function `disassemble` can be used to show what a function compiles into.\nFor example, consider the trivial function to add two numbers together.\nHere it is with and without declarations:\n\n```lisp\n(defun f (x y)\n  (declare (fixnum x y) (optimize (safety 0) (speed 3)))\n  (the fixnum (+ x y)))\n(defun g (x y) (+ x y))\n```\n\nHere is the disassembled code for f from Allegro Common Lisp for a Motorola 68000-series processor:\n\n```\n> (disassemble 'f)\n;; disassembling #<Function f @ #x83ef79  >\n;; formals: x y\n;; code vector @ #x83ef44\n0:      link    a6.#0\n4:      move.l  a2,-(a7)\n6:      move.l  a5,-(a7)\n8:      move.l  7(a2),a5\n12:     move.l  8(a6).d4 ; y\n16:     add.l   12(a6),d4 ; x\n20:     move.l  #1,d1\n22:     move.l  -8(a6),a5\n26:     unlk    a6\n28:     rtd     #8\n```\n\nThis may look intimidating at first glance, but you don't have to be an expert at 68000 assembler to gain some appreciation of what is going on here.\nThe instructions labeled 0-8 (labels are in the leftmost column) comprise the typical function preamble for the 68000.\nThey do subroutine linkage and store the new function object and constant vector into registers.\nSince f uses no constants, instructions 6, 8, and 22 are really unnecessary and could be omitted.\nInstructions 0,4, and 26 could also be omitted if you don't care about seeing this function in a stack trace during debugging.\nMore recent versions of the compiler will omit these instructions.\n\nThe heart of function `f` is the two-instruction sequence 12-16.\nInstruction 12 retrieves `y`, and 16 adds `y` to `x`, leaving the result in `d4`, which is the \"result\" register.\nInstruction 20 sets `d1`, the \"number of values returned\" register, to 1.\n\nContrast this to the code for `g`, which has no declarations and is compiled at default speed and safety settings:\n\n```\n> (disassemble 'g)\n;; disassembling #<Function g @ #x83dbd1  >\n;; formals: x y\n;; code vector @ #x83db64\n0:      add.l   #8,31(a2)\n4:      sub.w   #2,dl\n6:      beq.s   12\n8:      jmp     16(a4)        ; wnaerr\n12:     link    a6,#0\n16:     move.l  a2,-(a7)\n18:     move.l  a5,-(a7)\n20:     move.l  7(a2),a5\n24:     tst.b   -  208(a4)    ; signal-hit\n28:     beq.s   34\n30:     jsr     872(a4)       ; process-sig\n34:     move.l  8(a6),d4      ; y\n38:     move.l  12(a6),d0     ; x\n42:     or.l    d4,d0\n44:     and.b   #7,d0\n48:     bne.s   62\n50:     add.l   12(a6),d4     ; x\n54:     bvc.s   76\n56:     jsr     696(a4)       ; add-overflow\n60:     bra.s   76\n62:     move.l  12(a6),-(a7)  ; x\n66:     move.l  d4,-(a7)\n68:     move.l  #2,d1\n70:     move.l  -304(a4),a0   ; +  _2op\n74:     jsr     (a4)\n76:     move.l  #1,d1\n78:     move.l  -8(a6),a5\n82:     unlk    a6\n84:     rtd     #8\n```\n\nSee how much more work is done.\nThe first four instructions ensure that the right number of arguments have been passed to `g`.\nIf not, there is a jump to `wnaerr` (wrong-number-of-arguments-error).\nInstructions 12-20 have the argument loading code that was at 0-8 in `f`.\nAt 24-30 there is a check for asynchronous signals, such as the user hitting the abort key.\nAfter `x` and `y` are loaded, there is a type check (42-48).\nIf the arguments are not both fixnums, then the code at instructions 62-74 sets up a call to  `+_2op`, which handles type coercion and non-fixnum addition.\nIf all goes well, we don't have to call this routine, and do the addition at instruction 50 instead.\nBut even then we are not done-just because the two arguments were fixnums does not mean the result will be.\nInstructions 54-56 check and branch to an overflow routine if needed.\nFinally, instructions 76-84 return the final value, just as in `f`.\n\nSome low-quality compilers ignore declarations altogether.\nOther compilers don't need certain declarations, because they can rely on special instructions in the underlying architecture.\nOn a Lisp Machine, both `f` and `g` compile into the same code:\n\n```\n6 PUSH    ARG|0    ; X\n7 +       ARG|1    ; Y\n8 RETURN  PDL-POP\n```\n\nThe Lisp Machine has a microcoded `+` instruction that simultaneously does a fixnum add and checks for non-fixnum arguments, branching to a subroutine if either argument is not a fixnum.\nThe hardware does the work that the compiler has to do on a conventional processor.\nThis makes the Lisp Machine compiler simpler, so compiling a function is faster.\nHowever, on modern pipelined computers with instruction caches, there is little or no advantage to microcoding.\nThe current trend is away from microcode toward reduced instruction set computers (RISC).\n\nOn most computers, the following declarations are most likely to be helpful:\n\n*   `fixnum and float`.\nNumbers declared as fixnums or floating-point numbers can be handled directly by the host computer's arithmetic instructions.\nOn some systems, `float` by itself is not enough; you have to say `single-float` or `double-float`.\nOther numeric declarations will probably be ignored.\nFor example, declaring a variable as integer does not help the compiler much, because bignums are integers.\nThe code to add bignums is too complex to put inline, so the compiler will branch to a general-purpose routine (like `+_2op` in Allegro), the same routine it would use if no declarations were given.\n\n*   `list and array`.\nMany Lisp systems provide separate functions for the list- and array- versions of commonly used sequence functions.\nFor example, `(delete x (the list l))` compiles into `(sys: delete-list-eql x l)` on a TI Explorer Lisp Machine.\nAnother function, `sys:delete-vector`, is used for arrays, and the generic function `delete` is used only when the compiler can't tell what type the sequence is.\nSo if you know that the argument to a generic function is either a `list` or an `array`, then declare it as such.\n\n*   `simple-vector and simple-array`.\nSimple vectors and arrays are those that do not share structure with other arrays, do not have fill pointers, and are not adjustable.\nIn many implementations it is faster to aref a `simple-vector` than a `vector`.\nIt is certainly much faster than taking an `elt` of a sequence of unknown type.\nDeclare your arrays to be simple (if they in fact are).\n\n*   `(array *type*)`.\nIt is often important to specialize the type of array elements.\nFor example, an `(array short-float)` may take only half the storage of a general array, and such a declaration will usually allow computations to be done using the CPU's native floating-point instructions, rather than converting into and out of Common Lisp's representation of floating points.\nThis is very important because the conversion normally requires allocating storage, but the direct computation does not.\nThe specifiers `(simple-array *type*)` and `(vector *type*)` should be used instead of `(array *type*)` when appropriate.\nA very common mistake is to declare `(simple-vector *type*)`.\nThis is an error because Common Lisp expects `(simple-vector *size*)`-don't ask me why.\n\n*   `(array **dimensions*)`.\nThe full form of an array or `simple-array` type specifier is `(array *type dimensions*)`.\nSo, for example, `(array bit (* *))` is a two-dimensional bit array, and `(array bit (1024 1024))` is a 1024  x  1024 bit array.\nIt is very important to specify the number of dimensions when known, and less important to specify the exact size, although with multidimensional arrays, declaring the size is more important.\nThe format for a vector type specifier is `(vector *type size*)`.\n\nNote that several of these declarations can apply all at once.\nFor example, in\n\n```lisp\n(position # \\ . (the simple-string file-name))\n```\n\nthe variable `filename` has been declared to be a vector, a simple array, and a sequence of type `string-char`.\nAll three of these declarations are helpful.\nThe type `simple-string` is an abbreviation for `(simple-array string-char)`.\n\nThis guide applies to most Common Lisp systems, but you should look in the implementation notes for your particular system for more advice on how to fine-tune your code.\n\n## 10.2 Avoid Generic Functions\n\nCommon Lisp provides functions with great generality, but someone must pay the price for this generality.\nFor example, if you write `(elt x 0)`, different machine instruction will be executed depending on if x is a list, string, or vector.\nWithout declarations, checks will have to be done at runtime.\nYou can either provide declarations, as in `(elt (the list x) 0)`, or use a more specific function, such as `(first x)` in the case of lists, `(char x 0)` for strings, `(aref x 0)` for vectors, and `(svref x 0)` for simple vectors.\nOf course, generic functions are useful-I wrote `random-elt` as shown following to work on lists, when I could have written the more efficient `random-mem` instead.\nThe choice paid off when I wanted a function to choose a random character from a string-`random-elt` does the job unchanged, while `random-mem` does not.\n\n```lisp\n(defun random-elt (s) (elt s (random (length s))))\n(defun random-mem (l) (nth (random (length (the list l))) l))\n```\n\nThis example was simple, but in more complicated cases you can make your sequence functions more efficient by having them explicitly check if their arguments are lists or vectors.\nSee the definition of `map-into` on [page 857](chapter24.md#p857).\n\n## 10.3 Avoid Complex Argument Lists\n\nFunctions with keyword arguments suffer a large degree of overhead.\nThis may also be true for optional and rest arguments, although usually to a lesser degree.\nLet's look at some simple examples:\n\n```lisp\n(defun reg (a b c d) (list a b c d))\n(defun rst (a b c &rest d) (list* a b c d))\n(defun opt (&optional a b (c 1) (d (sqrt a))) (list a b c d))\n(defun key (&key a b (c 1) (d (sqrt a))) (list a b c d))\n```\n\nWe can see what these compile into for the TI Explorer, but remember that your compiler may be quite different.\n\n```\n> (disassemble 'reg)\n    8 PUSH            ARG|0     ; A\n    9 PUSH            ARG|1     ; B\n   10 PUSH            ARG|2     ; C\n   11 PUSH            ARG|3     ; D\n   12 TAIL-REC CALL-4 FEF|3     ; #'LIST\n\n> (disassemble 'rst)\n    8 PUSH            ARG|0     ; A\n    9 PUSH            ARG|1     ; B\n   10 PUSH            ARG|2     ; C\n   11 PUSH            LOCAL|0   ; D\n   12 RETURN CALL-4   FEF|3     ; #'LIST*\n```\n\nWith the regular argument list, we just push the four variables on the argument stack and branch to the list function.\n([Chapter 22](chapter22.md) explains why a tail-recursive call is just a branch statement.)\n\nWith a rest argument, things are almost as easy.\nIt turns out that on this machine, the microcode for the calling sequence automatically handles rest arguments, storing them in local variable 0.\nLet's compare with optional arguments:\n\n```\n(defun opt (&optional a b (c 1) (d (sqrt a))) (list a b c d))\n\n> (disassemble 'opt)\n  24 DISPATCH       FEF|5     ; [0=>25;1=>25;2=>25;3=>27;ELSE=>30]\n  25 PUSH-NUMBER    1\n  26 POP            ARG|2     ; C\n  27 PUSH           ARG|0     ; A\n  28 PUSH CALL-1    FEF|3     ; #'SQRT\n  29 POP            ARG|3     ; D\n  30 PUSH           ARG|0     ; A\n  31 PUSH           ARG|1     ; B\n  32 PUSH           ARG|2     ; C\n  33 PUSH           ARG|3     ; D\n  34 TAIL-REC CALL-4  FEF|4   ; #'LIST\n```\n\nAlthough this assembly language may be harder to read, it turns out that optional arguments are handled very efficiently.\nThe calling sequence stores the number of optional arguments on top of the stack, and the `DISPATCH` instruction uses this to index into a table stored at location `FEF|5` (an offset five words from the start of the function).\nThe result is that in one instruction the function branches to just the right place to initialize any unspecified arguments.\nThus, a function with optional arguments that are all supplied takes only one more instruction (the dispatch) than the \"regular\" case.\nUnfortunately, keyword arguments don't fare as well:\n\n```\n(defun key (&key a b` (`c 1`) `(d (sqrt a))) (list a b c d))\n> (disassemble 'key)\n  14 PUSH-NUMBER    1\n  15 POP            LOCAL|3   ; C\n  16 PUSH           FEF|3     ; SYS:-.KEYWORD-GARBAGE\n  17 POP            LOCAL|4\n  18 TEST           LOCAL|0\n  19 BR-NULL    24\n  20 PUSH           FEF|4     ; '(:A :B :C :D)\n  21 SET-NIL        PDL-PUSH\n  22 PUSH-LOC       LOCAL|1   ; A\n  23 (AUX) %STORE-KEY-WORD-ARGS\n  24 PUSH           LOCAL|1   ; A\n  25 PUSH           LOCAL|2   ; B\n  26 PUSH           LOCAL|3   ; C\n  27 PUSH           |4\n  28 EQ             FEF|3     ; SYS::KEYWORD-GARBAGE\n  29 BR-NULL    33\n  30 PUSH           LOCAL|1   ; A\n  31 PUSH CALL-1    FEF|5     ; #'SQRT\n  32 RETURN CALL-4  FEF|6     ; #'LIST\n  33 PUSH           LOCAL|4\n  34 RETURN CALL-4  FEF|6     ; #'LIST\n```\n\nIt is not important to be able to read all this assembly language.\nThe point is that there is considerable overhead, even though this architecture has a specific instruction `(%STORE-KEY-WORD-ARGS)` to help deal with keyword arguments.\n\nNow let's look at the results on another system, the Allegro compiler for the 68000.\nFirst, here's the assembly code for `reg`, to give you an idea of the minimal calling sequence:<a id=\"tfn10-1\"></a><sup>[1](#fn10-1)</sup>\n\n```\n> (disassemble 'reg)\n;; disassembling #<Function reg @ #x83db59>\n;; formals: a b c d\n;; code vector @ #x83dblc\n0:      link    a6,#0\n4:      move.l  a2,-(a7)\n6:      move.l  a5,-(a7)\n8:      move.l  7(a2),a5\n12:     move.l  20(a6),-(a7)    ; a\n16:     move.l  16(a6).-(a7)    ; b\n20:     move.l  12(a6),-(a7)    ; c\n24:     move.l  8(a6),-(a7)     ; d\n28:     move.l  #4,dl\n30:     jsr     848(a4)         ; list\n34:     move.l  -  8(a6),a5\n38:     unlk    a6\n40:     rtd     #10\n```\n\nNow we see that `&rest` arguments take a lot more code in this system:\n\n```\n> (disassemble 'rst)\n;; disassembling #<Function rst @ #x83de89>\n;; formals: a b c &rest d\n;; code vector @ #x83de34\n0:      sub.w   #3,dl\n2:      bge.s   8\n4:      jmp     16(a4)          ; wnaerr\n8:      move.l  (a7)+,al\n10:     move.l  d3,-(a7)        ; nil\n12:     sub.w   #l,dl\n14:     bit.s   38\n16:     move.l  al, -52(a4)     ; c_protected-retaddr\n20:     jsr     40(a4)          ; cons\n24:     move.l  d4,-(a7)\n26:     dbra    dl,20\n30:     move.l  -52(a4),al      ; c_protected-retaddr\n34:     clr.l   -52(a4)         ; c_protected-retaddr\n38:     move.l  al, -(a7)\n40:     link    a6,#0\n44:     move.l  a2,-(a7)\n46:     move.l  a5,-(a7)\n48:     move.l  7(a2),a5\n52:     move.l  -332(a4),a0     ; list*\n56:     move.l  -8(a6),a5\n60:     unlk    a6\n62:     move.l  #4,dl\n64:     jmp     (a4)\n```\n\nThe loop from 20-26 builds up the `&rest` list one cons at a time.\nPart of the difficulty is that `cons` could initiate a garbage collection at any time, so the list has to be built in a place that the garbage collector will know about.\nThe function with optional arguments is even worse, taking 34 instructions (104 bytes), and keywords are worst of all, weighing in at 71 instructions (178 bytes), and including a loop.\nThe overhead for optional arguments is proportional to the number of optional arguments, while for keywords it is proportional to the product of the number of parameters allowed and the number of arguments actually supplied.\n\nA good guideline to follow is to use keyword arguments primarily as an interface to infrequently used functions, and to provide versions of these functions without keywords that can be used in places where efficiency is important.\nConsider:\n\n```lisp\n(proclaim '(inline key))\n(defun key (&key a b (c 1) (d (sqrt a))) (*no-key a b c d))\n(defun *no-key (a b c d) (list a b c d))\n```\n\nHere the function `key` is used as an interface to the function `no-key`, which does the real work.\nThe inline proclamation should allow the compiler to compile a call to `key` as a call to `no-key` with the appropriate arguments:\n\n```\n> (disassemble #'(lambda (x y) (key :b x :a y)))\n  10 PUSH           ARG|1     ; Y\n  11 PUSH           ARG|0     ; X\n  12 PUSH-NUMBER    1\n  13 PUSH           ARG|1     ; Y\n  14 PUSH CALL-1    FEF|3     ; #'SORT\n  15 TAIL-REC CALL-4  FEF|4   ; #'NO-KEY\n```\n\nThe overhead only comes into play when the keywords are not known at compile time.\nIn the following example, the compiler is forced to call key, not `no-key`, because it doesn't know what the keyword `k` will be at run time:\n\n```\n> (disassemble #'(lambda (k x y) (key k x :a y)))\n  10 PUSH             ARG|0   ;  K\n  11 PUSH             ARG|1   ;  X\n  12 PUSH             FEF|3   ; ':A\n  13 PUSH             ARG|2   ;  Y\n  14 TAIL-REC CALL-4  FEF|4   ;  #'KEY\n```\n\nOf course, in this simple example I could have replaced `no-key` with `list`, but in general there will be some more complex processing.\nIf I had proclaimed `no-key` inline as well, then I would get the following:\n\n```\n> (disassemble #'(lambda (x y) (key :b x :a y)))\n  10 PUSH             ARG|1 ; Y\n  11 PUSH             ARG|0 ; X\n  12 PUSH-NUMBER      1\n  13 PUSH             ARG|1 ; Y\n  14 PUSH CALL-1      FEF|3 ; #'SORT\n  15 TAIL-REC CALL-4  FEF|4 ; #'LIST\n```\n\nIf you like, you can define a macro to automatically define the interface to the keyword-less function:\n\n```lisp\n(defmacro defun* (fn-name arg-list &rest body)\n \"Define two functions. one an interface to a &keyword-less\n version. Proclaim the interface function inline.\"\n (if (and (member '&key arg-list)\n    (not (member '&rest arg-list)))\n   (let ((no-key-fn-name (symbol fn-name '*no-key))\n    (args (mapcar #'first-or-self\n       (set-difference\n        arg-list\n        lambda-list-keywords))))\n   '(progn\n    (proclaim '(inline ,fn-name))\n    (defun ,no-key-fn-name ,args\n     .,body)\n    (defun ,fn-name ,arg-list\n     (,no-key-fn-name .,args))))\n  '(defun ,fn-name ,arg-list\n   .,body)))\n>(macroexpand '(defun* key (&key a b (c 1) (d (sqrt a)))\n      (list a b c d)))\n(PROGN (PROCLAIM '(INLINE KEY))\n  (DEFUN KEY*NO-KEY (A B C D) (LIST A B C D))\n  (DEFUN KEY (&KEY A B (C 1) (D (SQRT A)))\n   (KEY*NO-KEY A B C D)))\n>(macroexpand '(defun* reg (a b c d) (list a b c d)))\n(DEFUN REG (A B C D) (LIST A B C D))\n```\n\nThere is one disadvantage to this approach: a user who wants to declare `key` inline or not inline does not get the expected result.\nThe user has to know that `key` is implemented with `key*no-key`, and declare `key*no-key` inline.\n\nAn alternative is just to proclaim the function that uses `&key` to be inline.\nRob MacLachlan provides an example.\nIn CMU Lisp, the function `member` has the following definition, which is proclaimed inline:\n\n```lisp\n(defun member (item list &key (key #'identity)\n        (test #'eql testp)(test-not nil notp))\n (do ((list list (cdr list)))\n   ((null list) nil)\n  (let ((car (car list)))\n   (if (cond\n    (testp\n     (funcall test item\n        (funcall key car)))\n    (notp\n     (not\n   (funcall test-not item\n      (funcall key car))))\n  (t\n   (funcall test item\n      (funcall key car))))\n (return list)))))\n```\n\nA call like `(member ch 1 :key #'first-letter :test #'char =)` expands into the equivalent of the following code.\nUnfortunately, not all compilers are this clever with inline declarations.\n\n```lisp\n(do ((list list (cdr list)))\n   ((null list) nil)\n  (let ((car (car list)))\n   (if (char= ch (first-letter car))\n    (return list))))\n```\n\nThis chapter is concerned with efficiency and so has taken a stand against the use of keyword parameters in frequently used functions.\nBut when maintainability is considered, keyword parameters look much better.\nWhen a program is being developed, and it is not clear if a function will eventually need additional arguments, keyword parameters may be the best choice.\n\n## 10.4 Avoid Unnecessary Consing\n\nThe `cons` function may appear to execute quite quickly, but like all functions that allocate new storage, it has a hidden cost.\nWhen large amounts of storage are used, eventually the system must spend time garbage collecting.\nWe have not mentioned it earlier, but there are actually two relevant measures of the amount of space consumed by a program: the amount of storage allocated, and the amount of storage retained.\nThe difference is storage that is used temporarily but eventually freed.\nLisp guarantees that unused space will eventually be reclaimed by the garbage collector.\nThis happens automatically-the programmer need not and indeed can not explicitly free storage.\nThe problem is that the efficiency of garbage collection can vary widely.\nGarbage collection is particularly worrisome for real-time systems, because it can happen at any time.\n\nThe antidote to garbage woes is to avoid unnecessary copying of objects in often-used code.\nTry using destructive operations, like `nreverse, delete`, and `nconc`, rather than their nondestructive counterparts, (like reverse, remove, and append) whenever it is safe to do so.\nOr use vectors instead of lists, and reuse values rather than creating copies.\nAs usual, this gain in efficiency may lead to errors that can be difficult to debug.\nHowever, the most common kind of unnecessary copying can be eliminated by simple reorganization of your code.\nConsider the following version of `flatten`, which returns a list of all the atoms in its input, preserving order.\nUnlike the version in [chapter 5](chapter5.md), this version returns a single list of atoms, with no embedded lists.\n\n```lisp\n(defun flatten (input)\n \"Return a flat list of the atoms in the input.\n Ex: (flatten '((a) (b (c) d))) => (a b c d).\"\n (cond ((null input) nil)\n   ((atom input) (list input))\n   (t (append (flatten (first input))\n      (flatten (rest input))))))\n```\n\nThis definition is quite simple, and it is easy to see that it is correct.\nHowever, each call to `append` requires copying the first argument, so this version can cons *O*(*n*<sup>2</sup>) cells on an input with *n* atoms.\nThe problem with this approach is that it computes the list of atoms in the `first` and `rest` of each subcomponent of the input.\nBut the `first` sublist by itself is not part of the final answer-that's why we have to call `append.` We could avoid generating garbage by replacing `append` with `nconc,` but even then we would still be wasting time, because `nconc` would have to scan through each sublist to find its end.\n\nThe version below makes use of an *accumulator* to keep track of the atoms that have been collected in the rest, and to add the atoms in the `first` one at a time with cons, rather than building up unnecessary sublists and appending them.\nThis way no garbage is generated, and no subcomponent is traversed more than once.\n\n```lisp\n(defun flatten (input &optional accumulator)\n \"Return a flat list of the atoms in the input.\n Ex: (flatten '((a) (b (c) d))) => (a b c d).\"\n (cond ((null input) accumulator)\n   ((atom input) (cons input accumulator))\n   (t (flatten (first input)\n      (flatten (rest input) accumulator)))))\n```\n\nThe version with the accumulator may be a little harder to understand, but it is far more efficient than the original version.\nExperienced Lisp programmers become quite skilled at replacing calls to `append` with accumulators.\n\nSome of the early Lisp machines had unreliable garbage-collection, so users just turned garbage collection off, used the machine for a few days, and rebooted when they ran out of space.\nWith a large virtual memory system this is a feasible approach, because virtual memory is a cheap resource.\nThe problem is that real memory is still an expensive resource.\nWhen each page contains mostly garbage and only a little live data, the system will spend a lot of time paging data in and out.\nCompacting garbage-collection algorithms can relocate live data, packing it into a minimum number of pages.\n\nSome garbage-collection algorithms have been optimized to deal particularly well with just this case.\nIf your system has an *ephemeral* or *generational* garbage collector, you need not be so concerned with short-lived objects.\nInstead, it will be the medium-aged objects that cause problems.\nThe other problem with such systems arises when an object in an old generation is changed to point to an object in a newer generation.\nThis is to be avoided, and it may be that `reverse` is actually faster than `nreverse` in such cases.\nTo decide what works best on your particular system, design some test cases and time them.\n\nAs an example of efficient use of storage, here is a version of `pat-match` that eliminates (almost) all consing.\nThe original version of `pat-match,` as used in ELIZA ([page 180](chapter6.md#p180)), used an association list of variable/value pairs to represent the binding list.\nThis version uses two sequences: a sequence of variables and a sequence of values.\nThe sequences are implemented as vectors instead of lists.\nIn general, vectors take half as much space as lists to store the same information, since half of every list is just pointing to the next element.\n\nIn this case, the savings are much more substantial than just half.\nInstead of building up small binding lists for each partial match and adding to them when the match is extended, we will allocate a sufficiently large vector of variables and values just once, and use them over and over for each partial match, and even for each invocation of `pat-match.` To do this, we need to know how many variables we are currently using.\nWe could initialize a counter variable to zero and increment it each time we found a new variable in the pattern.\nThe only difficulty would be when the counter variable exceeds the size of the vector.\nWe could just give up and print an error message, but there are more user-friendly alternatives.\nFor example, we could allocate a larger vector for the variables, copy over the existing ones, and then add in the new one.\n\nIt turns out that Common Lisp has a built-in facility to do just this.\nWhen a vector is created, it can be given a *fill pointer*.\nThis is a counter variable, but one that is conceptually stored inside the vector.\nVectors with fill pointers act like a cross between a vector and a stack.\nYou can push new elements onto the stack with the functions `vector-push` or `vector-push-extend`.\nThe latter will automatically allocate a larger vector and copy over elements if necessary.\nYou can remove elements with `vector-pop`, or you can explicitly look at the fill pointer with `fill-pointer`, or change it with a `setf`.\nHere are some examples (with `*print-array*` set to `t` so we can see the results):\n\n```lisp\n> (setf a (make-array 5 :fill-pointer 0))\n#()\n\n> (vector-push 1 a)\n0\n\n> (vector-push 2 a)\n1\n\n> a\n#(1 2)\n\n> (vector-pop a)\n2\n\n> a\n#(1)\n\n> (dotimes (i 10) (vector-push-extend 'x a))\nNIL\n\n> a\n#(1 XXXXXXXXXX)\n\n> (fill-pointer a)\n11\n\n> (setf (fill-pointer a) 1)\n1\n\n> a\n#(1)\n\n> (find 'x a)\nNIL NIL         ; FIND can't find past the fill pointer\n\n> (aref a 2)\nX               ; But AREF can see beyond the fill pointer\n```\n\n\nUsing vectors with fill pointers in `pat-match,` the total storage for binding lists is just twice the number of variables in the largest pattern.\nI have arbitrarily picked 10 as the maximum number of variables, but even this is not a hard limit, because `vector-push-extend` can increase it.\nIn any case, the total storage is small, fixed in size, and amortized over all calls to `pat-match.` These are just the features that indicate a responsible use of storage.\n\nHowever, there is a grave danger with this approach: the value returned must be managed carefully.\nThe new `pat-match` returns the value of `success` when it matches.\n`success` is bound to a cons of the variable and value vectors.\nThese can be freely manipulated by the calling routine, but only up until the next call to `pat-match`.\nAt that time, the contents of the two vectors can change.\nTherefore, if any calling function needs to hang on to the returned value after another call to `pat-match,` it should make a copy of the returned value.\nSo it is not quite right to say that this version of `pat-match` eliminates all consing.\nIt will cons when `vector-push-extend` runs out of space, or when the user needs to make a copy of a returned value.\n\nHere is the new definition of `pat-match.` It is implemented by closing the definition of `pat-match` and its two auxiliary functions inside a `let` that establishes the bindings of `vars, vals`, and `success`, but that is not crucial.\nThose three variables could have been implemented as global variables instead.\nNote that it does not support segment variables, or any of the other options implemented in the `pat-match` of [chapter 6](chapter6.md).\n\n```lisp\n(let* ((vars (make-array 10 :fill-pointer 0 :adjustable t))\n   (vals (make-array 10 :fill-pointer 0 :adjustable t))\n   (success (cons vars vals)))\n(defun efficient-pat-match (pattern input)\n \"Match pattern against input.\"\n (setf (fill-pointer vars) 0)\n (setf (fill-pointer vals) 0)\n (pat-match-1 pattern input))\n(defun pat-match-1 (pattern input)\n (cond ((variable-p pattern) (match-var pattern input))\n   ((eql pattern input) success)\n   ((and (consp pattern) (consp input))\n    (and (pat-match-1 (first pattern) (first input))\n      (pat-match-1 (rest pattern) (rest input))))\n   (t fail)))\n(defun match-var (var input)\n \"Match a single variable against input.\"\n (let ((i (position var vars)))\n  (cond ((null i)\n     (vector-push-extend var vars)\n     (vector-push-extend input vals) success)\n   ((equal input (aref vals i)) success)\n   (t fail)))))\n```\n\nAn example of its use:\n\n```lisp\n>(efficient-pat-match '(?x + ?x = ?y . ?z)\n        '(2 + 2 = (3 + 1) is true))\n(#(?X ?Y ?Z) . #(2 (3 + 1) (IS TRUE)))\n```\n\nExtensible vectors with fill pointers are convenient, and much more efficient than consing up lists.\nHowever, there is some overhead involved in using them, and for those sections of code that must be most efficient, it is best to stick with simple vectors.\nThe following version of `efficient-pat-match` explicitly manages the size of the vectors and explicitly replaces them with new ones when the size is exceeded:\n\n```lisp\n(let* ((current-size 0)\n   (max-size 1)\n   (vars (make-array max-size))\n   (vals (make-array max-size))\n   (success (cons vars vals)))\n (declare (simple-vector vars vals)\n     (fixnum current-size max-size))\n(defun efficient-pat-match (pattern input)\n \"Match pattern against input.\"\n (setf current-size 0)\n (pat-match-1 pattern input))\n;; pat-match-1 is unchanged\n(defun match-var (var input)\n \"Match a single variable against input.\"\n (let ((i (position var vars)))\n  (cond\n   ((null i)\n    (when (= current-size max-size)\n     ;; Make new vectors when we run out of space\n     (setf max-size (* 2 max-size)\n       vars (replace (make-array max-size) vars)\n       vals (replace (make-array max-size) vals)\n       success (cons vars vals)))\n    ;; Store var and its value in vectors\n    (setf (aref vars current-size) var)\n    (setf (aref vals current-size) input)\n    (incf current-size)    success)\n   ((equal input (aref vals i)) success)\n   (t fail)))))\n```\n\nIn conclusion, replacing lists with vectors can often save garbage.\nBut when you must use lists, it pays to use a version of cons that avoids consing when possible.\nThe following is such a version:\n\n```lisp\n(proclaim '(inline reuse-cons))\n(defun reuse-cons (x y x-y)\n \"Return (cons x y), or just x-y if it is equal to (cons x y).\"\n (if (and (eql x (car x-y)) (eql y (cdr x-y)))\n   x-y\n   (cons x y)))\n```\n\nThe trick is based on the definition of subst in Steele's *Common Lisp the Language*.\nHere is a definition for a version of `remove` that uses `reuse-cons`:\n\n```lisp\n(defun remq (item list)\n \"Like REMOVE, but uses EQ, and only works on lists.\"\n (cond ((null list) nil )\n   ((eq item (first list)) (remq item (rest list)))\n   (t (reuse-cons (first list)\n        (remq item (rest list))\n        list))))\n```\n\n### Avoid Consing: Unique Lists\n\nOf course, `reuse-cons` only works when you have candidate cons cells around.\nThat is, (`reuse-cons a b c`) only saves space when `c` is (or might be) equal to (`cons a b`).\nFor some applications, it is useful to have a version of `cons` that returns a unique cons cell without needing `c` as a hint.\nWe will call this version `ucons` for \"unique cons.\"\n`ucons` maintains a double hash table: `*uniq-cons-table*` is a hash table whose keys are the `cars` of cons cells.\nThe value for each `car` is another hash table whose keys are the `cdrs` of cons cells.\nThe value of each `cdr` in this second table is the original cons cell.\nSo two different cons cells with the same `car` and `cdr` will retrieve the same value.\nHere is an implementation of `ucons`:\n\n```lisp\n(defvar *uniq-cons-table* (make-hash-table :test #'eq))\n(defun ucons (x y)\n \"Return a cons s.t. (eq (ucons x y) (ucons x y)) is true.\"\n (let ((car-table (or (gethash x *uniq-cons-table*)\n        (setf (gethash x *uniq-cons-table*)\n          (make-hash-table :test #'eq)))))\n  (or (gethash y car-table)\n    (setf (gethash y car-table) (cons x y)))))\n```\n\n`ucons`, unlike `cons`, is a true function: it will always return the same value, given the same arguments, where \"same\" is measured by `eq`.\nHowever, if `ucons` is given arguments that are `equal` but not `eq`, it will not return a unique result.\nFor that we need the function `unique`.\nIt has the property that `(unique x)` is eq to `(unique y)` whenever `x` and `y` are equal.\n`unique` uses a hash table for atoms in addition to the double hash table for conses.\nThis is necessary because strings and arrays can be equal without being eq.\nBesides `unique`, we also define `ulist` and uappend for convenience.\n\n```lisp\n(defvar *uniq-atom-table* (make-hash-table :test #'equal))\n (defun unique (exp)\n  \"Return a canonical representation that is EQUAL to exp,\n  such that (equal x y) implies (eq (unique x) (unique y)).\"\n  (typecase exp\n   (symbol exp)\n   (fixnum exp) ;; Remove if fixnums are not eq in your Lisp\n   (atom (or (gethash exp *uniq-atom-table*)\n        (setf (gethash exp *uniq-atom-table*) exp)))\n   (cons (unique-cons (car exp) (cdr exp)))))\n (defun unique-cons (x y)\n  \"Return a cons s.t. (eq (ucons x y) (ucons x2 y2)) is true\n  whenever (equal x x2) and (equal y y2) are true.\"\n  (ucons (unique x) (unique y)))\n (defun ulist (&rest args)\n  \"A uniquified list.\"\n  (unique args))\n (defun uappend (x y)\n  \"A unique list equal to (append x y).\"\n  (if (null x)\n    (unique y)\n    (ucons (first x) (uappend (rest x) y))))\n```\n\nThe above code works, but it can be improved.\nThe problem is that when `unique` is applied to a tree, it always traverses the tree all the way to the leaves.\nThe function `unique-cons` is like `ucons,` except that `unique-cons` assumes its arguments are not yet unique.\nWe can modify `unique-cons` so that it first checks to see if its arguments are unique, by looking in the appropriate hash tables:\n\n```lisp\n(defun unique-cons (x y)\n \"Return a cons s.t. (eq (ucons x y) (ucons x2 y2)) is true\n whenever (equal x x2) and (equal y y2) are true.\"\n (let ((ux) (uy)) ; unique x and y\n  (let ((car-table\n     (or (gethash x *uniq-cons-table*)\n      (gethash (setf ux (unique x)) *uniq-cons-table*)\n      (setf (gethash ux *uniq-cons-table*)\n        (make-hash-table :test #'eq)))))\n   (or (gethash y car-table)\n    (gethash (setf uy (unique y)) car-table)\n    (setf (gethash uy car-table)\n      (cons ux uy))))))\n```\n\nAnother advantage of `unique` is that it can help in indexing.\nIf lists are unique, then they can be stored in an `eq` hash table instead of a equal hash table.\nThis can lead to significant savings when the list structures are large.\nAn `eq` hash table for lists is almost as good as a property list on symbols.\n\n### Avoid Consing: Multiple Values\n\nParameters and multiple values can also be used to pass around values, rather than building up lists.\nFor example, instead of:\n\n```lisp\n(defstruct point \"A point in 3-D cartesian space.\" x y z)\n(defun scale-point (k pt)\n \"Multiply a point by a constant, K.\"\n (make-point :x (* k (point-x pt))\n         :y (* k (point-y pt))\n         :z (* k (point-z pt))))\n```\n\none could use the following approach, which doesn't generate structures:\n\n```lisp\n(defun scale-point (k x y z)\n \"Multiply the point (x,y,z) by a constant, K.\"\n (values (* k x) (* k y) (* k z)))\n```\n\n### Avoid Consing: Resources\n\nSometimes it pays to manage explicitly the storage of instances of some data type.\nA pool of these instances may be called a *resource*.\nExplicit management of a resource is appropriate when: (1) instances are frequently created, and are needed only temporarily; (2) it is easy/possible to be sure when instances are no longer needed; and (3) instances are fairly large structures or take a long time to initialize, so that it is worth reusing them instead of creating new ones.\nCondition (2) is the crucial one: If you deallocate an instance that is still being used, that instance will mysteriously be altered when it is reallocated.\nConversely, if you fail to deallocate unneeded instances, then you are wasting valuable memory space.\n(The memory management scheme is said to leak in this case.)\n\nThe beauty of using Lisp's built-in memory management is that it is guaranteed never to leak and never to deallocate structures that are in use.\nThis eliminates two potential bug sources.\nThe penalty you pay for this guarantee is some inefficiency of the general-purpose memory management as compared to a custom user-supplied management scheme.\nBut beware: modern garbage-collection techniques are highly optimized.\nIn particular, the so-called *generation scavenging* or *ephemeral* garbage collectors look more often at recently allocated storage, on the grounds that recently made objects are more likely to become garbage.\nIf you hold on to garbage in your own data structures, you may end up with worse performance.\n\nWith all these warnings in mind, here is some code to manage resources:\n\n```lisp\n(defmacro defresource (name &key constructor (initial-copies 0)\n         (size (max initial-copies 10)))\n (let ((resource (symbol name '-resource))\n   (deallocate (symbol 'deallocate- name))\n   (allocate (symbol 'allocate- name)))\n  '(let ((.resource (make-array ,size :fill-pointer 0)))\n   (defun ,allocate ()\n    \"Get an element from the resource pool, or make one.\"\n    (if (= (fill-pointer ,resource) 0)\n      ,constructor\n      (vector-pop ,resource)))\n   (defun ,deallocate (.name)\n    \"Place a no-longer-needed element back in the pool.\"\n    (vector-push-extend ,name ,resource))\n   .(if (> initial-copies 0)\n      '(mapc #',deallocate (loop repeat ,initial-copies\n             collect (,allocate))))\n   ',name)))\n```\n\nLet's say we had some structure called a buffer which we were constantly making instances of and then discarding.\nFurthermore, suppose that buffers are fairly complex objects to build, that we know we'll need at least 10 of them at a time, and that we probably won't ever need more than 100 at a time.\nWe might use the buffer resource as follows:\n\n```lisp\n(defresource buffer :constructor (make-buffer)\n      :size 100 : initial-copies 10)\n```\n\nThis expands into the following code:\n\n```lisp\n(let ((buffer-resource (make-array 100 :fill-pointer 0)))\n (defun allocate-buffer ()\n  \"Get an element from the resource pool, or make one.\"\n  (if (= (fill-pointer buffer-resource) 0)\n   (make-buffer)\n   (vector-pop buffer-resource)))\n (defun deallocate-buffer (buffer)\n  \"Place a no-longer-needed element back in the pool.\"\n  (vector-push-extend buffer buffer-resource))\n (mapc #'deallocate-buffer\n    (loop repeat 10 collect (allocate-buffer)))\n 'buffer)\n```\n\nWe could then use:\n\n```lisp\n(let ((b (allocate-buffer)))\n ...\n (process b)\n ...\n (deallocate-buffer b)))\n```\n\nThe important thing to remember is that this works only if the buffer `b` really can be deallocated.\nIf the function `process` stored away a pointer to `b` somewhere, then it would be a mistake to deallocate `b,` because a subsequent allocation could unpredictably alter the stored buffer.\nOf course, if `process` stored a *copy* of `b,` then everything is alright.\nThis pattern of allocation and deallocation is so common that we can provide a macro for it:\n\n```lisp\n(defmacro with-resource ((var resource &optional protect) &rest body)\n  \"Execute body with VAR bound to an instance of RESOURCE.\"\n  (let ((allocate (symbol 'allocate- resource))\n        (deallocate (symbol 'deallocate- resource)))\n    (if protect\n        `(let ((,var nil))\n           (unwind-protect (progn (setf ,var (,allocate)) ,@body)\n             (unless (null ,var) (,deallocate ,var))))\n        `(let ((,var (,allocate)))\n           ,@body\n           (,deallocate var)))))\n```\n\nThe macro allows for an optional argument that sets up an `unwind-protect` environment, so that the buffer gets deallocated even when the body is abnormally exited.\nThe following expansions should make this clearer:\n\n```lisp\n> (macroexpand '(with-resource (b buffer)\n                \"...\" (process b) \"...\"))\n(let ((b (allocate-buffer)))\n  \"...\"\n  (process b)\n  \"...\"\n  (deallocate-buffer b))\n> (macroexpand '(with-resource (b buffer t)\n                \"...\" \"...\" (process b) \"...\"))\n(let ((b nil))\n  (unwind-protect\n      (progn (setf b (allocate-buffer))\n          \"...\"\n                (process b)\n                \"...\")\n            (unless (null b)\n            (deallocate-buffer b))))\n```\n\nAn alternative to full resources is to just save a single data object.\nSuch an approach is simpler because there is no need to index into a vector of objects, but it is sufficient for some applications, such as a tail-recursive function call that only uses one object at a time.\n\nAnother possibility is to make the system slower but safer by having the `deallocate` function check that its argument is indeed an object of the correct type.\n\nKeep in mind that using resources may put you at odds with the Lisp system's own storage management scheme.\nIn particular, you should be concerned with paging performance on virtual memory systems.\nA common problem is to have only a few live objects on each page, thus forcing the system to do a lot of paging to get any work done.\nCompacting garbage collectors can collect live objects onto the same page, but using resources may interfere with this.\n\n## 10.5 Use the Right Data Structures\n\nIt is important to implement key data types with the most efficient implementation.\nThis can vary from machine to machine, but there are a few techniques that are universal.\nHere we consider three case studies.\n\n### The Right Data Structure: Variables\n\nAs an example, consider the implementation of pattern-matching variables.\nWe saw from the instrumentation of `simplify` that `variable-p` was one of the most frequently used functions.\nIn compiling the matching expressions, I did away with all calls to `variable-p`, but let's suppose we had an application that required run-time use of variables.\nThe specification of the data type `variable` will include two operators, the recognizer `variable-p`, and the constructor `make-variable`, which gives a new, previously unused variable.\n(This was not needed in the pattern matchers shown so far, but will be needed for unification with backward chaining.)\nOne implementation of variables is as symbols that begin with the character `#\\?`:\n\n```lisp\n(defun variable-p (x)\n \"Is x a variable (a symbol beginning with '?')?\"\n (and (symbolp x) (equal (elt (symbol-name x) 0) #\\?)))\n(defun make-variable O \"Generate a new variable\" (gentemp \"?\"))\n```\n\nWe could try to speed things up by changing the implementation of variables to be keywords and making the functions inline:\n\n```lisp\n(proclaim '(inline variable-p make-variable))\n(defun variable-p (x) \"Is x a variable?\" (keywordp x))\n(defun make-variable O (gentemp \"X\" #.(find-package \"KEYWORD\")))\n```\n\n(The reader character sequence `#.` means to evaluate at read time, rather than at execution time.)\nOn my machine, this implementation is pretty fast, and I accepted it as a viable compromise.\nHowever, other implementations were also considered.\nOne was to have variables as structures, and provide a read macro and print function:\n\n```lisp\n(defstruct (variable (:print-function print-variable)) name)\n\n(defvar *vars* (make-hash-table))\n\n(set-macro-character #\\?\n #'(lambda (stream char)\n   ;; Find an old var, or make a new one with the given name\n   (declare (ignore char))\n   (let ((name (read stream t nil t)))\n    (or (gethash name *vars*)\n     (setf (gethash name *vars*) (make-variable :name name))))))\n\n(defun print-variable (var stream depth)\n  (declare (ignore depth))\n  (format stream \"?~a\" (var-name var)))\n```\n\nIt turned out that, on all three Lisps tested, structures were slower than keywords or symbols.\nAnother alternative is to have the `?` read macro return a cons whose first is, say, `:var`.\nThis requires a special output routine to translate back to the `?` notation.\nYet another alternative, which turned out to be the fastest of all, was to implement variables as negative integers.\nOf course, this means that the user cannot use negative integers elsewhere in patterns, but that turned out to be acceptable for the application at hand.\nThe moral is to know which features are done well in your particular implementation and to go out of your way to use them in critical situations, but to stick with the most straightforward implementation in noncritical sections.\n\nLisp makes it easy to rely on lists, but one must avoid the temptation to overuse lists; to use them where another data structure is more appropriate.\nFor example, if you need to access elements of a sequence in arbitrary order, then a vector is more appropriate than list.\nIf the sequence can grow, use an adjustable vector.\nConsider the problem of maintaining information about a set of people, and searching that set.\nA naive implementation might look like this:\n\n```lisp\n(defvar *people* nil \"Will hold a list of people\")\n(defstruct person name address id-number)\n(defun person-with-id (id)\n (find id *people* :key #'person-id-number))\n```\n\nIn a traditional language like C, the natural solution is to include in the person structure a pointer to the next person, and to write a loop to follow these pointers.\nOf course, we can do that in Lisp too:\n\n```lisp\n(defstruct person name address id-number next)\n(defun person-with-id (id)\n (loop for person = *people* then (person-next person)\n   until (null person)\n   do (when (eql id (person-id-number person))\n     (RETURN person))))\n```\n\nThis solution takes less space and is probably faster, because it requires less memory accesses: one for each person rather than one for each person plus one for each cons cell.\nSo there is a small price to pay for using lists.\nBut Lisp programmers feel that price is worth it, because of the convenience and ease of coding and debugging afforded by general-purpose functions like `find`.\n\nIn any case, if there are going to be a large number of people, the list is definitely the wrong data structure.\nFortunately, Lisp makes it easy to switch to more efficient data structures, for example:\n\n```lisp\n(defun person-with-id (id)\n (gethash id *people*))\n```\n\n### The Right Data Structure: Queues\n\nA *queue* is a data structure where one can add elements at the rear and remove them from the front.\nThis is almost like a stack, except that in a stack, elements are both added and removed at the same end.\n\nLists can be used to implement stacks, but there is a problem in using lists to implement queues: adding an element to the rear requires traversing the entire list.\nSo collecting *n* elements would be *O*(*n<sup>2</sup>*) instead of *O*(*n*).\n\nAn alternative implementation of queues is as a cons of two pointers: one to the list of elements of the queue (the contents), and one to the last cons cell in the list.\nInitially, both pointers would be nil.\nThis implementation in fact existed in BBN Lisp and UCI Lisp under the function name `tconc`:\n\n```lisp\n;;; A queue is a (contents . last) pair\n(defun tconc (item q)\n \"Insert item at the end of the queue.\"\n (setf (cdr q)\n   (if (null (cdr q))\n     (setf (car q) (cons item nil))\n     (setf (rest (cdr q))\n       (cons item nil)))))\n```\n\nThe `tconc` implementation has the disadvantage that adding the first element to the contents is different from adding subsequent elements, so an `if` statement is required to decide which action to take.\nThe definition of queues given below avoids this disadvantage with a clever trick.\nFirst, the order of the two fields is reversed.\nThe `car` of the cons cell is the last element, and the `cdr` is the contents.\nSecond, the empty queue is a cons cell where the `cdr` (the contents field) is nil, and the `car` (the last field) is the cons itself.\nIn the definitions below, we change the name `tconc` to the more standard `enqueue`, and provide the other queue functions as well:\n\n```lisp\n;;; A queue is a (last . contents) pair\n(proclaim '(inline queue-contents make-queue enqueue dequeue\n        front empty-queue-p queue-nconc))\n\n(defun queue-contents (q) (cdr q))\n\n(defun make-queue ()\n \"Build a new queue, with no elements.\"\n (let ((q (cons nil nil)))\n  (setf (car q) q)))\n\n(defun enqueue (item q)\n \"Insert item at the end of the queue.\"\n (setf (car q)\n     (setf (rest (car q))\n      (cons item nil)))\n q)\n\n(defun dequeue (q)\n \"Remove an item from the front of the queue.\"\n (pop (cdr q))\n (if (null (cdr q)) (setf (car q) q))\n q)\n\n(defun front (q) (first (queue-contents q)))\n\n(defun empty-queue-p (q) (null (queue-contents q)))\n\n(defun queue-nconc (q list)\n \"Add the elements of LIST to the end of the queue.\"\n (setf (car q)\n     (last (setf (rest (car q)) list))))\n```\n\n### The Right Data Structure: Tables\n\nA *table* is a data structure to which one can insert a key and associate it with a value, and later use the key to look up the value.\nTables may have other operations, like counting the number of keys, clearing out all keys, or mapping a function over each key/value pair.\n\nLisp provides a wide variety of choices to implement tables.\nAn association list is perhaps the simplest: it is just a list of key/value pairs.\nIt is appropriate for small tables, up to a few dozen pairs.\nThe hash table is designed to be efficient for large tables, but may have significant overhead for small ones.\nIf the keys are symbols, property lists can be used.\nIf the keys are integers in a narrow range (or can be mapped into them), then a vector may be the most efficient choice.\n\nHere we implement an alternative data structure, the *trie*.\nA trie implements a table for keys that are composed of a finite sequence of components.\nFor example, if we were implementing a dictionary as a trie, each key would be a word, and each letter of the word would be a component.\nThe value of the key would be the word's definition.\nAt the top of the dictionary trie is a multiway branch, one for each possible first letter.\nEach second-level node has a branch for every possible second letter, and so on.\nTo find an *n*-letter word requires *n* reads.\nThis kind of organization is especially good when the information is stored on secondary storage, because a single read can bring in a node with all its possible branches.\n\nIf the keys can be arbitrary list structures, rather than a simple sequence of letters, we need to regularize the keys, transforming them into a simple sequence.\nOne way to do that makes use of the fact that any tree can be written as a linear sequence of atoms and cons operations, in prefix form.\nThus, we would make the following transformation:\n\n`(a (b c) d)` &Congruent;\n`(cons a (cons (cons b (cons c nil)) (cons d nil)))` &Congruent;\n`(cons a cons cons b cons c nil cons d nil)`\n\nIn the implementation of tries below, this transformation is done on the fly: The four user-level functions are `make-trie` to create a new trie, `put-trie` and `get-trie` to add and retrieve key/value pairs, and `delete-trie` to remove them.\n\nNotice that we use a distinguished value to mark deleted elements, and that `get-trie` returns two values: the actual value found, and a flag saying if anything was found or not.\nThis is consistent with the interface to `gethash` and `find`, and allows us to store null values in the trie.\nIt is an inobtrusive choice, because the programmer who decides not to store null values can just ignore the second value, and everything will work properly.\n\n```lisp\n(defstruct trie (value nil) (arcs nil))\n(defconstant trie-deleted \"deleted\")\n(defun put-trie (key trie value)\n \"Set the value of key in trie.\"\n (setf (trie-value (find-trie key t trie)) value))\n(defun get-trie (key trie)\n \"Return the value for a key in a trie, and t/nil if found.\"\n (let* ((key-trie (find-trie key nil trie))\n    (val (if key-trie (trie-value key-trie))))\n  (if (or (null key-trie) (eq val trie-deleted))\n    (values nil nil )\n    (values val t))))\n(defun delete-trie (key trie)\n \"Remove a key from a trie.\"\n (put-trie key trie trie-deleted))\n(defun find-trie (key extend? trie)\n \"Find the trie node for this key.\n If EXTEND? is true, make a new node if need be.\"\n (cond ((null trie) nil )\n    ((atom key)\n     (follow-arc key extend? trie))\n    (t (find-trie\n       (cdr key) extend?\n       (find-trie\n        (car key) extend?\n       (find-trie\n        \".\" extend? trie))))))\n(defun follow-arc (component extend? trie)\n \"Find the trie node for this component of the key.\n If EXTEND? is true, make a new node if need be.\"\n (let ((arc (assoc component (trie-arcs trie))))\n  (cond ((not (null arc)) (cdr arc))\n     ((not extend?) nil)\n     (t (let ((new-trie (make-trie)))\n       (push (cons component new-trie)\n         (trie-arcs trie))\n       new-trie)))))\n```\n\nThere are a few subtleties in the implementation.\nFirst, we test for deleted entries with an `eq` comparison to a distinguished marker, the string `trie-deleted`.\nNo other object will be `eq` to this string except `trie-deleted` itself, so this is a good test.\nWe also use a distinguished marker, the string `\".\"` to mark cons cells.\nComponents are implicitly compared against this marker with an `eql` test by the `assoc` in `follow-arc`.\nMaintaining the identity of this string is crucial; if, for example, you recompiled the definition of `find-trie` (without changing the definition at all), then you could no longer find keys that were indexed in an existing trie, because the `\".\"` used by `find-trie` would be a different one from the `\".\"` in the existing trie.\n\n*Artificial Intelligence Programming* ([Charniak et al.\n1987](bibliography.md#bb0180)) discusses variations on the trie, particularly in the indexing scheme.\nIf we always use proper lists (no non-null `cdrs`), then a more efficient encoding is possible.\nAs usual, the best type of indexing depends on the data to be indexed.\nIt should be noted that Charniak et al.\ncall the trie a *discrimination net*.\nIn general, that term refers to any tree with tests at the nodes.\n\nA trie is, of course, a kind of tree, but there are cases where it pays to convert a trie into a *dag*-a directed acyclic graph.\nA dag is a tree where some of the subtrees are shared.\nImagine you have a spelling corrector program with a list of some 50,000 or so words.\nYou could put them into a trie, each word with the value `t`.\nBut there would be many subtrees repeated in this trie.\nFor example, given a word list containing *look*, *looks*, *looked*, and *looking* as well as *show*, *shows*, *showed*, and *showing*, there would be repetition of the subtree containing *-s*, *-ed* and *-ing*.\nAfter the trie is built, we could pass the whole trie to `unique`, and it would collapse the shared subtrees, saving storage.\nOf course, you can no longer add or delete keys from the dag without risking unintended side effects.\n\nThis process was carried out for a 56,000 word list.\nThe trie took up 3.2Mbytes, while the dag was 1.1Mbytes.\nThis was still deemed unacceptable, so a more compact encoding of the dag was created, using a .2Mbytes vector.\nEncoding the same word list in a hash table took twice this space, even with a special format for encoding suffixes.\n\nTries work best when neither the indexing key nor the retrieval key contains variables.\nThey work reasonably well when the variables are near the end of the sequence.\nConsider looking up the pattern `yello?` in the dictionary, where the `?` character indicates a match of any letter.\nFollowing the branches for `yello` leads quickly to the only possible match, `yellow`.\nIn contrast, fetching with the pattern `??llow` is much less efficient.\nThe table lookup function would have to search all 26 top-level branches, and for each of those consider all possible second letters, and for each of those consider the path `llow`.\nQuite a bit of searching is required before arriving at the complete set of matches: bellow, billow, fallow, fellow, follow, hallow, hollow, mallow, mellow, pillow, sallow, tallow, wallow, willow, and yellow.\n\nWe will return to the problem of discrimination nets with variables in [section 14.8](chapter14.md#s0040), [page 472](chapter14.md#p472).\n\n## 10.6 Exercises\n\n**Exercise 10.1 [h]** Define the macro `deftable,` such that `(deftable person assoc`) will act much like a `defstruct` - it will define a set of functions for manipulating a table of people: `get-person`, `put-person`, `clear-person,` and `map-person`.\nThe table should be implemented as an association list.\nLater on, you can change the representation of the table simply by changing the form to `(deftable person hash)`, without having to change anything else in your code.\nOther implementation options include property lists and vectors.\n`deftable` should also take three keyword arguments: `inline`, `size` and `test`.\nHere is a possible macroexpansion:\n\n```\n\n> (macroexpand '(deftableperson hash :-inline t :size 100))\n(progn\n (proclaim '(inline get-person put-person map-person))\n (defparameter *person-table*\n  (make-hash-table :test #eql :size 100))\n (defun get-person (x &optional default)\n  (gethash x *person-table* default))\n (defun put-person (x value)\n  (setf (gethash x *person-table*) value))\n (defun clear-person () (clrhash *person-table*))\n (defun map-person (fn) (maphash fn *person-table*))\n (defsetf get-person put-person)\n 'person)\n```\n\n**Exercise 10.2 [m]** We can use the `:type` option to `defstruct` to define structures implemented as lists.\nHowever, often we have a two-field structure that we would like to implement as a cons cell rather than a two-element list, thereby cutting storage in half.\nSince `defstruct` does not allow this, define a new macro that does.\n\n**Exercise 10.3 [m]** Use `reuse-cons` to write a version of `flatten` (see [page 329](chapter10.md#p329)) that shares as much of its input with its output as possible.\n\n**Exercise 10.4 [h]** Consider the data type *set*.\nA set has two main operations: adjoin an element and test for membership.\nIt is convenient to also add a map-over-elements operation.\nWith these primitive operations it is possible to build up more complex operations like union and intersection.\n\nAs mentioned in [section 3.9](chapter3.md#s0095), Common Lisp provides several implementations of sets.\nThe simplest uses lists as the underlying representation, and provides the functions `adjoin, member, union, intersection`, and `set-difference`.\nAnother uses bit vectors, and a similar one uses integers viewed as bit sequences.\nAnalyze the time complexity of each implementation for each operation.\n\nNext, show how *sorted lists* can be used to implement sets, and compare the operations on sorted lists to their counterparts on unsorted lists.\n\n## 10.7 Answers\n\n**Answer 10.2**\n\n```lisp\n(defmacro def-cons-struct (cons car cdr &optional inline?)\n \"Define aliases for cons, car and cdr.\"\n '(progn (proclaim '(,(if inline? 'inline 'notinline)\n         ,car ,cdr ,cons))\n     (defun ,car (x) (car x))\n     (defun ,cdr (x) (cdr x))\n     (defsetf ,car (x) (val) '(setf (car ,x) ,val))\n     (defsetf ,cdr (x) (val) '(setf (cdr ,x) ,val))\n     (defun ,cons (x y) (cons x y))))\n```\n\n**Answer 10.3**\n\n```lisp\n(defun flatten (exp &optional (so-far nil) last-cons)\n \"Return a flat list of the atoms in the input.\n Ex: (flatten '((a) (b (c) d))) => (a b c d).\"\n (cond ((null exp) so-far)\n    ((atom exp) (reuse-cons exp so-far last-cons))\n    (t (flatten (first exp)\n         (flatten (rest exp) so-far exp)\n         exp))))\n```\n\n----------------------\n\n<a id=\"fn10-1\"></a><sup>[1](#tfn10-1)</sup>\nThese are all done with safety 0 and speed 3.\n\n"
  },
  {
    "path": "docs/chapter11.md",
    "content": "# Chapter 11\n## Logic Programming\n\n> A language that doesn't affect the way you think about programming is not worth knowing.\n\n> -Alan Perlis\n\nLisp is the major language for AI work, but it is by no means the only one.\nThe other strong contender is Prolog, whose name derives from \"programming in logic.\"<a id=\"tfn11-1\"></a><sup>[1](#fn11-1)</sup>\nThe idea behind logic programming is that the programmer should state the relationships that describe a problem and its solution.\nThese relationships act as constraints on the algorithms that can solve the problem, but the system itself, rather than the programmer, is responsible for the details of the algorithm.\nThe tension between the \"programming\" and \"logic\" will be covered in [chapter 14](chapter14.md), but for now it is safe to say that Prolog is an approximation to the ideal goal of logic programming.\nProlog has arrived at a comfortable niche between a traditional programming language and a logical specification language.\nIt relies on three important ideas:\n\n* Prolog encourages the use of a single *uniform data base.*\nGood compilers provide efficient access to this data base, reducing the need for vectors, hash tables, property lists, and other data structures that the Lisp programmer must deal with in detail.\nBecause it is based on the idea of a data base, Prolog is *relational,* while Lisp (and most languages) are *functional.* In Prolog we would represent a fact like \"the population of San Francisco is 750,000\" as a relation.\nIn Lisp, we would be inclined to write a function, `population,` which takes a city as input and returns a number.\nRelations are more flexible; they can be used not only to find the population of San Francisco but also, say, to find the cities with populations over 500,000.\n\n* Prolog provides *logic variables* instead of \"normal\" variables.\nA logic variable is bound by *unification* rather than by assignment.\nOnce bound, a logic variable can never change.\nThus, they are more like the variables of mathematics.\nThe existence of logic variables and unification allow the logic programmer to state equations that constrain the problem (as in mathematics), without having to state an order of evaluation (as with assignment statements).\n\n* Prolog provides *automatic backtracking.*\nIn Lisp each function call returns a single value (unless the programmer makes special arrangements to have it return multiple values, or a list of values).\nIn Prolog, each query leads to a search for relations in the data base that satisfy the query.\nIf there are several, they are considered one at a time.\nIf a query involves multiple relations, as in \"what city has a population over 500,000 and is a state capital?,\" Prolog will go through the population relation to find a city with a population over 500,000.\nFor each one it finds, it then checks the `capital` relation to see if the city is a capital.\nIf it is, Prolog prints the city; otherwise it *backtracks,* trying to find another city in the `population` relation.\nSo Prolog frees the programmer from worrying about both how data is stored and how it is searched.\nFor some problems, the naive automatic search will be too inefficient, and the programmer will have to restate the problem.\nBut the ideal is that Prolog programs state constraints on the solution, without spelling out in detail how the solutions are achieved.\n\nThis chapter serves two purposes: it alerts the reader to the possibility of writing certain programs in Prolog rather than Lisp, and it presents implementations of the three important Prolog ideas, so that they may be used (independently or together) within Lisp programs.\nProlog represents an interesting, different way of looking at the programming process.\nFor that reason it is worth knowing.\nIn subsequent chapters we will see several useful applications of the Prolog approach.\n\n## 11.1 Idea 1: A Uniform Data Base\n\nThe first important Prolog idea should be familiar to readers of this book: manipulating a stored data base of assertions.\nIn Prolog the assertions are called *clauses,* and they can be divided into two types: *facts,* which state a relationship that holds between some objects, and *rules,* which are used to state contingent facts.\nHere are representations of two facts about the population of San Francisco and the capital of California.\nThe relations are `population` and `capital,` and the objects that participate in these relations are `SF, 750000`, `Sacramento,` and `CA`:\n\n```lisp\n(population SF 750000)\n(capital Sacramento CA)\n```\n\nWe are using Lisp syntax, because we want a Prolog interpreter that can be embedded in Lisp.\nThe actual Prolog notation would be `population(sf,750000)`.\nHere are some facts pertaining to the `likes` relation:\n\n```lisp\n(likes Kim Robin)\n(likes Sandy Lee)\n(likes Sandy Kim)\n(likes Robin cats)\n```\n\nThese facts could be interpreted as meaning that Kim likes Robin, Sandy likes both Lee and Kim, and Robin likes cats.\nWe need some way of telling Lisp that these are to be interpreted as Prolog facts, not a Lisp function call.\nWe will use the macro `<-` to mark facts.\nThink of this as an assignment arrow which adds a fact to the data base:\n\n```lisp\n(<- (likes Kim Robin))\n(<- (likes Sandy Lee))\n(<- (likes Sandy Kim))\n(<- (likes Robin cats))\n```\n\nOne of the major differences between Prolog and Lisp hinges on the difference between relations and functions.\nIn Lisp, we would define a function `likes`, so that (`likes 'Sandy`) would return the list (`Lee Kim`).\nIf we wanted to access the information the other way, we would define another function, say, `likers-of`, so that (`likers-of 'Lee`) returns (`Sandy`).\nIn Prolog, we have a single `likes` relation instead of multiple functions.\nThis single relation can be used as if it were multiple functions by posing different queries.\nFor example, the query (`likes Sandy ?who`) succeeds with `?who` bound to `Lee or Kim`, and the query (`likes ?who Lee`) succeeds with `?who` bound to `Sandy.`\n\nThe second type of clause in a Prolog data base is the *rule.* Rules state contingent facts.\nFor example, we can represent the rule that Sandy likes anyone who likes cats as follows:\n\n```lisp\n(<- (likes Sandy ?x) (likes ?x cats))\n```\n\nThis can be read in two ways.\nViewed as a logical assertion, it is read, \"For any x, Sandy likes x if x likes cats.\" This is a *declarative* interpretation.\nViewed as a piece of a Prolog program, it is read, \"If you ever want to show that Sandy likes some x, one way to do it is to show that x likes cats.\" This is a *procedural* interpretation.\nIt is called a *backward-chaining* interpretation, because one reasons backward from the goal (Sandy likes x) to the premises (x likes cats).\nThe symbol `<-` is appropriate for both interpretations: it is an arrow indicating logical implication, and it points backwards to indicate backward chaining.\n\nIt is possible to give more than one procedural interpretation to a declarative form.\n(We did that in [chapter 1](chapter1.md), where grammar rules were used to generate both strings of words and parse trees.)\nThe rule above could have been interpreted procedurally as \"If you ever find out that some `x` likes cats, then conclude that Sandy likes `x`.\"\nThis would be *forward chaining:* reasoning from a premise to a conclusion.\nIt turns out that Prolog does backward chaining exclusively.\nMany expert systems use forward chaining exclusively, and some systems use a mixture of the two.\n\nThe leftmost expression in a clause is called the *head*, and the remaining ones are called the *body.* In this view, a fact is just a rule that has no body; that is, a fact is true no matter what.\nIn general, then, the form of a clause is:\n\n`(<-` *head body*...)\n\nA clause asserts that the head is true only if all the goals in the body are true.\nFor example, the following clause says that Kim likes anyone who likes both Lee and Kim:\n\n```lisp\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n```\n\nThis can be read as:\n\n*For any* x, *deduce that* `Kim likes x`\n\n*if it can be proved that* `x likes Lee` *and* x `likes Kim.`\n\n## 11.2 Idea 2: Unification of Logic Variables\n\nUnification is a straightforward extension of the idea of pattern matching.\nThe pattern-matching functions we have seen so far have always matched a pattern (an expression containing variables) against a constant expression (one with no variables).\nIn unification, two patterns, each of which can contain variables, are matched against each other.\nHere's an example of the difference between pattern matching and unification:\n\n```lisp\n> (pat-match '(?x + ?y) '(2 + 1)) => ((?Y . 1) (?X . 2))\n> (unify '(?x + 1) '(2 + ?y)) => ((?Y . 1) (?X . 2))\n```\n\nWithin the unification framework, variables (such as `?x` and `?y` above) are called *logic variables.* Like normal variables, a logic variable can be assigned a value, or it can be unbound.\nThe difference is that a logic variable can never be altered.\nOnce it is assigned a value, it keeps that value.\nAny attempt to unify it with a different value leads to failure.\nIt is possible to unify a variable with the same value more than once, just as it was possible to do a pattern match of `(?x + ?x`) with (`2 + 2`).\n\nThe difference between simple pattern matching and unification is that unification allows two variables to be matched against each other.\nThe two variables remain unbound, but they become equivalent.\nIf either variable is subsequently bound to a value, then both variables adopt that value.\nThe following example equates the variables `?x` and `?y` by binding `?x` to `?y`:\n\n```lisp\n> (unify '(f ?x) '(f ?y)) => ((?X . ?Y))\n```\n\nUnification can be used to do some sophisticated reasoning.\nFor example, if we have two equations, *a* + *a* = 0 and *x* + *y* = *y,* and if we know that these two equations unify, then we can conclude that *a*, *x,* and *y* are all 0.\nThe version of `unify` we will define shows this result by binding `?y` to `0`, `?x` to `?y`, and `?a` to `?x`.\nWe will also define the function `unifier`, which shows the structure that results from unifying two structures.\n\n```\n> (unify '(?a + ?a = 0) '(?x + ?y = ?y)) =>\n((?Y . 0) (?X . ?Y) (?A . ?X))\n\n> (unifier '(?a + ?a = 0) '(?x + ?y = ?y)) => (0 + 0 = 0)\n```\n\nTo avoid getting carried away by the power of unification, it is a good idea to take stock of exactly what unification provides.\nIt *does* provide a way of stating that variables are equal to other variables or expressions.\nIt does *not* provide a way of automatically solving equations or applying constraints other than equality.\nThe following example makes it clear that unification treats the symbol + only as an uninterpreted atom, not as the addition operator:\n\n```lisp\n> (unifier '(?a + ?a = 2) '(?x + ?y = ?y)) => (2 + 2 = 2)\n```\n\nBefore developing the code for `unify`, we repeat here the code taken from the pattern-matching utility ([chapter 6](chapter6.md)):\n\n```lisp\n(defconstant fail nil \"Indicates pat-match failure\")\n(defconstant no-bindings '((t . t))\n \"Indicates pat-match success, with no variables.\")\n(defun variable-p (x)\n \"Is x a variable (a symbol beginning with '?')?\"\n (and (symbolp x) (equal (char (symbol-name x) 0) #\\?)))\n(defun get-binding (var bindings)\n \"Find a (variable . value) pair in a binding list.\"\n (assoc var bindings))\n(defun binding-val (binding)\n \"Get the value part of a single binding.\"\n (cdr binding))\n(defun lookup (var bindings)\n \"Get the value part (for var) from a binding list.\"\n (binding-val (get-binding var bindings)))\n(defun extend-bindings (var val bindings)\n \"Add a (var . value) pair to a binding list.\"\n (cons (cons var val)\n       ;; Once we add a \"real\" binding,\n       ;; we can get rid of the dummy no-bindings\n       (if (and (eq bindings no-bindings))\n           nil\n           bindings)))\n(defun match-variable (var input bindings)\n \"Does VAR match input? Uses (or updates) and returns bindings.\"\n (let ((binding (get-binding var bindings)))\n (cond ((not binding) (extend-bindings var input bindings))\n       ((equal input (binding-val binding)) bindings)\n       (t fail))))\n```\n\nThe `unify` function follows; it is identical to `pat-match` (as defined on page 180) except for the addition of the line marked `***`.\nThe function `unify-variable` also follows `match-variable` closely:\n\n```lisp\n(defun unify (x y &optional (bindings no-bindings))\n \"See if x and y match with given bindings.\"\n (cond ((eq bindings fail) fail)\n       ((variable-p x) (unify-variable x y bindings))\n       ((variable-p y) (unify-variable y x bindings)) ;***\n       ((eql x y) bindings)\n       ((and (consp x) (consp y))\n        (unify (rest x) (rest y)\n               (unify (first x) (first y) bindings)))\n       (t fail)))\n(defun unify-variable (var x bindings)\n \"Unify var with x, using (and maybe extending) bindings.\"\n ;; Warning - buggy version\n (if (get-binding var bindings)\n  (unify (lookup var bindings) x bindings)\n  (extend-bindings var x bindings)))\n```\n\nUnfortunately, this definition is not quite right.\nIt handles simple examples:\n\n```lisp\n> (unify '(?x + 1) '(2 + ?y)) => ((?Y . 1) (?X . 2))\n> (unify '?x '?y) => ((?X . ?Y))\n> (unify '(?x ?x) '(?y ?y)) => ((?Y . ?Y) (?X . ?Y))\n```\n\nbut there are several pathological cases that it can't contend with:\n\n```lisp\n> (unify '(?x ?x ?x) '(?y ?y ?y))\n>>Trap #043622 (PDL-OVERFLOW REGULAR)\nThe regular push-down list has overflowed.\nWhile in the function GET-BINDING <= UNIFY-VARIABLE <= UNIFY\n```\n\nThe problem here is that once `?y` gets bound to itself, the call to `unify` inside `unify-variable` leads to an infinite loop.\nBut matching `?y` against itself must always succeed, so we can move the equality test in `unify` before the variable test.\nThis assumes that equal variables are `eql`, a valid assumption for variables implemented as symbols (but be careful if you ever decide to implement variables some other way).\n\n```lisp\n(defun unify (x y &optional (bindings no-bindings))\n \"See if x and y match with given bindings.\"\n (cond ((eq bindings fail) fail)\n  ((eql x y) bindings) ;*** moved this line\n  ((variable-p x) (unify-variable x y bindings))\n  ((variable-p y) (unify-variable y x bindings))\n  ((and (consp x) (consp y))\n  (unify (rest x) (rest y)\n      (unify (first x) (first y) bindings)))\n   (t fail)))\n```\n\nHere are some test cases:\n\n```lisp\n> (unify '(?x ?x) '(?y ?y)) => ((?X . ?Y))\n> (unify '(?x ?x ?x) '(?y ?y ?y)) => ((?X . ?Y))\n> (unify '(?x ?y) '(?y ?x)) => ((?Y . ?X) (?X . ?Y))\n> (unify '(?x ?y a) '(?y ?x ?x))\n>>Trap #043622 (PDL-OVERFLOW REGULAR)\nThe regular push-down list has overflowed.\nWhile in the function GET-BINDING <= UNIFY-VARIABLE <= UNIFY\n```\n\nWe have pushed off the problem but not solved it.\nAllowing both `(?Y . ?X`) and (`?X . ?Y`) in the same binding list is as bad as allowing (`?Y . ?Y`).\nTo avoid the problem, the policy should be never to deal with bound variables, but rather with their values, as specified in the binding list.\nThe function `unify-variable` fails to implement this policy.\nIt does have a check that gets the binding for var when it is a bound variable, but it should also have a check that gets the value of `x`, when `x` is a bound variable:\n\n```lisp\n(defun unify-variable (var x bindings)\n \"Unify var with x, using (and maybe extending) bindings.\"\n (cond ((get-binding var bindings)\n   (unify (lookup var bindings) x bindings))\n  ((and (variable-p x) (get-binding x bindings)) ;***\n   (unify var (lookup x bindings) bindings)) ;***\n  (t (extend-bindings var x bindings))))\n```\n\nHere are some more test cases:\n\n```lisp\n> (unify '(?x ?y) '(?y ?x)) => ((?X . ?Y))\n> (unify '(?x ?y a) '(?y ?x ?x)) => ((?Y . A) (?X . ?Y))\n```\n\nIt seems the problem is solved.\nNow let's try a new problem:\n\n```lisp\n> (unify '?x '(f ?x)) => ((?X F ?X))\n```\n\nHere `((?X F ?X))` really means `((?X . ((F ?X))))`, so `?X` is bound to (`F ?X`).\nThis represents a circular, infinite unification.\nSome versions of Prolog, notably Prolog II ([Giannesini et al.\n1986](bibliography.md#bb0460)), provide an interpretation for such structures, but it is tricky to define the semantics of infinite structures.\n\nThe easiest way to deal with such infinite structures is just to ban them.\nThis ban can be realized by modifying the unifier so that it fails whenever there is an attempt to unify a variable with a structure containing that variable.\nThis is known in unification circles as the *occurs check.* In practice the problem rarely shows up, and since it can add a lot of computational complexity, most Prolog systems have ignored the occurs check.\nThis means that these systems can potentially produce unsound answers.\nIn the final version of `unify` following, a variable is provided to allow the user to turn occurs checking on or off.\n\n```lisp\n(defparameter *occurs-check* t \"Should we do the occurs check?\")\n\n(defun unify (x y &optional (bindings no-bindings))\n \"See if x and y match with given bindings.\"\n (cond ((eq bindings fail) fail)\n       ((eql x y) bindings)\n       ((variable-p x) (unify-variable x y bindings))\n       ((variable-p y) (unify-variable y x bindings))\n       ((and (consp x) (consp y))\n        (unify (rest x) (rest y)\n               (unify (first x) (first y) bindings)))\n       (t fail)))\n\n(defun unify-variable (var x bindings)\n \"Unify var with x, using (and maybe extending) bindings.\"\n (cond ((get-binding var bindings)\n     (unify (lookup var bindings) x bindings))\n     ((and (variable-p x) (get-binding x bindings))\n     (unify var (lookup x bindings) bindings))\n     ((and *occurs-check* (occurs-check var x bindings)) fail)\n     (t (extend-bindings var x bindings))))\n\n(defun occurs-check (var x bindings)\n \"Does var occur anywhere inside x?\"\n (cond ((eq var x) t)\n     ((and (variable-p x) (get-binding x bindings))\n     (occurs-check var (lookup x bindings) bindings))\n     ((consp x) (or (occurs-check var (first x) bindings)\n         (occurs-check var (rest x) bindings)))\n     (t nil)))\n```\n\nNow we consider how `unify` will be used.\nIn particular, one thing we want is a function for substituting a binding list into an expression.\nWe originally chose association lists as the implementation of bindings because of the availability of the function `sublis`.\nIronically, `sublis` won't work any more, because variables can be bound to other variables, which are in turn bound to expressions.\nThe `function subst-bindings` acts like `sublis`, except that it substitutes recursive bindings.\n\n```lisp\n(defun subst-bindings (bindings x)\n \"Substitute the value of variables in bindings into x,\n taking recursively bound variables into account.\"\n (cond ((eq bindings fail) fail)\n     ((eq bindings no-bindings) x)\n     ((and (variable-p x) (get-binding x bindings))\n     (subst-bindings bindings (lookup x bindings)))\n     ((atom x) x)\n     (t (reuse-cons (subst-bindings bindings (car x))\n            (subst-bindings bindings (cdr x))\n            x))))\n```\n\nNow let's try `unify` on some examples:\n\n```lisp\n> (unify '(?x ?y a) '(?y ?x ?x)) => ((?Y . A) (?X . ?Y))\n> (unify '?x '(f ?x)) => NIL\n> (unify '(?x ?y) '((f ?y) (f ?x))) => NIL\n> (unify '(?x ?y ?z) '((?y ?z) (?x ?z) (?x ?y))) => NIL\n> (unify 'a 'a) => ((T . T))\n```\n\nFinally, the function `unifier` calls `unify` and substitutes the resulting binding list into one of the arguments.\nThe choice of `x` is arbitrary; an equal result would come from substituting the binding list into `y`.\n\n```lisp\n(defun unifier (x y)\n \"Return something that unifies with both x and y (or fail).\"\n (subst-bindings (unify x y) x))\n```\n\nHere are some examples of `unifier`:\n\n```lisp\n> (unifier '(?x ?y a) '(?y ?x ?x)) => (A A A)\n> (unifier '((?a * ?x ^ 2) + (?b * ?x) + ?c)\n        '(?z + (4 * 5) + 3)) =>\n((?A * 5 ^ 2) + (4 * 5) + 3)\n```\n\nWhen `*occurs-check*` is false, we get the following answers:\n\n```lisp\n> (unify '?x '(f ?x)) => ((?X F ?X))\n> (unify '(?x ?y) '((f ?y) (f ?x))) => ((?Y F ?X) (?X F ?Y))\n> (unify '(?x ?y ?z) '((?y ?z) (?x ?z) (?x ?y))) => ((?Z ?X ?Y) (?Y ?X ?Z) (?X ?Y ?Z))\n```\n\n### Programming with Prolog\n\nThe amazing thing about Prolog clauses is that they can be used to express relations that we would normally think of as \"programs,\" not \"data.\" For example, we can define the `member` relation, which holds between an item and a list that contains that item.\nMore precisely, an item is a member of a list if it is either the first element of the list or a member of the rest of the list.\nThis definition can be translated into Prolog almost verbatim:\n\n```lisp\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ?rest)) (member ?item ?rest))\n```\n\nOf course, we can write a similar definition in Lisp.\nThe most visible difference is that Prolog allows us to put patterns in the head of a clause, so we don't need recognizers like `consp` or accessors like `first` and `rest`.\nOtherwise, the Lisp definition is similar:<a id=\"tfn11-2\"></a><sup>[2](#fn11-2)</sup>\n\n```lisp\n(defun lisp-member (item list)\n  (and (consp list)\n  (or (eql item (first list))\n    (lisp-member item (rest list)))))\n```\n\nIf we wrote the Prolog code without taking advantage of the pattern feature, it would look more like the Lisp version:\n\n```lisp\n(<- (member ?item ?list)\n  (= ?list (?item . ?rest)))\n(<- (member ?item ?list)\n  (= ?list (?x . ?rest))\n  (member ?item ?rest))\n```\n\nIf we define or in Prolog, we would write a version that is clearly just a syntactic variant of the Lisp version.\n\n```lisp\n(<- (member ?item ?list)\n  (= ?list (?first . ?rest))\n  (or (= ?item ?first)\n  (member ?item ?rest)))\n```\n\nLet's see how the Prolog version of `member` works.\nImagine that we have a Prolog interpreter that can be given a query using the macro `?-`, and that the definition of `member` has been entered.\nThen we would see:\n\n```lisp\n> (?- (member 2 (1 2 3)))\nYes;\n> (?- (member 2 (1 2 3 2 1)))\nYes;\nYes;\n```\n\nThe answer to the first query is \"yes\" because 2 is a member of the rest of the list.\nIn the second query the answer is \"yes\" twice, because 2 appears in the list twice.\nThis is a little surprising to Lisp programmers, but there still seems to be a fairly close correspondence between Prolog's and Lisp's `member.` However, there are things that the Prolog `member` can do that Lisp cannot:\n\n```lisp\n> (?- (member ?x (1 2 3)))\n?X = 1;\n?X = 2;\n?X = 3;\n```\n\nHere `member` is used not as a predicate but as a generator of elements in a list.\nWhile Lisp functions always map from a specified input (or inputs) to a specified output, Prolog relations can be used in several ways.\nFor `member,` we see that the first argument, `?x`, can be either an input or an output, depending on the goal that is specified.\nThis power to use a single specification as a function going in several different directions is a very flexible feature of Prolog.\n(Unfortunately, while it works very well for simple relations like `member,` in practice it does not work well for large programs.\nIt is very difficult to, say, design a compiler and automatically have it work as a disassembler as well.)\n\nNow we turn to the implementation of the Prolog interpreter, as summarized in [figure 11.1](#f0010).\nThe first implementation choice is the representation of rules and facts.\nWe will build a single uniform data base of clauses, without distinguishing rules from facts.\nThe simplest representation of clauses is as a cons cell holding the head and the body.\nFor facts, the body will be empty.\n\n| Function                  | Description                                                 |\n|---------------------------|-------------------------------------------------------------|\n|                           | **Top-Level Macros**                                        |\n| `<-`                      | Add a clause to the database.                               |\n| `?-`                      | Prove a query and print answer(s).                          |\n|                           | **Special Variables**                                       |\n| `*db-predicates*`         | A list of all predicates.                                   |\n| `*occurs-check*`          | Should we check for circular unifications?                  |\n|                           | **Data Types**                                              |\n| `clause`                  | Consists of a head and a body.                              |\n| `variable`                | A symbol starting with a `?`.                               |\n|                           | **Major Functions**                                         |\n| `add-clause`              | Add a clause to the data base.                              |\n| `prove`                   | Return a list of possible solutions to goal.                |\n| `prove-all`               | Return a list of solutions to the conjunction of goals.     |\n| `top-level-prove`         | Prove the goals, and print variables readably.              |\n|                           | **Auxiliary Functions**                                     |\n| `get-clauses`             | Find all the clauses for a predicate.                       |\n| `predicate`               | Pick out the predicate from a relation.                     |\n| `clear-db`                | Remove all clauses (for all predicates) from the data base. |\n| `clear-predicate`         | Remove the clauses for a single predicate.                  |\n| `rename-variables`        | Replace all variables in `x` with new ones.                 |\n| `unique-find-anywhere-if` | Find all unique leaves satisfying predicate.                |\n| `show-prolog-solutions`   | Print the variables in each of the solutions.               |\n| `show-prolog-vars`        | Print each variable with its binding.                       |\n| `variables-in`            | Return a list of all the variables in an expression.        |\n|                           | **Previously Defined Constants**                            |\n| `fail`                    | An indication that unification has failed.                  |\n| `no-bindings`             | A successful unification with no variables.                 |\n|                           | **Previously Defined Functions**                            |\n| `unify`                   | Return bindings that unify two expressions (section 11.2).  |\n| `unify-variable`          | Unify a variable against an expression.                     |\n| `occurs-check`            | See if a particular variable occurs inside an expression.   |\n| `subst-bindings`          | Substitute bindings into an expression.                     |\n| `get-binding`             | Get the `(var . val)` binding for a variable.               |\n| `lookup`                  | Get the value for a variable.                               |\n| `extend-bindings`         | Add a new variable/value pair to a binding list.            |\n| `variable-p`              | Is the argument a variable?                                 |\n| `reuse-cons`              | Like `cons`, except will reuse an old value if possible.    |\n\nFigure 11.1: Glossary for the Prolog Interpreter\n\n```lisp\n;; Clauses are represented as (head . body) cons cells\n(defun clause-head (clause) (first clause))\n(defun clause-body (clause) (rest clause))\n```\n\nThe next question is how to index the clauses.\nRecall the procedural interpretation of a clause: when we want to prove the head, we can do it by proving the body.\nThis suggests that clauses should be indexed in terms of their heads.\nEach clause will be stored on the property list of the predicate of the head of the clause.\nSince the data base is now distributed across the property list of various symbols, we represent the entire data base as a list of symbols stored as the value of `*db-predicates*`.\n\n```lisp\n;; Clauses are stored on the predicate's plist\n(defun get-clauses (pred) (get pred 'clauses))\n(defun predicate (relation) (first relation))\n\n(defvar *db-predicates* nil\n  \"A list of all predicates stored in the database.\")\n```\n\nNow we need a way of adding a new clause.\nThe work is split up into the macro `<-`, which provides the user interface, and a function, `add-clause`, that does the work.\nIt is worth defining a macro to add clauses because in effect we are defining a new language: Prolog-In-Lisp.\nThis language has only two syntactic constructs: the `<-` macro to add clauses, and the `?-` macro to make queries.\n\n```lisp\n(defmacro <- (&rest clause)\n \"Add a clause to the data base.\"\n '(add-clause '.clause))\n\n(defun add-clause (clause)\n  \"Add a clause to the data base, indexed by head's predicate.\"\n  ;; The predicate must be a non-variable symbol.\n  (let ((pred (predicate (clause-head clause))))\n    (assert (and (symbolp pred) (not (variable-p pred))))\n    (pushnew pred *db-predicates*)\n    (setf (get pred 'clauses)\n          (nconc (get-clauses pred) (list clause)))\n    pred))\n```\n\nNow all we need is a way to remove clauses, and the data base will be complete.\n\n```lisp\n(defun clear-db ()\n  \"Remove all clauses (for all predicates) from the data base.\"\n  (mapc #'clear-predicate *db-predicates*))\n\n(defun clear-predicate (predicate)\n  \"Remove the clauses for a single predicate.\"\n  (setf (get predicate 'clauses) nil))\n```\n\nA data base is useless without a way of getting data out, as well as putting it in.\nThe function prove will be used to prove that a given goal either matches a fact that is in the data base directly or can be derived from the rules.\nTo prove a goal, first find all the candidate clauses for that goal.\nFor each candidate, check if the goal unifies with the head of the clause.\nIf it does, try to prove all the goals in the body of the clause.\nFor facts, there will be no goals in the body, so success will be immediate.\nFor rules, the goals in the body need to be proved one at a time, making sure that bindings from the previous step are maintained.\nThe implementation is straightforward:\n\n```lisp\n(defun prove (goal bindings)\n  \"Return a list of possible solutions to goal.\"\n  (mapcan #'(lambda (clause)\n              (let ((new-clause (rename-variables clause)))\n                (prove-all (clause-body new-clause)\n                           (unify goal (clause-head new-clause) bindings))))\n          (get-clauses (predicate goal))))\n\n(defun prove-all (goals bindings)\n  \"Return a list of solutions to the conjunction of goals.\"\n  (cond ((eq bindings fail) fail)\n        ((null goals) (list bindings))\n        (t (mapcan #'(lambda (goal1-solution)\n                       (prove-all (rest goals) goal1-solution))\n                   (prove (first goals) bindings)))))\n```\n\nThe tricky part is that we need some way of distinguishing a variable `?x` in one clause from another variable `?x` in another clause.\nOtherwise, a variable used in two different clauses in the course of a proof would have to take on the same value in each clause, which would be a mistake.\nJust as arguments to a function can have different values in different recursive calls to the function, so the variables in a clause are allowed to take on different values in different recursive uses.\nThe easiest way to keep variables distinct is just to rename all variables in each clause before it is used.\nThe function `rename-variables` does this:<a id=\"tfn11-3\"></a><sup>[3](#fn11-3)</sup>\n\n```lisp\n(defun rename-variables (x)\n  \"Replace all variables in x with new ones.\"\n  (sublis (mapcar #'(lambda (var) (cons var (gensym (string var))))\n                  (variables-in x))\n          x))\n```\n\n`Rename-variables` makes use of `gensym`, a function that generates a new symbol each time it is called.\nThe symbol is not interned in any package, which means that there is no danger of a programmer typing a symbol of the same name.\nThe predicate `variables-in` and its auxiliary function are defined here:\n\n```lisp\n(defun variables-in (exp)\n  \"Return a list of all the variables in EXP.\"\n  (unique-find-anywhere-if #'variable-p exp))\n\n(defun unique-find-anywhere-if (predicate tree\n                                &optional found-so-far)\n  \"Return a list of leaves of tree satisfying predicate,\n  with duplicates removed.\"\n  (if (atom tree)\n      (if (funcall predicate tree)\n          (adjoin tree found-so-far)\n          found-so-far)\n      (unique-find-anywhere-if\n        predicate\n        (first tree)\n        (unique-find-anywhere-if predicate (rest tree)\n                                 found-so-far))))\n```\n\nFinally, we need a nice interface to the proving functions.\nWe will use `?-` as a macro to introduce a query.\nThe query might as well allow a conjunction of goals, so `?-` will call `prove-all`.\nTogether, `<-` and `?-` define the complete syntax of our Prolog-In-Lisp language.\n\n```lisp\n(defmacro ?- (&rest goals) '(prove-all ',goals no-bindings))\n```\n\nNow we can enter all the clauses given in the prior example:\n\n```lisp\n(<- (likes Kim Robin))\n(<- (likes Sandy Lee))\n(<- (likes Sandy Kim))\n(<- (likes Robin cats))\n(<- (likes Sandy ?x) (likes ?x cats))\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n(<- (likes ?x ?x))\n```\n\nTo ask whom Sandy likes, we would use:\n\n```lisp\n> (?- (likes Sandy ?who))\n(((?WHO . LEE))\n  ((?WHO . KIM))\n  ((?X2856 . ROBIN) (?WHO .?X2856))\n  ((?X2860 . CATS) (?X2857 CATS) (?X2856 . SANDY) (?WHO ?X2856)\n  ((?X2865 . CATS) (?X2856 ?X2865)((?WHO . ?X2856))\n  (?WHO . SANDY) (?X2867 . SANDY)))\n```\n\nPerhaps surprisingly, there are six answers.\nThe first two answers are Lee and Kim, because of the facts.\nThe next three stem from the clause that Sandy likes everyone who likes cats.\nFirst, Robin is an answer because of the fact that Robin likes cats.\nTo see that Robin is the answer, we have to unravel the bindings: `?who` is bound to `?x2856`, which is in turn bound to Robin.\n\nNow we're in for some surprises: Sandy is listed, because of the following reasoning: (1) Sandy likes anyone/thing who likes cats, (2) cats like cats because everyone likes  themselves, (3) therefore Sandy likes cats, and (4) therefore Sandy likes Sandy.\nCats is an answer because of step (2), and finally, Sandy is an answer again, because of the clause about liking oneself.\nNotice that the result of the query is a list of solutions, where each solution corresponds to a different way of proving the query true.\nSandy appears twice because there are two different ways of showing that Sandy likes Sandy.\nThe order in which solutions appear is determined by the order of the search.\nProlog searches for solutions in a top-down, left-to-right fashion.\nThe clauses are searched from the top down, so the first clauses entered are the first ones tried.\nWithin a clause, the body is searched left to right.\nIn using the (`likes Kim ?x`) clause, Prolog would first try to find an `x` who likes Lee, and then see if `x` likes Kim.\n\nThe output from `prove-all` is not very pretty.\nWe can fix that by defining a new function, `top-level-prove,` which calls `prove-all` as before, but then passes the list of solutions to `show-prolog-solutions,` which prints them in a more readable format.\nNote that `show-prolog-solutions` returns no values: `(values).` This means the read-eval-print loop will not print anything when `(values)` is the result of a top-level call.\n\n```lisp\n(defmacro ?- (&rest goals) `(top-level-prove ',goals))\n\n(defun top-level-prove (goals)\n  \"Prove the goals, and print variables readably.\"\n  (show-prolog-solutions\n    (variables-in goals)\n    (prove-all goals no-bindings)))\n\n(defun show-prolog-solutions (vars solutions)\n  \"Print the variables in each of the solutions.\"\n  (if (null solutions)\n      (format t \"~&No.\")\n      (mapc #'(lambda (solution) (show-prolog-vars vars solution))\n            solutions))\n  (values))\n\n(defun show-prolog-vars (vars bindings)\n  \"Print each variable with its binding.\"\n  (if (null vars)\n      (format t \"~&Yes\")\n      (dolist (var vars)\n        (format t \"~&~a = ~a\" var\n                (subst-bindings bindings var))))\n  (princ \";\"))\n```\n\nNow let's try some queries:\n\n```lisp\n> (?- (likes Sandy ?who))\n?WHO = LEE;\n?WHO = KIM;\n?WHO = ROBIN;\n?WHO = SANDY;\n?WHO = CATS;\n?WHO = SANDY;\n> (?- (likes ?who Sandy))\n?WHO = SANDY;\n?WHO = KIM;\n?WHO = SANDY;\n> (?- (likes Robin Lee))\nNo.\n```\n\nThe first query asks again whom Sandy likes, and the second asks who likes Sandy.\nThe third asks for confirmation of a fact.\nThe answer is \"no,\" because there are no clauses or facts that say Robin likes Lee.\nHere's another example, a list of pairs of people who are in a mutual liking relation.\nThe last answer has an uninstantiated variable, indicating that everyone likes themselves.\n\n```lisp\n> (?- (likes ?x ?y) (likes ?y ?x))\n?Y = KIM\n?X = SANDY;\n?Y = SANDY\n?X = SANDY;\n?Y = SANDY\n?X = SANDY;\n?Y = SANDY\n?X = KIM;\n?Y = SANDY\n?X = SANDY;\n?Y = ?X3251\n?X = ?X3251;\n```\n\nIt makes sense in Prolog to ask open-ended queries like \"what lists is 2 a member of ?\" or even \"what items are elements of what lists?\"\n\n```lisp\n(?- (member 2 ?list))\n(?- (member ?item ?list))\n```\n\nThese queries are valid Prolog and will return solutions, but there will be an infinite number of them.\nSince our interpreter collects all the solutions into a single list before showing any of them, we will never get to see the solutions.\nThe next section shows how to write a new interpreter that fixes this problem.\n\n**Exercise  11.1 [m]** The representation of relations has been a list whose first element is a symbol.\nHowever, for relations with no arguments, some people prefer to write `(<- p q r)` rather than `(<- (p) (q) (r))`.\nMake changes so that either form is acceptable.\n\n**Exercise  11.2 [m]** Some people find the `<-` notation difficult to read.\nDefine macros `rule` and `fact` so that we can write:\n\n```lisp\n(fact (likes Robin cats))\n(rule (likes Sandy ?x) if (likes ?x cats))\n```\n\n## 11.3 Idea 3: Automatic Backtracking\n\nThe Prolog interpreter implemented in the last section solves problems by returning a list of all possible solutions.\nWe'll call this a *batch* approach, because the answers are retrieved in one uninterrupted batch of processing.\nSometimes that is just what you want, but other times a single solution will do.\nIn real Prolog, solutions are presented one at a time, as they are found.\nAfter each solution is printed, the user has the option of asking for more solutions, or stopping.\nThis is an *incremental* approach.\nThe incremental approach will be faster when the desired solution is one of the first out of many alternatives.\nThe incremental approach will even work when there is an infinite number of solutions.\nAnd if that is not enough, the incremental approach can be implemented so that it searches depth-first.\nThis means that at any point it will require less storage space than the batch approach, which must keep all solutions in memory at once.\n\nIn this section we implement an incremental Prolog interpreter.\nOne approach would be to modify the interpreter of the last section to use pipes rather than lists.\nWith pipes, unnecessary computation is delayed, and even infinite lists can be expressed in a finite amount of time and space.\nWe could change to pipes simply by changing the `mapcan` in `prove` and `prove-all` to `mappend-pipe` (page 286).\nThe books by [Winston and Horn (1988)](bibliography.md#bb1410) and by [Abelson and Sussman (1985)](bibliography.md#bb0010) take this approach.\nWe take a different one.\n\nThe first step is a version of `prove` and `prove-all` that return a single solution rather than a list of all possible solutions.\nThis should be reminiscent of `achieve` and `achieve-all` from `gps` ([chapter 4](chapter4.md)).\nUnlike `gps`, recursive subgoals and clobbered sibling goals are not checked for.\nHowever, `prove` is required to search systematically through all solutions, so it is passed an additional parameter: a list of other goals to achieve after achieving the first goal.\nThis is equivalent to passing a continuation to `prove`.\nThe result is that if `prove` ever succeeds, it means the entire top-level goal has succeeded.\nIf it fails, it just means the program is backtracking and trying another sequence of choices.\nNote that `prove` relies on the fact that `fail` is `nil`, because of the way it uses some.\n\n```lisp\n(defun prove-all (goals bindings)\n  \"Find a solution to the conjunction of goals.\"\n  (cond ((eq bindings fail) fail)\n        ((null goals) bindings)\n        (t (prove (first goals) bindings (rest goals)))))\n(defun prove (goal bindings other-goals)\n  \"Return a list of possible solutions to goal.\"\n  (some #'(lambda (clause)\n             (let ((new-clause (rename-variables clause)))\n               (prove-all\n                 (append (clause-body new-clause) other-goals)\n             (unify goal (clause-head new-clause) bindings))))\n  (get-clauses (predicate goal))))\n```\n\nIf `prove` does succeed, it means a solution has been found.\nIf we want more solutions, we need some way of making the process fail, so that it will backtrack and try again.\nOne way to do that is to extend every query with a goal that will print out the variables, and ask the user if the computation should be continued.\nIf the user says yes, then the goal *fails,* and backtracking starts.\nIf the user says no, the goal succeeds, and since it is the final goal, the computation ends.\nThis requires a brand new type of goal: one that is not matched against the data base, but rather causes some procedure to take action.\nIn Prolog, such procedures are called *primitives,* because they are built-in to the language, and new ones may not be defined by the user.\nThe user may, of course, define non-primitive procedures that call upon the primitives.\n\nIn our implementation, primitives will be represented as Lisp functions.\nA predicate can be represented either as a list of clauses (as it has been so far) or as a single primitive.\nHere is a version of `prove` that calls primitives when appropriate:\n\n```lisp\n(defun prove (goal bindings other-goals)\n  \"Return a list of possible solutions to goal.\"\n  (let ((clauses (get-clauses (predicate goal))))\n      (if (listp clauses)\n              (some\n                  #'(lambda (clause)\n                          (let ((new-clause (rename-variables clause)))\n                              (prove-all\n                                (append (clause-body new-clause) other-goals)\n                                (unify goal (clause-head new-clause) bindings))))\n                  clauses)\n              ;; The predicate's \"clauses\" can be an atom:\n              ;; a primitive function to call\n              (funcall clauses (rest goal) bindings\n                                other-goals))))\n```\n\nHere is the version of `top-level-prove` that adds the primitive goal `show-prolog-vars` to the end of the list of goals.\nNote that this version need not call `show-prolog-solutions` itself, since the printing will be handled by the primitive for `show-prolog-vars`.\n\n```lisp\n(defun top-level-prove (goals)\n  (prove-all '(,@goals (show-prolog-vars ,@(variables-in goals)))\n                        no-bindings)\n  (format t \"~&No.\")\n  (values))\n```\n\nHere we define the primitive `show-prolog-vars`.\nAll primitives must be functions of three arguments: a list of arguments to the primitive relation (here a list of variables to show), a binding list for these arguments, and a list of pending goals.\nA primitive should either return `fail` or call `prove-all` to continue.\n\n```lisp\n(defun show-prolog-vars (vars bindings other-goals)\n  \"Print each variable with its binding.\n  Then ask the user if more solutions are desired.\"\n  (if (null vars)\n          (format t \"~&Yes\")\n          (dolist (var vars)\n              (format t \"~&~a = ~a\" var\n                              (subst-bindings bindings var))))\n  (if (continue-p)\n          fail\n          (prove-all other-goals bindings)))\n```\n\nSince primitives are represented as entries on the `clauses` property of predicate symbols, we have to register `show-prolog-vars` as a primitive like this:\n\n```lisp\n(setf (get 'show-prolog-vars 'clauses) 'show-prolog-vars)\n```\n\nFinally, the Lisp predicate `continue-p` asks the user if he or she wants to see more solutions:\n\n```lisp\n(defun continue-p ()\n \"Ask user if we should continue looking for solutions.\"\n (case (read-char)\n  (#\\; t)\n  (#\\. nil)\n  (#\\newline (continue-p))\n  (otherwise\n   (format t \" Type ; to see more or . to stop\")\n   (continue-p))))\n```\n\nThis version works just as well as the previous version on finite problems.\nThe only difference is that the user, not the system, types the semicolons.\nThe advantage is that we can now use the system on infinite problems as well.\nFirst, we'll ask what lists 2 is a member of:\n\n```lisp\n> (?- (member 2 ?list))\n?LIST = (2 . ?REST3302);\n?LIST = (?X3303 2 . ?REST3307);\n?LIST = (?X3303 ?X3308 2 . ?REST3312);\n?LIST = (?X3303 ?X3308 ?X3313 2 . ?REST3317).\nNo.\n```\n\nThe answers mean that 2 is a member of any list that starts with 2, or whose second element is 2, or whose third element is 2, and so on.\nThe infinite computation was halted when the user typed a period rather than a semicolon.\nThe \"no\" now means that there are no more answers to be printed; it will appear if there are no answers at all, if the user types a period, or if all the answers have been printed.\n\nWe can ask even more abstract queries.\nThe answer to the next query says that an item is an element of a list when it is the the first element, or the second, or the third, or the fourth, and so on.\n\n```lisp\n> (?- (member ?item ?list))\n?ITEM = ?ITEM3318\n?LIST = (?ITEM3318 . ?REST3319);\n?ITEM = ?ITEM3323\n?LIST = (?X3320 ?ITEM3323 . ?REST3324);\n?ITEM = ?ITEM3328\n?LIST = (?X3320 ?X3325 ?ITEM3328 . ?REST3329);\n?ITEM = ?ITEM3333\n?LIST = (?X3320 ?X3325 ?X3330 ?ITEM3333 . ?REST3334).\nNo.\n```\n\nNow let's add the definition of the relation length:\n\n```lisp\n(<- (length () 0))\n(<- (length (?x . ?y) (1 + ?n)) (length ?y ?n))\n```\n\nHere are some queries showing that length can be used to find the second argument, the first, or both:\n\n```lisp\n> (?- (length (a b c d) ?n))\n?N = (1+ (1+ (1+ (1+ 0))));\nNo.\n> (?- (length ?list (1+ (1+ 0))))\n?LIST = (?X3869 ?X3872);\nNo.\n> (?- (length ?list ?n))\n?LIST = NIL\n?N = 0;\n?LIST = (?X3918)\n?N = (1+ 0);\n?LIST = (?X3918 ?X3921)\n?N = (1+ (1+ 0)).\nNo.\n```\n\nThe next two queries show the two lists of length two with `a` as a member.\nBoth queries give the correct answer, a two-element list that either starts or ends with `a`.\nHowever, the behavior after generating these two solutions is quite different.\n\n```lisp\n> (?- (length ?l (1 + (1 + 0))) (member a ?l))\n?L = (A ?X4057);\n?L = (?Y4061 A);\nNo.\n> (?- (member a ?l) (length ?l (1 + (1 + 0))))\n?L = (A ?X4081);\n?L = (?Y4085 A);[Abort]\n```\n\nIn the first query, length only generates one possible solution, the list with two unbound elements.\n`member` takes this solution and instantiates either the first or the second element to `a`.\n\nIn the second query, `member` keeps generating potential solutions.\nThe first two partial solutions, where `a` is the first or second member of a list of unknown length, are extended by `length` to yield the solutions where the list has length two.\nAfter that, `member` keeps generating longer and longer lists, which `length` keeps rejecting.\nIt is implicit in the definition of `member` that subsequent solutions will be longer, but because that is not explicitly known, they are all generated anyway and then explicitly tested and rejected by `length.`\n\nThis example reveals the limitations of Prolog as a pure logic-programming language.\nIt turns out the user must be concerned not only about the logic of the problem but also with the flow of control.\nProlog is smart enough to backtrack and find all solutions when the search space is small enough, but when it is infinite (or even very large), the programmer still has a responsibility to guide the flow of control.\nIt is possible to devise languages that do much more in terms of automatic flow of control.<a id=\"tfn11-4\"></a><sup>[4](#fn11-4)</sup>\nProlog is a convenient and efficient middle ground between imperative languages and pure logic.\n\n### Approaches to Backtracking\n\nSuppose you are asked to make a \"small\" change to an existing program.\nThe problem is that some function, `f`, which was thought to be single-valued, is now known to return two or more valid answers in certain circumstances.\nIn other words, `f` is nondeterministic.\n(Perhaps `f` is `sqrt`, and we now want to deal with negative numbers).\nWhat are your alternatives as a programmer?\nFive possibilities can be identified:\n\n* Guess.\nChoose one possibility and discard the others.\nThis requires a means of making the right guesses, or recovering from wrong guesses.\n\n* Know.\nSometimes you can provide additional information that is enough to decide what the right choice is.\nThis means changing the calling function(s) to provide the additional information.\n\n* Return a list.\nThis means that the calling function(s) must be changed to expect a list of replies.\n\n* Return a *pipe,* as defined in [section 9.3](chapter9.md#s0020).\nAgain, the calling function(s) must be changed to expect a pipe.\n\n* Guess and save.\nChoose one possibility and return it, but record enough information to allow computing the other possibilities later.\nThis requires saving the current state of the computation as well as some information on the remaining possibilities.\n\nThe last alternative is the most desirable.\nIt is efficient, because it doesn't require computing answers that are never used.\nIt is unobtrusive, because it doesn't require changing the calling function (and the calling function's calling function) to expect a list or pipe of answers.\nUnfortunately, it does have one major difficulty: there has to be a way of packaging up the current state of the computation and saving it away so that it can be returned to when the first choice does not work.\nFor our Prolog interpreter, the current state is succinctly represented as a list of goals.\nIn other problems, it is not so easy to summarize the entire state.\n\nWe will see in [section 22.4](chapter22.md#s0025) that the Scheme dialect of Lisp provides a function, `call-with-current-continuation`, that does exactly what we want: it packages the current state of the computation into a function, which can be stored away and invoked later.\nUnfortunately, there is no corresponding function in Common Lisp.\n\n### Anonymous Variables\n\nBefore moving on, it is useful to introduce the notion of an *anonymous variable.* This is a variable that is distinct from all others in a clause or query, but which the programmer does not want to bother to name.\nIn real Prolog, the underscore is used for anonymous variables, but we will use a single question mark.\nThe definition of `member` that follows uses anonymous variables for positions within terms that are not needed within a clause:\n\n```lisp\n(<- (member ?item (?item . ?)))\n(<- (member ?item (? . ?rest)) (member ?item ?rest))\n```\n\nHowever, we also want to allow several anonymous variables in a clause but still be able to keep each anonymous variable distinct from all other variables.\nOne way to do that is to replace each anonymous variable with a unique variable.\nThe function `replace-?-vars` uses `gensym` to do just that.\nIt is installed in the top-level macros `<-` and `?-` so that all clauses and queries get the proper treatment.\n\n```lisp\n(defmacro <- (&rest clause)\n  \"Add a clause to the data base.\"\n  '(add-clause ',(replace-?-vars clause)))\n(defmacro ?- (&rest goals)\n  \"Make a query and print answers.\"\n  '(top-level-prove '.(replace-?-vars goals)))\n(defun replace-?-vars (exp)\n  \"Replace any ? within exp with a var of the form ?123.\"\n  (cond ((eq exp '?) (gensym \"?\"))\n        ((atom exp) exp)\n        (t (reuse-cons (replace-?-vars (first exp))\n                       (replace-?-vars (rest exp))\n                       exp))))\n```\n\nA named variable that is used only once in a clause can also be considered an anonymous variable.\nThis is addressed in a different way in [section 12.3](chapter12.md#s0020).\n\n## 11.4 The Zebra Puzzle\n\nHere is an example of something Prolog is very good at: a logic puzzle.\nThere are fifteen facts, or constraints, in the puzzle:\n\n1.  There are five houses in a line, each with an owner, a pet, a cigarette, a drink, and a color.\n\n2.  The Englishman lives in the red house.\n\n3.  The Spaniard owns the dog.\n\n4.  Coffee is drunk in the green house.\n\n5.  The Ukrainian drinks tea.\n\n6.  The green house is immediately to the right of the ivory house.\n\n7.  The Winston smoker owns snails.\n\n8.  Kools are smoked in the yellow house.\n\n9.  Milk is drunk in the middle house.\n\n10.  The Norwegian lives in the first house on the left.\n\n11.  The man who smokes Chesterfields lives next to the man with the fox.\n\n12.  Kools are smoked in the house next to the house with the horse.\n\n13.  The Lucky Strike smoker drinks orange juice.\n\n14.  The Japanese smokes Parliaments.\n\n15.  The Norwegian lives next to the blue house.\n\nThe questions to be answered are: who drinks water and who owns the zebra?\nTo solve this puzzle, we first define the relations `nextto` (for \"next to\") and `iright` (for \"immediately to the right of\").\nThey are closely related to `member,` which is repeated here.\n\n```\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ? rest)) (member ?item ?rest))\n\n(<- (nextto ?x ?y ?list) (iright ?x ?y ?list))\n(<- (nextto ?x ?y ?list) (iright ?y ?x ?list))\n\n(<- (iright ?left ?right (?left ?right . ?rest)))\n(<- (iright ?left ?right (?x . ?rest))\n    (iright ?left ?right ?rest))\n\n(<- (= ?x ?x))\n```\n\nWe also defined the identity relation, `=`.\nIt has a single clause that says that any x is equal to itself.\nOne might think that this implements `eq` or `equal`.\nActually, since Prolog uses unification to see if the two arguments of a goal each unify with `?x`, this means that `=` is unification.\n\nNow we are ready to define the zebra puzzle with a single (long) clause.\nThe variable `?h` represents the list of five houses, and each house is represented by a term of the form (house *nationality pet cigarette drink color*).\nThe variable `?w` is the water drinker, and `?z` is the zebra owner.\nEach of the 15 constraints in the puzzle is listed in the body of `zebra`, although constraints 9 and 10 have been combined into the first one.\nConsider constraint 2, \"The Englishman lives in the red house.\" This is interpreted as \"there is a house whose nationality is Englishman and whose color is red, and which is a member of the list of houses\": in other words, `(member (house englishman ? ? ? red) ?h).` The other constraints are similarly straightforward.\n\n```lisp\n(<- (zebra ?h ?w ?z)\n ;; Each house is of the form:\n ;; (house nationality pet cigarette drink house-color)\n (= ?h ((house norwegian ? ? ? ?)                  ;1,10\n        ?\n        (house ? ? ? milk ?) ? ?))                 ; 9\n (member (house englishman ? ? ? red) ?h)          ; 2\n (member (house spaniard dog ? ? ?) ?h)            ; 3\n (member (house ? ? ? coffee green) ?h)            ; 4\n (member (house ukrainian ? ? tea ?) ?h)           ; 5\n (iright (house ? ? ? ? ivory)                     ; 6\n         (house 1111 green) ?h)\n (member (house ? snails winston ? ?) ?h)          ; 7\n (member (house ? ? kools ? yellow) ?h)            ; 8\n (nextto (house ? ? chesterfield ? ?)              ;11\n         (house ? fox ? ? ?) ?h)\n (nextto (house ? ? kools ? ?)                     ;12\n         (house ? horse ? ? ?) ?h)\n (member (house ? ? luckystrike orange-juice ?) ?h);13\n (member (house japanese ? parliaments ? ?) ?h)    ;14\n (nextto (house norwegian ? ? ? ?)                 ;15\n         (house ? ? ? ? blue) ?h)\n ;; Now for the questions:\n (member (house ?w ? ? water ?) ?h)                ;Q1\n (member (house ?z zebra ? ? ?) ?h))               ;Q2\n```\n\nHere's the query and solution to the puzzle:\n\n```lisp\n> (?- (zebra ?houses ?water-drinker ?zebra-owner))\n?HOUSES = ((HOUSE NORWEGIAN FOX KOOLS WATER YELLOW)\n                      (HOUSE UKRAINIAN HORSE CHESTERFIELD TEA BLUE)\n                      (HOUSE ENGLISHMAN SNAILS WINSTON MILK RED)\n                      (HOUSE SPANIARD DOG LUCKYSTRIKE ORANGE-JUICE IVORY)\n                      (HOUSE JAPANESE ZEBRA PARLIAMENTS COFFEE GREEN))\n?WATER-DRINKER = NORWEGIAN\n?ZEBRA-OWNER = JAPANESE.\nNo.\n```\n\nThis took 278 seconds, and profiling (see page 288) reveals that the function `prove` was called 12,825 times.\nA call to prove has been termed a *logical inference,* so our system is performing 12825/278 = 46 logical inferences per second, or LIPS.\nGood Prolog systems perform at 10,000 to 100,000 LIPS or more, so this is barely limping along.\n\nSmall changes to the problem can greatly affect the search time.\nFor example, the relation `nextto` holds when the first house is immediately right of the second, or when the second is immediately right of the first.\nIt is arbitrary in which order these clauses are listed, and one might think it would make no difference in which order they were listed.\nIn fact, if we reverse the order of these two clauses, the execution time is roughly cut in half.\n\n## 11.5 The Synergy of Backtracking and Unification\n\nProlog's backward chaining with backtracking is a powerful technique for generating the possible solutions to a problem.\nIt makes it easy to implement a *generate-and-test* strategy, where possible solutions are considered one at a time, and when a candidate solution is rejected, the next is suggested.\nBut generate-and-test is only feasible when the space of possible solutions is small.\n\nIn the zebra puzzle, there are five attributes for each of the five houses.\nThus there are 5!<sup>5</sup>, or over 24 billion candidate solutions, far too many to test one at a time.\nIt is the concept of unification (with the corresponding notion of a logic variable) that makes generate-and-test feasible on this puzzle.\nInstead of enumerating complete candidate solutions, unification allows us to specify *partial* candidates.\nWe start out knowing that there are five houses, with the Norwegian living on the far left and the milk drinker in the middle.\nRather than generating all complete candidates that satisfy these two constraints, we leave the remaining information vague, by unifying the remaining houses and attributes with anonymous logic variables.\nThe next constraint (number 2) places the Englishman in the red house.\nBecause of the way `member` is written, this first tries to place the Englishman in the leftmost house.\nThis is rejected, because Englishman and Norwegian fail to unify, so the next possibility is considered, and the Englishman is placed in the second house.\nBut no other features of the second house are specified-we didn't have to make separate guesses for the Englishman's house being green, yellow, and so forth.\nThe search continues, filling in only as much as is necessary and backing up whenever a unification fails.\n\nFor this problem, unification serves the same purpose as the delay macro (page 281).\nIt allows us to delay deciding the value of some attribute as long as possible, but to immediately reject a solution that tries to give two different values to the same attribute.\nThat way, we save time if we end up backtracking before the computation is made, but we are still able to fill in the value later on.\n\nIt is possible to extend unification so that it is doing more work, and backtracking is doing less work.\nConsider the following computation:\n\n```lisp\n(?- (length ?l 4)\n        (member d ?l) (member a ?l) (member c ?l) (member b ?l)\n        (= ?l (a b c d)))\n```\n\nThe first two lines generate permutations of the list (`d a c b`), and the third line tests for a permutation equal to (`a b c d`).\nMost of the work is done by backtracking.\nAn alternative is to extend unification to deal with lists, as well as constants and variables.\nPredicates like `length` and `member` would be primitives that would have to know about the representation of lists.\nThen the first two lines of the above program would `set ?l` to something like `#s (list :length 4 :members (d a c d))`.\nThe third line would be a call to the extended unification procedure, which would further specify `?l` to be something like:\n\n```lisp\n#s(list :length 4 imembers (d a c d) :order (abc d))\n```\n\nBy making the unification procedure more complex, we eliminate the need for backtracking entirely.\n\n**Exercise  11.3 [s]** Would a unification algorithm that delayed `member` tests be a good idea or a bad idea for the zebra puzzle?\n\n## 11.6 Destructive Unification\n\nAs we saw in [section 11.2](#s0015), keeping track of a binding list of variables is a little tricky.\nIt is also prone to inefficiency if the binding list grows large, because the list must be searched linearly, and because space must be allocated to hold the binding list.\nAn alternative implementation is to change `unify` to a destructive operation.\nIn this approach, there are no binding lists.\nInstead, each variable is represented as a structure that includes a field for its binding.\nWhen the variable is unified with another expression, the variable's binding field is modified to point to the expression.\nSuch variables will be called `vars` to distinguish them from the implementation of variables as symbols starting with a question mark.\n`vars` are defined with the following code:\n\n```lisp\n(defconstant unbound \"Unbound\")\n(defstruct var name (binding unbound))\n(defun bound-p (var) (not (eq (var-binding var) unbound)))\n```\n\nThe macro `deref` gets at the binding of a variable, returning its argument when it is an unbound variable or a non-variable expression.\nIt includes a loop because a variable can be bound to another variable, which in turn is bound to the ultimate value.\n\nNormally, it would be considered bad practice to implement deref as a macro, since it could be implemented as an inline function, provided the caller was willing to write `(setf x (deref x))` instead of `(deref x)`.\nHowever, deref will appear in code generated by some versions of the Prolog compiler that will be presented in the next section.\nTherefore, to make the generated code look neater, I have allowed myself the luxury of the `deref` macro.\n\n```lisp\n(defmacro deref (exp)\n  \"Follow pointers for bound variables.\"\n  '(progn (loop while (and (var-p ,exp) (bound-p ,exp))\n                        do (setf ,exp (var-binding ,exp)))\n                  ,exp))\n```\n\nThe function `unify!` below is the destructive version of `unify`.\nIt is a predicate that returns true for success and false for failure, and has the side effect of altering variable bindings.\n\n```lisp\n(defun unify! (x y)\n \"Destructively unify two expressions\"\n (cond ((eql (deref x) (deref y)) t)\n       ((var-p x) (set-binding! x y))\n       ((var-p y) (set-binding! y x))\n       ((and (consp x) (consp y))\n       (and (unify! (first x) (first y))\n            (unify! (rest x) (rest y))))\n       (t nil)))\n(defun set-binding! (var value)\n \"Set var's binding to value. Always succeeds (returns t).\"\n (setf (var-binding var) value)\n t)\n```\n\nTo make `vars` easier to read, we can install a `:print-function`:\n\n```lisp\n(defstruct (var (:print-function print-var))\n      name (binding unbound))\n  (defun print-var (var stream depth)\n      (if (or (and (numberp *print-level*)\n                        (>= depth *print-level*))\n              (var-p (deref var)))\n        (format stream \"?~a\" (var-name var))\n        (write var :stream stream)))\n```\n\nThis is the first example of a carefully crafted `:print-function`.\nThere are three things to notice about it.\nFirst, it explicitly writes to the stream passed as the argument.\nIt does not write to a default stream.\nSecond, it checks the variable `depth` against `*print-level*`, and prints just the variable name when the depth is exceeded.\nThird, it uses `write` to print the bindings.\nThis is because write pays attention to the current values of `*print-escape*`, `*print-pretty*`, and so on.\nOther printing functions such as `prinl` or `print` do not pay attention to these variables.\n\nNow, for backtracking purposes, we want to make `set-binding!` keep track of the bindings that were made, so they can be undone later:\n\n```lisp\n(defvar *trail* (make-array 200 :fill-pointer 0 :adjustable t))\n(defun set-binding! (var value)\n \"Set var's binding to value, after saving the variable\n in the trail. Always returns t.\"\n (unless (eq var value)\n   (vector-push-extend var *trail*)\n   (setf (var-binding var) value))\n t)\n(defun undo-bindings! (old-trail)\n \"Undo all bindings back to a given point in the trail.\"\n (loop until (= (fill-pointer *trail*) old-trail)\n   do (setf (var-binding (vector-pop *trail*)) unbound)))\n```\n\nNow we need a way of making new variables, where each one is distinct.\nThat could be done by `gensym-ing` a new name for each variable, but a quicker solution is just to increment a counter.\nThe constructor function `?` is defined to generate a new variable with a name that is a new integer.\nThis is not strictly necessary; we could have just used the automatically provided constructor `make-var`.\nHowever, I thought that the operation of providing new anonymous variable was different enough from providing a named variable that it deserved its own function.\nBesides, `make-var` may be less efficient, because it has to process the keyword arguments.\nThe function `?` has no arguments; it just assigns the default values specified in the slots of the `var` structure.\n\n```lisp\n(defvar *var-counter* 0)\n(defstruct (var (:constructor ? ())\n                      (:print-function print-var))\n  (name (incf *var-counter*))\n  (binding unbound))\n```\n\nA reasonable next step would be to use destructive unification to make a more efficient interpreter.\nThis is left as an exercise, however, and instead we put the interpreter aside, and in the next chapter develop a compiler.\n\n## 11.7 Prolog in Prolog\n\nAs stated at the start of this chapter, Prolog has many of the same features that make Lisp attractive for program development.\nJust as it is easy to write a Lisp interpreter in Lisp, it is easy to write a Prolog interpreter in Prolog.\nThe following Prolog metainterpreter has three main relations.\nThe relation clause is used to store clauses that make up the rules and facts that are to be interpreted.\nThe relation `prove` is used to prove a goal.\nIt calls `prove-all`, which attempts to prove a list of goals, `prove-all` succeeds in two ways: (1) if the list is empty, or (2) if there is some clause whose head matches the first goal, and if we can prove the body of that clause, followed by the remaining goals:\n\n```lisp\n(<- (prove ?goal) (prove-all (?goal)))\n(<- (prove-all nil))\n(<- (prove-all (?goal . ?goals))\n    (clause (<- ?goal . ?body))\n    (concat ?body ?goals ?new-goals)\n    (prove-all ?new-goals))\n```\n\nNow we add two clauses to the data base to define the member relation:\n\n```lisp\n(<- (clause (<- (mem ?x (?x . ?y)))))\n(<- (clause (<- (mem ?x (? . ?z)) (mem ?x ?z))))\n```\n\nFinally, we can prove a goal using our interpreter:\n\n```lisp\n(?- (prove (mem ?x (1 2 3))))\n?X = 1;\n?X = 2;\n?X = 3;\nNo.\n```\n\n## 11.8 Prolog Compared to Lisp\n\nMany of the features that make Prolog a successful language for AI (and for program development in general) are the same as Lisp's features.\nLet's reconsider the list of features that make Lisp different from conventional languages (see page 25) and see what Prolog has to offer:\n\n* *Built-in Support for Lists (and other data types).*\nNew data types can be created easily using lists or structures (structures are preferred).\nSupport for reading, printing, and accessing components is provided automatically.\nNumbers, symbols, and characters are also supported.\nHowever, because logic variables cannot be altered, certain data structures and operations are not provided.\nFor example, there is no way to update an element of a vector in Prolog.\n\n* *Automatic Storage Management.*\nThe programmer can allocate new objects without worrying about reclaiming them.\nReclaiming is usually faster in Prolog than in Lisp, because most data can be stack-allocated instead of heap-allocated.\n\n* *Dynamic Typing.*\nDeclarations are not required.\nIndeed, there is no standard way to make type declarations, although some implementations allow for them.\nSome Prolog systems provide only fixnums, so that eliminates the need for a large class of declarations.\n\n* *First-Class Functions.*\nProlog has no equivalent of `lambda`, but the built-in predicate `call` allows a term - a piece of data - to be called as a goal.\nAlthough backtracking choice points are not first-class objects, they can be used in a way very similar to continuations in Lisp.\n\n* *Uniform Syntax.*\nLike Lisp, Prolog has a uniform syntax for both programs and data.\nThis makes it easy to write interpreters and compilers in Prolog.\nWhile Lisp's prefix-operator list notation is more uniform, Prolog allows infix and postfix operators, which may be more natural for some applications.\n\n* *Interactive Environment.*\nExpressions can be immediately evaluated.\nHigh-quality Prolog systems offer both a compiler and interpreter, along with a host of debugging tools.\n\n* *Extensibility.*\nProlog syntax is extensible.\nBecause programs and data share the same format, it is possible to write the equivalent of macros in Prolog and to define embedded languages.\nHowever, it can be harder to ensure that the resulting code will be compiled efficiently.\nThe details of Prolog compilation are implementation-dependent.\n\nTo put things in perspective, consider that Lisp is at once one of the highest-level languages available and a universal assembly language.\nIt is a high-level language because it can easily capture data, functional, and control abstractions.\nIt is a good assembly language because it is possible to write Lisp in a style that directly reflects the operations available on modern computers.\n\nProlog is generally not as efficient as an assembly language, but it can be more concise as a specification language, at least for some problems.\nThe user writes specifications: lists of axioms that describe the relationships that can hold in the problem domain.\nIf these specifications are in the right form, Prolog's automatic backtracking can find a solution, even though the programmer does not provide an explicit algorithm.\nFor other problems, the search space will be too large or infinite, or Prolog's simple depth-first search with backup will be too inflexible.\nIn this case, Prolog must be used as a programming language rather than a specification language.\nThe programmer must be aware of Prolog's search strategy, using it to implement an appropriate algorithm for the problem at hand.\n\nProlog, like Lisp, has suffered unfairly from some common myths.\nIt has been thought to be an inefficient language because early implementations were interpreted, and because it has been used to write interpreters.\nBut modern compiled Prolog can be quite efficient (see [Warren et al.\n1977](bibliography.md#bb1335) and Van Roy 1990).\nThere is a temptation to see Prolog as a solution in itself rather than as a programming language.\nThose who take that view object that Prolog's depth-first search strategy and basis in predicate calculus is too inflexible.\nThis objection is countered by Prolog programmers who use the facilities provided by the language to build more powerful search strategies and representations, just as one would do in Lisp or any other language.\n\n## 11.9 History and References\n\nCordell [Green (1968)](bibliography.md#bb0490) was the first to articulate the view that mathematical results on theorem proving could be used to make deductions and thereby answer queries.\nHowever, the major technique in use at the time, resolution theorem proving (see [Robinson 1965](bibliography.md#bb0995)), did not adequately constrain search, and thus was not practical.\nThe idea of goal-directed computing was developed in Carl Hewitt's work (1971) on the PLANNER language for robot problem solving.\nHe suggested that the user provide explicit hints on how to control deduction.\n\nAt about the same time and independently, Alain Colmerauer was developing a system to perform natural language analysis.\nHis approach was to weaken the logical language so that computationally complex statements (such as logical disjunctions) could not be made.\nColmerauer and his group implemented the first Prolog interpreter using Algol-W in the summer of 1972 (see [Roussel 1975](bibliography.md#bb1005)).\nIt was Roussel's wife, Jacqueline, who came up with the name Prolog as an abbreviation for \"programmation en logique.\" The first large Prolog program was their natural language system, also completed that year ([Colmerauer et al.\n1973](bibliography.md#bb0255)).\nFor those who read English better than French, [Colmerauer (1985)](bibliography.md#bb0245) presents an overview of Prolog.\nRobert Kowalski is generally considered the co-inventor of Prolog.\nHis 1974 article outlines his approach, and his 1988 article is a historical review on the early logic programming work.\n\nThere are now dozens of text books on Prolog.\nIn my mind, six of these stand out.\nClocksin and Mellish's *Programming in Prolog* (1987) was the first and remains one of the best.\nSterling and Shapiro's *The Art of Prolog* (1986) has more substantial examples but is not as complete as a reference.\nAn excellent overview from a slightly more mathematical perspective is Pereira and Shieber's *Prolog and Natural-Language Analysis* (1987).\nThe book is worthwhile for its coverage of Prolog alone, and it also provides a good introduction to the use of logic programming for language understanding (see part V for more on this subject).\nO'Keefe's *The Craft of Prolog* (1990) shows a number of advanced techniques.\nO'Keefe is certainly one of the most influential voices in the Prolog community.\nHe has definite views on what makes for good and bad coding style and is not shy about sharing his opinions.\nThe reader is warned that this book evolved from a set of notes on the Clocksin and Mellish book, and the lack of organization shows in places.\nHowever, it contains advanced material that can be found nowhere else.\nAnother collection of notes that has been organized into a book is Coelho and Cotta's *Prolog by Example.* Published in 1988, this is an update of their 1980 book, *How to Solve it in Prolog.* The earlier book was an underground classic in the field, serving to educate a generation of Prolog programmers.\nBoth versions include a wealth of examples, unfortunately with little documentation and many typos.\nFinally, Ivan Bratko's *Prolog Programming for Artificial Intelligence* (1990) covers some introductory AI material from the Prolog perspective.\n\nMaier and Warren's *Computing with Logic* (1988) is the best reference for those interested in implementing Prolog.\nIt starts with a simple interpreter for a variable-free version of Prolog, and then moves up to the full language, adding improvements to the interpreter along the way.\n(Note that the second author, David S.\nWarren of Stonybrook, is different from David H.\nD.\nWarren, formerly at Edinburgh and now at Bristol.\nBoth are experts on Prolog.)\n\nLloyd's *Foundations of Logic Programming* (1987) provides a theoretical explanation of the formal semantics of Prolog and related languages.\n[Lassez et al.\n(1988)](bibliography.md#bb0705) and [Knight (1989)](bibliography.md#bb0625) provide overviews of unification.\n\nThere have been many attempts to extend Prolog to be closer to the ideal of Logic Programming.\nThe language MU-Prolog and NU-Prolog ([Naish 1986](bibliography.md#bb0890)) and Prolog III ([Colmerauer 1990](bibliography.md#bb0250)) are particularly interesting.\nThe latter includes a systematic treatment of the &ne; relation and an interpretation of infinite trees.\n\n## 11.10 Exercises\n\n**Exercise  11.4 [m]** It is somewhat confusing to see \"no\" printed after one or more valid answers have appeared.\nModify the program to print \"no\" only when there are no answers at all, and \"no more\" in other cases.\n\n**Exercise  11.5 [h]** At least six books (Abelson and Sussman 1985, [Charniak and McDermott 1985](bibliography.md#bb0175), Charniak et al.\n1986, [Hennessey 1989](bibliography.md#bb0530), [Wilensky 1986](bibliography.md#bb1390), and [Winston and Horn 1988](bibliography.md#bb1410)) present unification algorithms with a common error.\nThey all have problems unifying (`?x ?y a`) with (`?y ?x ?x`).\nSome of these texts assume that `unify` will be called in a context where no variables are shared between the two arguments.\nHowever, they are still suspect to the bug, as the following example points out:\n\n```lisp\n> (unify '(f (?x ?y a) (?y ?x ?x)) '(f ?z ?z))\n((?Y . A) (?X . ?Y) (?Z ?X ?Y A))\n```\n\nDespite this subtle bug, I highly recommend each of the books to the reader.\nIt is interesting to compare different implementations of the same algorithm.\nIt turns out there are more similarities than differences.\nThis indicates two things: (1) there is a generally agreed-upon style for writing these functions, and (2) good programmers sometimes take advantage of opportunities to look at other's code.\n\nThe question is: Can you give an informal proof of the correctness of the algorithm presented in this chapter?\nStart by making a clear statement of the specification.\nApply that to the other algorithms, and show where they go wrong.\nThen see if you can prove that the `unify` function in this chapter is correct.\nFailing a complete proof, can you at least prove that the algorithm will always terminate?\nSee [Norvig 1991](bibliography.md#bb0915) for more on this problem.\n\n**Exercise  11.6 [h]** Since logic variables are so basic to Prolog, we would like them to be efficient.\nIn most implementations, structures are not the best choice for small objects.\nNote that variables only have two slots: the name and the binding.\nThe binding is crucial, but the name is only needed for printing and is arbitrary for most variables.\nThis suggests an alternative implementation.\nEach variable will be a cons cell of the variable's binding and an arbitrary marker to indicate the type.\nThis marker would be checked by `variable-p`.\nVariable names can be stored in a hash table that is cleared before each query.\nImplement this representation for variables and compare it to the structure representation.\n\n**Exercise 11.7 [m]** Consider the following alternative implementation for anonymous variables: Leave the macros `<-` and `?-` alone, so that anonymous variables are allowed in assertions and queries.\nInstead, change `unify` so that it lets anything match against an anonymous variable:\n\n```lisp\n(defun unify (x y &optional (bindings no-bindings))\n  \"See if x and y match with given bindings.\"\n  (cond ((eq bindings fail) fail)\n              ((eql x y) bindings)\n              ((or (eq x '?) (eq y '?)) bindings)      ;***\n              ((variable-p x) (unify-variable x y bindings))\n              ((variable-p y) (unify-variable y x bindings))\n              ((and (consp x) (consp y))\n                (unify (rest x) (rest y)\n                          (unify (first x) (first y) bindings)))\n              (t fail)))\n```\n\nIs this alternative correct?\nIf so, give an informal proof.\nIf not, give a counterexample.\n\n**Exercise  11.8 [h]** Write a version of the Prolog interpreter that uses destructive unification instead of binding lists.\n\n**Exercise  11.9 [m]** Write Prolog rules to express the terms father, mother, son, daughter, and grand- versions of each of them.\nAlso define parent, child, wife, husband, brother, sister, uncle, and aunt.\nYou will need to decide which relations are primitive (stored in the Prolog data base) and which are derived by rules.\n\nFor example, here's a definition of grandfather that says that G is the grandfather of C if G is the father of some P, who is the parent of C:\n\n```lisp\n(<- (grandfather ?g ?c)\n        (father ?g ?p)\n        (parent ?p ?c))\n```\n\n**Exercise 11.10 [m]** The following problem is presented in [Wirth 1976](bibliography.md#bb1415):\n\n*I married a widow (let's call her W) who has a grown-up daughter (call her D).\nMy father (F), who visited us often, fell in love with my step-daughter and married her.\nHence my father became my son-in-law and my step-daughter became my mother.\nSome months later, my wife gave birth to a son (S<sub>1</sub>), who became the brother-in-law of my father, as well as my uncle.\nThe wife of my father, that is, my step-daughter, also had a son (S<sub>2</sub>).*\n\nRepresent this situation using the predicates defined in the previous exercise, verify its conclusions, and prove that the narrator of this tale is his own grandfather.\n\n**Exercise 11.11 [d]** Recall the example:\n\n```lisp\n> (?- (length (a b` c `d) ?n))\n?N = (1 + (1 + (1 + (1 + 0))));\n```\n\nIt is possible to produce 4 instead of `(1+ (1+ (1+ (1+ 0))))` by extending the notion of unification.\n[A&iuml;t-Kaci et al.\n1987](bibliography.md#bb0025) might give you some ideas how to do this.\n\n**Exercise  11.12 [h]** The function `rename-variables` was necessary to avoid confusion between the variables in the first argument to `unify` and those in the second argument.\nAn alternative is to change the `unify` so that it takes two binding lists, one for each argument, and keeps them separate.\nImplement this alternative.\n\n## 11.11 Answers\n\n**Answer 11.9** We will choose as primitives the unary predicates `male` and `female` and the binary predicates `child` and `married`.\nThe former takes the child first; the latter takes the husband first.\nGiven these primitives, we can make the following definitions:\n\n```lisp\n(<- (father ?f ?e)   (male ?f) (parent ?f ?c))\n(<- (mother ?m ?c)   (female ?m) (parent ?m c))\n(<- (son ?s ?p)      (male ?s) (parent ?p ?s))\n(<- (daughter ?s ?p) (male ?s) (parent ?p ?s))\n\n(<- (grandfather ?g ?c)     (father ?g ?p) (parent ?p ?c))\n(<- (grandmother ?g ?c)     (mother ?g ?p) (parent ?p ?c))\n(<- (grandson ?gs ?gp)      (son ?gs ?p) (parent ?gp ?p))\n(<- (granddaughter ?gd ?gp) (daughter ?gd ?p) (parent ?gp ?p))\n\n(<- (parent ?p ?c)   (child ?c ?p))\n(<- (wife ?w ?h)     (married ?h ?w))\n(<- (husband ?h ?w)  (married ?h ?w))\n\n(<- (sibling ?x ?y)  (parent ?p ?x) (parent ?p ?y))\n(<- (brother ?b ?x)  (male ?b) (sibling ?b ?x))\n(<- (sister ?s ?x)   (female ?s) (sibling ?s ?x))\n(<- (uncle ?u ?n)    (brother ?u ?p) (parent ?p ?n))\n(<- (aunt ?a ?n)     (sister ?a ?p) (parent ?p ?n  ))\n```\n\nNote that there is no way in Prolog to express a *true* definition.\nWe would like to say that \"P is the parent of C if and only if C is the child of P,\" but Prolog makes us express the biconditional in one direction only.\n\n**Answer 11.10** Because we haven't considered step-relations in the prior definitions, we have to extend the notion of parent to include step-parents.\nThe definitions have to be written very carefully to avoid infinite loops.\nThe strategy is to structure the defined terms into a strict hierarchy: the four primitives are at the bottom, then parent is defined in terms of the primitives, then the other terms are defined in terms of parent and the primitives.\n\nWe also provide a definition for son-in-law:\n\n```lisp\n(<- (parent ?p ?c) (married ?p ?w) (child ?c ?w))\n(<- (parent ?p ?c) (married ?h ?p) (child ?c ?w))\n(<- (son-in-law ?s ?p) (parent ?p ?w) (married ?s ?w))\n```\n\nNow we add the information from the story.\nNote that we only use the four primitives male, female, married, and child:\n\n```lisp\n(<- (male I)) (<- (male F)) (<- (male S1)) (<- (male S2))\n(<- (female W)) (<- (female D))\n(<- (married I W))\n(<- (married F D))\n(<- (child D W))\n(<- (child I F))\n(<- (child S1 I))\n(<- (child S2 F))\n```\n\nNow we are ready to make the queries:\n\n```lisp\n> (?- (son-in-law F I)) Yes.\n> (?- (mother D I)) Yes.\n> (?- (uncle S1 I)) Yes.\n> (?- (grandfather I I)) Yes.\n```\n\n----------------------\n\n<a id=\"fn11-1\"></a><sup>[1](#tfn11-1)</sup>\nActually, *programmation en logique*, since it was invented by a French group (see page 382).\n\n<a id=\"fn11-2\"></a><sup>[2](#tfn11-2)</sup>\nActually, this is more like the Lisp `find` than the Lisp `member`.\nIn this chapter we have adopted the traditional Prolog definition of `member`.\n\n<a id=\"fn11-3\"></a><sup>[3](#tfn11-3)</sup>\nSee exercise 11.12 for an alternative approach.\n\n<a id=\"fn11-4\"></a><sup>[4](#tfn11-4)</sup>\nSee the MU-Prolog and NU-Prolog languages ([Naish 1986](bibliography.md#bb0890)).\n"
  },
  {
    "path": "docs/chapter12.md",
    "content": "# Chapter 12\n## Compiling Logic Programs\n\nThe end of [chapter 11](chapter11.md) introduced a new, more efficient representation for logic variables.\nIt would be reasonable to build a new version of the Prolog interpreter incorporating this representation.\nHowever, [chapter 9](chapter9.md) has taught us that compilers run faster than interpreters and are not that much harder to build.\nThus, this chapter will present a Prolog compiler that translates from Prolog to Lisp.\n\nEach Prolog predicate will be translated into a Lisp function, and we will adopt the convention that a predicate called with a different number of arguments is a different predicate.\nIf the symbol `p` can be called with either one or two arguments, we will need two Lisp functions to implement the two predicates.\nFollowing Prolog tradition, these will be called `p/1` and `p/2`.\n\nThe next step is to decide what the generated Lisp code should look like.\nIt must unify the head of each clause against the arguments, and if the unification succeeds, it must call the predicates in the body.\nThe difficult part is that the choice points have to be remembered.\nIf a call to a predicate in the first clause fails, we must be able to return to the second clause and try again.\n\nThis can be done by passing in a *success continuation* as an extra argument to every predicate.\nThis continuation represents the goals that remain unsolved, the `other-goals` argument of `prove`.\nFor each clause in the predicate, if all the goals in a clause succeed, then we should call the success continuation.\nIf a goal fails, we don't do anything special; we just go on to the next clause.\nThere is one complication: after failing we have to undo any bindings made by `unify!`.\nConsider an example.\nThe clauses\n\n```lisp\n(<- (likes Robin cats))\n(<- (likes Sandy ?x) (likes ?x cats))\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n```\n\ncould be compiled into this:\n\n```lisp\n(defun likes/2 (?arg1 ?arg2 cont)\n ;; First clause:\n (if (and (unify! ?arg1 'Robin) (unify! ?arg2 'cats))\n   (funcall cont))\n (undo-bindings)\n ;; Second clause:\n (if (unify! ?argl 'Sandy)\n   (likes/2 ?arg2 'cats cont))\n (undo-bindings)\n ;; Third clause:\n (if (unify! ?argl 'Kim)\n   (likes/2 ?arg2 'Lee\n     #'(lambda () (likes/2 ?arg2 'Kim cont))))))\n```\n\nIn the first clause, we just check the two arguments and, if the unifications succeed, call the continuation directly, because the first clause has no body.\nIn the second clause, `likes/2` is called recursively, to see if `?arg2` likes `cats`.\nIf this succeeds, then the original goal succeeds, and the continuation `cont` is called.\nIn the third clause, we have to call `likes/2` recursively again, this time requesting that it check if `?arg2` likes `Lee`.\nIf this check succeeds, then the continuation will be called.\nIn this case, the continuation involves another call to `likes/2`, to check if `?arg2` likes `Kim`.\nIf this succeeds, then the original continuation, `cont`, will finally be called.\n\nRecall that in the Prolog interpreter, we had to append the list of pending goals, `other-goals`, to the goals in the body of the clause.\nIn the compiler, there is no need to do an `append.` Instead, the continuation cont represents the other-goals, and the body of the clause is represented by explicit calls to functions.\n\nNote that the code for `likes/2` given before has eliminated some unnecessary calls to `unify!`.\nThe most obvious implementation would have one call to `unify!` for each argument.\nThus, for the second clause, we would have the code:\n\n```lisp\n(if (and (unify! ?argl 'Sandy) (unify! ?arg2 ?x))\n (likes/2 ?x 'cats cont))\n```\n\nwhere we would need a suitable let binding for the variable `?x`.\n\n## 12.1 A Prolog Compiler\n\nThis section presents the compiler summarized in [figure 12.1](#f0010).\nAt the top level is the function `prolog-compile`, which takes a symbol, looks at the clauses defined for that symbol, and groups the clauses by arity.\nEach symbol/arity is compiled into a separate Lisp function by `compile-predicate`.\n\n| Function                    | Description                                                |\n|-----------------------------|------------------------------------------------------------|\n|                             | **Top-Level Functions**                                    |\n| `?-`                        | Make a query, but compile everything first.                |\n|                             | **Special Variables**                                      |\n| `*trail*`                   | A list of all bindings made so far.                        |\n|                             | **Major Functions**                                        |\n| `top-level-prove`           | New version compiles everything first.                     |\n| `run-prolog`                | Compile everything and call a Prolog function.             |\n| `prolog-compile-symbols`    | Compile a list of Prolog symbols.                          |\n| `prolog-compile`            | Compile a symbol; make a separate function for each arity. |\n| `compile-predicate`         | Compile all the clauses for a given symbol/arity.          |\n| `compile-clause`            | Transform away the head and compile the resulting body.    |\n| `compile-body`              | Compile the body of a clause.                              |\n| `compile-call`              | Compile a call to a Prolog predicate.                      |\n| `compile-arg`               | Generate code for an argument to a goal in the body.       |\n| `compile-unify`             | Return code that tests if var and term unify.              |\n|                             | **Auxiliary Functions**                                    |\n| `clauses-with-arity`        | Return all clauses whose head has a given arity.           |\n| `relation-arity`            | The number of arguments to a relation.                     |\n| `args`                      | The arguments of a relation.                               |\n| `make-parameters`           | Build a list of parameters.                                |\n| `make-predicate`            | Build a symbol of the form name/arity.                     |\n| `make-=`                    | Build a unification relation.                              |\n| `def-prolog-compiler-macro` | Define a compiler macro for Prolog.                        |\n| `prolog-compiler-macro`     | Fetch the compiler macro for a Prolog predicate.           |\n| `has-variable-p`            | Is there a variable anywhere in the expression `x`?        |\n| `proper-listp`              | Is `x` a proper (non-dotted) list?                         |\n| `maybe-add-undo-bindings`   | Undo any bindings that need undoing.                       |\n| `bind-unbound-vars`         | Add a `let` if needed.                                     |\n| `make-anonymous`            | Replace variables that are only used once with `?`.        |\n| `anonymous-variables-in`    | A list of anonymous variables.                             |\n| `compile-if`                | Compile an IF form.  No `else`-part allowed.               |\n| `compile-unify-variable`    | Compile the unification of a `var`.                        |\n| `bind-variables-in`         | Bind all variables in `exp` to themselves.                 |\n| `follow-binding`            | Get the ultimate binding of `var` according to bindings.   |\n| `bind-new-variables`        | Extend bindings to include any unbound variables.          |\n| `ignore`                    | Do nothing&mdash;ignore the arguments.                     |\n|                             | **Previously Defined Functions**                           |\n| `unify!`                    | Destructive unification (see section 11.6)                 |\n| `undo-bindings!`            | Use the trail to backtrack, undoing bindings.              |\n| `binding-val`               | Pick out the value part of a var/val binding.              |\n| `symbol`                    | Create or find an interned symbol.                         |\n| `new-symbol`                | Create a new uninterned symbol.                            |\n| `find-anywhere`             | Does item occur anywhere in tree?                          |\n\nFigure 12.1: Glossary for the Prolog Compiler\n\n```lisp\n(defun prolog-compile (symbol &optional\n                       (clauses (get-clauses symbol)))\n  \"Compile a symbol; make a separate function for each arity.\"\n  (unless (null clauses)\n    (let ((arity (relation-arity (clause-head (first clauses)))))\n      ;; Compile the clauses with this arity\n      (compile-predicate\n        symbol arity (clauses-with-arity clauses #'= arity))\n      ;; Compile all the clauses with any other arity\n      (prolog-compile\n        symbol (clauses-with-arity clauses #'/= arity)))))\n```\n\nThree utility functions are included here:\n\n```lisp\n(defun clauses-with-arity (clauses test arity)\n  \"Return all clauses whose head has given arity.\"\n  (find-all arity clauses\n            :key #'(lambda (clause)\n                     (relation-arity (clause-head clause)))\n            :test test))\n\n(defun relation-arity (relation)\n  \"The number of arguments to a relation.\n  Example: (relation-arity '(p a b c)) => 3\"\n  (length (args relation)))\n\n(defun args (x) \"The arguments of a relation\" (rest x))\n```\n\nThe next step is to compile the clauses for a given predicate with a fixed arity into a Lisp function.\nFor now, that will be done by compiling each clause independently and wrapping them in a `lambda` with the right parameter list.\n\n```lisp\n(defun compile-predicate (symbol arity clauses)\n  \"Compile all the clauses for a given symbol/arity\n  into a single LISP function.\"\n  (let ((predicate (make-predicate symbol arity))\n        (parameters (make-parameters arity)))\n    (compile\n     (eval\n      `(defun ,predicate (,@parameters cont)\n            .,(mapcar #'(lambda (clause)\n                        (compile-clause parameters clause 'cont))\n              clauses))))))\n\n(defun make-parameters (arity)\n  \"Return the list (?arg1 ?arg2 ... ?arg-arity)\"\n  (loop for i from 1 to arity\n        collect (new-symbol '?arg i)))\n\n(defun make-predicate (symbol arity)\n  \"Return the symbol: symbol/arity\"\n  (symbol symbol '/ arity))\n```\n\nNow for the hard part: we must actually generate the code for a clause.\nHere again is an example of the code desired for one clause.\nWe'll start by setting as a target the simple code:\n\n```lisp\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n(defun likes/2 (?arg1 ?arg2 cont)\n ...\n (if (and (unify! ?argl 'Kim) (unify! ?arg2 ?x)\n   (likes/2 ?arg2 'Lee\n      #'(lambda () (likes/2 ?x 'Kim))))\n```\n\n ...)\n\nbut we'll also consider the possibility of upgrading to the improved code:\n\n```lisp\n(defun likes/2 (?arg1 ?arg2 cont)\n ...\n (if (unify! ?arg1 'Kim)\n   (likes/2 ?arg2 'Lee\n      #'(lambda () (likes/2 ?arg2 'Kim))))\n```\n\n ...)\n\nOne approach would be to write two functions, `compile-head` and `compile-body`, and then combine them into the code (if *head body*).\nThis approach could easily generate the prior code.\nHowever, let's allow ourselves to think ahead a little.\nIf we eventually want to generate the improved code, we will need some communication between the head and the body.\nWe will have to know that the head decided not to compile the unification of `?arg2` and `?x`, but because of this, the body will have to substitute `?arg2` for `?x`.\nThat means that the `compile-head` function conceptually returns two values: the code for the head, and an indication of substitutions to perform in the body.\nThis could be handled by explicitly manipulating multiple values, but it seems complicated.\n\nAn alternate approach is to eliminate `compile-head` and just write `compile-body`.\nThis is possible if we in effect do a source-code transformation on the clause.\nInstead of treating the clause as:\n\n```lisp\n(<- (likes Kim ?x)\n  (likes ?x Lee) (likes ?x Kim))\n```\n\nwe transform it to the equivalent:\n\n```lisp\n(<- (likes ?arg1 ?arg2)\n  (= ?arg1 Kim) (= ?arg2 ?x) (likes ?x Lee) (likes ?x Kim))\n```\n\nNow the arguments in the head of the clause match the arguments in the function `likes/2`, so there is no need to generate any code for the head.\nThis makes things simpler by eliminating `compile-head`, and it is a better decomposition for another reason: instead of adding optimizations to `compile-head`, we will add them to the code in `compile-body` that handles `=`.\nThat way, we can optimize calls that the user makes to `=`, in addition to the calls introduced by the source-code transformation.\n\nTo get an overview, the calling sequence of functions will turn out to be as follows:\n\n```lisp\nprolog-compile\n  compile-predicate\n    compile-clause\n      compile-body\n        compile-call\n        compile-arg\n        compile-unify\n            compile-arg\n```\n\nwhere each function calls the ones below it that are indented one level.\nWe have already defined the first two functions.\nHere then is our first version of `compile-clause`:\n\n```lisp\n(defun compile-clause (parms clause cont)\n  \"Transform away the head, and compile the resulting body.\"\n  (compile-body\n    (nconc\n      (mapcar #'make-= parms (args (clause-head clause)))\n      (clause-body clause))\n    cont))\n\n(defun make-= (x y) `(= ,x ,y))\n```\n\nThe bulk of the work is in `compile-body`, which is a little more complicated.\nThere are three cases.\nIf there is no body, we just call the continuation.\nIf the body starts with a call to `=`, we compile a call to `unify!`.\nOtherwise, we compile a call to a function, passing in the appropriate continuation.\n\nHowever, it is worthwhile to think ahead at this point.\nIf we want to treat `=` specially now, we will probably want to treat other goals specially later.\nSo instead of explicitly checking for `=`, we will do a data-driven dispatch, looking for any predicate that has a `prolog-compiler-macro` property attached to it.\nLike Lisp compiler macros, the macro can decline to handle the goal.\nWe will adopt the convention that returning `:pass` means the macro decided not to handle it, and thus it should be compiled as a normal goal.\n\n```lisp\n(defun compile-body (body cont)\n  \"Compile the body of a clause.\"\n  (if (null body)\n      `(funcall ,cont)\n      (let* ((goal (first body))\n             (macro (prolog-compiler-macro (predicate goal)))\n             (macro-val (if macro\n                            (funcall macro goal (rest body) cont))))\n        (if (and macro (not (eq macro-val :pass)))\n            macro-val\n            (compile-call\n               (make-predicate (predicate goal)\n                               (relation-arity goal))\n               (mapcar #'(lambda (arg) (compile-arg arg))\n                       (args goal))\n               (if (null (rest body))\n                   cont\n                   `#'(lambda ()\n                      ,(compile-body (rest body) cont))))))))\n\n(defun compile-call (predicate args cont)\n  \"Compile a call to a prolog predicate.\"\n  `(,predicate ,@args ,cont))\n\n(defun prolog-compiler-macro (name)\n  \"Fetch the compiler macro for a Prolog predicate.\"\n  ;; Note NAME is the raw name, not the name/arity\n  (get name 'prolog-compiler-macro))\n\n(defmacro def-prolog-compiler-macro (name arglist &body body)\n  \"Define a compiler macro for Prolog.\"\n  `(setf (get ',name 'prolog-compiler-macro)\n         #'(lambda ,arglist .,body)))\n\n(def-prolog-compiler-macro = (goal body cont)\n  (let ((args (args goal)))\n    (if (/= (length args) 2)\n        :pass\n        `(if ,(compile-unify (first args) (second args))\n             ,(compile-body body cont)))))\n\n(defun compile-unify (x y)\n  \"Return code that tests if var and term unify.\"\n  `(unify! ,(compile-arg x) ,(compile-arg y)))\n```\n\nAll that remains is `compile-arg`, a function to compile the arguments to goals in the body.\nThere are three cases to consider, as shown in the compilation to the argument of `q` below:\n\n| []()                         |                              |\n|------------------------------|------------------------------|\n| `1 (<- (p ?x) (q ?x))`       | `(q/1 ?x cont)`              |\n| `2 (<- (p ?x) (q (f a b)))`  | `(q/1 '(f a b) cont)`        |\n| `3 (<- (p ?x) (q (f ?x b)))` | `(q/1 (list 'f ?x 'b) cont)` |\n\nIn case 1, the argument is a variable, and it is compiled as is.\nIn case 2, the argument is a constant expression (one without any variables) that compiles into a quoted expression.\nIn case 3, the argument contains a variable, so we have to generate code that builds up the expression.\nCase 3 is actually split into two in the list below: one compiles into a call to `list`, and the other a call to `cons`.\nIt is important to remember that the goal `(q (f ?x b))` does *not* involve a call to the function `f`.\nRather, it involves the term `(f ?x b)`, which is just a list of three elements.\n\n```lisp\n(defun compile-arg (arg)\n  \"Generate code for an argument to a goal in the body.\"\n  (cond ((variable-p arg) arg)\n        ((not (has-variable-p arg)) `',arg)\n        ((proper-listp arg)\n         `(list .,(mapcar #'compile-arg arg)))\n        (t `(cons ,(compile-arg (first arg))\n                  ,(compile-arg (rest arg))))))\n\n(defun has-variable-p (x)\n  \"Is there a variable anywhere in the expression x?\"\n  (find-if-anywhere #'variable-p x))\n\n(defun proper-listp (x)\n  \"Is x a proper (non-dotted) list?\"\n  (or (null x)\n      (and (consp x) (proper-listp (rest x)))))\n```\n\nLet's see how it works.\nWe will consider the following clauses:\n\n```lisp\n(<- (likes Robin cats))\n(<- (likes Sandy ?x) (likes ?x cats))\n(<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ?rest)) (member ?item ?rest))\n```\n\nHere's what `prolog-compile` gives us:\n\n```lisp\n(DEFUN LIKES/2 (?ARG1 ?ARG2 CONT)\n (IF (UNIFY! ?ARG1 'ROBIN)\n  (IF (UNIFY! ?ARG2 'CATS)\n   (FUNCALL CONT)))\n (IF (UNIFY! ?ARG1 'SANDY)\n  (IF (UNIFY! ?ARG2 ?X)\n   (LIKES/2 ?X 'CATS CONT)))\n (IF (UNIFY! ?ARG1 'KIM)\n  (IF (UNIFY! ?ARG2 ?X)\n   (LIKES/2 ?X 'LEE (LAMBDA ()\n      (LIKES/2 ?X 'KIM CONT))))))\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (IF (UNIFY! ?ARG1 ?ITEM)\n  (IF (UNIFY! ?ARG2 (CONS ?ITEM ?REST))\n   (FUNCALL CONT)))\n (IF (UNIFY! ?ARG1 ?ITEM)\n  (IF (UNIFY! ?ARG2 (CONS ?X ?REST))\n   (MEMBER/2 ?ITEM ?REST CONT))))\n```\n\n## 12.2 Fixing the Errors in the Compiler\n\nThere are some problems in this version of the compiler:\n\n*   We forgot to undo the bindings after each call to `unify!`.\n\n*   The definition of `undo-bindings!` defined previously requires as an argument an index into the `*trail*` array.\nSo we will have to save the current top of the trail when we enter each function.\n\n*   Local variables, such as `?x`, were used without being introduced.\nThey should be bound to new variables.\n\nUndoing the bindings is simple: we add a single line to `compile-predicate,` a call to the function `maybe-add-undo-bindings`.\nThis function inserts a call to `undo-bindings!` after every failure.\nIf there is only one clause, no undoing is necessary, because the predicate higher up in the calling sequence will do it when it fails.\nIf there are multiple clauses, the function wraps the whole function body in a let that captures the initial value of the trail's fill pointer, so that the bindings can be undone to the right point.\nSimilarly, we can handle the unbound-variable problem by wrapping a call to `bind-unbound-vars` around each compiled clause:\n\n```lisp\n(defun compile-predicate (symbol arity clauses)\n  \"Compile all the clauses for a given symbol/arity\n  into a single LISP function.\"\n  (let ((predicate (make-predicate symbol arity))\n        (parameters (make-parameters arity)))\n    (compile\n     (eval\n      `(defun ,predicate (,@parameters cont)\n  .,(maybe-add-undo-bindings                  ;***\n     (mapcar #'(lambda (clause)\n           (compile-clause parameters clause 'cont))\n      clauses)))))))\n\n(defun compile-clause (parms clause cont)\n  \"Transform away the head, and compile the resulting body.\"\n  (bind-unbound-vars                                   ;***\n    parms                                              ;***\n    (compile-body\n      (nconc\n        (mapcar #'make-= parms (args (clause-head clause)))\n        (clause-body clause))\n      cont)))\n\n(defun maybe-add-undo-bindings (compiled-exps)\n  \"Undo any bindings that need undoing.\n  If there are any, bind the trail before we start.\"\n  (if (length=1 compiled-exps)\n      compiled-exps\n      `((let ((old-trail (fill-pointer *trail*)))\n          ,(first compiled-exps)\n          ,@(loop for exp in (rest compiled-exps)\n                  collect '(undo-bindings! old-trail)\n                  collect exp)))))\n\n(defun bind-unbound-vars (parameters exp)\n  \"If there are any variables in exp (besides the parameters)\n  then bind them to new vars.\"\n  (let ((exp-vars (set-difference (variables-in exp)\n                                  parameters)))\n    (if exp-vars\n        `(let ,(mapcar #'(lambda (var) `(,var (?)))\n                       exp-vars)\n           ,exp)\n        exp)))\n```\n\nWith these improvements, here's the code we get for `likes` and `member`:\n\n```lisp\n(DEFUN LIKES/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (IF (UNIFY! ?ARG1 'ROBIN)\n   (IF (UNIFY! ?ARG2 'CATS)\n      (FUNCALL CONT)))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?X (?)))\n   (IF (UNIFY! ?ARG1 'SANDY)\n    (IF (UNIFY! ?ARG2 ?X)\n      (LIKES/2 ?X 'CATS CONT))))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?X (?)))\n   (IF (UNIFY! ?ARG1 'KIM)\n    (IF (UNIFY! ?ARG2 ?X)\n      (LIKES/2 ?X 'LEE (LAMBDA ()\n          (LIKES/2 ?X 'KIM CONT))))))))\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (LET ((?ITEM (?))\n      (?REST (?)))\n   (IF (UNIFY! ?ARG1 ?ITEM)\n      (IF (UNIFY! ?ARG2 (CONS ?ITEM ?REST))\n            (FUNCALL CONT))))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?X (?))\n      (? ITEM (?))\n      (?REST (?)))\n  (IF (UNIFY! ?ARG1 ?ITEM)\n   (IF (UNIFY! ?ARG2 (CONS ?X ?REST))\n            (MEMBER/2 ?ITEM ?REST CONT))))))\n```\n\n## 12.3 Improving the Compiler\n\nThis is fairly good, although there is still room for improvement.\nOne minor improvement is to eliminate unneeded variables.\nFor example, `?rest` in the first clause of `member` and `?x` in the second clause are bound to new variables-the result of the `(?)` call-and then only used once.\nThe generated code could be made a little tighter by just putting `(?)` inline, rather than binding it to a variable and then referencing that variable.\nThere are two parts to this change: updating `compile-arg` to compile an anonymous variable inline, and changing the `<-` macro so that it converts all variables that only appear once in a clause into anonymous variables:\n\n```lisp\n(defmacro <- (&rest clause)\n  \"Add a clause to the data base.\"\n  `(add-clause ',(make-anonymous clause)))\n\n(defun compile-arg (arg)\n  \"Generate code for an argument to a goal in the body.\"\n  (cond ((variable-p arg) arg)\n        ((not (has-variable-p arg)) `',arg)\n        ((proper-listp arg)\n         `(list .,(mapcar #'compile-arg arg)))\n        (t `(cons ,(compile-arg (first arg))\n                  ,(compile-arg (rest arg))))))\n\n(defun make-anonymous (exp &optional\n                       (anon-vars (anonymous-variables-in exp)))\n  \"Replace variables that are only used once with ?.\"\n  (cond ((consp exp)\n         (reuse-cons (make-anonymous (first exp) anon-vars)\n                     (make-anonymous (rest exp) anon-vars)\n                     exp))\n        ((member exp anon-vars) '?)\n        (t exp)))\n```\n\nFinding anonymous variables is tricky.\nThe following function keeps two lists: the variables that have been seen once, and the variables that have been seen twice or more.\nThe local function `walk` is then used to walk over the tree, recursively considering the components of each cons cell and updating the two lists as each variable is encountered.\nThis use of local functions should be remembered, as well as an alternative discussed in [exercise 12.23](#p4625) on [page 428](#p428).\n\n```lisp\n(defun anonymous-variables-in (tree)\n  \"Return a list of all variables that occur only once in tree.\"\n  (let ((seen-once nil)\n            (seen-more nil))\n    (labels ((walk (x)\n            (cond\n                ((variable-p x)\n                    (cond ((member x seen-once)\n                              (setf seen-once (delete x seen-once))\n                              (push x seen-more))\n                        ((member x seen-more) nil)\n                        (t (push x seen-once))))\n                ((consp x)\n                    (walk (first x))\n                    (walk (rest x))))))\n      (walk tree)\n      seen-once)))\n```\n\nNow `member` compiles into this:\n\n```lisp\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (LET ((?ITEM (?)))\n   (IF (UNIFY! ?ARG1 ?ITEM)\n    (IF (UNIFY! ?ARG2 (CONS ?ITEM (?)))\n        (FUNCALL CONT))))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?ITEM (?))\n    (?REST (?)))\n   (IF (UNIFY! ?ARG1 ?ITEM)\n    (IF (UNIFY! ?ARG2 (CONS (?) ?REST))\n      (MEMBER/2 ?ITEM ?REST CONT))))))\n```\n\n## 12.4 Improving the Compilation of Unification\n\nNow we turn to the improvement of `compile-unify`.\nRecall that we want to eliminate certain calls to `unify!` so that, for example, the first clause of `member`:\n\n```lisp\n(<- (member ?item (?item . ?rest)))\n```\n\ncompiles into:\n\n```lisp\n(LET ((?ITEM (?)))\n (IF (UNIFY! ?ARG1 ?ITEM)\n  (IF (UNIFY! ?ARG2 (CONS ?ITEM (?)))\n    (FUNCALL CONT))))\n```\n\nwhen it could compile to the more efficient:\n\n```lisp\n(IF (UNIFY! ?ARG2 (CONS ?ARG1 (?)))\n  (FUNCALL CONT))\n```\n\nEliminating the unification in one goal has repercussions in other goals later on, so we will need to keep track of expressions that have been unified together.\nWe have a design choice.\nEither `compile-unify` can modify a global state variable, or it can return multiple values.\nOn the grounds that global variables are messy, we make the second choice: `compile-unify` will take a binding list as an extra argument and will return two values, the actual code and an updated binding list.\nWe will expect that other related functions will have to be modified to deal with these multiple values.\n\nWhen `compile-unify` is first called in our example clause, it is asked to unify `?arg1` and `?item`.\nWe want it to return no code (or more precisely, the trivially true test, `t`).\nFor the second value, it should return a new binding list, with `?item` bound to `?arg1`.\nThat binding will be used to replace `?item` with `?arg1` in subsequent code.\n\nHow do we know to bind `?item` to `?arg1` rather than the other way around?\nBecause `?arg1` is already bound to something-the value passed in to `member.` We don't know what this value is, but we can't ignore it.\nThus, the initial binding list will have to indicate that the parameters are bound to something.\nA simple convention is to bind the parameters to themselves.\nThus, the initial binding list will be:\n\n```lisp\n((?arg1 .?arg1) (?arg2 . ?arg2))\n```\n\nWe saw in the previous chapter ([page 354](chapter11.md#p354)) that binding a variable to itself can lead to problems; we will have to be careful.\n\nBesides eliminating unifications of new variables against parameters, there are quite a few other improvements that can be made.\nFor example, unifications involving only constants can be done at compile time.\nThe call `(= (f a) (f a ))` always succeeds, while `(=  3 4)` always fails.\nIn addition, unification of two cons cells can be broken into components at compile time: `(= (f ?x) (f a))` reduces to `(= ?x a)` and `(= f f)`, where the latter trivially succeeds.\nWe can even do some occurs checking at compile time: `(= ?x (f ?x))` should fail.\n\nThe following table lists these improvements, along with a breakdown for the cases of unifying a bound `(?arg1)` or unbound `(?x)` variable agains another expression.\nThe first column is the unification call, the second is the generated code, and the third is the bindings that will be added as a result of the call:\n\n|      | Unification         | Code                    | Bindings            |\n|------|---------------------|-------------------------|---------------------|\n| 1    | `(= 3 3)`           | `t`                     | `-`                 |\n| 2    | `(= 3 4)`           | `nil`                   | `-`                 |\n| 3    | `(= (f ?x) (?p 3))` | `t`                     | `(?x . 3) (?p . f)` |\n| 4    | `(= ?arg1 ?y)`      | `t`                     | `(?y . ?arg1)`      |\n| 5    | `(= ?arg1 ?arg2)`   | `(unify! ?arg1 ?arg2)`  | `(?arg1 . ?arg2)`   |\n| 6    | `(= ?arg1 3)`       | `(unify! ?arg1 3)`      | `(?arg1 . 3)`       |\n| 7    | `(= ?arg1 (f ? y))` | `(unify! ?arg1 . . . )` | `(?y . ?y)`         |\n| 8    | `(= ?x ?y)`         | `t`                     | `(?y . ?y)`         |\n| 9    | `(= ?x 3)`          | `t`                     | `(?x . 3)`          |\n| 10   | `(= ?x (f ? y))`    | `(unify! ?x . . . )`    | `(?y . ?y)`         |\n| 11   | `(= ?x (f ? x))`    | `nil`                   | `-`                 |\n| 12   | `(= ?x ?)`          | `t`                     | `-`                 |\n\nFrom this table we can craft our new version of `compile-unify`.\nThe first part is fairly easy.\nIt takes care of the first three cases in this table and makes sure that `compile-unify-variable` is called with a variable as the first argument for the other cases.\n\n```lisp\n(defun compile-unify (x y bindings)\n  \"Return 2 values: code to test if x and y unify,\n  and a new binding list.\"\n  (cond\n    ;; Unify constants and conses:                       ; Case\n    ((not (or (has-variable-p x) (has-variable-p y)))    ; 1,2\n     (values (equal x y) bindings))\n    ((and (consp x) (consp y))                           ; 3\n     (multiple-value-bind (code1 bindings1)\n         (compile-unify (first x) (first y) bindings)\n       (multiple-value-bind (code2 bindings2)\n           (compile-unify (rest x) (rest y) bindings1)\n         (values (compile-if code1 code2) bindings2))))\n    ;; Here x or y is a variable.  Pick the right one:\n    ((variable-p x) (compile-unify-variable x y bindings))\n    (t              (compile-unify-variable y x bindings))))\n\n(defun compile-if (pred then-part)\n  \"Compile a Lisp IF form. No else-part allowed.\"\n  (case pred\n    ((t) then-part)\n    ((nil) nil)\n    (otherwise `(if ,pred ,then-part))))\n```\n\nThe function `compile-unify-variable` following is one of the most complex we have seen.\nFor each argument, we see if it has a binding (the local variables `xb` and `yb`), and then use the bindings to get the value of each argument (`x1` and `y1`).\nNote that for either an unbound variable or one bound to itself, `x` will equal `x1` (and the same for `y` and `y1`).\nIf either of the pairs of values is not equal, we should use the new ones (`x1` or `y1`), and the clause commented deref does that.\nAfter that point, we just go through the cases, one at a time.\nIt turns out that it was easier to change the order slightly from the preceding table, but each clause is commented with the corresponding number:\n\n```lisp\n(defun compile-unify-variable (x y bindings)\n  \"X is a variable, and Y may be.\"\n  (let* ((xb (follow-binding x bindings))\n         (x1 (if xb (cdr xb) x))\n         (yb (if (variable-p y) (follow-binding y bindings)))\n         (y1 (if yb (cdr yb) y)))\n    (cond                                                 ; Case:\n      ((or (eq x '?) (eq y '?)) (values t bindings))      ; 12\n      ((not (and (equal x x1) (equal y y1)))              ; deref\n       (compile-unify x1 y1 bindings))\n      ((find-anywhere x1 y1) (values nil bindings))       ; 11\n      ((consp y1)                                         ; 7,10\n       (values `(unify! ,x1 ,(compile-arg y1 bindings))\n               (bind-variables-in y1 bindings)))\n      ((not (null xb))\n       ;; i.e. x is an ?arg variable\n       (if (and (variable-p y1) (null yb))\n           (values 't (extend-bindings y1 x1 bindings))   ; 4\n           (values `(unify! ,x1 ,(compile-arg y1 bindings))\n                   (extend-bindings x1 y1 bindings))))    ; 5,6\n      ((not (null yb))\n       (compile-unify-variable y1 x1 bindings))\n      (t (values 't (extend-bindings x1 y1 bindings)))))) ; 8,9\n```\n\nTake some time to understand just how this function works.\nThen go on to the following auxiliary functions:\n\n```lisp\n(defun bind-variables-in (exp bindings)\n  \"Bind all variables in exp to themselves, and add that to\n  bindings (except for variables already bound).\"\n  (dolist (var (variables-in exp))\n    (unless (get-binding var bindings)\n      (setf bindings (extend-bindings var var bindings))))\n  bindings)\n\n(defun follow-binding (var bindings)\n  \"Get the ultimate binding of var according to bindings.\"\n  (let ((b (get-binding var bindings)))\n    (if (eq (car b) (cdr b))\n        b\n        (or (follow-binding (cdr b) bindings)\n            b))))\n```\n\nNow we need to integrate the new `compile-unify` into the rest of the compiler.\nThe problem is that the new version takes an extra argument and returns an extra value, so all the functions that call it need to be changed.\nLet's look again at the calling sequence:\n\n```lisp\nprolog-compile\n  compile-predicate\n    compile-clause\n      compile-body\n        compile-call\n        compile-arg\n          compile-unify\n            compile-arg\n```\n\nFirst, going downward, we see that `compile-arg` needs to take a binding list as an argument, so that it can look up and substitute in the appropriate values.\nBut it will not alter the binding list, so it still returns one value:\n\n```lisp\n(defun compile-arg (arg bindings)\n  \"Generate code for an argument to a goal in the body.\"\n  (cond ((eq arg '?) '(?))\n        ((variable-p arg)\n         (let ((binding (get-binding arg bindings)))\n           (if (and (not (null binding))\n                    (not (eq arg (binding-val binding))))\n             (compile-arg (binding-val binding) bindings)\n             arg)))\n        ((not (find-if-anywhere #'variable-p arg)) `',arg)\n        ((proper-listp arg)\n         `(list .,(mapcar #'(lambda (a) (compile-arg a bindings))\n                          arg)))\n        (t `(cons ,(compile-arg (first arg) bindings)\n                  ,(compile-arg (rest arg) bindings)))))\n```\n\nNow, going upward, `compile-body` needs to take a binding list and pass it on to various functions:\n\n```lisp\n(defun compile-body (body cont bindings)\n  \"Compile the body of a clause.\"\n  (cond\n    ((null body)\n     `(funcall ,cont))\n    ((eq (first body) '!)                              ;***\n     `(progn ,(compile-body (rest body) cont bindings) ;***\n             (return-from ,*predicate* nil)))          ;***\n    (t (let* ((goal (first body))\n              (macro (prolog-compiler-macro (predicate goal)))\n              (macro-val (if macro\n                             (funcall macro goal (rest body)\n                                      cont bindings))))\n        (if (and macro (not (eq macro-val :pass)))\n            macro-val\n            `(,(make-predicate (predicate goal)\n                               (relation-arity goal))\n              ,@(mapcar #'(lambda (arg)\n                            (compile-arg arg bindings))\n                        (args goal))\n              ,(if (null (rest body))\n                   cont\n                   `#'(lambda ()\n                        ,(compile-body\n                           (rest body) cont\n                           (bind-new-variables bindings goal))))))))))\n```\n\nThe function `bind-new-variables` takes any variables mentioned in the goal that have not been bound yet and binds these variables to themselves.\nThis is because the goal, whatever it is, may bind its arguments.\n\n```lisp\n(defun bind-new-variables (bindings goal)\n  \"Extend bindings to include any unbound variables in goal.\"\n  (let ((variables (remove-if #'(lambda (v) (assoc v bindings))\n                              (variables-in goal))))\n    (nconc (mapcar #'self-cons variables) bindings)))\n\n(defun self-cons (x) (cons x x))\n```\n\nOne of the functions that needs to be changed to accept a binding list is the compiler macro for `=`:\n\n```lisp\n(def-prolog-compiler-macro = (goal body cont bindings)\n  \"Compile a goal which is a call to =.\"\n  (let ((args (args goal)))\n    (if (/= (length args) 2)\n        :pass ;; decline to handle this goal\n        (multiple-value-bind (code1 bindings1)\n            (compile-unify (first args) (second args) bindings)\n          (compile-if\n            code1\n            (compile-body body cont bindings1))))))\n```\n\nThe last step upward is to change `compile-clause` so that it starts everything off by passing in to `compile-body` a binding list with all the parameters bound to themselves:\n\n```lisp\n(defun compile-clause (parms clause cont)\n  \"Transform away the head, and compile the resulting body.\"\n  (bind-unbound-vars\n    parms\n    (compile-body\n      (nconc\n        (mapcar #'make-= parms (args (clause-head clause)))\n        (clause-body clause))\n      cont\n      (mapcar #'self-cons parms))))                    ;***\n```\n\nFinally, we can see the fruits of our efforts:\n\n```lisp\n(DEFUN MEMBER/2 (?ARG1 ?ARG2 CONT)\n (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n  (IF (UNIFY! ?ARG2 (CONS ?ARG1 (?)))\n      (FUNCALL CONT))\n  (UNDO-BINDINGS! OLD-TRAIL)\n  (LET ((?REST (?)))\n    (IF (UNIFY! ?ARG2 (CONS (?) ?REST))\n        (MEMBER/2 ?ARG1 ?REST CONT)))))\n (DEFUN LIKES/2 (?ARG1 ?ARG2 CONT)\n  (LET ((OLD-TRAIL (FILL-POINTER *TRAIL*)))\n    (IF (UNIFY! ?ARG1 'ROBIN)\n        (IF (UNIFY! ?ARG2 'CATS)\n          (FUNCALL CONT)))\n    (UNDO-BINDINGS! OLD-TRAIL)\n    (IF (UNIFY! ?ARG1 'SANDY)\n      (LIKES/2 ?ARG2 'CATS CONT))\n    (UNDO-BINDINGS! OLD-TRAIL)\n    (IF (UNIFY! ?ARG1 'KIM)\n      (LIKES/2 ?ARG2 'LEE (LAMBDA ()\n            (LIKES/2 ?ARG2 'KIM CONT))))))\n```\n\n## 12.5 Further Improvements to Unification\n\nCould `compile-unify` be improved yet again?\nIf we insist that it call `unify!`, it seems that it can't be made much better.\nHowever, we could improve it by in effect compiling `unify!`.\nThis is a key idea in the Warren Abstract Machine, or WAM, which is the most commonly used model for Prolog compilers.\n\nWe call `unify!` in four cases (5, 6, 7, and 10), and in each case the first argument is a variable, and we know something about the second argument.\nBut the first thing `unify!` does is redundantly test if the first argument is a variable.\nWe could eliminate unnecessary tests by calling more specialized functions rather than the general-purpose function `unify!`.\nConsider this call:\n\n```lisp\n(unify! ?arg2 (cons ?arg1 (?)))\n```\n\nIf `?arg2` is an unbound variable, this code is appropriate.\nBut if `?arg2` is a constant atom, we should fail immediately, without allowing `cons` and `?` to generate garbage.\nWe could change the test to:\n\n```lisp\n(and (consp-or-variable-p ?arg2)\n  (unify-first! ?arg2 ?arg1)\n  (unify-rest! ?arg2 (?)))\n```\n\nwith suitable definitions for the functions referenced here.\nThis change should speed execution time and limit the amount of garbage generated.\nOf course, it makes the generated code longer, so that could slow things down if the program ends up spending too much time bringing the code to the processor.\n\n**Exercise  12.1 [h]** Write definitions for `consp-or-variable-p, unify-first!,` and `unify-rest!`, and change the compiler to generate code like that outlined previously.\nYou might want to look at the function `compile-rule` in [section 9.6](chapter9.md#s0035), starting on [page 300](chapter9.md#p300).\nThis function compiled a call to `pat-match` into individual tests; now we want to do the same thing to `unify!`.\nRun some benchmarks to compare the altered compiler to the original version.\n\n**Exercise  12.2 [h]** We can gain some more efficiency by keeping track of which variables have been dereferenced and calling an appropriate unification function: either one that dereferences the argument or one that assumes the argument has already been dereferenced.\nImplement this approach.\n\n**Exercise  12.3 [m]** What code is generated for `(= (f (g ?x) ?y) (f ?y (?p a)))?`What more efficient code represents the same unification?\nHow easy is it to change the compiler to get this more efficient result?\n\n**Exercise  12.4 [h]** In retrospect, it seems that binding variables to themselves, as in `(?argl . ?argl`), was not such a good idea.\nIt complicates the meaning of bindings, and prohibits us from using existing tools.\nFor example, I had to use `find-anywhere` instead of `occur-check` for case 11, because `occur-check` expects a noncircular binding list.\nBut find-anywhere does not do as complete a job as `occur-check`.\nWrite a version of `compile-unify` that returns three values: the code, a noncircular binding list, and a list of variables that are bound to unknown values.\n\n**Exercise  12.5 [h]** An alternative to the previous exercise is not to use binding lists at all.\nInstead, we could pass in a list of equivalence classes-that is, a list of lists, where each sublist contains one or more elements that have been unified.\nIn this approach, the initial equivalence class list would be `((?arg1) (?arg2))`.\nAfter unifying `?arg1` with `?x`, `?arg2` with `?y`, and `?x` with 4, the list would be ( `(4 ?arg1 ?x) (?arg2 ?y))`.\nThis assumes the convention that the canonical member of an equivalence class (the one that will be substituted for all others) comes first.\nImplement this approach.\nWhat advantages and disadvantages does it have?\n\n## 12.6 The User Interface to the Compiler\n\nThe compiler can translate Prolog to Lisp, but that does us no good unless we can conveniently arrange to compile the right Prolog relations and call the right Lisp functions.\nIn other words, we have to integrate the compiler with the `<-` and `?` macros.\nSurprisingly, we don't need to change these macros at all.\nRather, we will change the functions these macros call.\nWhen a new clause is entered, we will enter the clause's predicate in the list `*uncompiled*`.\nThis is a one-line addition to `add-clause:`\n\n```lisp\n(defvar *uncompiled* nil\n  \"Prolog symbols that have not been compiled.\")\n\n(defun add-clause (clause)\n  \"Add a clause to the data base, indexed by head's predicate.\"\n  ;; The predicate must be a non-variable symbol.\n  (let ((pred (predicate (clause-head clause))))\n    (assert (and (symbolp pred) (not (variable-p pred))))\n    (pushnew pred *db-predicates*)\n    (pushnew pred *uncompiled*)                          ;***\n    (setf (get pred 'clauses)\n          (nconc (get-clauses pred) (list clause)))\n    pred))\n```\n\nNow when a query is made, the `?-` macro expands into a call to `top-level-prove`.\nThe list of goals in the query, along with the `show-prolog-vars` goal, is added as the sole clause for the relation `top-level-query`.\nNext, that query, along with any others that are on the uncompiled list, are compiled.\nFinally, the newly compiled top-level query function is called.\n\n```lisp\n(defun top-level-prove (goals)\n  \"Prove the list of goals by compiling and calling it.\"\n  ;; First redefine top-level-query\n  (clear-predicate 'top-level-query)\n  (let ((vars (delete '? (variables-in goals))))\n    (add-clause `((top-level-query)\n                  ,@goals\n                  (show-prolog-vars ,(mapcar #'symbol-name vars)\n                                    ,vars))))\n  ;; Now run it\n  (run-prolog 'top-level-query/0 #'ignore)\n  (format t \"~&No.\")\n  (values))\n\n(defun run-prolog (procedure cont)\n  \"Run a 0-ary prolog procedure with a given continuation.\"\n  ;; First compile anything else that needs it\n  (prolog-compile-symbols)\n  ;; Reset the trail and the new variable counter\n  (setf (fill-pointer *trail*) 0)\n  (setf *var-counter* 0)\n  ;; Finally, call the query\n  (catch 'top-level-prove\n    (funcall procedure cont)))\n\n(defun prolog-compile-symbols (&optional (symbols *uncompiled*))\n  \"Compile a list of Prolog symbols.\n  By default, the list is all symbols that need it.\"\n  (mapc #'prolog-compile symbols)\n  (setf *uncompiled* (set-difference *uncompiled* symbols)))\n\n(defun ignore (&rest args)\n  (declare (ignore args))\n  nil)\n```\n\nNote that at the top level, we don't need the continuation to do anything.\nArbitrarily, we chose to pass in the function `ignore`, which is defined to ignore its arguments.\nThis function is useful in a variety of places; some programmers will proclaim it inline and then use a call to `ignore` in place of an ignore declaration:\n\n```lisp\n(defun third-arg (x y z)\n  (ignore x y)\n  z)\n```\n\nThe compiler's calling convention is different from the interpreter, so the primitives need to be redefined.\nThe old definition of the primitive `show-prolog-vars` had three parameters: the list of arguments to the goal, a binding list, and a list of pending goals.\nThe new definition of `show-prolog-vars/2` also has three parameters, but that is just a coincidence.\nThe first two parameters are the two separate arguments to the goal: a list of variable names and a list of variable values.\nThe last parameter is a continuation function.\nTo continue, we call that function, but to fail, we throw to the catch point set up in `top-level-prove`.\n\n```lisp\n(defun show-prolog-vars/2 (var-names vars cont)\n  \"Display the variables, and prompt the user to see\n  if we should continue.  If not, return to the top level.\"\n  (if (null vars)\n      (format t \"~&Yes\")\n      (loop for name in var-names\n            for var in vars do\n            (format t \"~&~a = ~a\" name (deref-exp var))))\n  (if (continue-p)\n      (funcall cont)\n      (throw 'top-level-prove nil)))\n\n(defun deref-exp (exp)\n  \"Build something equivalent to EXP with variables dereferenced.\"\n  (if (atom (deref exp))\n      exp\n      (reuse-cons\n        (deref-exp (first exp))\n        (deref-exp (rest exp))\n        exp)))\n```\n\nWith these definitions in place, we can invoke the compiler automatically just by making a query with the `?-` macro.\n\n**Exercise 12.6 [m]** Suppose you define a predicate `p`, which calls `q`, and then define `q`.\nIn some implementations of Lisp, when you make a query like `(?- (p ?x))`, you may get a warning message like `\"function q/1 undefined\"` before getting the correct answer.\nThe problem is that each function is compiled separately, so warnings detected during the compilation of `p/1` will be printed right away, even if the function `q/1` will be defined later.\nIn ANSI Common Lisp there is a way to delay the printing of warnings until a series of compilations are done: wrap the compilation with the macro `with-compilation-unit`.\nEven if your implementation does not provide this macro, it may provide the same functionality under a different name.\nFind out if `with-compilation-unit` is already defined in your implementation, or if it can be defined.\n\n## 12.7 Benchmarking the Compiler\n\nOur compiled Prolog code runs the zebra puzzle in 17.4 seconds, a 16-fold speed-up over the interpreted version, for a rate of 740 LIPS.\n\nAnother popular benchmark is Lisp's `reverse` function, which we can code as the `rev` relation:\n\n```lisp\n(<- (rev () ()))\n(<- (rev (?x . ?a) ?b) (rev ?a ?c) (concat ?c (?x) ?b))\n\n(<- (concat () ?1 ?1)\n(<- (concat (?x . ?a) ?b (?x . ?c)) (concat ?a ?b ?c))\n```\n\n`rev` uses the relation `concat`, which stands for concatenation.\n`(concat ?a ?b ?c)` is true when `?a` concatenated to `?b` yields `?c`.\nThis relationlike name is preferred over more procedural names like append.\nBut `rev` is very similar to the following Lisp definitions:\n\n```lisp\n(defun rev (1)\n  (if (null 1)\n    nil\n    (app (rev (rest 1 ))\n        (list (first 1)))))\n\n(defun app (x y)\n  (if (null x)\n    y\n      (cons (first x)\n        (app (rest x) y))))\n```\n\nBoth versions are inefficient.\nIt is possible to write an iterative version of `reverse` that does no extra consing and is tail-recursive:\n\n```lisp\n(<- (irev ?l ?r) (irev3 ?l () ?r))\n(<- (irev3 (?x . ?l) ?so-far ?r) (irev3 ?l (?x . ?so-far) ?r))\n(<- (irev3 () ?r ?r))\n```\n\nThe Prolog `irev` is equivalent to this Lisp program:\n\n```lisp\n(defun irev (list) (irev2 list nil))\n\n(defun irev2 (list so-far)\n  (if (consp list)\n      (irev2 (rest list) (cons (first list) so-far))\n      so-far))\n```\n\nThe following table shows times in seconds to execute these routines on lists of length 20 and 100, for both Prolog and Lisp, both interpreted and compiled.\n(Only compiled Lisp could execute rev on a 100-element list without running out of stack space.) Times for the zebra puzzle are also included, although there is no Lisp version of this program.\n\n| Problem    | Interp. Prolog | Comp. Prolog | Speed-up | Interp. Lisp | Comp. Lisp |\n|------------|----------------|--------------|----------|--------------|------------|\n| `zebra`    | 278.000        | 17.241       | 16       | -            | -          |\n| `rev 20`   | 4.24           | .208         | 20       | .241         | .0023      |\n| `rev 100`  | -              | -            | -        | -            | .0614      |\n| `irev 20`  | .22            | .010         | 22       | .028         | .0005      |\n| `irev 100` | 9.81           | .054         | 181      | .139         | .0014      |\n\nThis benchmark is too small to be conclusive, but on these examples the Prolog compiler is 16 to 181 times faster than the Prolog interpreter, slightly faster than interpreted Lisp, but still 17 to 90 times slower than compiled Lisp.\nThis suggests that the Prolog interpreter cannot be used as a practical programming tool, but the Prolog compiler can.\n\nBefore moving on, it is interesting to note that Prolog provides for optional arguments automatically.\nAlthough there is no special syntax for optional arguments, an often-used convention is to have two versions of a relation, one with *n* arguments and one with *n* - 1.\nA single clause for the *n* - 1 case provides the missing, and therefore \"optional,\" argument.\nIn the following example, `irev/2` can be considered as a version of `irev/3` where the missing optional argument is ().\n\n```lisp\n(<- (irev ?l ?r) (irev ?l () ?r))\n(<- (irev (?x . ?l ) ?so-far ?r) (irev ?l (?x . ?so-far) ?r))\n(<- (irev () ?r ?r))\n```\n\nThis is roughly equivalent to the following Lisp verison:\n\n```lisp\n(defun irev (list &optional (so-far nil))\n  (if (consp list)\n      (irev (rest list) (cons (first list) so-far))\n      so-far))\n```\n\n## 12.8 Adding More Primitives\n\nJust as a Lisp compiler needs machine instructions to do input/output, arithmetic, and the like, so our Prolog system needs to be able to perform certain primitive actions.\nFor the Prolog interpreter, primitives were implemented by function symbols.\nWhen the interpreter went to fetch a list of clauses, if it got a function instead, it called that function, passing it the arguments to the current relation, the current bindings, and a list of unsatisfied goals.\nFor the Prolog compiler, primitives can be installed simply by writing a Lisp function that respects the convention of taking a continuation as the final argument and has a name of the form *symbol/arity.* For example, here's an easy way to handle input and output:\n\n```lisp\n(defun read/1 (exp cont)\n (if (unify! exp (read))\n   (funcall cont)))\n(defun write/1 (exp cont)\n (write (deref-exp exp) :pretty t)\n (funcall cont))\n```\n\nCalling `(write ?x)` will always succeed, so the continuation will always be called.\nSimilarly, one could use `(read ?x)` to read a value and unify it with `?x`.\nIf `?x` is unbound, this is the same as assigning the value.\nHowever, it is also possible to make a call like `(read (?x + ?y))`, which succeeds only if the input is a three-element list with + in the middle.\nIt is an easy extension to define `read/2` and `write/2` as relations that indicate what stream to use.\nTo make this useful, one would need to define `open/2` as a relation that takes a pathname as one argument and gives a stream back as the other.\nOther optional arguments could also be supported, if desired.\n\nThe primitive `nl` outputs a newline:\n\n```lisp\n(defun nl/0 (cont) (terpri) (funcall cont))\n```\n\nWe provided special support for the unification predicate, `=`.\nHowever, we could have simplified the compiler greatly by having a simple definition for `=/2`:\n\n```lisp\n(defun =/2 (?arg1 ?arg2 cont)\n (if (unify! ?arg1 ?arg2)\n  (funcall cont)))\n```\n\nIn fact, if we give our compiler the single clause:\n\n`(<- (= ?x ?x))`\n\nit produces just this code for the definition of `=/2`.\nThere are other equality predicates to worry about.\nThe predicate `==/2` is more like equal in Lisp.\nIt does no unification, but instead tests if two structures are equal with regard to their elements.\nA variable is considered equal only to itself.\nHere's an implementation:\n\n```lisp\n(defun =/2 (?arg1 ?arg2 cont)\n \"Are the two arguments EQUAL with no unification,\n but with dereferencing? If so, succeed.\"\n (if (deref-equal ?arg1 ?arg2)\n  (funcall cont)))\n(defun deref-equal (x y)\n \"Are the two arguments EQUAL with no unification,\n but with dereferencing?\"\n (or (eql (deref x) (deref y))\n  (and (consp x)\n   (consp y)\n   (deref-equal (first x) (first y))\n   (deref-equal (rest x) (rest y)))))\n```\n\nOne of the most important primitives is `call`.\nLike `funcall` in Lisp, `call` allows us to build up a goal and then try to prove it.\n\n```lisp\n(defun call/1 (goal cont)\n  \"Try to prove goal by calling it.\"\n  (deref goal)\n  (apply (make-predicate (first goal)\n          (length (args goal)))\n      (append (args goal) (list cont))))\n```\n\nThis version of `call` will give a run-time error if the goal is not instantiated to a list whose first element is a properly defined predicate; one might want to check for that, and fail silently if there is no defined predicate.\nHere's an example of `call` where the goal is legal:\n\n```lisp\n> (?- (= ?p member) (call (?p ?x (a b c))))\n?P = MEMBER\n?X = A;\n?P = MEMBER\n?X = B;\n?P = MEMBER\n?X = C;\nNo.\n```\n\nNow that we have `call`, a lot of new things can be implemented.\nHere are the logical connectives and and or:\n\n```lisp\n(<- (or ?a ?b) (call ?a))\n(<- (or ?a ?b) (call ?b))\n\n(<- (and ?a ?b) (call ?a) (call ?b))\n```\n\nNote that these are only binary connectives, not the *n*-ary special forms used in Lisp.\nAlso, this definition negates most of the advantage of compilation.\nThe goals inside an `and` or `or` will be interpreted by `call`, rather than being compiled.\n\nWe can also define `not,` or at least the normal Prolog `not,` which is quite distinct from the logical `not.`\nIn fact, in some dialects, `not` is written `\\+`, which is supposed to be &#x22AC;, that is, \"can not be derived.\"\nThe interpretation is that if goal G can not be proved, then (`not G` ) is true.\nLogically, there is a difference between (`not G` ) being true and being unknown, but ignoring that difference makes Prolog a more practical programming language.\nSee [Lloyd 1987](bibliography.md#bb0745) for more on the formal semantics of negation in Prolog.\n\nHere's an implementation of `not/1`.\nSince it has to manipulate the trail, and we may have other predicates that will want to do the same, we'll package up what was done in `maybe-add-undo-bindings` into the macro `with-undo-bindings:`\n\n```lisp\n(defmacro with-undo-bindings (&body body)\n  \"Undo bindings after each expression in body except the last.\"\n  (if (length=1 body)\n      (first body)\n      '(let ((old-trail (fill-pointer *trail*)))\n         ,(first body)\n          ,@(loop for exp in (rest body)\n                  collect '(undo-bindings! old-trail)\n                  collect exp))))\n(defun not/1 (relation cont)\n  \"Negation by failure: If you can't prove G. then (not G) true.\"\n  ;; Either way, undo the bindings.\n  (with-undo-bindings\n    (call/1 relation #'(lambda () (return-from not/1 nil)))\n    (funcall cont)))\n```\n\nHere's an example where `not` works fine:\n\n```lisp\n> (?- (member ?x (a b c)) (not (= ?x b)))\n?X = A;\n?X = C;\nNo.\n```\n\nNow see what happens when we simply reverse the order of the two goals:\n\n```lisp\n> (?- (not (= ?x b)) (member ?x (a b c)))\nNo.\n```\n\nThe first example succeeds unless `?x` is bound to `b`.\nIn the second example, `?x` is unbound at the start, so `(= ?x b )` succeeds, the `not` fails, and the `member` goal is never reached.\nSo our implementation of `not` has a consistent procedural interpretation, but it is not equivalent to the declarative interpretation usually given to logical negation.\nNormally, one would expect that `a` and `c` would be valid solutions to the query, regardless of the order of the goals.\n\nOne of the fundamental differences between Prolog and Lisp is that Prolog is relational: you can easily express individual relations.\nLisp, on the other hand, is good at expressing collections of things as lists.\nSo far we don't have any way of forming a collection of objects that satisfy a relation in Prolog.\nWe can easily iterate over the objects; we just can't gather them together.\nThe primitive `bagof` is one way of doing the collection.\nIn general, `(bagof ?x (p ?x) ?bag)` unifies `?bag` with a list of all `?x's` that satisfy `(p ?x)`.\nIf there are no such `?x's`, then the call to `bagof` fails.\nA *bag* is an unordered collection with duplicates allowed.\nFor example, the bag {*a*, *b, a*} is the same as the bag {*a*, *a*, *b*}, but different from {*a*, *b*}.\nBags stands in contrast to *sets,* which are unordered collections with no duplicates.\nThe set {*a*, *b*} is the same as the set {*b*, *a*}.\nHere is an implementation of `bagof`:\n\n```lisp\n(defun bagof/3 (exp goal result cont)\n \"Find all solutions to GOAL, and for each solution,\n collect the value of EXP into the list RESULT.\"\n ;; Ex: Assume (p 1) (p 2) (p 3). Then:\n ;: (bagof ?x (p ?x) ?1) => ?1 = (1 2 3)\n (let ((answers nil))\n (call/1 goal #'(lambda ()\n   (push (deref-copy exp) answers)))\n (if (and (not (null answers))\n  (unify! result (nreverse answers)))\n (funcall cont))))\n (defun deref-copy (exp)\n \"Copy the expression, replacing variables with new ones.\n The part without variables can be returned as is.\"\n (sublis (mapcar #'(lambda (var) (cons (deref var) (?))\n  (unique-find-anywhere-if #'var-p exp))\n exp))\n```\n\nBelow we use `bagof` to collect a list of everyone Sandy likes.\nNote that the result is a bag, not a set: Sandy appears more than once.\n\n```lisp\n> (?- (bagof ?who (likes Sandy ?who) ?bag))\n?WHO = SANDY\n?BAG = (LEE KIM ROBIN SANDY CATS SANDY);\nNo.\n```\n\nIn the next example, we form the bag of every list of length three that has `A` and `B` as members:\n\n```lisp\n> (?- (bagof ?l (and (length ?l (1  + (1  + (1  + 0))))\n      (and (member a ?l) (member b ?l)))\n    ?bag))\n?L = (?5 ?8 ?11 ?68 ?66)\n?BAG = ((A B ?17) (A ?21 B) (B A ?31) (?38 A B) (B ?48 A) (?52 B A))\nNo.\n```\n\nThose who are disappointed with a bag containing multiple versions of the same answer may prefer the primitive `setof`, which does the same computation as `bagof` but then discards the duplicates.\n\n```lisp\n(defun setof/3 (exp goal result cont)\n \"Find all unique solutions to GOAL, and for each solution,\n collect the value of EXP into the list RESULT.\"\n ;; Ex: Assume (p 1) (p 2) (p 3). Then:\n ;; (setof ?x (p ?x) ?l ) => ?l = (1 2 3)\n (let ((answers nil))\n (call/1 goal #'(lambda ()\n   (push (deref-copy exp) answers)))\n (if (and (not (null answers))\n  (unify! result (delete-duplicates\n    answers\n    :test #'deref-equal)))\n (funcall cont))))\n```\n\nProlog supports arithmetic with the operator `is`.\nFor example, `(is ?x (+ ?y 1))` unifies `?x` with the value of `?y` plus one.\nThis expression fails if `?y` is unbound, and it gives a run-time error if `?y` is not a number.\nFor our version of Prolog, we can support not just arithmetic but any Lisp expression:\n\n```lisp\n(defun is/2 (var exp cont)\n ;; Example: (is ?x (+ 3 (* ?y (+ ?z 4))))\n ;; Or even: (is (?x ?y ?x) (cons (first ?z) ?l))\n (if (and (not (find-if-anywhere #'unbound-var-p exp))\n  (unify! var (eval (deref-exp exp))))\n (funcall cont)))\n(defun unbound-var-p (exp)\n \"Is EXP an unbound var?\"\n (and (var-p exp) (not (bound-p exp))))\n```\n\nAs an aside, we might as well give the Prolog programmer access to the function `unbound-var-p`.\nThe standard name for this predicate is `var/1`:\n\n```lisp\n(defun var/1 (?arg1 cont)\n  \"Succeeds if ?arg1 is an uninstantiated variable.\"\n  (if (unbound-var-p ?arg1)\n  (funcall cont)))\n```\n\nThe is primitive fails if any part of the second argument is unbound.\nHowever, there are expressions with variables that can be solved, although not with a direct call to `eval`.\nFor example, the following goal could be solved by binding `?x` to `2`:\n\n```lisp\n(solve (=  12 (* (+ ?x 1) 4)))\n```\n\nWe might want to have more direct access to Lisp from Prolog.\nThe problem with `is` is that it requires a check for unbound variables, and it calls `eval` to evaluate arguments recursively.\nIn some cases, we just want to get at Lisp's `apply`, without going through the safety net provided by is.\nThe primitive `lisp` does that.\nNeedless to say, `lisp` is not a part of standard Prolog.\n\n```lisp\n(defun lisp/2 (?result exp cont)\n \"Apply (first exp) to (rest exp), and return the result.\"\n (if (and (consp (deref exp))\n  (unify! ?result (apply (first exp) (rest exp))))\n (funcall cont)))\n```\n\n**Exercise  12.7 [m]** Define the primitive `solve/1`, which works like the function `solve` used in student ([page 225](chapter7.md#p225)).\nDecide if it should take a single equation as argument or a list of equations.\n\n**Exercise  12.8 [h]** Assume we had a goal of the form `(solve (=  12 (* (+ ?x 1) 4)))`.\nRather than manipulate the equation when `solve/1` is called at run time, we might prefer to do part of the work at compile time, treating the call as if it were `(solve (= ?x 2))`.\nWrite a Prolog compiler macro for `solve`.\nNotice that even when you have defined a compiler macro, you still need the underlying primitive, because the predicate might be invoked through a `call/1`.\nThe same thing happens in Lisp: even when you supply a compiler macro, you still need the actual function, in case of a `funcall` or `apply`.\n\n**Exercise  12.9 [h]** Which of the predicates `call`, `and`, `or`, `not`, or `repeat` could benefit from compiler macros?\nWrite compiler macros for those predicates that could use one.\n\n**Exercise  12.10 [m]** You might have noticed that `call/1` is inefficient in two important ways.\nFirst, it calls `make-predicate`, which must build a symbol by appending strings and then look the string up in the Lisp symbol table.\nAlter `make-predicate` to store the predicate symbol the first time it is created, so it can do a faster lookup on subsequent calls.\nThe second inefficiency is the call to append.\nChange the whole compiler so that the continuation argument comes first, not last, thus eliminating the need for append in `call`.\n\n**Exercise  12.11 [s]** The primitive `true/0` always succeeds, and `fail/0` always fails.\nDefine these primitives.\nHint: the first corresponds to a Common Lisp function, and the second is a function already defined in this chapter.\n\n**Exercise 12.12 [s]** Would it be possible to write `==/2` as a list of clauses rather than as a primitive?\n\n**Exercise  12.13 [m]** Write a version of `deref-copy` that traverses the argument expression only once.\n\n## 12.9 The Cut\n\nIn Lisp, it is possible to write programs that backtrack explicitly, although it can be awkward when there are more than one or two backtrack points.\nIn Prolog, backtracking is automatic and implicit, but we don't yet know of any way to *avoid* backtracking.\nThere are two reasons why a Prolog programmer might want to disable backtracking.\nFirst, keeping track of the backtrack points takes up time and space.\nA programmer who knows that a certain problem has only one solution should be able to speed up the computation by telling the program not to consider the other possible branches.\nSecond, sometimes a simple logical specification of a problem will yield redundant solutions, or even some unintended solutions.\nIt may be that simply pruning the search space to eliminate some backtracking will yield only the desired answers, while restructuring the program to give all and only the right answers would be more difficult.\nHere's an example.\nSuppose we wanted to define a predicate, `max/3`, which holds when the third argument is the maximum of the first two arguments, where the first two arguments will always be instantiated to numbers.\nThe straightforward definition is:\n\n```lisp\n(<- (max ?x ?y ?x) (>= ?x ?y))\n(<- (max ?x ?y ?y) (< ?x ?y))\n```\n\nDeclaratively, this is correct, but procedurally it is a waste of time to compute the `<` relation if the `>=` has succeeded: in that case the `<` can never succeed.\nThe cut symbol, written `!`, can be used to stop the wasteful computation.\nWe could write:\n\n```lisp\n(<- (max ?x ?y ?x) (>= ?x ?y) !)\n(<- (max ?x ?y ?y))\n```\n\nThe cut in the first clause says that if the first clause succeeds, then no other clauses will be considered.\nSo now the second clause can not be interpreted on its own.\nRather, it is interpreted as \"if the first clause fails, then the `max` of two numbers is the second one.\"\n\nIn general, a cut can occur anywhere in the body of a clause, not just at the end.\nThere is no good declarative interpretation of a cut, but the procedural interpretation is two-fold.\nFirst, when a cut is \"executed\" as a goal, it always succeeds.\nBut in addition to succeeding, it sets up a fence that cannot be crossed by subsequent backtracking.\nThe cut serves to cut off backtracking both from goals to the right of the cut (in the same clause) and from clauses below the cut (in the same predicate).\nLet's look at a more abstract example:\n\n```lisp\n(<- (p) (q) (r) ! (s) (t))\n(<- (p) (s))\n```\n\nIn processing the first clause of `p`, backtracking can occur freely while attempting to solve `q` and `r`.\nOnce `r` is solved, the cut is encountered.\nFrom that point on, backtracking can occur freely while solving `s` and `t`, but Prolog will never backtrack past the cut into `r`, nor will the second clause be considered.\nOn the other hand, if `q` or `r` failed (before the cut is encountered), then Prolog would go on to the second clause.\n\nNow that the intent of the cut is clear, let's think of how it should be implemented.\nWe'll look at a slightly more complex predicate, one with variables and multiple cuts:\n\n```lisp\n(<- (p ?x a) ! (q ?x))\n(<- (p ?x b) (r ?x) ! (s ?x))\n```\n\nWe have to arrange it so that as soon as we backtrack into a cut, no more goals are considered.\nIn the first clause, when `q/1` fails, we want to return from `p/2` immediately, rather than considering the second clause.\nSimilarly, the first time `s/1` fails, we want to return from `p/2`, rather than going on to consider other solutions to `r/1`.\nThus, we want code that looks something like this:\n\n```lisp\n(defun p/2 (argl arg2 cont)\n (let ((old-trail (fill-pointer *trail*)))\n  (if (unify! arg2 'a)\n   (progn (q/1 argl cont)\n     (return-from p/2 nil)))\n  (undo-bindings! old-trail)\n  (if (unify! arg2 'b)\n   (r/1 argl #'(lambda ()\n       (progn (s/1 argl cont)\n        (return-from p/2 nil)))))))\n```\n\nWe can get this code by making a single change to `compile-body`: when the first goal in a body (or what remains of the body) is the cut symbol, then we should generate a `progn` that contains the code for the rest of the body, followed by a `return-from` the predicate being compiled.\nUnfortunately, the name of the predicate is not available to `compile-body`.\nWe could change `compile-clause` and `compile-body` to take the predicate name as an extra argument, or we could bind the predicate as a special variable in `compile-predicate`.\nI choose the latter:\n\n```lisp\n(defvar *predicate* nil\n  \"The Prolog predicate currently being compiled\")\n\n(defun compile-predicate (symbol arity clauses)\n  \"Compile all the clauses for a given symbol/arity\n  into a single LISP function.\"\n  (let ((*predicate* (make-predicate symbol arity))    ;***\n        (parameters (make-parameters arity)))\n    (compile\n     (eval\n      `(defun ,*predicate* (,@parameters cont)\n  .,(maybe-add-undo-bindings\n     (mapcar #'(lambda (clause)\n           (compile-clause parameters clause 'cont))\n      clauses)))))))\n\n(defun compile-body (body cont bindings)\n  \"Compile the body of a clause.\"\n  (cond\n    ((null body)\n     `(funcall ,cont))\n    ((eq (first body) '!)                              ;***\n     `(progn ,(compile-body (rest body) cont bindings) ;***\n             (return-from ,*predicate* nil)))          ;***\n    (t (let* ((goal (first body))\n              (macro (prolog-compiler-macro (predicate goal)))\n              (macro-val (if macro\n                             (funcall macro goal (rest body)\n                                      cont bindings))))\n        (if (and macro (not (eq macro-val :pass)))\n            macro-val\n            `(,(make-predicate (predicate goal)\n                               (relation-arity goal))\n              ,@(mapcar #'(lambda (arg)\n                            (compile-arg arg bindings))\n                        (args goal))\n              ,(if (null (rest body))\n                   cont\n                   `#'(lambda ()\n                        ,(compile-body\n                           (rest body) cont\n                           (bind-new-variables bindings goal))))))))))\n```\n\n**Exercise  12.14 [m]** Given the definitions below, figure out what a call to `test-cut` will do, and what it will write:\n\n```lisp\n(<- (test-cut) (p a) (p b) ! (p c) (p d))\n(<- (test-cut) (p e))\n(<- (p ?x) (write (?x 1)))\n(<- (p ?x) (write (?x 2)))\n```\n\nAnother way to use the cut is in a *repeat/fail* loop.\nThe predicate `repeat` is defined with the following two clauses:\n\n```lisp\n(<- (repeat))\n(<- (repeat) (repeat))\n```\n\nAn alternate definition as a primitive is:\n\n```lisp\n(defun repeat/0 (cont)\n  (loop (funcall cont)))\n```\n\nUnfortunately, `repeat` is one of the most abused predicates.\nSeveral Prolog books present programs like this:\n\n```lisp\n(<- (main)\n  (write \"Hello.\")\n  (repeat)\n  (write \"Command: \")\n  (read ?command)\n  (process ?command)\n  (= ?command exit)\n  (write \"Good bye.\"))\n```\n\nThe intent is that commands are read one at a time, and then processed.\nFor each command except `exit`, `process` takes the appropriate action and then fails.\nThis causes a backtrack to the repeat goal, and a new command is read and processed.\nWhen the command is `exit`, the procedure returns.\n\nThere are two reasons why this is a poor program.\nFirst, it violates the principle of referential transparency.\nThings that look alike are supposed to be alike, regardless of the context in which they are used.\nBut here there is no way to tell that four of the six goals in the body comprise a loop, and the other goals are outside the loop.\nSecond, it violates the principle of abstraction.\nA predicate should be understandable as a separate unit.\nBut here the predicate process can only be understood by considering the context in which it is called: a context that requires it to fail after processing each command.\nAs [Richard O'Keefe 1990](bibliography.md#bb0925) points out, the correct way to write this clause is as follows:\n\n```lisp\n(<- (main)\n  (write \"Hello.\")\n  (repeat)\n      (write \"Command: \")\n      (read ?command)\n      (process ?command)\n      (or (= ?command exit) (fail))\n  !\n  (write \"Good bye.\"))\n```\n\nThe indentation clearly indicates the limits of the repeat loop.\nThe loop is terminated by an explicit test and is followed by a cut, so that a calling program won't accidently backtrack into the loop after it has exited.\nPersonally, I prefer a language like Lisp, where the parentheses make constructs like loops explicit and indentation can be done automatically.\nBut O'Keefe shows that well-structured readable programs can be written in Prolog.\n\nThe if-then and if-then-else constructions can easily be written as clauses.\nNote that the if-then-else uses a cut to commit to the `then` part if the test is satisfied.\n\n```lisp\n(<- (if ?test ?then) (if ?then ?else (fail)))\n(<- (if ?test ?then ?else)\n  (call ?test)\n  !\n  (call ?then))\n(<- (if ?test ?then ?else)\n  (call ?else))\n```\n\nThe cut can be used to implement the nonlogical `not`.\nThe following two clauses are often given before as the definition of `not`.\nOur compiler successfully turns these two clauses into exactly the same code as was given before for the primitive `not/1`:\n\n```lisp\n(<- (not ?p) (call ?p) ! (fail))\n(<- (not ?p))\n```\n\n## 12.10 \"Real\" Prolog\n\nThe Prolog-In-Lisp system developed in this chapter uses Lisp syntax because it is intended to be embedded in a Lisp system.\nOther Prolog implementations using Lisp syntax include micro-Prolog, Symbolics Prolog, and LMI Prolog.\n\nHowever, the majority of Prolog systems use a syntax closer to traditional mathematical notation.\nThe following table compares the syntax of \"standard\" Prolog to the syntax of Prolog-In-Lisp.\nWhile there is currently an international committee working on standardizing Prolog, the final report has not yet been released, so different dialects may have slightly different syntax.\nHowever, most implementations follow the notation summarized here.\nThey derive from the Prolog developed at the University of Edinburgh for the DEC-10 by David H.\nD.\nWarren and his colleagues.\nThe names for the primitives in the last section are also taken from Edinburgh Prolog.\n\n|           | Prolog          | Prolog-In-Lisp        |\n|-----------|-----------------|-----------------------|\n| atom      | `lower`         | `const`               |\n| variable  | `Upper`         | `?var`                |\n| anonymous | `-`             | `?`                   |\n| goal      | `p(Var,const)`  | `(p ?var const)`      |\n| rule      | `p(X) :- q(X).` | `(<- (p ?x) (q ?x))`  |\n| fact      | `p(a).`         | `(<- (p a))`          |\n| query     | `?- p(X).`      | `(?- (p ?x))`         |\n| list      | `[a,b,c]`       | `(a b c)`             |\n| cons      | `[a| Rest]`     | `(a . ?rest)`         |\n| nil       | `[]`            | `()`                  |\n| and       | `p(X). q(X)`    | `(and (p ?x) (q ?x)>` |\n| or        | `P(X): q(X)`    | `(or (p ?x) (q ?x))`  |\n| not       | `\\+ p(X)`       | `(not (p ?x))`        |\n\nWe have adopted Lisp's bias toward lists; terms are built out of atoms, variables, and conses of other terms.\nIn real Prolog cons cells are provided, but terms are usually built out of *structures*, not lists.\nThe Prolog term `p(a,b)` corresponds to the Lisp vector `#(p/2 a b)`, not the list `(p a b)`.\nA minority of Prolog implementations use *structure sharing.* In this approach, every non-atomic term is represented by a skeleton that contains place holders for variables and a header that points to the skeleton and also contains the variables that will fill the place holders.\nWith structure sharing, making a copy is easy: just copy the header, regardless of the size of the skeleton.\nHowever, manipulating terms is complicated by the need to keep track of both skeleton and header.\nSee [Boyer and Moore 1972](bibliography.md#bb0110) for more on structure sharing.\n\nAnother major difference is that real Prolog uses the equivalent of failure continuations, not success continuations.\nNo actual continuation, in the sense of a closure, is built.\nInstead, when a choice is made, the address of the code for the next choice is pushed on a stack.\nUpon failure, the next choice is popped off the stack.\nThis is reminiscent of the backtracking approach using Scheme's `call/cc` facility outlined on [page 772](chapter22.md#p772).\n\n**Exercise  12.15 [m]** Assuming an approach using a stack of failure continuations instead of success continuations, show what the code for `p` and `member` would look like.\nNote that you need not pass failure continuations around; you can just push them onto a stack that `top-level-prove` will invoke.\nHow would the cut be implemented?\nDid we make the right choice in implementing our compiler with success continuations, or would failure continuations have been better?\n\n## 12.11 History and References\n\nAs described in [chapter 11](chapter11.md), the idea of logic programming was fairly well understood by the mid-1970s.\nBut because the implementations of that time were slow, logic programming did not catch on.\nIt was the Prolog compiler for the DEC-10 that made logic programming a serious alternative to Lisp and other general-purpose languages.\nThe compiler was developed in 1977 by David H.\nD.\nWarren with Fernando Pereira and Luis Pereira.\nSee the paper by [Warren (1979)](bibliography.md#bb1325) and by all three (1977).\n\nUnfortunately, David H.\nD.\nWarren's pioneering work on compiling Prolog has never been published in a widely accessible form.\nHis main contribution was the description of the Warren Abstract Machine (WAM), an instruction set for compiled Prolog.\nMost existing compilers use this instruction set, or a slight modification of it.\nThis can be done either through byte-code interpretation or through macroexpansion to native machine instructions.\n[A&iuml;t-Kaci 1991](bibliography.md#bb0020) provides a good tutorial on the WAM, much less terse than the original ([Warren 1983](bibliography.md#bb1330)).\nThe compiler presented in this chapter does not use the WAM.\nInstead, it is modeled after Mark [Stickel's (1988)](bibliography.md#bb1200) theorem prover.\nA similar compiler is briefly sketched by Jacques [Cohen 1985](bibliography.md#bb0225).\n\n## 12.12 Exercises\n\n**Exercise  12.16 [m]** Change the Prolog compiler to allow implicit `calls`.\nThat is, if a goal is not a cons cell headed by a predicate, compile it as if it were a `call`.\nThe clause:\n\n```lisp\n(<- (p ?x ?y) (?x c) ?y)\n```\n\nshould be compiled as if it were:\n\n```lisp\n(<- (p ?x ?y) (call (?x c)) (call ?y))\n```\n\n**Exercise  12.17 [h]** Here are some standard Prolog primitives:\n\n*   `get/1` Read a single character and unify it with the argument.\n\n*   `put/1` Print a single character.\n\n*   `nonvar/1, /=, /==` The opposites of `var, = and = =` , respectively.\n\n*   `integer/1` True if the argument is an integer.\n\n*   `atom/1` True if the argument is a symbol (like Lisp's `symbol p`).\n\n*   `atomic/1` True if the argument is a number or symbol (like Lisp's `atom`).\n\n*   `<`, `>`, `=<`, `>=` Arithmetic comparison; succeeds when the arguments are both instantiated to numbers and the comparison is true.\n\n*   `listing/0` Print out the clauses for all defined predicates.\n\n*   `listing/1` Print out the clauses for the argument predicate.\n\nImplement these predicates.\nIn each case, decide if the predicate should be implemented as a primitive or a list of clauses, and if it should have a compiler macro.\n\nThere are some naming conflicts that need to be resolved.\nTerms like `atom` have one meaning in Prolog and another in Lisp.\nAlso, in Prolog the normal notation is `\\=` and `\\==`, not `/=` and `/==`.\nFor Prolog-In-Lisp, you need to decide which notations to use: Prolog's or Lisp's.\n\n**Exercise  12.18 [s]** In Lisp, we are used to writing n-ary calls like `(< 1 n 10 )` or `(= x y z)`.\nWrite compiler macros that expand n-ary calls into a series of binary calls.\nFor example, `(< 1 n 10)` should expand into `(and (< 1 n) (< n 10))`.\n\n**Exercise  12.19 [m]** One feature of Lisp that is absent in Prolog is the `quote` mechanism.\nIs there a use for `quote?` If so, implement it; if not, explain why it is not needed.\n\n**Exercise  12.20 [h]** Write a tracing mechanism for Prolog.\nAdd procedures `p-trace` and `p-untrace` to trace and untrace Prolog predicates.\nAdd code to the compiler to generate calls to a printing procedure for goals that are traced.\nIn Lisp, we have to trace procedures when they are called and when they return.\nIn Prolog, there are four cases to consider: the call, successful completion, backtrack into subsequent clauses, and failure with no more clauses.\nWe will call these four cases `call`, `exit`, `redo`, and `fail`, respectively.\nIf we traced `member,` we would expect tracing output to look something like this:\n\n```lisp\n> (?- (member ?x (a b c d)) (fail))\n  CALL MEMBER: ?1 (A B C D)\n  EXIT MEMBER: A (A B C D)\n  REDO MEMBER: ?1 (A B C D)\n    CALL MEMBER: ?1 (B C D)\n    EXIT MEMBER: B (B C D)\n    REDO MEMBER: ?1 (B C D)\n      CALL MEMBER: ?1 (C D)\n      EXIT MEMBER: C (C D)\n      REDO MEMBER: ?1 (C D)\n        CALL MEMBER: ?1 (D)\n        EXIT MEMBER: D (D)\n        REDO MEMBER: ?1 (D)\n          CALL MEMBER: ?1 NIL\n          REDO MEMBER: ?1 NIL\n          FAIL MEMBER: ?1 NIL\n        FAIL MEMBER: ?1 (D)\n      FAIL MEMBER: ?1 (C D)\n    FAIL MEMBER: ?1 (B C D)\n  FAIL MEMBER: ?1 (A B C D)\nNo.\n```\n\n**Exercise  12.21 [m]** Some Lisp systems are very slow at compiling functions.\n`KCL` is an example; it compiles by translating to `C` and then calling the `C` compiler and assembler.\nIn `KCL` it is best to compile only code that is completely debugged, and run interpreted while developing a program.\n\nAlter the Prolog compiler so that calling the Lisp compiler is optional.\nIn all cases, Prolog functions are translated into Lisp, but they are only compiled to machine language when a variable is set.\n\n**Exercise  12.22 [d]** Some Prolog systems provide the predicate `freeze` to \"freeze\" a goal until its variables are instantiated.\nFor example, the goal `(freeze x (> x 0))` is interpreted as follows: if `x` is instantiated, then just evaluate the goal `(> x 0)`, and succeed or fail depending on the result.\nHowever, if `x` is unbound, then succeed and continue the computation, but remember the goal `(> x 0)` and evaluate it as soon as `x` becomes instantiated.\nImplement `freeze`.\n\n**Exercise  12.23 [m]** Write a recursive version of `anonymous-variables-in` that does not use a local function.\n\n## 12.13 Answers\n\n**Answer 12.6** Here's a version that works for Texas Instruments and Lucid implementations:\n\n```lisp\n(defmacro with-compilation-unit (options &body body)\n  \"Do the body, but delay compiler warnings until the end.\"\n  ;; This is defined in Common Lisp the Language, 2nd ed.\n  '(,(read-time-case\n    #+TI 'compiler:compiler-warnings-context-bind\n    #+Lucid 'with-deferred-warnings\n        'progn)\n    .,body))\n\n(defun prolog-compile-symbols (&optional (symbols *uncompiled*))\n  \"Compile a list of Prolog symbols.\n  By default, the list is all symbols that need it.\"\n  (with-compilation-unit ()\n  (mapc #'prolog-compile symbols)\n  (setf *uncompiled* (set-difference *uncompiled* symbols))))\n```\n\n**Answer 12.9** Macros for `and` and `or` are very important, since these are commonly used.\nThe macro for `and` is trivial:\n\n```lisp\n(def-prolog-compiler-macro and (goal body cont bindings)\n  (compile-body (append (args goal) body) cont bindings))\n```\n\nThe macro for `or` is trickier:\n\n```lisp\n(def-prolog-compiler-macro or (goal body cont bindings)\n  (let ((disjuncts (args goal)))\n    (case (length disjuncts)\n      (0 fail)\n      (1 (compile-body (cons (first disjuncts) body) cont bindings))\n      (t (let ((fn (gensym \"F\")))\n        '(flet ((,fn () ,(compile-body body cont bindings)))\n          .,(maybe-add-undo-bindings\n            (loop for g in disjuncts collect\n              (compile-body (list g) '#',fn\n                bindings)))))))))\n```\n\n**Answer 12.11** `true/0` is `funcall`: when a goal succeeds, we call the continuation, `fail/0` is `ignore`: when a goal fails, we ignore the continuation.\nWe could also define compiler macros for these primitives:\n\n```lisp\n(def-prolog-compiler-macro true (goal body cont bindings)\n  (compile-body body cont bindings))\n\n(def-prolog-compiler-macro fail (goal body cont bindings)\n  (declare (ignore goal body cont bindings))\n  nil)\n```\n\n**Answer 12.13**\n\n```lisp\n(defun deref-copy (exp)\n  \"Build a copy of the expression, which may have variables.\n  The part without variables can be returned as is.\"\n  (let ((var-alist nil ))\n    (labels\n      ((walk (exp)\n        (deref exp)\n        (cond ((consp exp)\n          (reuse-cons (walk (first exp))\n              (walk (rest exp))\n              exp))\n          ((var-p exp)\n          (let ((entry (assoc exp var-alist)))\n            (if (not (null entry))\n            (cdr entry)\n            (let ((var-copy (?)))\n                (push (cons exp var-copy) var-alist)\n                var-copy))))\n          (t exp))))\n    (walk exp))))\n```\n\n**Answer 12.14** In the first clause of `test-cut`, all four calls to `p` will succeed via the first clause of `p`.\nThen backtracking will occur over the calls to `(p c)` and `(p d)`.\nAll four combinations of `1` and `2` succeed.\nAfter that, backtracking would normally go back to the call to `(p b)`.\nBut the cut prevents this, and the whole `(test-cut)` goal fails, without ever considering the second clause.\nHere's the actual output:\n\n```lisp\n(?- (test-cut))\n(A 1)(B 1)(C 1) (D 1)\nYes;\n(D 2)\nYes;\n(C 2)(D 1)\nYes;\n(D 2)\nYes;\nNo.\n```\n\n**Answer 12.17** For example:\n\n```lisp\n(defun >/2 (x y cont)\n  (if (and (numberp (deref x)) (numberp (deref y)) (> x y))\n    (funcall cont)))\n(defun numberp/1 (x cont)\n  (if (numberp (deref x))\n    (funcall cont)))\n```\n\n**Answer 12.19** Lisp uses `quote` in two ways: to distinguish a symbol from the value of the variable represented by that symbol, and to distinguish a literal list from the value that would be returned by evaluating a function call.\nThe first distinction Prolog makes by a lexical convention: variables begin with a question mark in our Prolog, and they are capitalized in real Prolog.\nThe second distinction is not necessary because Prolog is relational rather than functional.\nAn expression is a goal if it is a member of the body of a clause, and is a literal if it is an argument to a goal.\n\n**Answer 12.20** Hint: Here's how `member` could be augmented with calls to a procedure, `prolog-trace`, which will print information about the four kinds of tracing events:\n\n```lisp\n(defun member/2 (?arg1 ?arg2 cont)\n (let ((old-trail (fill-pointer *tra1l*))\n   (exit-cont #'(lambda ()\n     (prolog-trace 'exit 'member ?arg1 ?arg2 )\n     (funcall cont))))\n  (prolog-trace 'call 'member ?arg1 ?arg2)\n  (if (unify! ?arg2 (cons ?arg1 (?)))\n   (funcall exit-cont))\n  (undo-bindings! old-trail)\n  (prolog-trace 'redo 'member ?arg1 ?arg2)\n  (let ((?rest (?)))\n   (if (unify! ?arg2 (cons (?) ?rest))\n   (member/2 ?arg1 ?rest exit-cont)))\n  (prolog-trace 'fail 'member ?arg1 ?arg2)))\n```\n\nThe definition of `prolog-trace` is:\n\n```lisp\n(defvar *prolog-trace-indent* 0)\n(defun prolog-trace (kind predicate &rest args)\n  (if (member kind '(call redo))\n  (incf *prolog-trace-indent* 3))\n  (format t \"~&~VT~a ~  a:~{ ~  a  ~}\"\n      *prolog-trace-indent* kind predicate args)\n  (if (member kind '(fail exit))\n  (decf *prolog-trace-indent* 3)))\n```\n\n**Answer 12.23**\n\n```lisp\n(defun anonymous-variables-in (tree)\n  \"Return a list of all variables that occur only once in tree.\"\n  (values (anon-vars-in tree nil nil)))\n\n(defun anon-vars-in (tree seen-once seen-more)\n  \"Walk the data structure TREE, returning a list of variables\n  seen once, and a list of variables seen more than once.\"\n  (cond\n    ((consp tree)\n    (multiple-value-bind (new-seen-once new-seen-more)\n      (anon-vars-in (first tree) seen-once seen-more)\n      (anon-vars-in (rest tree) new-seen-once new-seen-more)))\n    ((not (variable-p tree)) (values seen-once seen-more))\n    ((member tree seen-once)\n    (values (delete tree seen-once) (cons tree seen-more)))\n    ((member tree seen-more)\n    (values seen-once seen-more))\n    (t (values (cons tree seen-once) seen-more))))\n```\n"
  },
  {
    "path": "docs/chapter13.md",
    "content": "# Chapter 13\n## Object-Oriented Programming\n\nThe programs in this book cover a wide range of problems.\nIt is only natural that a wide range of programming styles have been introduced to attack these problems.\nOne style not yet covered that has gained popularity in recent years is called *object-oriented programming*.\nTo understand what object-oriented programming entails, we need to place it in the context of other styles.\n\nHistorically, the first computer programs were written in an *imperative programming* style.\nA program was construed as a series of instructions, where each instruction performs some action: changing the value of a memory location, printing a result, and so forth.\nAssembly language is an example of an imperative language.\n\nAs experience (and ambition) grew, programmers looked for ways of controlling the complexity of programs.\nThe invention of subroutines marked the *algorithmic* or *procedural programming* style, a subclass of the imperative style.\nSubroutines are helpful for two reasons: breaking up the problem into small pieces makes each piece easier to understand, and it also makes it possible to reuse pieces.\nExamples of procedural languages are FORTRAN, C, Pascal, and Lisp with `setf`.\n\nSubroutines are still dependent on global state, so they are not completely separate pieces.\nThe use of a large number of global variables has been criticized as a factor that makes it difficult to develop and maintain large programs.\nTo eliminate this problem, the *functional programming* style insists that functions access only the parameters that are passed to them, and always return the same result for the same inputs.\nFunctional programs have the advantage of being mathematically clean-it is easy to prove properties about them.\nHowever, some applications are more naturally seen as taking action rather than calculating functional values, and are therefore unnatural to program in a functional style.\nExamples of functional languages are FP and Lisp without `setf`.\n\nIn contrast to imperative languages are *declarative* languages, which attempt to express \"what to do\" rather than \"how to do it.\" One type of declarative programming is *rule-based* programming, where a set of rules states how to transform a problem into a solution.\nExamples of rule-based systems are ELIZA and STUDENT.\n\nAn important kind of declarative programming is *logic programming*, where axioms are used to describe constraints, and computation is done by a constructive proof of a goal.\nAn example of logic language is Prolog.\n\n*Object-oriented programming* is another way to tame the problem of global state.\nInstead of prohibiting global state (as functional programming does), object-oriented programming breaks up the unruly mass of global state and encapsulates it into small, manageable pieces, or objects.\nThis chapter covers the object-oriented approach.\n\n## 13.1 Object-Oriented Programming\n\nObject-oriented programming turns the world of computing on its side: instead of viewing a program primarily as a set of actions which manipulate objects, it is viewed as a set of objects that are manipulated by actions.\nThe state of each object and the actions that manipulate that state are defined once and for all when the object is created.\nThis can lead to modular, robust systems that are easy to use and extend.\nIt also can make systems correspond more closely to the \"real world,\" which we humans perceive more easily as being made up of objects rather than actions.\nExamples of object-oriented languages are Simula, C++, and CLOS, the Common Lisp Object System.\nThis chapter will first introduce object-oriented programming in general, and then concentrate on the Common Lisp Object System.\n\nMany people are promoting object-oriented programming as the solution to the software development problem, but it is hard to get people to agree on just what object-orientation means.\n[Peter Wegner 1987](bibliography.md#bb1355) proposes the following formula as a definition:\n\n*Object-orientation = Objects + Classes + Inheritance*\n\nBriefly, *objects* are modules that encapsulate some data and operations on that data.\nThe idea of *information hiding*-insulating the representation of that data from operations outside of the object-is an important part of this concept.\n*Classes* are groups of similar objects with identical behavior.\nObjects are said to be instances of classes.\n*Inheritance* is a means of defining new classes as variants of existing classes.\nThe new class inherits the behavior of the parent class, and the programmer need only specify how the new class is different.\n\nThe object-oriented style brings with it a new vocabulary, which is summarized in the following glossary.\nEach term will be explained in more detail when it comes up.\n\n*class:* A group of similar objects with identical behavior.\n\n*class variable:* A variable shared by all members of a class.\n\n*delegation:* Passing a message from an object to one of its components.\n\n*generic function:* A function that accepts different types or classes of arguments.\n\n*inheritance:* A means of defining new classes as variants of existing classes.\n\n*instance:* An instance of a class is an object.\n\n*instance variable:* A variable encapsulated within an object.\n\n*message:* A name for an action.\nEquivalent to generic function.\n\n*method:* A means of handling a message for a particular class.\n\n*multimethod:* A method that depends on more than one argument.\n\n*multiple inheritance:* Inheritance from more than one parent class.\n\n*object:* An encapsulation of local state and behavior.\n\n## 13.2 Objects\n\nObject-oriented programming, by definition, is concerned with *objects*.\nAny datum that can be stored in computer memory can be thought of as an object.\nThus, the number 3, the atom `x`, and the string `\"hello\"` are all objects.\nUsually, however, the term *object* is used to denote a more complex object, as we shall see.\n\nOf course, all programming is concerned with objects, and with procedures operating on those objects.\nWriting a program to solve a particular problem will necessarily involve writing definitions for both objects and procedures.\nWhat distinguishes object-oriented programming is that the primary way of decomposing the problem into modules is based on the objects rather than on the procedures.\nThe difference can best be seen with an example.\nHere is a simple program to create bank accounts and keep track of withdrawals, deposits, and accumulation of interest.\nFirst, the program is written in traditional procedural style:\n\n```lisp\n(defstruct account\n  (name \"\") (balance 0.00) (interest-rate .06))\n\n(defun account-withdraw (account amt)\n  \"Make a withdrawal from this account.\"\n  (if (<= amt (account-balance account))\n      (decf (account-balance account) amt)\n      'insufficient-funds))\n\n(defun account-deposit (account amt)\n  \"Make a deposit to this account.\"\n  (incf (account-balance account) amt))\n\n(defun account-interest (account)\n  \"Accumulate interest in this account.\"\n  (incf (account-balance account)\n        (* (account-interest-rate account)\n           (account-balance account))))\n```\n\nWe can create new bank accounts with `make-account` and modify them with `account-withdraw`, `account-deposit`, and `account-interest`.\nThis is a simple problem, and this simple solution suffices.\nProblems appear when we change the specification of the problem, or when we envision ways that this implementation could be inadvertently used in error.\nFor example, suppose a programmer looks at the `account` structure and decides to use `(decf (account-balance account)`) directly instead of going through the `account-withdraw` function.\nThis could lead to negative account balances, which were not intended.\nOr suppose that we want to create a new kind of account, where only a certain maximum amount can be withdrawn at one time.\nThere would be no way to ensure that `account-withdraw` would not be applied to this new, limited account.\n\nThe problem is that once we have created an account, we have no control over what actions are applied to it.\nThe object-oriented style is designed to provide that control.\nHere is the same program written in object-oriented style (using plain Lisp):\n\n```lisp\n(defun new-account (name &optional (balance 0.00)\n                    (interest-rate .06))\n  \"Create a new account that knows the following messages:\"\n  #'(lambda (message)\n      (case message\n        (withdraw #'(lambda (amt)\n                      (if (<= amt balance)\n                          (decf balance amt)\n                          'insufficient-funds)))\n        (deposit  #'(lambda (amt) (incf balance amt)))\n        (balance  #'(lambda () balance))\n        (name     #'(lambda () name))\n        (interest #'(lambda ()\n                      (incf balance\n                            (* interest-rate balance)))))))\n```\n\nThe function `new-account` creates account objects, which are implemented as closures that encapsulate three variables: the name, balance, and interest rate of the account.\nAn account object also encapsulates functions to handle the five messages to which the object can respond.\nAn account object can do only one thing: receive a message and return the appropriate function to execute that message.\nFor example, if you pass the message `withdraw` to an account object, it will return a function that, when applied to a single argument (the amount to withdraw), will perform the withdrawal action.\nThis function is called the *method* that implements the message.\nThe advantage of this approach is that account objects are completely encapsulated; the information corresponding to the name, balance, and interest rate is only accessible through the five messages.\nWe have a guarantee that no other code can manipulate the information in the account in any other way.<a id=\"tfn13-1\"></a><sup>[1](#fn13-1)</sup>\n\nThe function `get-method` finds the method that implements a message for a given object.\nThe function `send` gets the method and applies it to a list of arguments.\nThe name send comes from the Flavors object-oriented system, which is discussed in the history section ([page 456](#p456)).\n\n```lisp\n(defun get-method (object message)\n  \"Return the method that implements message for this object.\"\n  (funcall object message))\n\n(defun send (object message &rest args)\n  \"Get the function to implement the message,\n  and apply the function to the args.\"\n  (apply (get-method object message) args))\n```\n\nHere is an example of the use of `new-account` and `send`:\n\n```lisp\n> (setf acct (new-account \"J. Random Customer\" 1000.00)) =>\n#<CLOSURE 23652465>\n\n> (send acct 'withdraw 500.00) => 500.0\n\n> (send acct 'deposit 123.45) => 623.45\n\n> (send acct 'name) => \"J. Random Customer\"\n\n> (send acct 'balance) => 623.45\n```\n\n## 13.3 Generic Functions\n\nThe `send` syntax is awkward, as it is different from the normal Lisp function-calling syntax, and it doesn't fit in with the other Lisp tools.\nFor example, we might like to say `(mapcar 'balance accounts)`, but with messages we would have to write that as:\n\n```lisp\n(mapcar #'(lambda (acct) (send acct 'balance)) accounts)\n```\n\nWe can fix this problem by defining *generic* functions that find the right method to execute a message.\nFor example, we could define:\n\n```lisp\n(defun withdraw (object &rest args)\n  \"Define withdraw as a generic function on objects.\"\n  (apply (get-method object 'withdraw) args))\n```\n\nand then write `(withdraw acct x)` instead of `(send acct 'withdraw x)`.\nThe function `withdraw` is generic because it not only works on account objects but also works on any other class of object that handles the `withdraw` message.\nFor example, we might have a totally unrelated class, `army,` which also implements a `withdraw` method.\nThen we could say `(send 5th-army 'withdraw)` or `(withdraw 5th-army)` and have the correct method executed.\nSo object-oriented programming eliminates many problems with name clashes that arise in conventional programs.\n\nMany of the built-in Common Lisp functions can be considered generic functions, in that they operate on different types of data.\nFor example, `sqrt` does one thing when passed an integer and quite another when passed an imaginary number.\nThe sequence functions (like `find` or `delete`) operate on lists, vectors, or strings.\nThese functions are not implemented like `withdraw,` but they still act like generic functions.<a id=\"tfn13-2\"></a><sup>[2](#fn13-2)</sup>\n\n## 13.4 Classes\n\nIt is possible to write macros to make the object-oriented style easier to read and write.\nThe macro `define-class` defines a class with its associated message-handling methods.\nIt also defines a generic function for each message.\nFinally, it allows the programmer to make a distinction between variables that are associated with each object and those that are associated with a class and are shared by all member s of the class.\nFor example, you might want to have all instances of the class `account` share the same interest rate, but you wouldn't want them to share the same balance.\n\n```lisp\n(defmacro define-class (class inst-vars class-vars &body methods)\n  \"Define a class for object-oriented programming.\"\n  ;; Define constructor and generic functions for methods\n  `(let ,class-vars\n     (mapcar #'ensure-generic-fn ',(mapcar #'first methods))\n     (defun ,class ,inst-vars\n       #'(lambda (message)\n           (case message\n             ,@(mapcar #'make-clause methods))))))\n\n(defun make-clause (clause)\n  \"Translate a message from define-class into a case clause.\"\n  `(,(first clause) #'(lambda ,(second clause) .,(rest2 clause))))\n\n(defun ensure-generic-fn (message)\n  \"Define an object-oriented dispatch function for a message,\n  unless it has already been defined as one.\"\n  (unless (generic-fn-p message)\n    (let ((fn #'(lambda (object &rest args)\n                  (apply (get-method object message) args))))\n      (setf (symbol-function message) fn)\n      (setf (get message 'generic-fn) fn))))\n\n(defun generic-fn-p (fn-name)\n  \"Is this a generic function?\"\n  (and (fboundp fn-name)\n       (eq (get fn-name 'generic-fn) (symbol-function fn-name))))\n```\n\nNow we define the class account with this macro.\nWe make `interest-rate` a class variable, one that is shared by all accounts:\n\n```lisp\n(define-class account (name &optional (balance 0.00))\n        ((interest-rate .06))\n (withdraw (amt) (if (<= amt balance)\n            (decf balance amt)\n            'insufficient-funds))\n (deposit (amt) (incf balance amt))\n (balance () balance)\n (name () name)\n (interest () (incf balance (* interest-rate balance))))\n```\n\nHere we use the generic functions defined by this macro:\n\n```lisp\n> (setf acct2 (account \"A. User\" 2000.00)) => #<CLOSURE 24003064>\n> (deposit acct2 42.00) => 2042.0\n> (interest acct2) => 2164.52\n> (balance acct2) => 2164.52\n> (balance acct) => 623.45\n```\n\nIn this last line, the generic function `balance` is applied to `acct,` an object that was created before we even defined the account class and the function `balance.` But `balance` still works properly on this object, because it obeys the message-passing protocol.\n\n## 13.5 Delegation\n\nSuppose we want to create a new kind of account, one that requires a password for each action.\nWe can define a new class, `password-account,` that has two message clauses.\nThe first clause allows for changing the password (if you have the original password), and the second is an `otherwise` clause, which checks the password given and, if it is correct, passes the rest of the arguments on to the account that is being protected by the password.\n\nThe definition of `password-account` takes advantage of the internal details of `define-class` in two ways: it makes use of the fact that `otherwise` can be used as a catch-all clause in a `case` form, and it makes use of the fact that the dispatch variable is called `message.` Usually, it is not a good idea to rely on details about the implementation of a macro, and soon we will see cleaner ways of defining classes.\nBut for now, this simple approach works:\n\n```lisp\n(define-class password-account (password acct) ()\n (change-password (pass new-pass)\n       (if (equal pass password)\n        (setf password new-pass)\n        'wrong-password))\n (otherwise (pass &rest args)\n       (if (equal pass password)\n        (apply message acct args)\n        'wrong-password)))\n```\n\nNow we see how the class `password-account` can be used to provide protection for an existing account:\n\n```lisp\n(setf acct3 (password-account \"secret\" acct2)) => #<CLOSURE 33427277>\n> (balance acct3 \"secret\") => 2164.52\n> (withdraw acct3 \"guess\" 2000.00) => WRONG-PASSWORD\n> (withdraw acct3 \"secret\" 2000.00) => 164.52\n```\n\nNow let's try one more example.\nSuppose we want to have a new class of account where only a limited amount of money can be withdrawn at any time.\nWe could define the class `limited-account`:\n\n```lisp\n(define-class limited-account (limit acct) ()\n (withdraw (amt)\n       (if (> amt limit)\n          'over-limit\n          (withdraw acct amt)))\n (otherwise (&rest args)\n       (apply message acct args)))\n```\n\nThis definition redefines the `withdraw` message to check if the limit is exceeded before passing on the message, and it uses the `otherwise` clause simply to pass on all other messages unchanged.\nIn the following example, we set up an account with both a password and a limit:\n\n```lisp\n> (setf acct4 (password-account \"pass\"\n       (limited-account 100.00\n        (account \"A. Thrifty Spender\" 500.00)))) =>\n#<CLOSURE 34136775>\n> (withdraw acct4 \"pass\" 200.00) => OVER-LIMIT\n> (withdraw acct4 \"pass\" 20.00) => 480.0\n> (withdraw acct4 \"guess\" 20.00) => WRONG-PASSWORD\n```\n\nNote that functions like `withdraw` are still simple generic functions that just find the right method and apply it to the arguments.\nThe trick is that each class defines a different way to handle the withdraw message.\nCalling `withdraw` with `acct4` as argument results in the following flow of control.\nFirst, the method in the `password-account` class checks that the password is correct.\nIf it is, it calls the method from the `limited-account` class.\nIf the limit is not exceeded, we finally call the method from the `account` class, which decrements the balance.\nPassing control to the method of a component is called *delegation*.\n\nThe advantage of the object-oriented style is that we can introduce a new class by writing one definition that is localized and does not require changing any existing code.\nIf we had written this in traditional procedural style, we would end up with functions like the following:\n\n```lisp\n(defun withdraw (acct amt &optional pass)\n (cond ((and (typep acct 'password-account)\n        (not (equal pass (account-password acct))))\n      'wrong-password)\n      ((and (typep acct 'limited-account)\n        (> amt (account-limit account)))\n      'over-limit)\n      ((> amt balance)\n      'insufficient-funds)\n      (t (decf balance amt))))\n```\n\nThere is nothing wrong with this, as an individual function.\nThe problem is that when the bank decides to offer a new kind of account, we will have to change this function, along with all the other functions that implement actions.\nThe \"definition\" of the new account is scattered rather than localized, and altering a bunch of existing functions is usually more error prone than writing a new class definition.\n\n## 13.6 Inheritance\n\nIn the following table, data types (classes) are listed across the horizontal axis, and functions (messages) are listed up and down the vertical axis.\nA complete program needs to fill in all the boxes, but the question is how to organize the process of filling them in.\nIn the traditional procedural style, we write function definitions that fill in a row at a time.\nIn the object-oriented style, we write class definitions that fill in a column at a time.\nA third style, the *data-driven* or *generic* style, fills in only one box at a time.\n\n|            | `account limited-account` | `password-account` | `...` |\n| ---        | ---                       | ---                | ---   |\n| `name`     |                           | *object*           |       |\n| `deposit`  |                           | *oriented*         |       |\n| `withdraw` | *function oriented*       |                    |       |\n| `balance`  |                           |                    |       |\n| `interest` | *generic*                 |                    |       |\n| `...`      |                           |                    |       |\n\nIn this table there is no particular organization to either axis; both messages and classes are listed in random order.\nThis ignores the fact that classes are organized hierarchically: both limited-account and password-account are subclasses of account.\nThis was implicit in the definition of the classes, because both `limited-account` and `password-account` contain accounts as components and delegate messages to those components.\nBut it would be cleaner to make this relationship explicit.\n\nThe `defstruct` mechanism does allow for just this kind of explicit inheritance.\nIf we had defined `account` as a structure, then we could define `limited-account` with:\n\n```lisp\n(defstruct (limited-account (:include account)) limit)\n```\n\nTwo things are needed to provide an inheritance facility for classes.\nFirst, we should modify `define-class` so that it takes the name of the class to inherit from as the second argument.\nThis will signal that the new class will inherit all the instance variables, class variables, and methods from the parent class.\nThe new class can, of course, define new variables and methods, or it can shadow the parent's variables and methods.\nIn the form below, we define `limited-account` to be a subclass of `account` that adds a new instance variable, `limit`, and redefines the `withdraw` method so that it checks for amounts that are over the limit.\nIf the amount is acceptable, then it uses the function `call-next-method` (not yet defined) to get at the `withdraw` method for the parent class, `account`.\n\n```lisp\n(define-class limited-account account (limit) ()\n (withdraw (amt)\n        (if (> amt limit)\n          'over-limit\n          (call-next-method))))\n```\n\nIf inheritance is a good thing, then multiple inheritance is an even better thing.\nFor example, assuming we have defined the classes `limited-account` and `password-account`, it is very convenient to define the following class, which inherits from both of them:\n\n```lisp\n(define-class limited-account-with-password\n           (password-account limited-account))\n```\n\nNotice that this new class adds no new variables or methods.\nAll it does is combine the functionality of two parent classes into one.\n\n**Exercise  13.1 [d]** Define a version of `define-class` that handles inheritance and `call-next-method`.\n\n**Exercise  13.2 [d]** Define a version of `define-class` that handles multiple inheritance.\n\n## 13.7 CLOS: The Common Lisp Object System\n\nSo far, we have developed an object-oriented programming system using a macro, `define-class`, and a protocol for implementing objects as closures.\nThere have been many proposals for adding object-oriented features to Lisp, some similar to our approach, some quite different.\nRecently, one approach has been approved to become an official part of Common Lisp, so we will abandon our ad hoc approach and devote the rest of this chapter to CLOS, the Common Lisp Object System.\nThe correspondence between our system and CLOS is summarized here:\n\n| our system                   | CLOS                      |\n|------------------------------|---------------------------|\n| `define-class`               | `defclass`                |\n| *`methods defined in class`* | `defmethod`               |\n| *`class-name`*               | `make-instance`           |\n| `call-next-method`           | `call-next-method`        |\n| `ensure-generic-fn`          | `ensure-generic-function` |\n\nLike most object-oriented systems, CLOS is primarily concerned with defining classes and methods for them, and in creating instances of the classes.\nIn CLOS the macro `defclass` defines a class, `defmethod` defines a method, and `make-instance` creates an instance of a class-an object.\nThe general form of the macro `defclass` is:\n\n(`defclass` *class-name* (*superclass...*) (*slot-specifier...*) *optional-class-option...*)\n\nThe class-options are rarely used.\n`defclass` can be used to define the class `account`:\n\n```lisp\n(defclass account ()\n ((name :initarg :name ireader name)\n   (balance :initarg :balance :initform 0.00 :accessor balance)\n   (interest-rate :allocation :class :initform .06\n        :reader interest-rate)))\n```\n\nIn the definition of `account`, we see that the list of superclasses is empty, because `account` does not inherit from any classes.\nThere are three slot specifiers, for the `name`, `balance`, and `interest-rate` slots.\nEach slot name can be followed by optional keyword/value pairs defining how the slot is used.\nThe `name` slot has an `:initarg` option, which says that the name can be specified when a new account is created with `make-instance`.\nThe `:reader` slot creates a method called `name` to get at the current value of the slot.\n\nThe balance slot has three options: another `:initarg`, saying that the balance can be specified when a new account is made; an `:initform`, which says that if the balance is not specified, it defaults to `0.00`, and an `:accessor`, which creates a method for getting at the slot's value just as `:reader` does, and also creates a method for updating the slot with `setf`.\n\nThe `interest-rate` slot has an `:initform` option to give it a default value and an `:allocation` option to say that this slot is part of the class, not of each instance of the class.\n\nHere we see the creation of an object, and the application of the automatically defined methods to it.\n\n```lisp\n> (setf al (make-instance 'account :balance 5000.00\n             :name \"Fred\")) => #<ACCOUNT 26726272>\n> (name al) => \"Fred\"\n> (balance al) => 5000.0\n> (interest-rate al) => 0.06\n```\n\nCLOS differs from most object-oriented systems in that methods are defined separately from classes.\nTo define a method (besides the ones defined automatically by `:reader`, `:writer`, or `:accessor` options) we use the `defmethod` macro.\nIt is similar to `defun` in form:\n\n`(defmethod` *method-name* (*parameter...*) *body...*)\n\nRequired parameters to a `defmethod` can be of the form (*var class*), meaning that this is a method that applies only to arguments of that class.\nHere is the method for withdrawing from an account.\nNote that CLOS does not have a notion of instance variable, only instance slot.\nSo we have to use the method (`balance acct`) rather than the instance variable `balance`:\n\n```lisp\n(defmethod withdraw ((acct account) amt)\n (if (< amt (balance acct))\n  (decf (balance acct) amt)\n  'insufficient-funds))\n```\n\nWith CLOS it is easy to define a `limited-account` as a subclass of `account`, and to define the `withdraw` method for `limited-accounts`:\n\n```lisp\n(defclass limited-account (account)\n ((limit :initarg :limit :reader limit)))\n(defmethod withdraw ((acct limited-account) amt)\n (if (> amt (limit acct))\n     'over-limit\n     (call-next-method)))\n```\n\nNote the use of `call-next-method` to invoke the `withdraw` method for the `account` class.\nAlso note that all the other methods for accounts automatically work on instances of the class limited-account, because it is defined to inherit from `account`.\nIn the following example, we show that the `name` method is inherited, that the `withdraw` method for `limited-account` is invoked first, and that the `withdraw` method for `account` is invoked by the `call-next-method` function:\n\n```lisp\n> (setf a2 (make-instance 'limited-account\n            :name \"A. Thrifty Spender\"\n            :balance 500.00 :limit 100.00)) =>\n#<LIMITED-ACCOUNT 24155343>\n> (name a2) => \"A. Thrifty Spender\"\n> (withdraw a2 200.00) => OVER-LIMIT\n> (withdraw a2 20.00) => 480.0\n```\n\nIn general, there may be several methods appropriate to a given message.\nIn that case, all the appropriate methods are gathered together and sorted, most specific first.\nThe most specific method is then called.\nThat is why the method for `limited-account` is called first rather than the method for `account`.\nThe function `call-next-method` can be used within the body of a method to call the next most specific method.\n\nThe complete story is actually even more complicated than this.\nAs one example of the complication, consider the class `audited-account`, which prints and keeps a trail of all deposits and withdrawals.\nIt could be defined as follows using a new feature of CLOS, `:before` and `:after` methods:\n\n```lisp\n(defclass audited-account (account)\n ((audit-trail :initform nil :accessor audit-trail)))\n(defmethod withdraw :before ((acct audited-account) amt)\n (push (print '(withdrawing ,amt))\n  (audit-trail acct)))\n(defmethod withdraw :after ((acct audited-account) amt)\n (push (print '(withdrawal (,amt) done))\n  (audit-trail acct)))\n```\n\nNow a call to `withdraw` with a `audited-account` as the first argument yields three applicable methods: the primary method from `account` and the `:before` and `:after` methods.\nIn general, there might be several of each kind of method.\nIn that case, all the `:before` methods are called in order, most specific first.\nThen the most specific primary method is called.\nIt may choose to invoke `call-next-method` to get at the other methods.\n(It is an error for a `:before` or `:after` method to use `call-next-method`.)\nFinally, all the `:after` methods are called, least specific first.\n\nThe values from the `:before` and `:after` methods are ignored, and the value from the primary method is returned.\nHere is an example:\n\n```lisp\n> (setf a3 (make-instance 'audited-account :balance 1000.00))\n#<AUDITED-ACCOUNT 33555607>\n> (withdraw a3 100.00)\n(WITHDRAWING 100.0)\n(WITHDRAWAL (100.0) DONE)\n900.0\n> (audit-trail a3)\n((WITHDRAWAL (100.0) DONE) (WITHDRAWING 100.0))\n> (setf (audit-trail a3) nil)\nNIL\n```\n\nThe last interaction shows the biggest flaw in CLOS: it fails to encapsulate information.\nIn order to make the `audit-trail` accessible to the `withdraw` methods, we had to give it accessor methods.\nWe would like to encapsulate the writer function for `audit-trail` so that it can only be used with deposit and `withdraw`.\nBut once the writer function is defined it can be used anywhere, so an unscrupulous outsider can destroy the audit trail, setting it to nil or anything else.\n\n## 13.8 A CLOS Example: Searching Tools\n\nCLOS is most appropriate whenever there are several types that share related behavior.\nA good example of an application that fits this description is the set of searching tools defined in [section 6.4](chapter6.md#s0025).\nThere we defined functions for breadth-first, depth-first, and best-first search, as well as tree- and graph-based search.\nWe also defined functions to search in particular domains, such as planning a route between cities.\n\nIf we had written the tools in a straightforward procedural style, we would have ended up with dozens of similar functions.\nInstead, we used higher-order functions to control the complexity.\nIn this section, we see how CLOS can be used to break up the complexity in a slightly different fashion.\n\nWe begin by defining the class of search problems.\nProblems will be classified according to their domain (route planning, etc.), their topology (tree or graph) and their search strategy (breadth-first or depth-first, etc.).\nEach combination of these features results in a new class of problem.\nThis makes it easy for the user to add a new class to represent a new domain, or a new search strategy.\nThe basic class, `problem`, contains a single-instance variable to hold the unexplored states of the problem.\n\n```lisp\n(defclass problem ()\n ((states :initarg :states :accessor problem-states)))\n```\n\nThe function searcher is similar to the function `tree-search` of [section 6.4](chapter6.md#s0025).\nThe main difference is that searcher uses generic functions instead of passing around functional arguments.\n\n```lisp\n(defmethod searcher ((prob problem))\n \"Find a state that solves the search problem.\"\n (cond ((no-states-p prob) fail)\n  ((goal-p prob) (current-state prob))\n  (t (let ((current (pop-state prob)))\n       (setf (problem-states prob)\n         (problem-combiner\n          prob\n          (problem-successors prob current)\n          (problem-states prob))))\n      (searcher prob))))\n```\n\n`searcher` does not assume that the problem states are organized in a list; rather, it uses the generic function `no-states-p` to test if there are any states, `pop-state` to remove and return the first state, and `current-state` to access the first state.\nFor the basic `problem` class, we will in fact implement the states as a list, but another class of problem is free to use another representation.\n\n```lisp\n(defmethod current-state ((prob problem))\n \"The current state is the first of the possible states.\"\n (first (problem-states prob)))\n(defmethod pop-state ((prob problem))\n \"Remove and return the current state.\"\n (pop (problem-states prob)))\n(defmethod no-states-p ((prob problem))\n \"Are there any more unexplored states?\"\n (null (problem-states prob)))\n```\n\nIn `tree-search`, we included a statement to print debugging information.\nWe can do that here, too, but we can hide it in a separate method so as not to clutter up the main definition of `searcher`.\nIt is a `:before` method because we want to see the output before carrying out the operation.\n\n```lisp\n(defmethod searcher :before ((prob problem))\n (dbg 'search \";; Search: ~a\" (problem-states prob)))\n```\n\nThe generic functions that remain to be defined are `goal-p`, `problem-combiner`, and `problem-successors`.\nWe will address `goal-p` first, by recognizing that for many problems we will be searching for a state that is `eql` to a specified goal state.\nWe define the class `eql-problem` to refer to such problems, and specify `goal-p` for that class.\nNote that we make it possible to specify the goal when a problem is created, but not to change the goal:\n\n```lisp\n(defclass eql-problem (problem)\n ((goal rinitarg :goal :reader problem-goal)))\n(defmethod goal-p ((prob eql-problem))\n (eql (current-state prob) (problem-goal prob)))\n```\n\nNow we are ready to specify two search strategies: depth-first search and breadth-first search.\nWe define problem classes for each strategy and specify the `problem-combiner` function:\n\n```lisp\n(defclass dfs-problem (problem) ()\n (:documentation \"Depth-first search problem.\"))\n(defclass bfs-problem (problem) ()\n (:documentation \"Breadth-first search problem.\"))\n(defmethod problem-combiner ((prob dfs-problem) new old)\n \"Depth-first search looks at new states first.\"\n (append new old))\n(defmethod problem-combiner ((prob bfs-problem) new old)\n \"Depth-first search looks at old states first.\"\n (append old new))\n```\n\nWhile this code will be sufficient for our purposes, it is less than ideal, because it breaks an information-hiding barrier.\nIt treats the set of old states as a list, which is the default for the `problem` class but is not necessarily the implementation that every class will use.\nIt would have been cleaner to define generic functions `add-states-to-end` and `add-states-to-front` and then define them with `append` in the default class.\nBut Lisp provides such nice list-manipulation primitives that it is difficult to avoid the temptation of using them directly.\n\nOf course, the user who defines a new implementation for `problem-states` could just redefine `problem-combiner` for the offending classes, but this is precisely what object-oriented programming is designed to avoid: specializing one abstraction (states) should not force us to change anything in another abstraction (search strategy).\n\nThe last step is to define a class that represents a particular domain, and define `problem-successors` for that domain.\nAs the first example, consider the simple binary tree search from [section 6.4](chapter6.md#s0025).\nNaturally, this gets represented as a class:\n\n```lisp\n(defclass binary-tree-problem (problem) ())\n(defmethod problem-successors ((prob binary-tree-problem) state)\n (let ((n (* 2 state)))\n   (list n (+ n 1))))\n```\n\nNow suppose we want to solve a binary-tree problem with breadth-first search, searching for a particular goal.\nSimply create a class that mixes in `binary-tree-problem`, `eql-problem` and `bfs-problem,` create an instance of that class, and call `searcher` on that instance:\n\n```lisp\n(defclass binary-tree-eql-bfs-problem\n      (binary-tree-problem eql-problem bfs-problem) ())\n> (setf pl (make-instance 'binary-tree-eql-bfs-problem\n             :states '(1) :goal 12))\n#<BINARY-TREE-EQL-BFS-PROBLEM 26725536>\n> (searcher pl)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 4 5)\n;; Search: (4 5 6 7)\n;; Search: (5 6 7 8 9)\n;; Search: (6 7 8 9 10 11)\n;; Search: (7 8 9 10 11 12 13)\n;; Search: (8 9 10 11 12 13 14 15)\n;; Search: (9 10 11 12 13 14 15 16 17)\n;; Search: (10 11 12 13 14 15 16 17 18 19)\n;; Search: (11 12 13 14 15 16 17 18 19 20 21)\n;; Search: (12 13 14 15 16 17 18 19 20 21 22 23)\n12\n```\n\n### Best-First Search\n\nIt should be clear how to proceed to define best-first search: define a class to represent best-first search problems, and then define the necessary methods for that class.\nSince the search strategy only affects the order in which states are explored, the only method necessary will be for `problem-combiner`.\n\n```lisp\n(defclass best-problem (problem) ()\n (:documentation \"A Best-first search problem.\"))\n(defmethod problem-combiner ((prob best-problem) new old)\n \"Best-first search sorts new and old according to cost-fn.\"\n (sort (append new old) #'<\n      :key #'(lambda (state) (cost-fn prob state))))\n```\n\nThis introduces the new function `cost-fn`; naturally it will be a generic function.\nThe following is a `cost-fn` that is reasonable for any `eql-problem` dealing with numbers, but it is expected that most domains will specialize this function.\n\n```lisp\n(defmethod cost-fn ((prob eql-problem) state)\n (abs (- state (problem-goal prob))))\n```\n\nBeam search is a modification of best-first search where all but the best *b* states are thrown away on each iteration.\nA beam search problem is represented by a class where the instance variable `beam-width` holds the parameter *b*.\nIf this is nil, then full best-first search is done.\nBeam search is implemented by an `:around` method on `problem-combiner`.\nIt calls the next method to get the list of states produced by best-first search, and then extracts the first *b* elements.\n\n```lisp\n(defclass beam-problem (problem)\n ((beam-width :initarg :beam-width :initform nil\n         :reader problem-beam-width)))\n(defmethod problem-combiner :around ((prob beam-problem) new old)\n (let ((combined (call-next-method)))\n   (subseq combined 0 (min (problem-beam-width prob)\n             (length combined)))))\n```\n\nNow we apply beam search to the binary-tree problem.\nAs usual, we have to make up another class to represent this type of problem:\n\n```lisp\n(defclass binary-tree-eql-best-beam-problem\n (binary-tree-problem eql-problem best-problem beam-problem)\n ())\n> (setf p3 (make-instance 'binary-tree-eql-best-beam-problem\n             :states '(1) :goal 12 :beam-width 3))\n#<BINARY-TREE-EQL-BEST-BEAM-PROBLEM 27523251>\n> (searcher p3)\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (14 15 6)\n;; Search: (15 6 28)\n;; Search: (6 28 30)\n;; Search: (12 13 28)\n12\n```\n\nSo far the case for CLOS has not been compelling.\nThe code in this section duplicates the functionality of code in [section 6.4](chapter6.md#s0025), but the CLOS code tends to be more verbose, and it is somewhat disturbing that we had to make up so many long class names.\nHowever, this verbosity leads to flexibility, and it is easier to extend the CLOS code by adding new specialized classes.\nIt is useful to make a distinction between the systems programmer and the applications programmer.\nThe systems programmer would supply a library of classes like `dfs-problem` and generic functions like `searcher`.\nThe applications programmer then just picks what is needed from the library.\nFrom the following we see that it is not too difficult to pick out the right code to define a trip-planning searcher.\nCompare this with the definition of `trip` on page 198 to see if you prefer CLOS in this case.\nThe main difference is that here we say that the cost function is `air-distance` and the successors are the `neighbors` by defining methods; in `trip` we did it by passing parameters.\nThe latter is a little more succinct, but the former may be more clear, especially as the number of parameters grows.\n\n```lisp\n(defclass trip-problem (binary-tree-eql-best-beam-problem)\n ((beam-width :initform 1)))\n(defmethod cost-fn ((prob trip-problem) city)\n (air-distance (problem-goal prob) city))\n(defmethod problem-successors ((prob trip-problem) city)\n (neighbors city))\n```\n\nWith the definitions in place, it is easy to use the searching tool:\n\n```lisp\n> (setf p4 (make-instance 'trip-problem\n            :states (list (city 'new-york))\n            :goal (city 'san-francisco)))\n#<TRIP-PROBLEM 31572426>\n> (searcher p4)\n;; Search: ((NEW-YORK 73.58 40.47))\n;; Search: ((PITTSBURG 79.57 40.27))\n;; Search: ((CHICAGO 87.37 41.5))\n;; Search: ((KANSAS-CITY 94.35 39.06))\n;; Search: ((DENVER 105.0 39.45))\n;; Search: ((FLAGSTAFF 111.41 35.13))\n;; Search: ((RENO 119.49 39.3))\n;; Search: ((SAN-FRANCISCO 122.26 37.47))\n(SAN-FRANCISCO 122.26 37.47)\n```\n\n## 13.9 Is CLOS Object-Oriented?\n\nThere is some argument whether CLOS is really object-oriented at all.\nThe arguments are:\n\nCLOS *is* an object-oriented system because it provides all three of the main criteria for object-orientation: objects with internal state, classes of objects with specialized behavior for each class, and inheritance between classes.\n\nCLOS is *not* an object-oriented system because it does not provide modular objects with information-hiding.\nIn the `audited-account` example, we would like to encapsulate the `audit-trail` instance variable so that only the `withdraw` methods can change it.\nBut because methods are written separately from class definitions, we could not do that.\nInstead, we had to define an accessor for `audit-trail`.\nThat enabled us to write the `withdraw` methods, but it also made it possible for anyone else to alter the audit trail as well.\n\nCLOS is *more general than* an object-oriented system because it allows for methods that specialize on more than one argument.\nIn true object-oriented systems, methods are associated with objects of a particular class.\nThis association is lexically obvious (and the message-passing metaphor is clear) when we write the methods inside the definition of the class, as in our `define-class` macro.\nThe message-passing metaphor is still apparent when we write generic functions that dispatch on the class of their first argument, which is how we've been using CLOS so far.\n\nBut CLOS methods can dispatch on the class of any required argument, or any combination of them.\nConsider the following definition of `conc,` which is like `append` except that it works for vectors as well as lists.\nRather than writing `conc` using conditional statements, we can use the multimethod dispatch capabilities of CLOS to define the four cases: (1) the first argument is nil, (2) the second argument is nil, (3) both arguments are lists, and (4) both arguments are vectors.\nNotice that if one of the arguments is nil there will be two applicable methods, but the method for `null` will be used because the class `null` is more specific than the class `list.`\n\n```lisp\n(defmethod conc ((x null) y) y)\n(defmethod conc (x (y null)) x)\n(defmethod conc ((x list) (y list))\n (cons (first x) (conc (rest x) y)))\n(defmethod conc ((x vector) (y vector))\n (let ((vect (make-array (+ (length x) (length y)))))\n   (replace vect x)\n   (replace vect y :startl (length x))))\n```\n\nHere we see that this definition works:\n\n```lisp\n> (conc nil '(a b c)) => (A B C)\n> (conc '(a b c) nil) => (A B C)\n> (conc '(a b c) '(d e f)) => (A B C D E F)\n> (conc '#(a b c) '#(d e f)) => #(A B C D E F)\n```\n\nIt works, but one might well ask: where are the objects?\nThe metaphor of passing a message to an object does not apply here, unless we consider the object to be the list of arguments, rather than a single privileged argument.\n\nIt is striking that this style of method definition is very similar to the style used in Prolog.\nAs another example, compare the following two definitions of `len`, a relation/function to compute the length of a list:\n\n```\n;; CLOS\n(defmethod len ((x null)) 0)\n(defmethod len ((x cons))\n(+  1 (len (rest x))))\n```\n\n```\n%% Prolog\nlen([],0).\nlen(CXIL].N1) :-\nlen(L.N). NI is N+1.\n```\n\n## 13.10 Advantages of Object-Oriented Programming\n\nBertrand Meyer, in his book on the object-oriented language Eiffel (1988), lists five qualities that contribute to software quality:\n\n*   *Correctness*.\nClearly, a correct program is of the utmost importance.\n\n*   *Robustness*.\nPrograms should continue to function in a reasonable manner even for input that is beyond the original specifications.\n\n*   *Extendability*.\nPrograms should be easy to modify when the specifications change.\n\n*   *Reusability*.\nProgram components should be easy to transport to new programs, thus amortizing the cost of software development over several projects.\n\n*   *Compatibility*.\nPrograms should interface well with other programs.\nFor example, a spreadsheet program should not only manipulate numbers correctly but also be compatible with word processing programs, so that spreadsheets can easily be included in documents.\n\nHere we list how the object-oriented approach in general and CLOS in particular can effect these measures of quality:\n\n*   *Correctness*.\nCorrectness is usually achieved in two stages: correctness of individual modules and correctness of the whole system.\nThe object-oriented approach makes it easier to prove correctness for modules, since they are clearly defined, and it may make it easier to analyze interactions between modules, since the interface is strictly limited.\nCLOS does not provide for information-hiding the way other systems do.\n\n*   *Robustness*.\nGeneric functions make it possible for a function to accept, at run time, a class of argument that the programmer did not anticipate at compile time.\nThis is particularly true in CLOS, because multiple inheritance makes it feasible to write default methods that can be used by a wide range of classes.\n\n*   *Extendability*.\nObject-oriented systems with inheritance make it easy to define new classes that are slight variants on existing ones.\nAgain, CLOS's multiple inheritance makes extensions even easier than in single-inheritance systems.\n\n*   *Reusability*.\nThis is the area where the object-oriented style makes the biggest contribution.\nInstead of writing each new program from scratch, object-oriented programmers can look over a library of classes, and either reuse existing classes as is, or specialize an existing class through inheritance.\nLarge libraries of CLOS classes have not emerged yet.\nPerhaps they will when the language is more established.\n\n*   *Compatibility*.\nThe more programs use standard components, the more they will be able to communicate with each other.\nThus, an object-oriented program will probably be compatible with other programs developed from the same library of classes.\n\n## 13.11 History and References\n\nThe first object-oriented language was Simula, which was designed by Ole-Johan Dahl and Krysten Nygaard ([1966](bibliography.md#bb0265), [Nygaard and Dahl 1981](bibliography.md#bb0920)) as an extension of Algol 60.\nIt is still in use today, mostly in Norway and Sweden.\nSimula provides the ability to define classes with single inheritance.\nMethods can be inherited from a superclass or overridden by a subclass.\nIt also provides *coroutines*, class instances that execute continuously, saving local state in instance variables but periodically pausing to let other coroutines run.\nAlthough Simula is a general-purpose language, it provides special support for simulation, as the name implies.\nThe built-in class `simulation` allows a programmer to keep track of simulated time while running a set of processes as coroutines.\n\nIn 1969 Alan Kay was a graduate student at the University of Utah.\nHe became aware of Simula and realized that the object-oriented style was well suited to his research in graphics ([Kay 1969](bibliography.md#bb0600)).\nA few years later, at Xerox, he joined with Adele Goldberg and Daniel Ingalls to develop the Smalltalk language (see [Goldberg and Robinson 1983](bibliography.md#bb0475)).\nWhile Simula can be viewed as an attempt to add object-oriented features to strongly typed Algol 60, Smalltalk can be seen as an attempt to use the dynamic, loosely typed features of Lisp, but with methods and objects replacing functions and s-expressions.\nIn Simula, objects existed alongside traditional data types like numbers and strings; in Smalltalk, every datum is an object.\nThis gave Smalltalk the feel of an integrated Lisp environment, where the user can inspect, copy, or edit any part of the environment.\nIn fact, it was not the object-oriented features of Smalltalk per se that have made a lasting impression but rather the then-innovative idea that every user would have a large graphical display and could interact with the system using a mouse and menus rather than by typing commands.\n\nGuy Steele's *LAMBDA: The Ultimate Declarative* (1976a and b) was perhaps the first paper to demonstrate how object-oriented programming can be done in Lisp.\nAs the title suggests, it was all done using `lambda,` in a similar way to our `define-class` example.\nSteele summarized the approach with the equation \"Actors = Closures (mod Syntax),\" refering to Carl Hewitt's \"Actors\" object-oriented formalism.\n\nIn 1979, the MIT Lisp Machine group developed the Flavors system based on this approach but offering considerable extensions ([Cannon 1980](bibliography.md#bb0155), [Weinreb 1980](bibliography.md#bb1360), [Moon et al.\n1983](bibliography.md#bb0860)).\n\"Flavor\" was a popular jargon word for \"type\" or \"kind\" at MIT, so it was natural that it became the term for what we call classes.\n\nThe Flavor system was the first to support multiple inheritance.\nOther languages shunned multiple inheritance because it was too dynamic.\nWith single inheritance, each instance variable and method could be assigned a unique offset number, and looking up a variable or method was therefore trivial.\nBut with multiple inheritance, these computations had to be done at run time.\nThe Lisp tradition enabled programmers to accept this dynamic computation, when other languages would not.\nOnce it was accepted, the MIT group soon came to embrace it.\nThey developed complex protocols for combining different flavors into new ones.\nThe concept of *mix-ins* was developed by programmers who frequented Steve's Ice Cream parlor in nearby Davis Square.\nSteve's offered a list of ice cream flavors every day but also offered to create new flavors-dynamically-by mixing in various cookies, candies, or fruit, at the request of the individual customer.\nFor example, Steve's did not have chocolate-chip ice cream on the menu, but you could always order vanilla ice cream with chocolate chips mixed in.<a id=\"tfn13-3\"></a><sup>[3](#fn13-3)</sup>\n\nThis kind of \"flavor hacking\" appealed to the MIT Lisp Machine group, who adopted the metaphor for their object-oriented programming system.\nAll flavors inherited from the top-most flavor in the hierarchy: vanilla.\nIn the window system, for example, the flavor `basic-window` was defined to support the minimal functionality of all windows, and then new flavors of window were defined by combining mix-in flavors such as `scroll-bar-mixin`, `label-mixin`, and `border-mixin`.\nThese mix-in flavors were used only to define other flavors.\nJust as you couldn't go into Steve's and order \"crushed Heath bars, hold the ice cream,\" there was a mechanism to prohibit instantiation of mix-ins.\n\nA complicated repetoire of *method combinations* was developed.\nThe default method combination on Flavors was similar to CLOS: first do all the `:before` methods, then the most specific primary method, then the `:after` methods.\nBut it was possible to combine methods in other ways as well.\nFor example, consider the `inside-width` method, which returns the width in pixels of the usable portion of a window.\nA programmer could specify that the combined method for `inside-width` was to be computed by calling all applicable methods and summing them.\nThen an `inside-width` method for the `basic-window` flavor would be defined to return the width of the full window, and each mix-in would have a simple method to say how much of the width it consumed.\nFor example, if borders are 8 pixels wide and scroll bars are 12 pixels wide, then the `inside-width` method for `border-mixin` returns `-8` and `scroll-bar-mixin` returns `-12`.\nThen any window, no matter how many mix-ins it is composed of, automatically computes the proper inside width.\n\nIn 1981, Symbolics came out with a more efficient implementation of Flavors.\nObjects were no longer just closures.\nThey were still funcallable, but there was additional hardware support that distinguished them from other functions.\nAfter a few years Symbolics abandoned the (send *object message*) syntax in favor of a new syntax based on generic functions.\nThis system was known as New Flavors.\nIt had a strong influence on the eventual CLOS design.\n\nThe other strong influence on CLOS was the CommonLoops system developed at Xerox PARC.\n(See [Bobrow 1982](bibliography.md#bb0095), [Bobrow et al.\n1986](bibliography.md#bb0105), [Stefik and Bobrow 1986](bibliography.md#bb1185).) CommonLoops continued the New Flavors trend away from message passing by introducing *multimethods*: methods that specialize on more than one argument.\n\nAs of summer 1991, CLOS itself is in a state of limbo.\nIt was legitimized by its appearance in *Common Lisp the Language*, 2d edition, but it is not yet official, and an important part, the metaobject protocol, is not yet complete.\nA tutorial on CLOS is [Keene 1989](bibliography.md#bb0620).\n\nWe have seen how easy it is to build an object-oriented system on top of Lisp, using `lambda` as the primary tool.\nAn interesting alternative is to build Lisp on top of an object-oriented system.\nThat is the approach taken in the Oaklisp system of [Lang and Perlmutter (1988)](bibliography.md#bb0695).\nInstead of defining methods using `lambda` as the primitive, Oaklisp has `add-method` as a primitive and defines `lambda` as a macro that adds a method to an anonymous, empty operation.\n\nOf course, object-oriented systems are thriving outside the Lisp world.\nWith the success of UNIX-based workstations, C has become one of the most widely available programming languages.\nC is a fairly low-level language, so there have been several attempts to use it as a kind of portable assembly language.\nThe most successful of these attempts is C++, a language developed by Bjarne Stroustrup of AT&T Bell Labs ([Stroustrup 1986](bibliography.md#bb1210)).\nC++ provides a number of extensions, including the ability to define classes.\nHowever, as an add-on to an existing language, it does not provide as many features as the other languages discussed here.\nCrucially, it does not provide garbage collection, nor does it support fully generic functions.\n\nEiffel ([Meyer 1988](bibliography.md#bb0830)) is an attempt to define an object-oriented system from the ground up rather than tacking it on to an existing language.\nEiffel supports multiple inheritance and garbage collection and a limited amount of dynamic dispatching.\n\nSo-called modern languages like Ada and Modula support information-hiding through generic functions and classes, but they do not provide inheritance, and thus can not be classified as true object-oriented languages.\n\nDespite these other languages, the Lisp-based object-oriented systems are the only ones since Smalltalk to introduce important new concepts: multiple inheritance and method combination from Flavors, and multimethods from CommonLoops.\n\n## 13.12 Exercises\n\n**Exercise  13.3 [m]** Implement `deposit` and `interest` methods for the `account` class using CLOS.\n\n**Exercise  13.4 [m]** Implement the `password-account` class using CLOS.\nCan it be done as cleanly with inheritance as it was done with delegation?\nOr should you use delegation within CLOS?\n\n**Exercise  13.5 [h]** Implement graph searching, search paths, and A* searching as classes in CLOS.\n\n**Exercise  13.6 [h]** Implement a priority queue to hold the states of a problem.\nInstead of a list, the `problem-states` will be a vector of lists, each initially null.\nEach new state will have a priority (determined by the generic function `priority`) which must be an integer between zero and the length of the vector, where zero indicates the highest priority.\nA new state with priority *p* is pushed onto element *p* of the vector, and the state to be explored next is the first state in the first nonempty position.\nAs stated in the text, some of the previously defined methods made the unwarranted assumption that `problem-states` would always hold a list.\nChange these methods.\n\n----------------------\n\n<a id=\"fn13-1\"></a><sup>[1](#tfn13-1)</sup>\nMore accurately, we have a guarantee that there is no way to get at the inside of a closure using portable Common Lisp code.\nParticular implementations may provide debugging tools for getting at this hidden information, such as `inspect`.\nSo closures are not perfect at hiding information from these tools.\nOf course, no information-hiding method will be guaranteed against such covert channels-even with the most sophisticated software security measures, it is always possible to, say, wipe a magnet over the computer's disks and alter sensitive data.\n\n<a id=\"fn13-2\"></a><sup>[2](#tfn13-2)</sup>\nThere is a technical sense of \"generic function\" that is used within CLOS.\nThese functions are not generic according to this technical sense.\n\n<a id=\"fn13-3\"></a><sup>[3](#tfn13-3)</sup>\nFlavor fans will be happy to know that Steve's Ice Cream is now sold nationally in the United States.\nAlas, it is not possible to create flavors dynamically.\nAlso, be warned that Steve's was bought out by his Teal Square rival, Joey's.\nThe original Steve retired from the business for years, then came back with a new line of stores under his last name, Harrell.\n\n"
  },
  {
    "path": "docs/chapter14.md",
    "content": "# Chapter 14\n## Knowledge Representation and Reasoning\n\n> *Knowledge itself is power.* \\\n> -Francis Bacon (1561-1626)\n\n> *The power resides in the knowledge.* \\\n> -Edward Feigenbaum \\\n> Stanford University Heuristic Programming Project\n\n> *Knowledge is Knowledge, and vice versa.* \\\n> -Tee shirt \\\n> Stanford University Heuristic Programming Project\n\nIn the 1960s, much of AI concentrated on search techniques.\nIn particular, a lot of work was concerned with *theorem proving:* stating a problem as a small set of axioms and searching for a proof of the problem.\nThe implicit assumption was that the power resided in the inference mechanism-if we could just find the right search technique, then all our problems would be solved, and all our theorems would be proved.\n\nStarting in the 1970s, this began to change.\nThe theorem-proving approach failed to live up to its promise.\nAI workers slowly began to realize that they were not going to solve NP-hard problems by coming up with a clever inference algorithm.\nThe general inferencing mechanisms that worked on toy examples just did not scale up when the problem size went into the thousands (or sometimes even into the dozens).\n\nThe *expert-system* approach offered an alternative.\nThe key to solving hard problems was seen to be the acquisition of special-case rules to break the problem into easier problems.\nAccording to Feigenbaum, the lesson learned from expert systems like MYCIN (which we will see in [chapter 16](chapter16.md)) is that the choice of inferencing mechanism is not as important as having the right knowledge.\nIn this view it doesn't matter very much if MYCIN uses forward- or backward-chaining, or if it uses certainty factors, probabilities, or fuzzy set theory.\nWhat matters crucially is that we know pseudomonas is a gram-negative, rod-shaped organism that can infect patients with compromised immune systems.\nIn other words, the key problem is acquiring and representing knowledge.\n\nWhile the expert system approach had some successes, it also had failures, and researchers were interested in learning the limits of this new technology and understanding exactly how it works.\nMany found it troublesome that the meaning of the knowledge used in some systems was never clearly defined.\nFor example, does the assertion `(color apple red)` mean that a particular apple is red, that all apples are red, or that some/most apples are red?\nThe field of *knowledge representation* concentrated on providing clear semantics for such representations, as well as providing algorithms for manipulating the knowledge.\nMuch of the emphasis was on finding a good trade-off between *expressiveness* and *efficiency.* An efficient language is one for which all queries (or at least the average query) can be answered quickly.\nIf we want to guarantee that queries will be answered quickly, then we have to limit what can be expressed in the language.\n\nIn the late 1980s, a series of results shed doubt on the hopes of finding an efficient language with any reasonable degree of expressiveness at all.\nUsing mathematical techniques based on worst-case analysis, it was shown that even seemingly trivial languages were *intractable*—in the worst case, it would take an exponential amount of time to answer a simple query.\n\nThus, in the 1990s the emphasis has shifted to *knowledge representation and reasoning,* a field that encompasses both the expressiveness and efficiency of languages but recognizes that the average case is more important than the worst case.\nNo amount of knowledge can help solve an intractable problem in the worse case, but in practice the worst case rarely occurs.\n\n## 14.1 A Taxonomy of Representation Languages\n\nAI researchers have investigated hundreds of knowledge representation languages, trying to find languages that are convenient, expressive, and efficient.\nThe languages can be classified into four groups, depending on what the basic unit of representation is.\nHere are the four categories, with some examples:\n\n*   *Logical Formulae* (Prolog)\n\n*   *Networks* (semantic nets, conceptual graphs)\n\n*   *Objects* (scripts, frames)\n\n*   *Procedures* (Lisp, production systems)\n\nWe have already dealt with *logic-based* languages like Prolog.\n\n*Network-based* languages can be seen as a syntactic variation on logical languages.\nA link *L* between nodes *A* and *B* is just another way of expressing the logical relation *L(A, B).* The difference is that network-based languages take their links more seriously: they are intended to be implemented directly by pointers in the computer, and inference is done by traversing these pointers.\nSo placing a link *L* between *A* and *B* not only asserts that *L(A, B)* is true, but it also says something about how the knowledge base is to be searched.\n\n*Object-oriented* languages can also be seen as syntactic variants of predicate calculus.\nHere is a statement in a typical slot-filler frame language:\n\n```lisp\n(a person\n  (name = Jan)\n  (age = 32))\n```\n\nThis is equivalent to the logical formula:\n\n&exist;p: person(p) &and; name(p,Jan) &and; age(p,32)\n\nThe frame notation has the advantage of being easier to read, in some people's opinion.\nHowever, the frame notation is less expressive.\nThere is no way to say that the person's name is either Jan or John, or that the person's age is not 34.\nIn predicate calculus, of course, such statements can be easily made.\n\nFinally, *procedural* languages are to be contrasted with representation languages: procedural languages compute answers without explicit representation of knowledge.\n\nThere are also hybrid representation languages that use different methods to encode different kinds of knowledge.\nThe KL-ONE family of languages uses both logical formulae and objects arranged into a network, for example.\nMany frame languages allow *procedural attachment,* a technique that uses arbitrary procedures to compute values for expressions that are inconvenient or impossible to express in the frame language itself.\n\n## 14.2 Predicate Calculus and its Problems\n\nSo far, many of our representations have been based on predicate calculus, a notation with a distinguished position in AI: it serves as the universal standard by which other representations are defined and evaluated.\nThe previous section gave an example expression from a frame language.\nThe frame language may have many merits in terms of the ease of use of its syntax or the efficiency of its internal representation of data.\nHowever, to understand what expressions in the language mean, there must be a clear definition.\nMore often than not, that definition is given in terms of predicate calculus.\n\nA predicate calculus representation assumes a universe of individuals, with relations and functions on those individuals, and sentences formed by combining relations with the logical connectives `and`, `or`, and `not`.\nPhilosophers and psychologists will argue the question of how appropriate predicate calculus is as a model of human thought, but one point stands clear: predicate calculus is sufficient to represent anything that can be represented in a digital computer.\nThis is easy to show: assuming the computer's memory has *n* bits, and the equation *b<sub>i</sub>* = 1 means that bit *i* is on, then the entire state of the computer is represented by a conjunction such as:\n\n<img src=\"images/chapter14/si1_e.svg\"\nonerror=\"this.src='images/chapter14/si1_e.png'; this.onerror=null;\"\nalt=\"b_{0}=0 \\wedge b_{1}=0 \\wedge b_{2}=1 ... \\wedge b_{n}=0\" />\n\nOnce we can represent a state of the computer, it becomes possible to represent any computer program in predicate calculus as a set of axioms that map one state onto another.\nThus, predicate calculus is shown to be a *sufficient* language for representing anything that goes on inside a computer-it can be used as a tool for analyzing any program from the outside.\n\nThis does not prove that predicate calculus is an *appropriate* tool for all applications.\nThere are good reasons why we may want to represent knowledge in a form that is quite different from predicate calculus, and manipulate the knowledge with procedures that are quite different from logical inference.\nBut we should still be able to describe our system in terms of predicate calculus axioms, and prove theorems about it.\nTo do any less is to be sloppy.\nFor example, we may want to manipulate numbers inside the computer by using the arithmetic instructions that are built into the CPU rather than by manipulating predicate calculus axioms, but when we write a square-root routine, it had better satisfy the axiom:\n\n<img src=\"images/chapter14/si2_e.svg\"\nonerror=\"this.src='images/chapter14/si2_e.png'; this.onerror=null;\"\nalt=\"\\sqrt{x} = y \\Rightarrow y \\times y = x\" />\n\nPredicate calculus also serves another purpose: as a tool that can be used *by* a program rather than *on* a program.\nAll programs need to manipulate data, and some programs will manipulate data that is considered to be in predicate calculus notation.\nIt is this use that we will be concerned with.\n\nPredicate calculus makes it easy to start writing down facts about a domain.\nBut the most straightforward version of predicate calculus suffers from a number of serious limitations:\n\n* *Decidability* - given a set of axioms and a goal, it may be that neither the goal nor its negation can be derived from the axioms.\n\n* *Tractability* - even when a goal is provable, it may take too long to find the proof using the available inferencing mechanisms.\n\n* *Uncertainty* - it can be inconvenient to deal with relations that are probable to a degree but not known to be definitely true or false.\n\n* *Monotonicity* - in pure predicate calculus, once a theorem is proved, it is true forever.\nBut we would like a way to derive tentative theorems that rely on assumptions, and be able to retract them when the assumptions prove false.\n\n* *Consistency* - pure predicate calculus admits no contradictions.\nIf by accident both *P* and &not;*P* are derived, then *any* theorem can be proved.\nIn effect, a single contradiction corrupts the entire data base.\n\n* *Omniscience* - it can be difficult to distinguish what is provable from what should be proved.\nThis can lead to the unfounded assumption that an agent believes all the consequences of the facts it knows.\n\n* *Expressiveness* - the first-order predicate calculus makes it awkward to talk about certain things, such as the relations and propositions of the language itself.\n\nThe view held predominantly today is that it is best to approach these problems with a dual attack that is both within and outside of predicate calculus.\nIt is considered a good idea to invent new notations to address the problems-both for convenience and to facilitate special-purpose reasoners that are more efficient than a general-purpose theorem prover.\nHowever, it is also important to define scrupulously the meaning of the new notation in terms of familiar predicate-calculus notation.\nAs Drew McDermott put it, \"No notation without denotation!\" (1978).\n\nIn this chapter we show how new notations (and their corresponding meanings) can be used to extend an existing representation and reasoning system.\nProlog is chosen as the language to extend.\nThis is not meant as an endorsement for Prolog as the ultimate knowledge representation language.\nRather, it is meant solely to give us a clear and familiar foundation from which to build.\n\n## 14.3 A Logical Language: Prolog\n\nProlog has been proposed as the answer to the problem of programming in logic.\nWhy isn't it accepted as the universal representation language?\nProbably because Prolog is a compromise between a representation language and a programming language.\nGiven two specifications that are logically equivalent, one can be an efficient Prolog program, while the other is not.\nKowalski's famous equation \"*algorithm = logic + control\"* expresses the limits of logic alone: *logic = algorithm - control.* Many problems (especially in AI) have large or infinite search spaces, and if Prolog is not given some advice on how to search that space, it will not come up with the answer in any reasonable length of time.\n\nProlog's problems fall into three classes.\nFirst, in order to make the language efficient, its expressiveness was restricted.\nIt is not possible to assert that a person's name is either Jan or John in Prolog (although it is possible to *ask* if the person's name is one of those).\nSimilarly, it is not possible to assert that a fact is false; Prolog does not distinguish between false and unknown.\nSecond, Prolog's inference mechanism is neither sound nor complete.\nBecause it does not check for circular unification, it can give incorrect answers, and because it searches depth-first it can miss correct answers.\nThird, Prolog has no good way of adding control information to the underlying logic, making it inefficient on certain problems.\n\n## 14.4 Problems with Prolog's Expressiveness\n\nIf Prolog is programming in logic, it is not the full predicate logic we are familiar with.\nThe main problem is that Prolog can't express certain kinds of indefinite facts.\nIt can represent definite facts: the capital of Rhode Island is Providence.\nIt can represent conjunctions of facts: the capital of Rhode Island is Providence and the capital of California is Sacramento.\nBut it can not represent disjunctions or negations: that the capital of California is *not* Los Angeles, or that the capital of New York is *either* New York City *or* Albany.\nWe could try this:\n\n```lisp\n(<- (not (capital LA CA)))\n(<- (or (capital Albany NY) (capital NYC NY)))\n```\n\nbut note that these last two facts concern the relation `not` and `or`, not the relation `capital`.\nThus, they will not be considered when we ask a query about `capital`.\nFortunately, the assertion \"Either NYC or Albany is the capital of NY\" can be rephrased as two assertions: \"Albany is the capital of NY if NYC is not\" and \"NYC is the capital of NY if Albany is not:\"\n\n```lisp\n(<- (capital Albany NY) (not (capital NYC NY)))\n(<- (capital NYC NY) (not (capital Albany NY)))\n```\n\nUnfortunately, Prolog's `not` is different from logic's `not`.\nWhen Prolog answers \"no\" to a query, it means the query cannot be proven from the known facts.\nIf everything is known, then the query must be false, but if there are facts that are not known, the query may in fact be true.\nThis is hardly surprising; we can't expect a program to come up with answers using knowledge it doesn't have.\nBut in this case, it causes problems.\nGiven the previous two clauses and the query `(capital ?c NY)`, Prolog will go into an infinite loop.\nIf we remove the first clause, Prolog would fail to prove that Albany is the capital, and hence conclude that NYC is.\nIf we remove the second clause, the opposite conclusion would be drawn.\n\nThe problem is that Prolog equates \"not proven\" with \"false.\" Prolog makes what is called the *closed world assumption*-it assumes that it knows everything that is true.\nThe closed world assumption is reasonable for most programs, because the programmer does know all the relevant information.\nBut for knowledge representation in general, we would like a system that does not make the closed world assumption and has three ways to answer a query: \"yes,\" \"no,\" or \"unknown.\" In this example, we would not be able to conclude that the capital of NY is or is not NYC, hence we would not be able to conclude anything about Albany.\n\nAs another example, consider the clauses:\n\n```lisp\n(<- (damned) (do))\n(<- (damned) (not (do)))\n```\n\nWith these rules, the query `(? (damned))` should logically be answered \"yes.\"\nFurthermore, it should be possible to conclude `(damned)` without even investigating if `(do)` is provable or not.\nWhat Prolog does is first try to prove `(do)`.\nIf this succeeds, then `(damned)` is proved.\nEither way, Prolog then tries again to prove `(do)`, and this time if the proof fails, then `(damned)` is proved.\nSo Prolog is doing the same proof twice, when it is unnecessary to do the proof at all.\nIntroducing negation wrecks havoc on the simple Prolog evaluation scheme.\nIt is no longer sufficient to consider a single clause at a time.\nRather, multiple clauses must be considered together if we want to derive all the right answers.\n\nRobert [Moore 1982](bibliography.md#bb0865) gives a good example of the power of disjunctive reasoning.\nHis problem concerned three colored blocks, but we will update it to deal with three countries.\nSuppose that a certain Eastern European country, *E*, has just decided if it will remain under communist rule or become a democracy, but we do not know the outcome of the decision.\n*E* is situated between the democracy *D* and the communist country *C*:\n\n<a id=\"diagram-14-02\"></a>\n<img src=\"images/chapter14/diagram-14-02.svg\"\n  onerror=\"this.src='images/chapter4/diagram-14-02.png'; this.onerror=null;\"\n  alt=\"Diagram 14.2\" />\n\nThe question is: Is there a communist country next to a democracy?\nMoore points out that the answer is \"yes,\" but discovering this requires reasoning by cases.\nIf *E* is a democracy then it is next to *C* and the answer is yes.\nBut if *E* is communist then it is next to *D* and the answer is still yes.\nSince those are the only two possibilities, the answer must be yes in any case.\nLogical reasoning gives us the right answer, but Prolog can not.\nWe can describe the problem with the following seven assertions and one query, but Prolog can not deal with the or in the final assertion.\n\n```lisp\n(<- (next-to D E))    (<- (next-to E D))\n(<- (next-to E C))    (<- (next-to C E))\n(<- (democracy D))    (<- (communist C))\n(<- (or (democracy E)  (communist E)))\n(?- (next-to ?A ?B) (democracy ?A) (communist ?B))\n```\n\nWe have seen that Prolog is not very good at representing disjunctions and negations.\nIt also has difficulty representing existentials.\nConsider the following statement in English, logic, and Prolog:\n\nJan likes everyone.\n\n&forall; *x* person(*x*) => likes(Jan,*x*)\n\n```lisp\n(<- (likes Jan ?x) (person ?x))\n```\n\nThe Prolog translation is faithful.\nBut there is no good translation for \"Jan likes someone.\" The closest we can get is:\n\nJan likes someone.\n\n&exist; *x* person(x) => likes(Jan,x)\n\n```lisp\n(<- (likes Jan pl))\n(<- (person pl))\n```\n\nHere we have invented a new symbol, `p1`, to represent the unknown person that Jan likes, and have asserted that `p1` is a person.\nNotice that `p1` is a constant, not a variable.\nThis use of a constant to represent a specific but unknown entity is called a *Skolem constant,* after the logician Thoralf Skolem (1887-1963).\nThe intent is that `p1` may be equal to some other person that we know about.\nIf we find out that Adrian is the person Jan likes, then in logic we can just add the assertion p1 = Adrian.\nBut that does not work in Prolog, because Prolog implicitly uses the *unique name assumption-*all atoms represent distinct individuals.\n\nA Skolem constant is really just a special case of a *Skolem function-*an unknown entity that depends on one or more variable.\nFor example, to represent \"Everyone likes someone\" we could use:\n\nEveryone likes someone.\n\n&forall;*y*&exist; *x* person (*x*) => likes (*y, x*)\n\n```lisp\n(<- (likes ?y (p2 ?y)))\n(<- (person (p2 ?y)))\n```\n\nHere `p2` is a Skolem function that depends on the variable `?y`.\nIn other words, everyone likes some person, but not necessarily the same person.\n\n## 14.5 Problems with Predicate Calculus's Expressiveness\n\nIn the previous section we saw that Prolog has traded some expressiveness for efficiency.\nThis section explores the limits of predicate calculus's expressiveness.\n\nSuppose we want to assert that lions, tigers, and bears are kinds of animals.\nIn predicate calculus or in Prolog we could write an implication for each case:\n\n```lisp\n(<- (animal ?x) (lion ?x))\n(<- (animal ?x) (tiger ?x))\n(<- (animal ?x) (bear ?x))\n```\n\nThese implications allow us to prove that any known lion, tiger, or bear is in fact an animal.\nHowever, they do not allow us to answer the question \"What kinds of animals are there?\"\nIt is not hard to imagine extending Prolog so that the query\n\n```lisp\n(?- (<- (animal ?x) ?proposition))\n```\n\nwould be legal.\nHowever, this happens not to be valid Prolog, and it is not even valid first-order predicate calculus (or FOPC).\nIn FOPC the variables must range over constants in the language, not over relations or propositions.\nHigher-order predicate calculus removes this limitation, but it has a more complicated proof theory.\n\nIt is not even clear what the values of `?proposition` should be in the query above.\nSurely `(lion ?x)` would be a valid answer, but so would `(animal ?x), (or (tiger ?x) (bear ?x))`, and an infinite number of other propositions.\nPerhaps we should have two types of queries, one that asks about \"kinds,\" and another that asks about propositions.\n\nThere are other questions that we might want to ask about relations.\nJust as it is useful to declare the types of parameters to a Lisp function, it can be useful to declare the types of the parameters of a relation, and later query those types.\nFor example, we might say that the `likes` relation holds between a person and an object.\n\nIn general, a sentence in the predicate calculus that uses a relation or sentence as a term is called a higher-order sentence.\nThere are some quite subtle problems that come into play when we start to allow higher-order expressions.\nAllowing sentences in the calculus to talk about the truth of other sentences can lead to a paradox: is the sentence \"This sentence is false\" true or false?\n\nPredicate calculus is defined in terms of a universe of individuals and their properties and relations.\nThus it is well suited for a model of the world that picks out individuals and categorizes them-a person here, a building there, a sidewalk between them.\nBut how well does predicate calculus fare in a world of continuous substances?\nConsider a body of water consisting of an indefinite number of subconstituents that are all water, with some of the water evaporating into the air and rising to form clouds.\nIt is not at all obvious how to define the individuals here.\nHowever, Patrick Hayes has shown that when the proper choices are made, predicate calculus can describe this kind of situation quite well.\nThe details are in Hayes 1985.\n\nThe need to define categories is a more difficult problem.\nPredicate calculus works very well for crisp, mathematical categories: *x* is a triangle if and only if *x* is a polygon with three sides.\nUnfortunately, most categories that humans deal with in everyday life are not defined so rigorously.\nThe category *friend* refers to someone you have mostly positive feelings for, whom you can usually trust, and so on.\nThis \"definition\" is not a set of necessary and sufficient conditions but rather is an open-ended list of ill-defined qualities that are highly correlated with the category *friend.* We have a prototype for what an ideal friend should be, but no clear-cut boundaries that separate *friend* from, say, *acquaintance.* Furthermore, the boundaries seem to vary from one situation to another: a person you describe as a good friend in your work place might be only an acquaintance in the context of your home life.\n\nThere are versions of predicate calculus that admit quantifiers like \"most\" in addition to \"for all\" and \"there exists,\" and there have been attempts to define prototypes and measure distances from them.\nHowever, there is no consensus on the way to approach this problem.\n\n## 14.6 Problems with Completeness\n\nBecause Prolog searches depth-first, it can get caught in one branch of the search space and never examine the other branches.\nThis problem can show up, for example, in trying to define a commutative relation, like `sibling`:\n\n```lisp\n(<- (sibling lee kim))\n(<- (sibling ?x ?y) (sibling ?y ?x))\n```\n\nWith these clauses, we expect to be able to conclude that Lee is Kim's sibling, and Kim is Lee's.\nLet's see what happens:\n\n```lisp\n> (?- (sibling ?x ?y))\n?X = LEE\n?Y = KIM;\n?X = KIM\n?Y = LEE;\n?X = LEE\n?Y = KIM;\n?X = KIM\n?Y = LEE.\nNo.\n```\n\nWe get the expected conclusions, but they are deduced repeatedly, because the commutative clause for siblings is applied over and over again.\nThis is annoying, but not critical.\nFar worse is when we ask `(?- (sibling fred ?x))`.\nThis query loops forever.\nHappily, this particular type of example has an easy fix: just introduce two predicates, one for data-base level facts, and one at the level of axioms and queries:\n\n```lisp\n(<- (sibling-fact lee kim))\n(<- (sibling ?x ?y) (sibling-fact ?x ?y))\n(<- (sibling ?x ?y) (sibling-fact ?y ?x))\n```\n\nAnother fix would be to change the interpreter to fail when a repeated goal was detected.\nThis was the approach taken in GPS.\nHowever, even if we eliminated repeated goals, Prolog can still get stuck in one branch of a depth-first search.\nConsider the example:\n\n```lisp\n(<- (natural 0))\n(<- (natural (1+ ?n)) (natural ?n))\n```\n\nThese rules define the natural numbers (the non-negative integers).\nWe can use the rules either to confirm queries like `(natural (1  + (1  + (1  + 0))))` or to generate the natural numbers, as in the query `(natural ?n)`.\nSo far, everything is fine.\nBut suppose we wanted to define all the integers.\nOne approach would be this:\n\n```lisp\n(<- (integer 0))\n(<- (integer ?n) (integer (1+ ?n)))\n(<- (integer (1+ ?n)) (integer ?n))\n```\n\nThese rules say that 0 is an integer, and any *n* is an integer if *n* + 1 is, and *n* + 1 is if *n* is.\nWhile these rules are correct in a logical sense, they don't work as a Prolog program.\nAsking `(integer` *x*`)` will result in an endless series of ever-increasing queries: `(integer (1+` *x*`))`, `(integer (1+ (1+` *x*`)))`, and so on.\nEach goal is different, so no check can stop the recursion.\n\nThe occurs check may or may not introduce problems into Prolog, depending on your interpretation of infinite trees.\nMost Prolog systems do not do the occurs check.\nThe reasoning is that unifying a variable with some value is the Prolog equivalent of assigning a value to a variable, and programmers expect such a basic operation to be fast.\nWith the occurs check turned off, it will in fact be fast.\nWith checking on, it takes time proportional to the size of the value, which is deemed unacceptable.\n\nWith occurs checking off, the programmer gets the benefit of fast unification but can run into problems with circular structures.\nConsider the following clauses:\n\n```lisp\n(<- (parent ?x (mother-of ?x)))\n(<- (parent ?x (father-of ?x)))\n```\n\nThese clauses say that, for any person, the mother of that person and the father of that person are parents of that person.\nNow let us ask if there is a person who is his or her own parent:\n\n```lisp\n> (? (parent ?y ?y))\n?Y = [Abort]\n```\n\nThe system has found an answer, where `?y = (mother-of ?y).` The answer can't be printed, though, because `deref` (or `subst-bindings` in the interpreter) goes into an infinite loop trying to figure out what `?y` is.\nWithout the printing, there would be no infinite loop:\n\n```lisp\n(<- (self-parent) (parent ?y ?y))\n> (? (self-parent))\nYes;\nYes;\nNo.\n```\n\nThe `self-parent` query succeeds twice, once with the mother clause and once with the father clause.\nHas Prolog done the right thing here?\nIt depends on your interpretation of infinite circular trees.\nIf you accept them as valid objects, then the answer is consistent.\nIf you don't, then leaving out the occurs check makes Prolog *unsound:* it can come up with incorrect answers.\n\nThe same problem comes up if we ask if there are any sets that include themselves as members.\nThe query `(member ?set ?set)` will succeed, but we will not be able to print the value of `?set`.\n\n## 14.7 Problems with Efficiency: Indexing\n\nOur Prolog compiler is designed to handle \"programlike\" predicates-predicates with a small number of rules, perhaps with complex bodies.\nThe compiler does much worse on \"tablelike\" predicates-predicates with a large number of simple facts.\nConsider the predicate `pb`, which encodes phone-book facts in the form:\n\n```lisp\n(pb (name Jan Doe) (num 415 555 1212))\n```\n\nSuppose we have a few thousand entries of this kind.\nA typical query for this data base would be:\n\n```lisp\n(pb (name Jan Doe) ?num)\n```\n\nIt would be inefficient to search through the facts linearly, matching each one against the query.\nIt would also be inefficient to recompile the whole `pb/2` predicate every time a new entry is added.\nBut that is just what our compiler does.\n\nThe solutions to the three problems-expressiveness, completeness, and indexing-will be considered in reverse order, so that the most difficult one, expressiveness, will come last.\n\n## 14.8 A Solution to the Indexing Problem\n\nA better solution to the phone-book problem is to index each phone-book entry in some kind of table that makes it easy to add, delete, and retrieve entries.\nThat is what we will do in this section.\nWe will develop an extension of the trie or discrimination tree data structure built in [section 10.5](chapter10.md#s0030) ([page 344](chapter10.md#p344)).\n\nMaking a discrimination tree for Prolog facts is complicated by the presence of variables in both the facts and the query.\nEither facts with variables in them will have to be indexed in several places, or queries with variables will have to look in several places, or both.\nWe also have to decide if the discrimination tree itself will handle variable binding, or if it will just return candidate matches which are then checked by some other process.\nIt is not clear what to store in the discrimination tree: copies of the fact, functions that can be passed continuations, or something else.\nMore design choices will come up as we proceed.\n\nIt is difficult to make design choices when we don't know exactly how the system will be used.\nWe don't know what typical facts will look like, nor typical queries.\nTherefore, we will design a fairly abstract tool, forgetting for the moment that it will be used to index Prolog facts.\n\nWe will address the problem of a discrimination tree where both the keys and queries are predicate structures with wild cards.\nA wild card is a variable, but with the understanding that there is no variable binding; each instance of a variable can match anything.\nA predicate structure is a list whose first element is a nonvariable symbol.\nThe discrimination tree supports three operations:\n\n*   `index` - add a key/value pair to the tree\n\n*   `fetch` - find all values that potentially match a given key\n\n*   `unindex` - remove all key/value pairs that match a given key\n\nTo appreciate the problems, we need an example.\nSuppose we have the following six keys to index.\nFor simplicity, the value of each key will be the key itself:\n\n```lisp\n1 (p a b)\n2 (p a c)\n3 (p a ?x)\n4 (p b c)\n5 (p b (f c))\n6 (p a (f . ?x))\n```\n\nNow assume the query `(p ?y c)`.\nThis should match keys 2, 3, and 4.\nHow could we efficiently arrive at this set?\nOne idea is to list the key/value pairs under every atom that they contain.\nThus, all six would be listed under the atom `p`, while 2, 4, and 5 would be listed under the atom c.\nA unification check could eliminate 5, but we still would be missing 3.\nKey 3 (and every key with a variable in it) could potentially contain the atom `c`.\nSo to get the right answers under this approach, we will need to index every key that contains a variable under every atom-not an appealing situation.\n\nAn alternative is to create indices based on both atoms and their position.\nSo now we would be retrieving all the keys that have a c in the second argument position: 2 and 4, plus the keys that have a variable as the second argument: 3.\nThis approach seems to work much better, at least for the example shown.\nTo create the index, we essentially superimpose the list structure of all the keys on top of each other, to arrive at one big discrimination tree.\nAt each position in the tree, we create an index of the keys that have either an atom or a variable at that position.\n[Figure 14.1](#f0010) shows the discrimination tree for the six keys.\n\n| <a id=\"fig-14-01\"></a>[]() |\n|---|\n| <img src=\"images/chapter14/fig-14-01.svg\" onerror=\"this.src='images/chapter14/fig-14-01.png'; this.onerror=null;\" alt=\"Figure 14.1\" /> |\n| **Figure 14.1: Discrimination Tree with Six Keys** |\n\nConsider the query `(p ?y c)`.\nEither the `p` or the `c` could be used as an index.\nThe `p` in the predicate position retrieves all six keys.\nBut the c in the second argument position retrieves only three keys: 2 and 4, which are indexed under c itself, and 3, which is indexed under the variable in that position.\n\nNow consider the query `(p ?y (f ?z))`.\nAgain, the `p` serves as an index to all six keys.\nThe `f` serves as an index to only three keys: the 5 and 6, which are indexed directly under f in that position, and 3, which is indexed under the variable in a position along the path that lead to f.\nIn general, all the keys indexed under variables along the path must be considered.\n\nThe retrieval mechanism can overretrieve.\nGiven the query `(p a (f ?x))`, the atom `p` will again retrieve all six keys, the atom a retrieves 1, 2, 3, and 6, and f again retrieves 5, 6, and 3.\nSo `f` retrieves the shortest list, and hence it will be used to determine the final result.\nBut key 5 is `(p b (f c))`, which does not match the query `(pa (f?x))`.\n\nWe could eliminate this problem by intersecting all the lists instead of just taking the shortest list.\nIt is perhaps feasible to do the intersection using bit vectors, but probably too slow and wasteful of space to do it using lists.\nEven if we did intersect keys, we would still overretrieve, for two reasons.\nFirst, we don't use nil as an index, so we are ignoring the difference between `(f ?x)` and `(f . ?x)`.\nSecond, we are using wild-card semantics, so the query `(p ?x ?x)` would retrieve all six keys, when it should only retrieve three.\nBecause of these problems, we make a design choice: we will first build a data base retrieval function that retrieves potential matches, and later worry about the unification process that will eliminate mismatches.\n\nWe are ready for a more complete specification of the indexing strategy:\n\n*   The value will be indexed under each non-nil nonvariable atom in the key, with a separate index for each position.\nFor example, given the preceding data base, the atom `a` in the first argument position would index values 1, 2, 3, and 6, while the atom `b` in the second argument position would index value 4 and 5.\nThe atom `p` in the predicate position would index all six values.\n\n*   In addition, we will maintain a separate index for variables at each position.\nFor example, value 3 would be stored under the index \"variable in second argument position.\"\n\n*   \"Position\" does not refer solely to the linear position in the top-level list.\nFor example, value 5 would be indexed under atom f in the caaddr position.\n\n*   It follows that a key with *n* atoms will be indexed in *n* different ways.\n\nFor retrieval, the strategy is:\n\n*   For each non-nil nonvariable atom in the retrieval key, generate a list of possible matches.\nChoose the shortest such list.\n\n*   Each list of possible matches will have to be augmented with the values indexed under a variable at every position \"above.\" For example, `f` in the `caaddr` position retrieves value 5, but it also must retrieve value 3, because the third key has a variable in the `caddr` position, and `caddr` is \"above\" `caaddr.`\n\n*   The discrimination tree may return values that are not valid matches.\nThe purpose of the discrimination tree is to reduce the number of values we will have to unify against, not to determine the exact set of matches.\n\nIt is important that the retrieval function execute quickly.\nIf it is slow, we might just as well match against every key in the table linearly.\nTherefore, we will take care to implement each part efficiently.\nNote that we will have to compare the length of lists to choose the shortest possibility.\nOf course, it is trivial to compare lengths using `length,` but `length` requires traversing the whole list.\nWe can do better if we store the length of the list explicitly.\nA list with its length will be called an `nlist`.\nIt will be implemented as a cons cell containing the number of elements and a list of the elements themselves.\nAn alternative would be to use extensible vectors with fill pointers.\n\n```lisp\n;; An nlist is implemented as a (count . elements) pair:\n(defun make-empty-nlist ()\n  \"Create a new, empty nlist.\"\n  (cons 0 nil))\n\n(defun nlist-n (x) \"The number of elements in an nlist.\" (car x))\n(defun nlist-list (x) \"The elements in an nlist.\" (cdr x))\n\n(defun nlist-push (item nlist)\n  \"Add a new element to an nlist.\"\n  (incf (car nlist))\n  (push item (cdr nlist))\n  nlist)\n```\n\nNow we need a place to store these nlists.\nWe will build the data base out of discrimination tree nodes called dtree nodes.\nEach dtree node has a field to hold the variable index, the atom indices, and pointers to two subnodes, one for the `first` and one for the `rest`.\nWe implement dtrees as vectors for efficiency, and because we will never need a `dtree-p` predicate.\n\n```lisp\n(defstruct (dtree (:type vector))\n  (first nil) (rest nil) (atoms nil) (var (make-empty-nlist)))\n```\n\nA separate dtree will be stored for each predicate.\nSince the predicates must be symbols, it is possible to store the dtrees on the predicate's property list.\nIn most implementations, this will be faster than alternatives such as hash tables.\n\n```lisp\n;; Not all Lisps handle the closure properly, so change the local PREDICATES\n;; to a global *predicates* - norvig Jun 11 1996\n(defvar *predicates* nil)\n\n(defun get-dtree (predicate)\n  \"Fetch (or make) the dtree for this predicate.\"\n  (cond ((get predicate 'dtree))\n        (t (push predicate *predicates*)\n           (setf (get predicate 'dtree) (make-dtree)))))\n\n(defun clear-dtrees ()\n  \"Remove all the dtrees for all the predicates.\"\n  (dolist (predicate *predicates*)\n    (setf (get predicate 'dtree) nil))\n  (setf *predicates* nil))\n```\n\nThe function `index` takes a relation as key and stores it in the dtree for the predicate of the relation.\nIt calls `dtree-index` to do all the work of storing a value under the proper indices for the key in the proper dtree node.\n\nThe atom indices are stored in an association list.\nProperty lists would not work, because they are searched using eq and atoms can be numbers, which are not necessarily `eq`.\nAssociation lists are searched using `eql` by default.\nAn alternative would be to use hash tables for the index, or even to use a scheme that starts with association lists and switches to a hash table when the number of entries gets large.\nI use `lookup` to look up the value of a key in a property list.\nThis function, and its `setf` method, are defined on [page 896](chapter25.md#p896).\n\n```lisp\n(defun index (key)\n  \"Store key in a dtree node.  Key must be (predicate . args);\n  it is stored in the predicate's dtree.\"\n  (dtree-index key key (get-dtree (predicate key))))\n\n(defun dtree-index (key value dtree)\n  \"Index value under all atoms of key in dtree.\"\n  (cond\n    ((consp key)               ; index on both first and rest\n     (dtree-index (first key) value\n                  (or (dtree-first dtree)\n                      (setf (dtree-first dtree) (make-dtree))))\n     (dtree-index (rest key) value\n                  (or (dtree-rest dtree)\n                      (setf (dtree-rest dtree) (make-dtree)))))\n    ((null key))               ; don't index on nil\n    ((variable-p key)          ; index a variable\n     (nlist-push value (dtree-var dtree)))\n    (t ;; Make sure there is an nlist for this atom, and add to it\n     (nlist-push value (lookup-atom key dtree)))))\n\n(defun lookup-atom (atom dtree)\n  \"Return (or create) the nlist for this atom in dtree.\"\n  (or (lookup atom (dtree-atoms dtree))\n      (let ((new (make-empty-nlist)))\n        (push (cons atom new) (dtree-atoms dtree))\n        new)))\n```\n\nNow we define a function to test the indexing routine.\nCompare the output with [figure 14.1](#f0010).\n\n```lisp\n(defun test-index ()\n  (let ((props '((p a b) (p a c) (p a ?x) (p b c)\n                 (p b (f c)) (p a (f . ?x)))))\n    (clear-dtrees)\n    (mapc #'index props)\n    (write (list props (get-dtree 'p))\n           :circle t :array t :pretty t)\n    (values)))\n\n> (test-index)\n((#1=(P A B)\n  #2=(P A C)\n  #3=(P A ?X)\n  #4=(P B C)\n  #5=(P B (F C))\n  #6=(P A (F . ?X)))\n  #(#(NIL NIL (P (6 #6# #5# #4# #3# #2# #1#)) (0))\n  #(#(NIL NIL (B (2 #5# #4#) A (4 #6# #3# #2# #1#)) (0))\n    #(#(#(NIL NIL (F (2 #6# #5#)) (0))\n      #(#(NIL NIL (C (1 #5#)) (0))\n        #(NIL NIL NIL (0)) NIL (1 #6#))\n      (C (2 #4# #2#) B (1 #1#))\n      (1 #3#))\n    #(NIL NIL NIL (0))\n    NIL (0))\n  NIL (0))\n  NIL (0)))\n```\n\nThe next step is to fetch matches from the dtree data base.\nThe function `fetch` takes a query, which must be a valid relation, as its argument, and returns a list of possible matches.\nIt calls `dtree-fetch` to do the work:\n\n```lisp\n(defun fetch (query)\n  \"Return a list of buckets potentially matching the query,\n  which must be a relation of form (predicate . args).\"\n  (dtree-fetch query (get-dtree (predicate query))\n               nil 0 nil most-positive-fixnum))\n```\n\n`dtree-fetch` must be passed the query and the dtree, of course, but it is also passed four additional arguments.\nFirst, we have to accumulate matches indexed under variables as we are searching through the dtree.\nSo two arguments are used to pass the actual matches and a count of their total number.\nSecond, we want `dtree-fetch` to return the shortest possible index, so we pass it the shortest answer found so far, and the size of the shortest answer.\nThat way, as it is making its way down the tree, accumulating values indexed under variables, it can be continually comparing the size of the evolving answer with the best answer found so far.\n\nWe could use nlists to pass around count/values pairs, but nlists only support a push operation, where one new item is added.\nWe need to append together lists of values coming from the variable indices with values indexed under an atom.\nAppend is expensive, so instead we make a list-of-lists and keep the count in a separate variable.\nWhen we are done, `dtree-fetch` and hence `fetch` does a multiple-value return, yielding the list-of-lists and the total count.\n\nThere are four cases to consider in `dtree-fetch.` If the dtree is null or the query pattern is either null or a variable, then nothing will be indexed, so we should just return the best answer found so far.\nOtherwise, we bind `var-n` and `var-list` to the count and list-of-lists of variable matches found so far, including at the current node.\nIf the count `var-n` is greater than the best count so far, then there is no sense continuing, and we return the best answer found.\nOtherwise we look at the query pattern.\nIf it is an atom, we use `dtree-atom-fetch` to return either the current index (along with the accumulated variable index) or the accumulated best answer, whichever is shorter.\nIf the query is a cons, then we use `dtree-fetch` on the first part of the cons, yielding a new best answer, which is passed along to the call of `dtree-fetch` on the rest of the cons.\n\n```lisp\n(defun dtree-fetch (pat dtree var-list-in var-n-in best-list best-n)\n  \"Return two values: a list-of-lists of possible matches to pat,\n  and the number of elements in the list-of-lists.\"\n  (if (or (null dtree) (null pat) (variable-p pat))\n      (values best-list best-n)\n      (let* ((var-nlist (dtree-var dtree))\n             (var-n (+ var-n-in (nlist-n var-nlist)))\n             (var-list (if (null (nlist-list var-nlist))\n                           var-list-in\n                           (cons (nlist-list var-nlist)\n                                 var-list-in))))\n        (cond\n          ((>= var-n best-n) (values best-list best-n))\n          ((atom pat) (dtree-atom-fetch pat dtree var-list var-n\n                                        best-list best-n))\n          (t (multiple-value-bind (list1 n1)\n                 (dtree-fetch (first pat) (dtree-first dtree)\n                              var-list var-n best-list best-n)\n               (dtree-fetch (rest pat) (dtree-rest dtree)\n                            var-list var-n list1 n1)))))))\n\n(defun dtree-atom-fetch (atom dtree var-list var-n best-list best-n)\n  \"Return the answers indexed at this atom (along with the vars),\n  or return the previous best answer, if it is better.\"\n  (let ((atom-nlist (lookup atom (dtree-atoms dtree))))\n    (cond\n      ((or (null atom-nlist) (null (nlist-list atom-nlist)))\n       (values var-list var-n))\n      ((and atom-nlist (< (incf var-n (nlist-n atom-nlist)) best-n))\n       (values (cons (nlist-list atom-nlist) var-list) var-n))\n      (t (values best-list best-n)))))\n```\n\nHere we see a call to `fetch` on the data base created by `test-index`.\nIt returns two values: a list-of-lists of facts, and the total number of facts, three.\n\n```lisp\n(fetch '(p ? c))\n(((P B C) (P A C))\n  ((P A ?X)))\n3\n```\n\nNow let's stop and see what we have accomplished.\nThe functions `fetch and dtree-fetch` fulfill their contract of returning potential matches.\nHowever, we still need to integrate the dtree facility with Prolog.\nWe need to go through the potential matches and determine which candidates are actual matches.\nFor simplicity we will use the version of `unify` with binding lists defined in [section 11.2](chapter11.md#s0020).\n(It is also possible to construct a more efficient version that uses the compiler and the destructive function `unify!`.)\n\nThe function `mapc-retrieve` calls `fetch` to get a list-of-lists of potential matches and then calls `unify` to see if the match is a true one.\nIf the match is true, it calls the supplied function with the binding list that represents the unification as the argument, `mapc-retrieve` is proclaimed `inline` so that functions passed to it can also be compiled in place.\n\n```lisp\n(proclaim '(inline mapc-retrieve))\n\n(defun mapc-retrieve (fn query)\n  \"For every fact that matches the query,\n  apply the function to the binding list.\"\n  (dolist (bucket (fetch query))\n    (dolist (answer bucket)\n      (let ((bindings (unify query answer)))\n        (unless (eq bindings fail)\n          (funcall fn bindings))))))\n```\n\nThere are many ways to use this retriever.\nThe function `retrieve` returns a list of the matching binding lists, and `retrieve-matches` substitutes each binding list into the original query so that the result is a list of expressions that unify with the query.\n\n```lisp\n(defun retrieve (query)\n  \"Find all facts that match query.  Return a list of bindings.\"\n  (let ((answers nil))\n    (mapc-retrieve #'(lambda (bindings) (push bindings answers))\n                   query)\n    answers))\n\n(defun retrieve-matches (query)\n  \"Find all facts that match query.\n  Return a list of expressions that match the query.\"\n  (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n          (retrieve query)))\n```\n\nThere is one further complication to consider.\nRecall that in our original Prolog interpreter, the function prove had to rename the variables in each clause as it retrieved it from the data base.\nThis was to insure that there was no conflict between the variables in the query and the variables in the clause.\nWe could do that in `retrieve`.\nHowever, if we assume that the expressions indexed in discrimination trees are tablelike rather than rulelike and thus are not recursive, then we can get away with renaming the variables only once, when they are entered into the data base.\nThis is done by changing `index`:\n\n```lisp\n(defun index (key)\n \"Store key in a dtree node. Key must be (predicate . args);\n it is stored in the predicate's dtree.\"\n (dtree-index key (rename-variables key) ; store unique vars\n     (get-dtree (predicate key))))\n```\n\nWith the new `index` in place, and after calling `test-index` to rebuild the data base, we are now ready to test the retrieval mechanism:\n\n```lisp\n> (fetch '(p ?x c))\n(((P B C) (P A C))\n  ((P A ?X3408)))\n3\n> (retrieve '(p ?x c))\n(((?X3408 . C) (?X . A))\n  ((?X . A))\n  ((?X . B)))\n> (retrieve-matches '(p ?x c))\n((P A C) (P A C) (P B C))\n> (retrieve-matches '(p ?x (?fn c)))\n((P A (?FN C)) (P A (F C)) (P B (F C)))\n```\n\nActually, it is better to use `mapc-retrieve` when possible, since it doesn't cons up answers the way `retrieve` and `retrieve-matches` do.\nThe macro `query-bind` is provided as a nice interface to `mapc-retrieve`.\nThe macro takes as arguments a list of variables to bind, a query, and one or more forms to apply to each retrieved answer.\nWithin this list of forms, the variables will be bound to the values that satisfy the query.\nThe syntax was chosen to be the same as `multiple-value-bind`.\nHere we see a typical use of `query-bind`, its result, and its macro-expansion:\n\n```lisp\n> (query-bind (?x ?fn) '(p ?x (?fn c))\n  (format t \"~&P holds between ~a and ~a of c.\" ?x ?fn)) =>\nP holds between B and F of c.\nP holds between A and F of c.\nP holds between A and ?FN of c.\nNIL\n= (mapc-retrieve\n  #'(lambda (#:bindings6369)\n    (let ((?x (subst-bindings #:bindings6369 *?x))\n            (?fn (subst-bindings #:bindings6369 *?fn)))\n      (format t \"~&P holds between ~a and ~a of c.\" ?x ?fn)))\n  '(p ?x (?fn c)))\n```\n\nHere is the implementation:\n\n```lisp\n(defmacro query-bind (variables query &body body)\n  \"Execute the body for each match to the query.\n  Within the body, bind each variable.\"\n  (let* ((bindings (gensym \"BINDINGS\"))\n         (vars-and-vals\n           (mapcar\n             #'(lambda (var)\n                 (list var `(subst-bindings ,bindings ',var)))\n             variables)))\n    `(mapc-retrieve\n       #'(lambda (,bindings)\n           (let ,vars-and-vals\n             ,@body))\n       ,query)))\n```\n\n## 14.9 A Solution to the Completeness Problem\n\nWe saw in [chapter 6](chapter6.md) that iterative deepening is an efficient way to cover a search space without falling into an infinite loop.\nIterative deepening can also be used to guide the search in Prolog.\nIt will insure that all valid answers are found eventually, but it won't turn an infinite search space into a finite one.\n\nIn the interpreter, iterative deepening is implemented by passing an extra argument to `prove` and `prove-all` to indicate the depth remaining to be searched.\nWhen that argument is zero, the search is cut off, and the proof fails.\nOn the next iteration the bounds will be increased and the proof may succeed.\nIf the search is never cut off by a depth bound, then there is no reason to go on to the next iteration, because all proofs have already been found.\nThe special variable `*search-cut-off*` keeps track of this.\n\n```lisp\n(defvar *search-cut-off* nil \"Has the search been stopped?\")\n\n(defun prove-all (goals bindings depth)\n  \"Find a solution to the conjunction of goals.\"\n  ;; This version just passes the depth on to PROVE.\n  (cond ((eq bindings fail) fail)\n        ((null goals) bindings)\n        (t (prove (first goals) bindings (rest goals) depth))))\n\n(defun prove (goal bindings other-goals depth)\n  \"Return a list of possible solutions to goal.\"\n  ;; Check if the depth bound has been exceeded\n  (if (= depth 0)                            ;***\n      (progn (setf *search-cut-off* t)       ;***\n             fail)                           ;***\n      (let ((clauses (get-clauses (predicate goal))))\n        (if (listp clauses)\n            (some\n              #'(lambda (clause)\n                  (let ((new-clause (rename-variables clause)))\n                    (prove-all\n                      (append (clause-body new-clause) other-goals)\n                      (unify goal (clause-head new-clause) bindings)\n                      (- depth 1))))          ;***\n              clauses)\n            ;; The predicate's \"clauses\" can be an atom:\n            ;; a primitive function to call\n            (funcall clauses (rest goal) bindings\n                     other-goals depth)))))   ;***\n```\n\n`prove` and `prove-all` now implement search cutoff, but we need something to control the iterative deepening of the search.\nFirst we define parameters to control the iteration: one for the initial depth, one for the maximum depth, and one for the increment between iterations.\nSetting the initial and increment values to one will make the results come out in strict breadth-first order, but will duplicate more effort than a slightly larger value.\n\n```lisp\n(defparameter *depth-start* 5\n  \"The depth of the first round of iterative search.\")\n(defparameter *depth-incr* 5\n  \"Increase each iteration of the search by this amount.\")\n(defparameter *depth-max* most-positive-fixnum\n  \"The deepest we will ever search.\")\n```\n\nA new version of `top-level-prove` will be used to control the iteration.\nIt calls `prove-all` for all depths from the starting depth to the maximum depth, increasing by the increment.\nHowever, it only proceeds to the next iteration if the search was cut off at some point in the previous iteration.\n\n```lisp\n(defun top-level-prove (goals)\n  (let ((all-goals\n          `(,@goals (show-prolog-vars ,@(variables-in goals)))))\n    (loop for depth from *depth-start* to *depth-max* by *depth-incr*\n          while (let ((*search-cut-off* nil))\n                  (prove-all all-goals no-bindings depth)\n                  *search-cut-off*)))\n  (format t \"~&No.\")\n  (values))\n```\n\nThere is one final complication.\nWhen we increase the depth of search, we may find some new proofs, but we will also find all the old proofs that were found on the previous iteration.\nWe can modify `show-prolog-vars` to only print proofs that are found with a depth less than the increment-that is, those that were not found on the previous iteration.\n\n```lisp\n(defun show-prolog-vars (vars bindings other-goals depth)\n  \"Print each variable with its binding.\n  Then ask the user if more solutions are desired.\"\n  (if (> depth *depth-incr*)\n      fail\n      (progn\n        (if (null vars)\n            (format t \"~&Yes\")\n            (dolist (var vars)\n              (format t \"~&~a = ~a\" var\n                      (subst-bindings bindings var))))\n        (if (continue-p)\n            fail\n            (prove-all other-goals bindings depth)))))\n```\n\nTo test that this works, try setting `*depth-max*` to 5 and running the following assertions and query.\nThe infinite loop is avoided, and the first four solutions are found.\n\n```lisp\n(<- (natural 0))\n(<- (natural (1  + ?n)) (natural ?n))\n\n> (?- (natural ?n))\n?N = 0;\n?N = (1  + 0);\n?N = (1  + (1  + 0));\n?N = (1  + (1  + (1  + 0)));\nNo.\n```\n\n## 14.10 Solutions to the Expressiveness Problems\n\nIn this section we present solutions to three of the limitations described above:\n\n*   Treatment of (limited) higher-order predications.\n\n*   Introduction of a frame-based syntax.\n\n*   Support for possible worlds, negation, and disjunction.\n\nWe also introduce a way to attach functions to predicates to do forward-chaining and error detection, and we discuss ways to extend unification to handle Skolem constants and other problems.\n\n### Higher-Order Predications\n\nFirst we will tackle the problem of answering questions like \"What kinds of animals are there?\"\nParadoxically, the key to allowing more expressiveness in this case is to invent a new, more limited language and insist that all assertions and queries are made in that language.\nThat way, queries that would have been higher-order in the original language become first-order in the restricted language.\n\nThe language admits three types of objects: *categories, relations*, and *individuals.* A category corresponds to a one-place predicate, a relation to a two-place predicate, and an individual to constant, or zero-place predicate.\nStatements in the language must have one of five primitive operators: `sub, rel, ind, val`, and `and.` They have the following form:\n\n`(sub` *subcategory super category*)\n\n`(rel` *relation domain-category range-category*)\n\n`(ind` *individual category*)\n\n`(val` *relation individual value*)\n\n`(and` *assertion...*)\n\nThe following table gives some examples, along with English translations:\n\n| []()                         |                                                                |\n|------------------------------|----------------------------------------------------------------|\n| `(sub dog animal)`           | Dog is a kind of animal.                                       |\n| `(rel birthday animal date)` | The birthday relation holds between each animal and some date. |\n| `(ind fido dog)`             | The individual Fido is categorized as a dog.                   |\n| `(val birthday fido july-1)` | The birthday of Fido is July-1.                                |\n| `(and` *A B*`)`              | Both *A* and *B* are true.                                     |\n\nFor those who feel more comfortable with predicate calculus, the following table gives the formal definition of each primitive.\nThe most complicated definition is for rel.\nThe form (rel *R A B*) means that every *R* holds between an individual of *A* and an individual of *B,* and furthermore that every individual of *A* participates in at least one *R* relation.\n\n| []()             |                                                                                                                    |\n|------------------|--------------------------------------------------------------------------------------------------------------------|\n| `(sub` *AB*)     | &forall;*x:A*(*x*) &Superset; *B*(*x*)                                                                             |\n| `(rel` *RAB*)    | &forall;*x,y* : *R*(*x,y*) &Superset; *A*(*x*) A *B*(*y*) *^*&forall;*xA*(*x*) &Superset; &exist;*y* : *R*(*x, y*) |\n| `(ind` *IC)*     | *C*(*I*)                                                                                                           |\n| `(val` *RIV*)    | *R*(*I, V*)                                                                                                        |\n| `(and` *P Q...*) | *P ^ Q...*                                                                                                         |\n\nQueries in the language, not surprisingly, have the same form as assertions, except that they may contain variables as well as constants.\nThus, to find out what kinds of animals there are, use the query `(sub ?kind animal)`.\nTo find out what individual animals there are, use the query `(ind ?x animal)`.\nTo find out what individual animals of what kinds there are, use:\n\n```lisp\n(and (sub ?kind animal) (ind ?x ?kind))\n```\n\nThe implementation of this new language can be based directly on the previous implementation of dtrees.\nEach assertion is stored as a fact in a dtree, except that the components of an `and` assertion are stored separately.\nThe function `add-fact` does this:\n\n```lisp\n(defun add-fact (fact)\n  \"Add the fact to the data base.\"\n  (if (eq (predicate fact) 'and)\n      (mapc #'add-fact (args fact))\n      (index fact)))\n```\n\nQuerying this new data base consists of querying the dtree just as before, but with a special case for conjunctive (and) queries.\nConceptually, the function to do this, `retrieve-fact`, should be as simple as the following:\n\n```lisp\n(defun retrieve-fact (query)\n \"Find all facts that match query. Return a list of bindings.\n Warning!! this version is incomplete.\"\n (if (eq (predicate query) 'and)\n  (retrieve-conjunction (args query))\n  (retrieve query bindings)))\n```\n\nUnfortunately, there are some complications.\nThink about what must be done in `retrieve-conjunction`.\nIt is passed a list of conjuncts and must return a list of binding lists, where each binding list satisfies the query.\nFor example, to find out what people were born on July 1st, we could use the query:\n\n```lisp\n(and (val birthday ?p july-1) (ind ?p person))\n```\n\n`retrieve-conjunction` could solve this problem by first calling `retrieve-fact` on `(val birthday ?p july-1)`.\nOnce that is done, there is only one conjunct remaining, but in general there could be several, so we need to call `retrieve-conjunction` recursively with two arguments: the remaining conjuncts, and the result that `retrieve-fact` gave for the first solution.\nSince `retrieve-fact` returns a list of binding lists, it will be easiest if `retrieve-conjunction` accepts such a list as its second argument.\nFurthermore, when it comes time to call `retrieve-fact` on the second conjunct, we will want to respect the bindings set up by the first conjunct.\nSo `retrieve-fact` must accept a binding list as its second argument.\nThus we have:\n\n```lisp\n(defun retrieve-fact (query &optional (bindings no-bindings))\n  \"Find all facts that match query.  Return a list of bindings.\"\n  (if (eq (predicate query) 'and)\n      (retrieve-conjunction (args query) (list bindings))\n      (retrieve query bindings)))\n\n(defun retrieve-conjunction (conjuncts bindings-lists)\n  \"Return a list of binding lists satisfying the conjuncts.\"\n  (mapcan\n    #'(lambda (bindings)\n        (cond ((eq bindings fail) nil)\n              ((null conjuncts) (list bindings))\n              (t (retrieve-conjunction\n                   (rest conjuncts)\n                   (retrieve-fact\n                     (subst-bindings bindings (first conjuncts))\n                     bindings)))))\n    bindings-lists))\n```\n\nNotice that `retrieve` and therefore `mapc-retrieve` now also must accept a binding list.\nThe changes to them are shown in the following.\nIn each case the extra argument is made optional so that previously written functions that call these functions without passing in the extra argument will still work.\n\n```lisp\n(defun mapc-retrieve (fn query &optional (bindings no-bindings))\n  \"For every fact that matches the query,\n  apply the function to the binding list.\"\n  (dolist (bucket (fetch query))\n    (dolist (answer bucket)\n      (let ((new-bindings (unify query answer bindings)))\n        (unless (eq new-bindings fail)\n          (funcall fn new-bindings))))))\n\n(defun retrieve (query &optional (bindings no-bindings))\n  \"Find all facts that match query.  Return a list of bindings.\"\n  (let ((answers nil))\n    (mapc-retrieve #'(lambda (bindings) (push bindings answers))\n                   query bindings)\n    answers))\n```\n\nNow `add-fact` and `retrieve-fact` comprise all we need to implement the language.\nHere is a short example where `add-fact` is used to add facts about bears and dogs, both as individuals and as species:\n\n```lisp\n> (add-fact '(sub dog animal)) => T\n> (add-fact '(sub bear animal)) => T\n> (add-fact '(ind Fido dog)) => T\n> (add-fact '(ind Yogi bear)) => T\n> (add-fact '(val color Yogi brown)) => T\n> (add-fact '(val color Fido golden)) => T\n> (add-fact '(val latin-name bear ursidae)) => T\n> (add-fact '(val latin-name dog canis-familiaris)) => T\n```\n\nNow `retrieve-fact` is used to answer three questions: What kinds of animals are there?\nWhat are the Latin names of each kind of animal?\nand What are the colors of each individual bear?\n\n```lisp\n> (retrieve-fact '(sub ?kind animal))\n(((?KIND . DOG))\n((?KIND . BEAR)))\n> (retrieve-fact '(and (sub ?kind animal)\n          (val latin-name ?kind ?latin)))\n(((?LATIN . CANIS-FAMILIARIS) (?KIND . DOG))\n  ((?LATIN . URSIDAE) (?KIND . BEAR)))\n> (retrieve-fact '(and (ind ?x bear) (val color ?x ?c)))\n(((?C . BROWN) (?X . YOGI)))\n```\n\n### Improvements\n\nThere are quite a few improvements that can be made to this system.\nOne direction is to provide different kinds of answers to queries.\nThe following two functions are similar to `retrieve-matches` in that they return lists of solutions that match the query, rather than lists of possible bindings:\n\n```lisp\n(defun retrieve-bagof (query)\n  \"Find all facts that match query.\n  Return a list of queries with bindings filled in.\"\n  (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n          (retrieve-fact query)))\n\n(defun retrieve-setof (query)\n  \"Find all facts that match query.\n  Return a list of unique queries with bindings filled in.\"\n  (remove-duplicates (retrieve-bagof query) :test #'equal))\n```\n\nAnother direction to take is to provide better error checking.\nThe current system does not complain if a fact or query is ill-formed.\nIt also relies on the user to input all facts, even those that could be derived automatically from the semantics of existing facts.\nFor example, the semantics of `sub` imply that if `(sub bear animal)` and `(sub polar-bear bear)` are true, then `(sub polar-bear animal)` must also be true.\nThis kind of implication can be handled in two ways.\nThe typical Prolog approach would be to write rules that derive the additional `sub` facts by backward-chaining.\nThen every query would have to check if there were rules to run.\nThe alternative is to use a *forward-chaining* approach, which caches each new `sub` fact by adding it to the data base.\nThis latter alternative takes more storage, but because it avoids rederiving the same facts over and over again, it tends to be faster.\n\nThe following version of `add-fact` does error checking, and it automatically caches facts that can be derived from existing facts.\nBoth of these things are done by a set of functions that are attached to the primitive operators.\nIt is done in a data-driven style to make it easier to add new primitives, should that become necessary.\n\nThe function `add-fact` checks that each argument to a primitive relation is a nonvariable atom, and it also calls `fact-present-p` to check if the fact is already present in the data base.\nIf not, it indexes the fact and calls `run-attached-fn` to do additional checking and caching:\n\n```lisp\n(defparameter *primitives* '(and sub ind rel val))\n(defun add-fact (fact)\n  \"Add the fact to the data base.\"\n  (cond ((eq (predicate fact) 'and)\n      (mapc #'add-fact (args fact)))\n    ((or (not (every #'atom (args fact)))\n        (some #'variable-p (args fact))\n        (not (member (predicate fact) *primitives*)))\n      (error \"Ill-formed fact: ~a\" fact))\n    ((not (fact-present-p fact))\n      (index fact)\n      (run-attached-fn fact)))\n  t)\n(defun fact-present-p (fact)\n  \"Is this fact present in the data base?\"\n  (retrieve fact))\n```\n\nThe attached functions are stored on the operator's property list under the indicator `attached-fn`:\n\n```lisp\n(defun run-attached-fn (fact)\n  \"Run the function associated with the predicate of this fact.\"\n  (apply (get (predicate fact) 'attached-fn) (args fact)))\n\n(defmacro def-attached-fn (pred args &body body)\n  \"Define the attached function for a primitive.\"\n  `(setf (get ',pred 'attached-fn)\n         #'(lambda ,args .,body)))\n```\n\nThe attached functions for `ind` and `val` are fairly simple.\nIf we know `(sub bear animal)`, then when `(ind Yogi bear)` is asserted, we have to also assert `(ind Yogi animal)`.\nSimilarly, the values in a `val` assertion must be individuals of the categories in the relation's `rel` assertion.\nThat is, if `(rel birthday animal date)` is a fact and `(val birthday Lee july-1)` is added, then we can conclude `(ind Lee animal)` and `(ind july-1 date).` The following functions add the appropriate facts:\n\n```lisp\n(def-attached-fn ind (individual category)\n  ;; Cache facts about inherited categories\n  (query-bind (?super) `(sub ,category ?super)\n    (add-fact `(ind ,individual ,?super))))\n\n(def-attached-fn val (relation ind1 ind2)\n  ;; Make sure the individuals are the right kinds\n  (query-bind (?cat1 ?cat2) `(rel ,relation ?cat1 ?cat2)\n    (add-fact `(ind ,ind1 ,?cat1))\n    (add-fact `(ind ,ind2 ,?cat2))))\n```\n\nThe attached function for rel simply runs the attached function for any individual of the given relation.\nNormally one would make all `rel` assertions before `ind` assertions, so this will have no effect at all.\nBut we want to be sure the data base stays consistent even if facts are asserted in an unusual order.\n\n```lisp\n(def-attached-fn rel (relation cat1 cat2)\n  ;; Run attached function for any IND's of this relation\n  (query-bind (?a ?b) `(ind ,relation ?a ?b)\n    (run-attached-fn `(ind ,relation ,?a ,?b))))\n```\n\nThe most complicated attached function is for `sub`.\nAdding a fact such as `(sub bear animal)` causes the following to happen:\n\n*   All of `animal`'s supercategories (such as `living-thing)` become supercategories of all of `bear`'s subcategories (such as `polar-bear`).\n\n*   `animal` itself becomes a supercategory all of `bear`'s subcategories.\n\n*   `bear` itself becomes a subcategory of all of `animal`'s supercategories.\n\n*   All of the individuals of `bear` become individuals of `animal` and its supercategories.\n\nThe following accomplishes these four tasks.\nIt does it with four calls to `index-new-fact`, which is used instead of `add-fact` because we don't need to run the attached function on the new facts.\nWe do, however, need to make sure that we aren't indexing the same fact twice.\n\n```lisp\n(def-attached-fn sub (subcat supercat)\n  ;; Cache SUB facts\n  (query-bind (?super-super) `(sub ,supercat ?super-super)\n    (index-new-fact `(sub ,subcat ,?super-super))\n    (query-bind (?sub-sub) `(sub ?sub-sub ,subcat)\n      (index-new-fact `(sub ,?sub-sub ,?super-super))))\n  (query-bind (?sub-sub) `(sub ?sub-sub ,subcat)\n    (index-new-fact `(sub ,?sub-sub ,supercat)))\n  ;; Cache IND facts\n  (query-bind (?super-super) `(sub ,subcat ?super-super)\n    (query-bind (?sub-sub) `(sub ?sub-sub ,supercat)\n      (query-bind (?ind) `(ind ?ind ,?sub-sub)\n        (index-new-fact `(ind ,?ind ,?super-super))))))\n\n(defun index-new-fact (fact)\n  \"Index the fact in the data base unless it is already there.\"\n  (unless (fact-present-p fact)\n    (index fact)))\n```\n\nThe following function tests the attached functions.\nIt shows that adding the single fact `(sub bear animal)` to the given data base causes 18 new facts to be added.\n\n```lisp\n(defun test-bears ()\n  (clear-dtrees)\n  (mapc #'add-fact\n      '((sub animal living-thing)\n        (sub living-thing thing) (sub polar-bear bear)\n        (sub grizzly bear) (ind Yogi bear) (ind Lars polar-bear)\n        (ind Helga grizzly)))\n  (trace index)\n  (add-fact '(sub bear animal))\n  (untrace index))\n>(test-bears)\n(1 ENTER INDEX: (SUB BEAR ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB BEAR THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB GRIZZLY THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB POLAR-BEAR THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB BEAR LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB GRIZZLY LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB POLAR-BEAR LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB GRIZZLY ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (SUB POLAR-BEAR ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND LARS LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND HELGA LIVING-THING)\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND YOGI LIVING-THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND LARS THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND HELGA THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND YOGI THING))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND LARS ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND HELGA ANIMAL))\n(1 EXIT INDEX: T)\n(1 ENTER INDEX: (IND YOGI ANIMAL))\n(1 EXIT INDEX: T)\n(INDEX)\n```\n\n### A Frame Language\n\nAnother direction we can take is to provide an alternative syntax that will be easier to read and write.\nMany representation languages are based on the idea of *frames,* and their syntax reflects this.\nA frame is an object with slots.\nWe will continue to use the same data base in the same format, but we will provide an alternative syntax that considers the individuals and categories as frames, and the relations as slots.\n\nHere is an example of the frame syntax for individuals, which uses the operator `a`.\nNote that it is more compact than the equivalent notation using the primitives.\n\n```lisp\n(a person (name Joe) (age 27)) =\n(and (ind person1 person)\n  (val name person1 Joe)\n  (val age person1 27))\n```\n\nThe syntax also allows for nested expressions to appear as the values of slots.\nNotice that the Skolem constant `person1` was generated automatically; an alternative is to supply a constant for the individual after the category name.\nFor example, the following says that Joe is a person of age 27 whose best friend is a person named Fran who is 28 and whose best friend is Joe:\n\n```lisp\n(a person p1 (name Joe) (age 27)\n  (best-friend (a person (name Fran) (age 28)\n          (best-friend pl)))) =\n(and (ind p1 person) (val name p1 joe) (val age p1 27)\n  (ind person2 person) (val name person2 fran)\n  (val age person2 28) (val best-friend person2 pl)\n  (val best-friend p1 person2))\n```\n\nThe frame syntax for categories uses the operator `each`.\nFor example:\n\n```lisp\n(each person (isa animal) (name person-name) (age integer)) =\n(and (sub person animal)\n  (rel name person person-name)\n  (rel age person integer))\n```\n\nThe syntax for queries is the same as for assertions, except that variables are used instead of the Skolem constants.\nThis is true even when the Skolem constants are automatically generated, as in the following query:\n\n```lisp\n(a person (age 27)) = (AND (IND ?3 PERSON) (VAL AGE ?3 27))\n```\n\nTo support the frame notation, we define the macros `a` and `each` to make assertions and `??` to make queries.\n\n```lisp\n(defmacro a (&rest args)\n \"Define a new individual and assert facts about it in the data base.\"\n '(add-fact ',(translate-exp (cons 'a args))))\n(defmacro each (&rest args)\n \"Define a new category and assert facts about it in the data base.\"\n '(add-fact ',(translate-exp (cons 'each args))))\n(defmacro ?? (&rest queries)\n \"Return a list of answers satisfying the query or queries.\"\n '(retrieve-setof\n  '.(translate-exp (maybe-add 'and (replace-?-vars queries))\n     :query)))\n```\n\nAll three of these macros call on `translate-exp` to translate from the frame syntax to the primitive syntax.\nNote that an `a` or `each` expression is computing a conjunction of primitive relations, but it is also computing a *term* when it is used as the nested value of a slot.\nIt would be possible to do this by returning multiple values, but it is easier to build `translate-exp` as a set of local functions that construct facts and push them on the local variable `conjuncts`.\nAt the end, the list of `conjuncts` is returned as the value of the translation.\nThe local functions `translate-a` and `translate-each` return the atom that represents the term they are translating.\nThe local function `translate` translates any kind of expression, `translate-slot` handles a slot, and `collect-fact` is responsible for pushing a fact onto the list of conjuncts.\nThe optional argument `query-mode-p` tells what to do if the individual is not provided in an `a` expression.\nIf `query-mode-p` is true, the individual will be represented by a variable; otherwise it will be a Skolem constant.\n\n```lisp\n(defun translate-exp (exp &optional query-mode-p)\n  \"Translate exp into a conjunction of the four primitives.\"\n  (let ((conjuncts nil))\n    (labels\n      ((collect-fact (&rest terms) (push terms conjuncts))\n        (translate (exp)\n          ;; Figure out what kind of expression this is\n          (cond\n            ((atom exp) exp)\n            ((eq (first exp) 'a) (translate-a (rest exp)))\n            ((eq (first exp) 'each) (translate-each (rest exp)))\n            (t (apply #'collect-fact exp) exp)))\n        (translate-a (args)\n          ;; translate (A category [ind] (rel filler)*)\n          (let* ((category (pop args))\n              (self (cond ((and args (atom (first args)))\n                  (pop args))\n                (query-mode-p (gentemp \"?\"))\n                (t (gentemp (string category))))))\n            (collect-fact 'ind self category)\n            (dolist (slot args)\n              (translate-slot 'val self slot))\n            self))\n        (translate-each (args)\n          ;; translate (EACH category [(isa cat*)] (slot cat)*)\n          (let* ((category (pop args)))\n            (when (eq (predicate (first args)) 'isa)\n              (dolist (super (rest (pop args)))\n                (collect-fact 'sub category super)))\n            (dolist (slot args)\n              (translate-slot 'rel category slot))\n            category))\n        (translate-slot (primitive self slot)\n          ;; translate (relation value) into a REL or SUB\n          (assert (= (length slot) 2))\n          (collect-fact primitive (first slot) self\n                  (translate (second slot)))))\n      ;; Body of translate-exp:\n      (translate exp) ;; Build up the list of conjuncts\n      (maybe-add 'and (nreverse conjuncts)))))\n```\n\nThe auxiliary functions `maybe-add` and `replace-?-vars` are shown in the following:\n\n```lisp\n(defun maybe-add (op exps &optional if-nil)\n  \"For example, (maybe-add 'and exps t) returns\n  t if exps is nil, (first exps) if there is only one,\n  and (and expl exp2...) if there are several exps.\"\n  (cond ((null exps) if-nil)\n    ((length=1 exps) (first exps))\n    (t (cons op exps))))\n(defun length=1 (x)\n  \"Is x a list of length 1?\"\n  (and (consp x) (null (cdr x))))\n(defun replace-?-vars (exp)\n  \"Replace each ? in exp with a temporary var: ?123\"\n  (cond ((eq exp '?) (gentemp \"?\"))\n    ((atom exp) exp)\n    (t (reuse-cons (replace-?-vars (first exp))\n          (replace-?-vars (rest exp))\n          exp))))\n```\n\n### Possible Worlds: Truth, Negation, and Disjunction\n\nIn this section we address four problems: distinguishing `unknown` from `false`, representing negations, representing disjunctions, and representing multiple possible states of affairs.\nIt turns out that all four problems can be solved by introducing two new techniques: possible worlds and negated predicates.\nThe solution is not completely general, but it is practical in a wide variety of applications.\n\nThere are two basic ways to distinguish unknown from false.\nThe first possibility is to store a truth value-`true` or `false`-along with each proposition.\nThe second possibility is to include the truth value as part of the proposition.\nThere are several syntactic variations on this theme.\nThe following table shows the possibilities for the propositions \"Jan likes Dean is true\" and \"Jan likes Ian is false:\"\n\n| Approach | True Prop.                 | False Prop.                |\n|----------|----------------------------|----------------------------|\n| (1)      | `(likes Jan Dean) -- true` | `(likes Jan Ian) -- false` |\n| (2a)     | `(likes true Jan Dean)`    | `(likes false Jan Ian)`    |\n| (2b)     | `(likes Jan Dean)`         | `(not (likes Jan Dean))`   |\n| (2c)     | `(likes Jan Dean)`         | `(~likes Jan Dean)`        |\n\nThe difference between (1) and (2) shows up when we want to make a query.\nWith (1), we make the single query `(likes Jan Dean)` (or perhaps `(likes Jan ?x))`, and the answers will tell us who Jan does and does not like.\nWith (2), we make one query to find out what liking relationships are true, and another to find out which ones are false.\nIn either approach, if there are no responses then the answer is truly unknown.\n\nApproach (1) is better for applications where most queries are of the form \"Is this sentence true or false?\" But applications that include backward-chaining rules are not like this.\nThe typical backward-chaining rule says \"Conclude X is true if Y is true.\" Thus, most queries will be of the type \"Is Y true?\" Therefore, some version of approach (2) is preferred.\n\nRepresenting true and false opens the door to a host of possible extensions.\nFirst, we could add multiple truth values beyond the simple \"true\" and \"false.\" These could be symbolic values like \"probably-true\" or \"false-by-default\" or they could be numeric values representing probabilities or certainty factors.\n\nSecond, we could introduce the idea of *possible worlds.*\nThat is, the truth of a proposition could be unknown in the current world, but true if we assume *p*, and false if we assume *q.*\nIn the possible world approach, this is handled by calling the current world *W*, and then creating a new world *W*<sub>1</sub>, which is just like *W* except that *p* is true, and *W*<sub>2</sub>, which is just like *W* except that *q* is true.\nBy doing reasoning in different worlds we can make predictions about the future, resolve ambiguities about the current state, and do reasoning by cases.\n\nFor example, possible worlds allow us to solve Moore's communism/democracy problem ([page 466](#p466)).\nWe create two new possible worlds, one where *E* is a democracy and one where it is communist.\nIn each world it is easy to derive that there is a democracy next to a communist country.\nThe trick is to realize then that the two worlds form a partition, and that therefore the assertion holds in the original \"real\" world as well.\nThis requires an interaction between the Prolog-based tactical reasoning going on within a world and the planning-based strategic reasoning that decides which worlds to consider.\n\nWe could also add a *truth maintenance system* (or TMS) to keep track of the assumptions or justifications that lead to each fact being considered true.\nA truth maintenance system can lessen the need to backtrack in a search for a global solution.\nAlthough truth maintenance systems are an important part of AI programming, they will not be covered in this book.\n\nIn this section we extend the dtree facility ([section 14.8](#s0045)) to handle truth values and possible worlds.\nWith so many options, it is difficult to make design choices.\nWe will choose a fairly simple system, one that remains close to the simplicity and speed of Prolog but offers additional functionality when needed.\nWe will adopt approach (2c) to truth values, using negated predicates.\nFor example, the negated predicate of `likes` is `~likes`, which is pronounced \"not likes.\"\n\nWe will also provide minimal support for possible worlds.\nAssume that there is always a current world, *W,* and that there is a way to create alternative worlds and change the current world to an alternative one.\nAssertions and queries will always be made with respect to the current world.\nEach fact is indexed by the atoms it contains, just as before.\nThe difference is that the facts are also indexed by the current world.\nTo support this, we need to modify the notion of the numbered list, or `nlist`, to include a numbered association list, or `nalist`.\nThe following is an `nalist` showing six facts indexed under three different worlds: `W0, Wl`, and `W2`:\n\n```lisp\n(6 (W0 #1# #2# #3#) (Wl #4#) (W2 #5# #6#))\n```\n\nThe fetching routine will remain unchanged, but the postfetch processing will have to sort through the nalists to find only the facts in the current world.\nIt would also be possible for `fetch` to do this work, but the reasoning is that most facts will be indexed under the \"real world,\" and only a few facts will exist in alternative, hypothetical worlds.\nTherefore, we should delay the effort of sorting through the answers to eliminate those answers in the wrong world-it may be that the first answer fetched will suffice, and then it would have been a waste to go through and eliminate other answers.\nThe following changes to `index` and `dtree-index` add support for worlds:\n\n```lisp\n(defvar *world* 'W0 \"The current world used by index and fetch.\")\n(defun index (key &optional (world *world*))\n \"Store key in a dtree node. Key must be (predicate . args);\n it is stored in the dtree, indexed by the world.\"\n (dtree-index key key world (get-dtree (predicate key))))\n(defun dtree-index (key value world dtree)\n \"Index value under all atoms of key in dtree.\"\n (cond\n  ((consp key)  ; index on both first and rest\n   (dtree-index (first key) value world\n      (or (dtree-first dtree)\n       (setf (dtree-first dtree) (make-dtree))))\n   (dtree-index (rest key) value world\n      (or (dtree-rest dtree)\n       (setf (dtree-rest dtree) (make-dtree)))))\n  ((null key))  ; don't index on nil\n  ((variable-p key)  ; index a variable\n   (nalist-push world value (dtree-var dtree)))\n  (t ;; Make sure there is an nlist for this atom. and add to it\n   (nalist-push world value (lookup-atom key dtree)))))\n```\n\nThe new function `nalist-push` adds a value to an nalist, either by inserting the value in an existing key's list or by adding a new key/value list:\n\n```lisp\n(defun nalist-push (key val nalist)\n  \"Index val under key in a numbered alist.\"\n  ;; An nalist is of the form (count (key val*)*)\n  ;; Ex: (6 (nums 12 3) (letters a b c))\n  (incf (car nalist))\n  (let ((pair (assoc key (cdr nalist))))\n    (if pair\n      (push val (cdr pair))\n      (push (list key val) (cdr nalist)))))\n```\n\nIn the following, `fetch` is used on the same data base created by `test-index`, indexed under the world `W0`.\nThis time the result is a list-of-lists of world/values a-lists.\nThe count, 3, is the same as before.\n\n```lisp\n>(fetch '(p ?x c))\n(((W0 (P B C) (P A C)))\n  ((W0 (P A ?X))))\n3\n```\n\nSo far, worlds have been represented as symbols, with the implication that different symbols represent completely distinct worlds.\nThat doesn't make worlds very easy to use.\nWe would like to be able to use worlds to explore alternatives-create a new hypothetical world, make some assumptions (by asserting them as facts in the hypothetical world), and see what can be derived in that world.\nIt would be tedious to have to copy all the facts from the real world into each hypothetical world.\n\nAn alternative is to establish an inheritance hierarchy among worlds.\nThen a fact is considered true if it is indexed in the current world or in any world that the current world inherits from.\n\nTo support inheritance, we will implement worlds as structures with a name field and a field for the list of parents the world inherits from.\nSearching through the inheritance lattice could become costly, so we will do it only once each time the user changes worlds, and mark all the current worlds by setting the `current` field on or off.\nHere is the definition for the world structure:\n\n```lisp\n(defstruct (world (:print-function print-world))\n  name parents current)\n```\n\nWe will need a way to get from the name of a world to the world structure.\nAssuming names are symbols, we can store the structure on the name's property list.\nThe function `get-world` gets the structure for a name, or builds a new one and stores it.\n`get-world` can also be passed a world instead of a name, in which case it just returns the world.\nWe also include a definition of the default initial world.\n\n```lisp\n(defun get-world (name &optional current (parents (list *world*)))\n  \"Look up or create the world with this name.\n  If the world is new, give it the list of parents.\"\n  (cond ((world-p name) name) ; ok if it already is a world\n      ((get name 'world))\n      (t (setf (get name 'world)\n          (make-world :name name :parents parents\n            :current current)))))\n(defvar *world* (get-world 'W0 nil nil)\n  \"The current world used by index and fetch.\")\n```\n\nThe function `use-world` is used to switch to a new world.\nIt first makes the current world and all its parents no longer current, and then makes the new chosen world and all its parents current.\nThe function `use-new-world` is more efficient in the common case where you want to create a new world that inherits from the current world.\nIt doesn't have to turn any worlds off; it just creates the new world and makes it current.\n\n```lisp\n(defun use-world (world)\n  \"Make this world current.\"\n  ;; If passed a name, look up the world it names\n  (setf world (get-world world))\n  (unless (eq world *world*)\n    ;; Turn the old world(s) off and the new one(s) on,\n    ;; unless we are already using the new world\n    (set-world-current *world* nil)\n    (set-world-current world t)\n    (setf *world* world)))\n(defun use-new-world ()\n  \"Make up a new world and use it.\n  The world inherits from the current world.\"\n  (setf *wor1d* (get-world (gensym \"W\")))\n  (setf (world-current *world*) t)\n  *world*)\n(defun set-world-current (world on/off)\n  \"Set the current field of world and its parents on or off.\"\n  ;; nil is off, anything else is on.\n  (setf (world-current world) on/off)\n  (dolist (parent (world-parents world))\n    (set-world-current parent on/off)))\n```\n\nWe also add a print function for worlds, which just prints the world's name.\n\n```lisp\n(defun print-world (world &optional (stream t) depth)\n  (declare (ignore depth))\n  (prin1 (world-name world) stream))\n```\n\nThe format of the dtree data base has changed to include worlds, so we need new retrieval functions to search through this new format.\nHere the functions `mapc-retrieve, retrieve`, and `retrieve-bagof` are modified to give new versions that treat worlds.\nTo reflect this change, the new functions all have names ending in -`in-world`:\n\n```lisp\n(defun mapc-retrieve-in-world (fn query)\n \"For every fact in the current world that matches the query,\n apply the function to the binding list.\"\n (dolist (bucket (fetch query))\n  (dolist (world/entries bucket)\n   (when (world-current (first world/entries))\n    (dolist (answer (rest world/entries))\n     (let ((bindings (unify query answer)))\n      (unless (eq bindings fall)\n       (funcall fn bindings))))))))\n(defun retrieve-in-world (query)\n \"Find all facts that match query. Return a list of bindings.\"\n (let ((answers nil))\n  (mapc-retrieve-in-world\n   #'(lambda (bindings) (push bindings answers))\n   query)\n  answers))\n(defun retrieve-bagof-in-world (query)\n \"Find all facts in the current world that match query.\n Return a list of queries with bindings filled in.\"\n (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n     (retrieve-in-world query)))\n```\n\nNow let's see how these worlds work.\nFirst, in `W0` we see that the facts from `test-index` are still in the data base:\n\n```lisp\n> *world* => W0\n\n> (retrieve-bagof-in-world '(p ?z c)) =>\n((P A C) (P A C) (P B C))\n```\n\nNow we create and use a new world that inherits from `W0`.\nTwo new facts are added to this new world:\n\n```lisp\n> (use-new-world) => W7031\n> (index '(p new c)) => T\n> (index '(~p b b)) => T\n```\n\nWe see that the two new facts are accessible in this world:\n\n```lisp\n> (retrieve-bagof-in-world '(p ?z c)) =>\n((P A C) (P A C) (P B C) (P NEW C))\n\n> (retrieve-bagof-in-world '(~p ?x ?y)) =>\n((~P B B))\n```\n\nNow we create another world as an alternative to the current one by first switching back to the original `W0`, then creating the new world, and then adding some facts:\n\n```lisp\n> (use-world 'W0) => W0\n> (use-new-world) => W7173\n> (index '(p newest c)) => T\n> (index '(~p c newest)) => T\n```\n\nHere we see that the facts entered in `W7031` are not accessible, but the facts in the new world and in `W0` are:\n\n```lisp\n> (retrieve-bagof-in-world '(p ?z c)) =>\n((P A C) (P A C) (P B C) (P NEWEST C))\n\n> (retrieve-bagof-in-world '(~p ?x ?y)) =>\n((~P C NEWEST))\n```\n\n### Unification, Equality, Types, and Skolem Constants\n\nThe lesson of the zebra puzzle in [section 11.4](chapter11.md#s0040) was that unification can be used to lessen the need for backtracking, because an uninstantiated logic variable or partially instantiated term can stand for a whole range of possible solutions.\nHowever, this advantage can quickly disappear when the representation forces the problem solver to enumerate possible solutions rather than treating a whole range of solutions as one.\nFor example, consider the following query in the frame language and its expansion into primitives:\n\n```lisp\n(a person (name Fran))\n= (and (ind ?p person) (val name ?p fran))\n```\n\nThe way to answer this query is to enumerate all individuals `?p` of type `person` and then check the `name` slot of each such person.\nIt would be more efficient if `(ind ?p person)` did not act as an enumeration, but rather as a constraint on the possible values of `?p`.\nThis would be possible if we changed the definition of variables (and of the unification function) so that each variable had a type associated with it.\nIn fact, there are at least three sources of information that have been implemented as constraints on variables terms:\n\n*   The type or category of the term.\n\n*   The members or size of a term considered as a set or list.\n\n*   Other terms this term is equal or not equal to.\n\nNote that with a good solution to the problem of equality, we can solve the problem of Skolem constants.\nThe idea is that a regular constant unifies with itself but no other regular constant.\nOn the other hand, a Skolem constant can potentially unify with any other constant (regular or Skolem).\nThe equality mechanism is used to keep track of each Skolem variable's possible bindings.\n\n## 14.11 History and References\n\n[Brachman and Levesque (1985)](bibliography.md#bb0115) collect thirty of the key papers in knowledge representation.\nIncluded are some early approaches to semantic network based ([Quillian 1967](bibliography.md#bb0965)) and logic-based ([McCarthy 1968](bibliography.md#bb0805)) representation.\nTwo thoughtful critiques of the ad hoc use of representations without defining their meaning are by [Woods (1975)](bibliography.md#bb1430) and [McDermott (1978)](bibliography.md#bb0820).\nIt is interesting to contrast the latter with [McDermott 1987](bibliography.md#bb0825), which argues that logic by itself is not sufficient to solve the problems of AI.\nThis argument should not be surprising to those who remember the slogan *logic = algorithm - control.*\n\n[Genesereth and Nilsson's textbook (1987)](bibliography.md#bb0455) cover the predicate-calculus-based approach to knowledge representation and AI in general.\n[Ernest Davis (1990)](bibliography.md#bb0275) presents a good overview of the field that includes specialized representations for time, space, qualitative physics, propositional attitudes, and the interaction between agents.\n\nMany representation languages focus on the problem of defining descriptions for categories of objects.\nThese have come to be known as *term-subsumption languages.*\nExamples include KL-ONE ([Schmolze and Lipkis 1983](bibliography.md#bb1060)) and KRYPTON ([Brachman, Fikes, and Levesque 1983](bibliography.md#bb0120)).\nSee [Lakoff 1987](bibliography.md#bb0685) for much more on the problem of categories and prototypes.\n\nHector [Levesque (1986)](bibliography.md#bb0720) points out that the areas Prolog has difficulty with-disjunction, negation, and existentials-all involve a degree of vagueness.\nIn his term, they lack *vividness.* A vivid proposition is one that could be represented directly in a picture: the car is blue; she has a martini in her left hand; Albany is the capital of New York.\nNonvivid propositions cannot be so represented: the car is not blue; she has a martini in one hand; either Albany or New York City is the capital of New York.\nThere is interest in separating vivid from nonvivid reasoning, but no current systems are actually built this way.\n\nThe possible world approach of [section 14.10](#s0055) was used in the MRS system ([Russell 1985](bibliography.md#bb1020)).\nMore recent knowledge representation systems tend to use truth maintenance systems instead of possible worlds.\nThis approach was pioneered by [Doyle (1979)](bibliography.md#bb0340) and [McAllester (1982)](bibliography.md#bb0785).\nDoyle tried to change the name to \"reason maintenance,' in (1983), but it was too late.\nThe version in widest used today is the assumption-based truth maintenance system, or ATMS, developed by de Kleer (1986a,b,c).\n[Charniak et al.\n(1987)](bibliography.md#bb0180) present a complete Common Lisp implementation of a McAllester-style TMS.\n\nThere is little communication between the logic programming and knowledge representation communities, even though they cover overlapping territory.\n[Colmerauer (1990)](bibliography.md#bb0250) and [Cohen (1990)](bibliography.md#bb0230) describe Logic Programming languages that address some of the issues covered in this chapter.\nKey papers in equality reasoning include Galler and Fisher 1974, [Kornfeld 1983](bibliography.md#bb0645),<a id=\"tfn14-1\"></a><sup>[1](#fn14-1)</sup>\nJaffar, Lassez, and Maher 1984, and [van Emden and Yukawa 1987](bibliography.md#bb1265).\n[H&ouml;lldobler's book (1987)](bibliography.md#bb0550) includes an overview of the area.\nPapers on extending unification in ways other than equality include [A&iuml;t-Kaci et al.\n1987](bibliography.md#bb0025) and [Staples and Robinson 1988](bibliography.md#bb1125).\nFinally, papers on extending Prolog to cover disjunction and negation (i.e., non-Horn clauses) include [Loveland 1987](bibliography.md#bb0755), [Plaisted 1988](bibliography.md#bb0960), and [Stickel 1988](bibliography.md#bb1200).\n\n## 14.12 Exercises\n\n**Exercise  14.1 [m]** Arrange to store dtrees in a hash table rather than on the property list of predicates.\n\n**Exercise  14.2 [m]** Arrange to store the `dtree-atoms` in a hash table rather than in an association list.\n\n**Exercise  14.3 [m]** Change the `dtree` code so that `nil` is used as an atom index.\nTime the performance on an application and see if the change helps or hurts.\n\n**Exercise  14.4 [m]** Consider the query `(p a b c d e f g)`.\nIf the index under a returns only one or two keys, then it is probably a waste of time for `dtree-fetch` to consider the other keys in the hope of finding a smaller bucket.\nIt is certainly a waste if there are no keys at all indexed under `a`.\nMake appropriate changes to `dtree-fetch`.\n\n**Exercise  14.5 [h]** Arrange to delete elements from a `dtree`.\n\n**Exercise  14.6 [h]** Implement iterative-deepening search in the Prolog compiler.\nYou will have to change each function to accept the depth as an extra argument, and compile in checks for reaching the maximum depth.\n\n**Exercise  14.7 [d]** Integrate the Prolog compiler with the dtree data base.\nUse the dtrees for predicates with a large number of clauses, and make sure that each predicate that is implemented as a dtree has a Prolog primitive accessing the dtree.\n\n**Exercise  14.8 [d]** Add support for possible worlds to the Prolog compiler with dtrees.\nThis support has already been provided for dtrees, but you will have to provide it for ordinary Prolog rules.\n\n**Exercise  14.9 [h]** Integrate the language described in [section 14.10](#s0055) and the frame syntax from [section 14.10](#s0055) with the extended Prolog compiler from the previous exercise.\n\n**Exercise  14.10 [d]** Build a strategic reasoner that decides when to create a possible world and does reasoning by cases over these worlds.\nUse it to solve Moore's problem ([page 466](#p466)).\n\n## 14.13 Answers\n\n**Answer 14.1**\n\n```lisp\n(let ((dtrees (make-hash-table :test #'eq)))\n  (defun get-dtree (predicate)\n    \"Fetch (or make) the dtree for this predicate.\"\n    (setf (gethash predicate dtrees)\n        (or (gethash predicate dtrees)\n          (make-dtree))))\n  (defun clear-dtrees ()\n  \"Remove all the dtrees for all the predicates.\"\n  (clrhash dtrees)))\n```\n\n**Answer 14.5** Hint: here is the code for `nlist-delete`.\nNow figure out how to find all the nlists that an item is indexed under.\n\n```lisp\n(defun nlist-delete (item nlist)\n  \"Remove an element from an nlist.\n  Assumes that item is present exactly once.\"\n  (decf (car nlist))\n  (setf (cdr nlist) (delete item (cdr nlist) :count 1))\n  nlist)\n```\n\n----------------------\n\n<a id=\"fn14-1\"></a><sup>[1](#tfn14-1)</sup>\nA commentary on this paper appears in [Elcock and Hoddinott 1986](bibliography.md#bb0360).\n"
  },
  {
    "path": "docs/chapter15.md",
    "content": "# Chapter 15\n## Symbolic Mathematics with Canonical Forms\n\n> Anything simple always interests me.\n\n> -David Hockney\n\n[Chapter 8](chapter8.md) started with high hopes: to take an existing pattern matcher, copy down some mathematical identities out of a reference book, and come up with a usable symbolic algebra system.\nThe resulting system *was* usable for some purposes, and it showed that the technique of rule-based translation is a powerful one.\nHowever, the problems of [section 8.5](chapter8.md#s0030) show that not everything can be done easily and efficiently within the rule-based pattern matching framework.\n\nThere are important mathematical transformations that are difficult to express in the rule-based approach.\nFor example, dividing two polynomials to obtain a quotient and remainder is a task that is easier to express as an algorithm-a program-than as a rule or set of rules.\n\nIn addition, there is a problem with efficiency.\nPieces of the input expressions are simplified over and over again, and much time is spent interpreting rules that do not apply.\n[Section 9.6](chapter9.md#s0035) showed some techniques for speeding up the program by a factor of 100 on inputs of a dozen or so symbols, but for expressions with a hundred or so symbols, the speed-up is not enough.\nWe can do better by designing a specialized representation from the ground up.\n\nSerious algebraic manipulation programs generally enforce a notion of *canonical simplification.* That is, expressions are converted into a canonical internal format that may be far removed from the input form.\nThey are then manipulated, and translated back to external form for output.\nOf course, the simplifier we have already does this kind of translation, to some degree.\nIt translates `(3 + x + -3 + y)` into `(+ x y)` internally, and then outputs it as `(x + y)`.\nBut a *canonical* representation must have the property that any two expressions that are equal have identical canonical forms.\nIn our system the expression `(5 + y + x + -5)` is translated to the internal form `(+ y x)`, which is not identical to `(+ x y)`, even though the two expressions are equal.\nThus, our system is not canonical.\nMost of the problems of the previous section stem from the lack of a canonical form.\n\nAdhering to canonical form imposes grave restrictions on the representation.\nFor example, *x<sup>2</sup>* - 1 and (*x* - 1)(*x* + 1) are equal, so they must be represented identically.\nOne way to insure this is to multiply out all factors and collect similar terms.\nSo (*x* - 1)(*x* + 1) is *x<sup>2</sup>* - *x* + *x* - 1, which simplifies to *x<sup>2</sup>* - 1, in whatever the canonical internal form is.\nThis approach works fine for *x<sup>2</sup>* - 1, but for an expression like (*x* - 1)<sup>1000</sup>, multiplying out all factors would be quite time- (and space-) consuming.\nIt is hard to find a canonical form that is ideal for all problems.\nThe best we can do is choose one that works well for the problems we are most likely to encounter.\n\n## 15.1 A Canonical Form for Polynomials\n\nThis section will concentrate on a canonical form for *polynomials.* Mathematically speaking, a polynomial is a function (of one or more variables) that can be computed using only addition and multiplication.\nWe will speak of a polynomial's *main variable, coefficients,* and *degree.* In the polynomial:\n\n<img src=\"images/chapter15/si1_e.svg\"\nonerror=\"this.src='images/chapter15/si1_e.png'; this.onerror=null;\"\nalt=\"5 \\times x^{3} +b \\times x^{2} +c \\times x + 1\" />\n\nthe main variable is *x,* the degree is 3 (the highest power of *x*), and the coefficients are 5, *b, c* and 1.\nWe can define an input format for polynomials as follows:\n\n1.  Any Lisp number is a polynomial.\n\n2.  Any Lisp symbol is a polynomial.\n\n3.  If *p* and *q* are polynomials, so are (*p + q*) and (*p \\* q*).\n\n4.  If *p* is a polynomial and *n* is a positive integer, then (*p* ^ *n*) is a polynomial.\n\nHowever, the input format cannot be used as the canonical form, because it would admit both `(x + y)` and `(y + x)`, and both `4` and `(2 + 2)`.\n\nBefore considering a canonical form for polynomials, let us see why polynomials were chosen as the target domain.\nFirst, the volume of programming needed to support canonical forms for a larger class of expressions grows substantially.\nTo make things easier, we have eliminated complications like log and trig functions.\nPolynomials are a good choice because they are closed under addition and multiplication: the sum or product of any two polynomials is a polynomial.\nIf we had allowed division, the result would not be closed, because the quotient of two polynomials need not be a polynomial.\nAs a bonus, polynomials are also closed under differentiation and integration, so we can include those operators as well.\n\nSecond, for sufficiently large classes of expressions it becomes not just difficult but impossible to define a canonical form.\nThis may be surprising, and we don't have space here to explain exactly why it is so, but here is an argument: Consider what would happen if we added enough functionality to duplicate all of Lisp.\nThen \"converting to canonical form\" would be the same as \"running a program.\" But it is an elementary result of computability theory that it is in general impossible to determine the result of running an arbitrary program (this is known as the halting problem).\nThus, it is not surprising that it is impossible to canonicalize complex expressions.\n\nOur task is to convert a polynomial as previously defined into some canonical form.<a id=\"tfn15-1\"></a><sup>[1](#fn15-1)</sup>\nMuch of the code and some of the commentary on this format and the routines to manipulate it was written by Richard Fateman, with some enhancements made by Peter Klier.\n\nThe first design decision is to assume that we will be dealing mostly with *dense* polynomials, rather than *sparse* ones.\nThat is, we expect most of the polynomials to be like *ax*<sup>3</sup> + *bx*<sup>2</sup> + *cx* + *d,* not like *ax*<sup>100</sup>+ *bx*<sup>50</sup> + *c.*\nFor dense polynomials, we can save space by representing the main variable (*x* in these examples) and the individual coefficients (*a*, *b*, *c*, and *d* in these examples) explicitly, but representing the exponents only implicitly, by position.\nVectors will be used instead of lists, to save space and to allow fast access to any element.\nThus, the representation of 5*x*<sup>3</sup> + 10*x*<sup>2</sup> + 20*x* + 30 will be the vector:\n\n```lisp\n#(x 30 20 10 5)\n```\n\nThe main variable, *x*, is in the 0th element of the vector, and the coefficient of the *i*th power of *x* is in element *i* + 1 of the vector.\nA single variable is represented as a vector whose first coefficient is 1, and a number is represented as itself:\n\n| []()              |                                                              |\n|-------------------|--------------------------------------------------------------|\n| `#(x 30 20 10 5)` | represents 5*x*<sup>3</sup> + 10*x*<sup>2</sup> + 20*x* + 30 |\n| `#(x 0 1)`        | represents *x*                                               |\n| `5`               | represents 5                                                 |\n\nThe fact that a number is represented as itself is a possible source of confusion.\nThe number 5, for example, is a polynomial by our mathematical definition of polynomials.\nBut it is represented as 5, not as a vector, so `(typep 5 'polynomial)` will be false.\nThe word \"polynomial\" is used ambiguously to refer to both the mathematical concept and the Lisp type, but it should be clear from context which is meant.\n\nA glossary for the canonical simplifier program is given in [figure 15.1](#f0010).\n\n| Function           | Description                                                         |\n|--------------------|---------------------------------------------------------------------|\n|                    | **Top-Level Functions**                                             |\n| `canon-simplifier` | A read-canonicalize-print loop.                                     |\n| `canon`            | Canonicalize argument and convert it back to infix.                 |\n|                    | **Data Types**                                                      |\n| `polynomial`       | A vector of main variable and coefficients.                         |\n|                    | **Major Functions**                                                 |\n| `prefix->canon`    | Convert a prefix expression to canonical polynomial.                |\n| `canon->prefix`    | Convert a canonical polynomial to a prefix expression.              |\n| `poly+poly`        | Add two polynomials.                                                |\n| `poly*poly`        | Multiply two polynomials.                                           |\n| `poly^n`           | Raise the polynomial *p* to the nth power, *n*>=0.                  |\n| `deriv-poly`       | Return the derivative, *dp/dx*, of the polynomial *p*.              |\n|                    | **Auxiliary Functions**                                             |\n| `poly`             | Construct a polynomial with given coefficients.                     |\n| `make-poly`        | Construct a polynomial of given degree.                             |\n| `coef`             | Pick out the ith coefficient of a polynomial.                       |\n| `main-var`         | The main variable of a polynomial.                                  |\n| `degree`           | The degree of a polynomial; e.g., `(degree` *x*<sup>2</sup>`) = 2`. |\n| `var=`             | Are two variables identical?                                        |\n| `var>`             | Is one variable ordered before another?                             |\n| `poly+`            | Unary or binary polynomial addition.                                |\n| `poly-`            | Unary or binary polynomial subtraction.                             |\n| `k+poly`           | Add a constant *k* to a polynomial *p*.                             |\n| `k*poly`           | Multiply a polynomial *p* by a constant *k*.                        |\n| `poly+same`        | Add two polynomials with the same main variable.                    |\n| `poly*same`        | Multiply two polynomials with the same main variable.               |\n| `normalize-poly`   | Alter a polynomial by dropping trailing zeros.                      |\n| `exponent->prefix` | Used to convert to prefix.                                          |\n| `args->prefix`     | Used to convert to prefix.                                          |\n| `rat-numerator`    | Select the numerator of a rational.                                 |\n| `rat-denominator`  | Select the denominator of a rational.                               |\n| `rat*rat`          | Multiply two rationals.                                             |\n| `rat+rat`          | Add two rationals.                                                  |\n| `rat/rat`          | Divide two rationals.                                               |\n\nFigure 15.1: Glossary for the Symbolic Manipulation Program\n\nThe functions defining the type `polynomial` follow.\n\nBecause we are concerned with efficiency, we proclaim certain short functions to be compiled inline, use the specific function `svref` (simple-vector reference) rather than the more general aref, and provide declarations for the polynomials using the special form the.\nMore details on efficiency issues are given in [Chapter 9](chapter9.md).\n\n```lisp\n(proclaim '(inline main-var degree coef\n                   var= var> poly make-poly))\n\n(deftype polynomial () 'simple-vector)\n\n(defun main-var (p) (svref (the polynomial p) 0))\n(defun coef (p i)   (svref (the polynomial p) (+ i 1)))\n(defun degree (p)   (-(length (the polynomial p)) 2))\n```\n\nWe had to make another design decision in defining `coef`, the function to extract a coefficient from a polynomial.\nAs stated above, the *i*th coefficient of a polynomial is in element *i* + 1 of the vector.\nIf we required the caller of `coef` to pass in *i* + 1 to get *i,* we might be able to save a few addition operations.\nThe design decision was that this would be too confusing and error prone.\nThus, `coef` expects to be passed *i* and does the addition itself.\n\nFor our format, we will insist that main variables be symbols, while coefficients can be numbers or other polynomials.\nA \"production\" version of the program might have to account for main variables like `(sin x)`, as well as other complications like + and * with more than two arguments, and noninteger powers.\n\nNow we can extract information from a polynomial, but we also need to build and modify polynomials.\nThe function `poly` takes a variable and some coefficients and builds a vector representing the polynomial.\n`make-poly` takes a variable and a degree and produces a polynomial with all zero coefficients.\n\n```lisp\n(defun poly (x &rest coefs)\n  \"Make a polynomial with main variable x\n  and coefficients in increasing order.\"\n  (apply #'vector x coefs))\n\n(defun make-poly (x degree)\n  \"Make the polynomial 0 + 0*x + 0*x^2 + ... 0*x^degree\"\n  (let ((p (make-array (+ degree 2) :initial-element 0)))\n    (setf (main-var p) x)\n    p))\n```\n\nA polynomial can be altered by setting its main variable or any one of its coefficients using the following `defsetf` forms.\n\n```lisp\n(defsetf main-var (p) (val)\n  `(setf (svref (the polynomial ,p) 0) ,val))\n\n(defsetf coef (p i) (val)\n  `(setf (svref (the polynomial ,p) (+ ,i 1)) ,val))\n```\n\nThe function `poly` constructs polynomials in a fashion similar to `list` or `vector`: with an explicit list of the contents, `make-poly`, on the other hand, is like `make-array`: it makes a polynomial of a specified size.\n\nWe provide `setf` methods for modifying the main variable and coefficients.\nSince this is the first use of `defsetf`, it deserves some explanation.\nA `defsetf` form takes a function (or macro) name, an argument list, and a second argument list that must consist of a single argument, the value to be assigned.\nThe body of the form is an expression that stores the value in the proper place.\nSo the `defsetf` for `main-var` says that `(setf (main-varp) val)` is equivalent to `(setf (svref (the polynomial p) 0) val)`.\nA `defsetf` is much like a `defmacro`, but there is a little less burden placed on the writer of `defsetf`.\nInstead of passing `p` and `val` directly to the `setf` method, Common Lisp binds local variables to these expressions, and passes those variables to the `setf` method.\nThat way, the writer does not have to worry about evaluating the expressions in the wrong order or the wrong number of times.\nIt is also possible to gain finer control over the whole process with `define-setf-method`, as explained on [page 884](chapter25.md#p884).\n\nThe functions `poly+poly, poly*poly` and `poly^n` perform addition, multiplication, and exponentiation of polynomials, respectively.\nThey are defined with several helping functions.\n`k*poly` multiplies a polynomial by a constant, `k`, which may be a number or another polynomial that is free of polynomial `p`'s main variable.\n`poly*same` is used to multiply two polynomials with the same main variable.\nFor addition, the functions `k+poly` and `poly+same` serve analogous purposes.\nWith that in mind, here's the function to convert from prefix to canonical form:\n\n```lisp\n(defun prefix->canon (x)\n  \"Convert a prefix Lisp expression to canonical form.\n  Exs: (+ (^ x 2) (* 3 x)) => #(x 0 3 1)\n       (- (* (- x 1) (+ x 1)) (- (^ x 2) 1)) => 0\"\n  (cond ((numberp x) x)\n        ((symbolp x) (poly x 0 1))\n        ((and (exp-p x) (get (exp-op x) 'prefix->canon))\n         (apply (get (exp-op x) 'prefix->canon)\n                (mapcar #'prefix->canon (exp-args x))))\n        (t (error \"Not a polynomial: ~a\" x))))\n```\n\nIt is data-driven, based on the `prefix->canon` property of each operator.\nIn the following we install the appropriate functions.\nThe existing functions `poly*poly` and `poly^n` can be used directly.\nBut other operators need interface functions.\nThe operators + and - need interface functions that handle both unary and binary.\n\n```lisp\n(dolist (item '((+ poly+) (- poly-) (* poly*poly)\n                (^ poly^n) (D deriv-poly)))\n  (setf (get (first item) 'prefix->canon) (second item)))\n\n(defun poly+ (&rest args)\n  \"Unary or binary polynomial addition.\"\n  (ecase (length args)\n    (1 (first args))\n    (2 (poly+poly (first args) (second args)))))\n\n(defun poly- (&rest args)\n  \"Unary or binary polynomial subtraction.\"\n  (ecase (length args)\n    (0 0)\n    (1 (poly*poly -1 (first args)))\n    (2 (poly+poly (first args) (poly*poly -1 (second args))))))\n```\n\nThe function `prefix->canon` accepts inputs that were not part of our definition of polynomials: unary positive and negation operators and binary subtraction and differentiation operators.\nThese are permissible because they can all be reduced to the elementary `+` and `*` operations.\n\nRemember that our problems with canonical form all began with the inability to decide which was simpler: `(+ x y)` or `(+ y x)`.\nIn this system, we define a canonical form by imposing an ordering on variables (we use alphabetic ordering as defined by `string>`).\nThe rule is that a polynomial `p` can have coefficients that are polynomials in a variable later in the alphabet than `p`'s main variable, but no coefficients that are polynomials in variables earlier than `p`'s main variable.\nHere's how to compare variables:\n\n```lisp\n(defun var= (x y) (eq x y))\n(defun var> (x y) (string> x y))\n```\n\nThe canonical form of the variable `x` will be `#(x 0 1)`, which is 0 *x*<sup>0</sup> + 1 *x*<sup>1</sup>.\nThe canonical form of `(+ x y)` is `#(x #(y 0 1) 1)`.\nIt couldn't be `#(y #(x 0 1) 1)`, because then the resulting polynomial would have a coefficient with a lesser main variable.\nThe policy of ordering variables assures canonicality, by properly grouping like variables together and by imposing a particular ordering on expressions that would otherwise be commutative.\n\nHere, then, is the code for adding two polynomials:\n\n```lisp\n(defun poly+poly (p q)\n  \"Add two polynomials.\"\n  (normalize-poly\n    (cond\n      ((numberp p)                      (k+poly p q))\n      ((numberp q)                      (k+poly q p))\n      ((var= (main-var p) (main-var q)) (poly+same p q))\n      ((var> (main-var q) (main-var p)) (k+poly q p))\n      (t                                (k+poly p q)))))\n\n(defun k+poly (k p)\n  \"Add a constant k to a polynomial p.\"\n  (cond ((eql k 0) p)                 ;; 0 + p = p\n        ((and (numberp k) (numberp p))\n         (+ k p))                     ;; Add numbers\n        (t (let ((r (copy-poly p)))   ;; Add k to x^0 term of p\n             (setf (coef r 0) (poly+poly (coef r 0) k))\n             r))))\n\n(defun poly+same (p q)\n  \"Add two polynomials with the same main variable.\"\n  ;; First assure that q is the higher degree polynomial\n  (if (> (degree p) (degree q))\n      (poly+same q p)\n      ;; Add each element of p into r (which is a copy of q).\n      (let ((r (copy-poly q)))\n        (loop for i from 0 to (degree p) do\n              (setf (coef r i) (poly+poly (coef r i) (coef p i))))\n        r)))\n\n(defun copy-poly (p)\n  \"Make a copy a polynomial.\"\n  (copy-seq p))\n```\n\nand the code for multiplying polynomials:\n\n```lisp\n(defun poly*poly (p q)\n  \"Multiply two polynomials.\"\n  (normalize-poly\n    (cond\n      ((numberp p)                      (k*poly p q))\n      ((numberp q)                      (k*poly q p))\n      ((var= (main-var p) (main-var q)) (poly*same p q))\n      ((var> (main-var q) (main-var p)) (k*poly q p))\n      (t                                (k*poly p q)))))\n\n(defun k*poly (k p)\n  \"Multiply a polynomial p by a constant factor k.\"\n  (cond\n    ((eql k 0)         0)       ;; 0 * p = 0\n    ((eql k 1)         p)       ;; 1 * p = p\n    ((and (numberp k)\n          (numberp p)) (* k p)) ;; Multiply numbers\n    (t ;; Multiply each coefficient\n     (let ((r (make-poly (main-var p) (degree p))))\n       ;; Accumulate result in r;  r[i] = k*p[i]\n       (loop for i from 0 to (degree p) do\n             (setf (coef r i) (poly*poly k (coef p i))))\n       r))))\n```\n\nThe hard part is multiplying two polynomials with the same main variable.\nThis is done by creating a new polynomial, `r`, whose degree is the sum of the two input polynomials `p` and `q`.\nInitially, all of `r`'s coefficients are zero.\nA doubly nested loop multiplies each coefficient of `p` and `q` and adds the `result` into the appropriate coefficient of `r`.\n\n```lisp\n(defun poly*same (p q)\n  \"Multiply two polynomials with the same variable.\"\n  ;; r[i] = p[0]*q[i] + p[1]*q[i-1] + ...\n  (let* ((r-degree (+ (degree p) (degree q)))\n         (r (make-poly (main-var p) r-degree)))\n    (loop for i from 0 to (degree p) do\n          (unless (eql (coef p i) 0)\n            (loop for j from 0 to (degree q) do\n                  (setf (coef r (+ i j))\n                        (poly+poly (coef r (+ i j))\n                                   (poly*poly (coef p i)\n                                              (coef q j)))))))\n    r))\n```\n\nBoth `poly+poly` and `poly*poly` make use of the function `normalize-poly` to \"normalize\" the result.\nThe idea is that `(- (^ 5) (^ x 5))` should return `0`, not `#(x 0 0 0 0 0 0)`.\nNote that `normalize-poly` is a destructive operation: it calls `delete`, which can actually alter its argument.\nNormally this is a dangerous thing, but since `normalize-poly` is replacing something with its conceptual equal, no harm is done.\n\n```lisp\n(defun normalize-poly (p)\n  \"Alter a polynomial by dropping trailing zeros.\"\n  (if (numberp p)\n      p\n      (let ((p-degree (- (position 0 p :test (complement #'eql)\n                                       :from-end t)\n                         1)))\n        (cond ((<= p-degree 0) (normalize-poly (coef p 0)))\n              ((< p-degree (degree p))\n               (delete 0 p :start p-degree))\n              (t p)))))\n```\n\nThere are a few loose ends to clean up.\nFirst, the exponentiation function:\n\n```lisp\n(defun poly^n (p n)\n \"Raise polynomial p to the nth power, n>=0.\"\n (check-type n (integer 0 *))\n (cond ((= n 0) (assert (not (eql p 0))) 1)\n   ((integerp p) (expt p n))\n   (t (poly*poly p (poly^n p (- n 1))))))\n```\n\n## 15.2 Differentiating Polynomials\n\nThe differentiation routine is easy, mainly because there are only two operators (`+` and `*`) to deal with:\n\n```lisp\n(defun deriv-poly (p x)\n  \"Return the derivative, dp/dx, of the polynomial p.\"\n  ;; If p is a number or a polynomial with main-var > x,\n  ;; then p is free of x, and the derivative is zero;\n  ;; otherwise do real work.\n  ;; But first, make sure X is a simple variable,\n  ;; of the form #(X 0 1).\n  (assert (and (typep x 'polynomial) (= (degree x) 1)\n         (eql (coef x 0) 0) (eql (coef x 1) 1)))\n  (cond\n    ((numberp p) 0)\n    ((var> (main-var p) (main-var x)) 0)\n    ((var= (main-var p) (main-var x))\n     ;; d(a + bx + cx^2 + dx^3)/dx = b + 2cx + 3dx^2\n     ;; So, shift the sequence p over by 1, then\n     ;; put x back in, and multiply by the exponents\n     (let ((r (subseq p 1)))\n       (setf (main-var r) (main-var x))\n       (loop for i from 1 to (degree r) do\n             (setf (coef r i) (poly*poly (+ i 1) (coef r i))))\n       (normalize-poly r)))\n    (t ;; Otherwise some coefficient may contain x.  Ex:\n     ;; d(z + 3x + 3zx^2 + z^2x^3)/dz\n     ;; = 1 +  0 +  3x^2 +  2zx^3\n     ;; So copy p, and differentiate the coefficients.\n     (let ((r (copy-poly p)))\n       (loop for i from 0 to (degree p) do\n             (setf (coef r i) (deriv-poly (coef r i) x)))\n       (normalize-poly r)))))\n```\n\n**Exercise  15.1 [h]** Integrating polynomials is not much harder than differentiating them.\nFor example:\n\n<img src=\"images/chapter15/si2_e.svg\"\nonerror=\"this.src='images/chapter15/si2_e.png'; this.onerror=null;\"\nalt=\"\\int ax^{2} + bx\\, dx = \\frac {ax^{3}}{3} + \\frac {bx^{2}}{2} + c.\" />\n\nWrite a function to integrate polynomials and install it in `prefix->canon`.\n\n**Exercise  15.2 [m]** Add support for *definite* integrals, such as\n<img src=\"images/chapter15/si3_e.svg\"\nonerror=\"this.src='images/chapter15/si3_e.png'; this.onerror=null;\"\nalt=\"\\int_{a}^{b} y\\, dx\" />.\nYou will need to make up a suitable notation and properly install it in both `infix->prefix` and `prefix->canon`.\nA full implementation of this feature would have to consider infinity as a bound, as well as the problem of integrating over singularities.\nYou need not address these problems.\n\n## 15.3 Converting between Infix and Prefix\n\nAll that remains is converting from canonical form back to prefix form, and from there back to infix form.\nThis is a good point to extend the prefix form to allow expressions with more than two arguments.\nFirst we show an updated version of `prefix->infix` that handles multiple arguments:\n\n```lisp\n(defun prefix->infix (exp)\n  \"Translate prefix to infix expressions.\n  Handles operators with any number of args.\"\n  (if (atom exp)\n      exp\n      (intersperse\n        (exp-op exp)\n        (mapcar #'prefix->infix (exp-args exp)))))\n\n(defun intersperse (op args)\n  \"Place op between each element of args.\n  Ex: (intersperse '+ '(a b c)) => '(a + b + c)\"\n  (if (length=1 args)\n      (first args)\n      (rest (loop for arg in args\n               collect op\n               collect arg))))\n```\n\nNow we need only convert from canonical form to prefix:\n\n```lisp\n(defun canon->prefix (p)\n  \"Convert a canonical polynomial to a lisp expression.\"\n  (if (numberp p)\n      p\n      (args->prefix\n        '+ 0\n        (loop for i from (degree p) downto 0\n              collect (args->prefix\n                        '* 1\n                        (list (canon->prefix (coef p i))\n                              (exponent->prefix\n                                (main-var p) i)))))))\n\n(defun exponent->prefix (base exponent)\n  \"Convert canonical base^exponent to prefix form.\"\n  (case exponent\n    (0 1)\n    (1 base)\n    (t `(^ ,base ,exponent))))\n\n(defun args->prefix (op identity args)\n  \"Convert arg1 op arg2 op ... to prefix form.\"\n  (let ((useful-args (remove identity args)))\n    (cond ((null useful-args) identity)\n          ((and (eq op '*) (member 0 args)) 0)\n          ((length=1 args) (first useful-args))\n          (t (cons op (mappend\n                        #'(lambda (exp)\n                            (if (starts-with exp op)\n                                (exp-args exp)\n                                (list exp)))\n                        useful-args))))))\n```\n\nFinally, here's a top level to make use of all this:\n\n```lisp\n(defun canon (infix-exp)\n  \"Canonicalize argument and convert it back to infix\"\n  (prefix->infix (canon->prefix (prefix->canon (infix->prefix infix-exp)))))\n\n(defun canon-simplifier ()\n  \"Read an expression, canonicalize it, and print the result.\"\n  (loop\n    (print 'canon>)\n    (print (canon (read)))))\n```\n\nand an example of it in use:\n\n```lisp\n> (canon-simplifier)\nCANON> (3 + x + 4 - x)\n7\nCANON> (x + y + y + x)\n((2 * X) + (2 * Y))\nCANON> (3 * x + 4 * x)\n(7 * X)\nCANON> (3 * x + y + x + 4 * x)\n((8 * X) + Y)\nCANON> (3 * x + y + z + x + 4 * x)\n((8 * X) + (Y + Z))\nCANON> ((x + 1) ^ 10)\n((X ^ 10) + (10 * (X ^ 9)) + (45 * (X ^ 8)) + (120 * (X ^ 7))\n + (210 * (X ^ 6)) + (252 * (X ^ 5)) + (210 * (X ^ 4))\n + (120 * (X ^ 3)) + (45 * (X ^ 2)) + (10 * X) + 1)\nCANON> ((x + 1) ^ 10 + (x - 1) ^ 10)\n((2 * (X ^ 10)) + (90 * (X ^ 8)) + (420 * (X ^ 6))\n + (420 * (X ^ 4)) + (90 * (X ^ 2)) + 2)\nCANON> ((x + 1) ^ 10 - (x - 1) ^ 10)\n((20 * (X ^ 8)) + (240 * (X ^ 7)) + (504 * (X ^ 5))\n + (240 * (X ^ 3)) + (20 * X))\nCANON> (3 * x ^ 3 + 4 * x * y * (x - 1) + x ^ 2 * (x + y))\n((4 * (X ^ 3)) + ((5 * Y) * (X ^ 2)) + ((-4 * Y) * X))\nCANON> (3 * x ^ 3 + 4 * x * w * (x - 1) + x ^ 2 * (x + w))\n((((5 * (X ^ 2)) + (-4 * X)) * W) + (4 * (X ^ 3)))\nCANON> (d (3 * x ^ 2 + 2 * x + 1) / d x)\n((6 * X) + 2)\nCANON> (d(z + 3 * x + 3 * z * x ^ 2 + z ^ 2 * x ^ 3) / d z)\n(((2 * Z) * (X ^ 3)) + (3 * (X ^ 2)) + 1)\nCANON> [Abort]\n```\n\n## 15.4 Benchmarking the Polynomial Simplifier\n\nUnlike the rule-based program, this version gets all the answers right.\nNot only is the program correct (at least as far as these examples go), it is also fast.\nWe can compare it to the canonical simplifier originally written for MACSYMA by William Martin (circa 1968), and modified by Richard Fateman.\nThe modified version was used by Richard Gabriel in his suite of Common Lisp benchmarks (1985).\nThe benchmark program is called `frpoly`, because it deals with polynomials and was originally written in the dialect Franz Lisp.\nThe `frpoly` benchmark encodes polynomials as lists rather than vectors, and goes to great lengths to be efficient.\nOtherwise, it is similar to the algorithms used here (although the code itself is quite different, using progs and gos and other features that have fallen into disfavor in the intervening decades).\nThe particular benchmark we will use here is raising 1 + *x* + *y* + *z* to the 15th power:\n\n```lisp\n(defun r15-test ()\n (let ((r (prefix->canon'(+ 1 (+ x (+ y z))))))\n  (time (poly^n r 15))\n  nil))\n```\n\nThis takes .97 seconds on our system.\nThe equivalent test with the original `frpoly` code takes about the same time: .98 seconds.\nThus, our program is as fast as production-quality code.\nIn terms of storage space, vectors use about half as much storage as lists, because half of each cons cell is a pointer, while vectors are all useful data.<a id=\"tfn15-2\"></a><sup>[2](#fn15-2)</sup>\n\nHow much faster is the polynomial-based code than the rule-based version?\nUnfortunately, we can't answer that question directly.\nWe can time `(simp ' ( (1 + x + y + z) ^ 15)))`.\nThis takes only a tenth of a second, but that is because it is doing no work at all-the answer is the same as the input!\nAlternately, we can take the expression computed by `(poly^n r 15)`, convert it to prefix, and pass that to `simplify`.\n`simplify` takes 27.8 seconds on this, so the rule-based version is much slower.\n[Section 9.6](chapter9.md#s0035) describes ways to speed up the rule-based program, and a comparison of timing data appears on [page 525](#p525).\n\nThere are always surprises when it comes down to measuring timing data.\nFor example, the alert reader may have noticed that the version of `poly^n` defined above requires *n* multiplications.\nUsually, exponentiation is done by squaring a value when the exponent is even.\nSuch an algorithm takes only log *n* multiplications instead of *n.* We can add a line to the definition of `poly^n` to get an *O*(log *n*) algorithm:\n\n```lisp\n(defun poly^n (p n)\n \"Raise polynomial p to the nth power, n>=0.\"\n (check-type n (integer 0 *))\n (cond ((= n 0) (assert (not (eql p 0))) 1)\n   ((integerp p) (expt p n))\n   ((evenp n) (poly^2 (poly^n p (/ n 2)))) ;***\n   (t (poly*poly p (poly^n p (- n 1))))))\n(defun poly^2 (p) (poly*poly p p))\n```\n\nThe surprise is that this takes *longer* to raise `*r*` to the 15th power.\nEven though it does fewer `poly*poly` operations, it is doing them on more complex arguments, and there is more work altogether.\nIf we use this version of `poly^n,` then `r15-test` takes 1.6 seconds instead of .98 seconds.\n\nBy the way, this is a perfect example of the conceptual power of recursive functions.\nWe took an existing function, poly^n, added a single cond clause, and changed it from an *O*(*n*) to *O*(log *n*) algorithm.\n(This turned out to be a bad idea, but that's beside the point.\nIt would be a good idea for raising integers to powers.)\nThe reasoning that allows the change is simple: First, *p<sup>n</sup>* is certainly equal to (*p*<sup>*n*/2</sup>)<sup>2</sup> when *n* is even, so the change can't introduce any wrong answers.\nSecond, the change continues the policy of decrementing *n* on every recursive call, so the function must eventually terminate (when *n* = 0).\nIf it gives no wrong answers, and it terminates, then it must give the right answer.\n\nIn contrast, making the change for an iterative algorithm is more complex.\nThe initial algorithm is simple:\n\n```lisp\n(defun poly^n (p n)\n (let ((result 1))\n  (loop repeat n do (setf result (poly*poly p result)))\n  result))\n```\n\nBut to change it, we have to change the repeat loop to a `while` loop, explicitly put in the decrement of *n*, and insert a test for the even case:\n\n```lisp\n(defun poly^n (p n)\n (let ((result 1))\n  (loop while (> n 0)\n   do (if (evenp n)\n     (setf p (poly^2 p)\n       n (/ n 2))\n     (setf result (poly*poly p result)\n       n (- n 1))))\n  result))\n```\n\nFor this problem, it is clear that thinking recursively leads to a simpler function that is easier to modify.\n\nIt turns out that this is not the final word.\nExponentiation of polynomials can be done even faster, with a little more mathematical sophistication.\n[Richard Fateman's 1974](bibliography.md#bb0380) paper on Polynomial Multiplication analyzes the complexity of a variety of exponentiation algorithms.\nInstead of the usual asymptotic analysis (e.g.\n*O*(*n*) or *O*(*n*<sup>2</sup>)), he uses a fine-grained analysis that computes the constant factors (e.g.\n1000 x *n* or 2 x *n*<sup>2</sup>).\nSuch analysis is crucial for small values of *n*.\nIt turns out that for a variety of polynomials, an exponentiation algorithm based on the binomial theorem is best.\nThe binomial theorem states that\n\n<img src=\"images/chapter15/si4_e.svg\"\nonerror=\"this.src='images/chapter15/si4_e.png'; this.onerror=null;\"\nalt=\"( a + b ) ^{n} = \\sum_{i=0}^{n} \\frac {n!}{i! (n-i)!)} a^{i} b^{n-i}\" />\n\nfor example,\n\n<img src=\"images/chapter15/si5_e.svg\"\nonerror=\"this.src='images/chapter15/si5_e.png'; this.onerror=null;\"\nalt=\"(a+b)^{3} = b^{3} + 3ab^{2} + 3a^{2}b + a^{3}\" />\n\nWe can use this theorem to compute a power of a polynomial all at once, instead of computing it by repeated multiplication or squaring.\nOf course, a polynomial will in general be a sum of more than two components, so we have to decide how to split it into the *a* and *b* pieces.\nThere are two obvious ways: either cut the polynomial in half, so that *a* and *b* will be of equal size, or split off one component at a time.\nFateman shows that the latter method is more efficient in most cases.\nIn other words, a polynomial\n*k*<sub>1</sub>*x<sup>n</sup>* + *k*<sub>2</sub>*x<sup>n-1</sup>* + *k*<sub>3</sub>*x<sup>n-2</sup>* + ...\nwill be treated as the sum *a + b* where\n*a* = *k*<sub>1</sub>*x<sup>n</sup>*\nand *b* is the rest of the polynomial.\n\nFollowing is the code for binomial exponentiation.\nIt is somewhat messy, because the emphasis is on efficiency.\nThis means reusing some data and using `p-add-into!` instead of the more general `poly+poly`.\n\n```lisp\n(defun poly^n (p n)\n  \"Raise polynomial p to the nth power, n>=0.\"\n  ;; Uses the binomial theorem\n  (check-type n (integer 0 *))\n  (cond\n    ((= n 0) 1)\n    ((integerp p) (expt p n))\n    (t ;; First: split the polynomial p = a + b, where\n     ;; a = k*x^d and b is the rest of p\n     (let ((a (make-poly (main-var p) (degree p)))\n           (b (normalize-poly (subseq p 0 (- (length p) 1))))\n           ;; Allocate arrays of powers of a and b:\n           (a^n (make-array (+ n 1)))\n           (b^n (make-array (+ n 1)))\n           ;; Initialize the result:\n           (result (make-poly (main-var p) (* (degree p) n))))\n       (setf (coef a (degree p)) (coef p (degree p)))\n       ;; Second: Compute powers of a^i and b^i for i up to n\n       (setf (aref a^n 0) 1)\n       (setf (aref b^n 0) 1)\n       (loop for i from 1 to n do\n             (setf (aref a^n i) (poly*poly a (aref a^n (- i 1))))\n             (setf (aref b^n i) (poly*poly b (aref b^n (- i 1)))))\n       ;; Third: add the products into the result,\n       ;; so that result[i] = (n choose i) * a^i * b^(n-i)\n       (let ((c 1)) ;; c helps compute (n choose i) incrementally\n         (loop for i from 0 to n do\n               (p-add-into! result c\n                            (poly*poly (aref a^n i)\n                                 (aref b^n (- n i))))\n               (setf c (/ (* c (- n i)) (+ i 1)))))\n       (normalize-poly result)))))\n\n(defun p-add-into! (result c p)\n  \"Destructively add c*p into result.\"\n  (if (or (numberp p)\n          (not (var= (main-var p) (main-var result))))\n      (setf (coef result 0)\n            (poly+poly (coef result 0) (poly*poly c p)))\n      (loop for i from 0 to (degree p) do\n            (setf (coef result i)\n                  (poly+poly (coef result i) (poly*poly c (coef p i))))))\n  result)\n```\n\nUsing this version of `poly^n, r15-test` takes only .23 seconds, four times faster than the previous version.\nThe following table compares the times for `r15-test` with the three versions of `poly^n`, along with the times for applying `simply` to the `r15` polynomial, for various versions of `simplify`:\n\n\n|      | program                 | secs | speed-up |\n|------|-------------------------|------|----------|\n|      | **rule-based versions** |      |          |\n| 1    | original                | 27.8 | -        |\n| 2    | memoization             | 7.7  | 4        |\n| 3    | memo+index              | 4.0  | 7        |\n| 4    | compilation only        | 2.5  | 11       |\n| 5    | memo+compilation        | 1.9  | 15       |\n|      | **canonical versions**  |      |          |\n| 6    | squaring `poly^n`       | 1.6  | 17       |\n| 7    | iterative `poly^n`      | .98  | 28       |\n| 8    | binomial `poly^n`       | .23  | 120      |\n\nAs we remarked earlier, the general techniques of memoization, indexing, and compilation provide for dramatic speed-ups.\nHowever, in the end, they do not lead to the fastest program.\nInstead, the fastest version was achieved by throwing out the original rule-based program, replacing it with a canonical-form-based program, and fine-tuning the algorithms within that program, using mathematical analysis.\n\nNow that we have achieved a sufficiently fast system, the next two sections concentrate on making it more powerful.\n\n## 15.5 A Canonical Form for Rational Expressions\n\nA *rational* number is defined as a fraction: the quotient of two integers.\nA *rational expression* is hereby defined as the quotient of two polynomials.\nThis section presents a canonical form for rational expressions.\n\nFirst, a number or polynomial will continue to be represented as before.\nThe quotient of two polynomials will be represented as a cons cells of numerator and denominator pairs.\nHowever, just as Lisp automatically reduces rational numbers to simplest form (6/8 is represented as 3/4), we must reduce rational expressions.\nSo, for example, (*x*<sup>2</sup> - 1)/(*x* - 1) must be reduced to *x* + 1, not left as a quotient of two polynomials.\n\nThe following functions build and access rational expressions but do not reduce to simplest form, except in the case where the denominator is a number.\nBuilding up the rest of the functionality for full rational expressions is left to a series of exercises:\n\n```lisp\n(defun make-rat (numerator denominator)\n  \"Build a rational: a quotient of two polynomials.\"\n  (if (numberp denominator)\n      (k*poly (/ 1 denominator) numerator)\n      (cons numerator denominator)))\n\n(defun rat-numerator (rat)\n  \"The numerator of a rational expression.\"\n  (typecase rat\n    (cons (car rat))\n    (number (numerator rat))\n    (t rat)))\n\n(defun rat-denominator (rat)\n  \"The denominator of a rational expression.\"\n  (typecase rat\n    (cons (cdr rat))\n    (number (denominator rat))\n    (t 1)))\n```\n\n**Exercise  15.3 [s]** Modify `prefix->canon` to accept input of the form `x / y` and to return rational expressions instead of polynomials.\nAlso allow for input of the form `x ^ - n`.\n\n**Exercise  15.4 [m]** Add arithmetic routines for multiplication, addition, and division of rational expressions.\nCall them `rat*rat, rat+rat`, and `rat/rat` respectively.\nThey will call upon `poly*poly.\npoly+poly` and a new function, `poly/poly`, which is defined in the next exercise.\n\n**Exercise  15.5 [h]** Define `poly-gcd`, which computes the greatest common divisor of two polynomials.\n\n**Exercise  15.6 [h]** Using `poly-gcd`, define the function `poly/poly`, which will implement division for polynomials.\nPolynomials are closed under addition and multiplication, so `poly+poly` and `poly*poly` both returned polynomials.\nPolynomials are not closed under division, so `poly/poly` will return a rational expression.\n\n## 15.6 Extending Rational Expressions\n\nNow that we can divide polynomials, the final step is to reinstate the logarithmic, exponential, and trigonometric functions.\nThe problem is that if we allow all these functions, we get into problems with canonical form again.\nFor example, the following three expressions are all equivalent:\n\n<img src=\"images/chapter15/si7_e.svg\"\nonerror=\"this.src='images/chapter15/si7_e.png'; this.onerror=null;\"\nalt=\"\\sin{(x)},\n\\cos{\\left (x - \\frac {\\pi}{2} \\right ) },\n\\frac {e^{ix} - e^{-ix}} {2i}\" />\n\nIf we are interested in assuring we have a canonical form, the safest thing is to allow only *e<sup>x</sup>* and log(*x*).\nAll the other functions can be defined in terms of these two.\nWith this extension, the set of expressions we can form is closed under differentiation, and it is possible to canonicalize expressions.\nThe `result` is a mathematically sound construction known as a *differentiable field.*\nThis is precisely the construct that is assumed by the Risch integration algorithm ([Risch 1969](bibliography.md#bb0985), [1979](bibliography.md#bb0990)).\n\nThe disadvantage of this minimal extension is that answers may be expressed in unfamiliar terms.\nThe user asks for *d* sin(*x*<sup>2</sup>)*/dx,* expecting a simple answer in terms of cos, and is surprised to see a complex answer involving *e<sup>ix</sup>*.\nBecause of this problem, most computer algebra systems have made more radical extensions, allowing sin, cos, and other functions.\nThese systems are treading on thin mathematical ice.\nAlgorithms that would be guaranteed to work over a simple differentiable field may fail when the domain is extended this way.\nIn general, the result will not be a wrong answer but rather the failure to find an answer at all.\n\n## 15.7 History and References\n\nA brief history of symbolic algebra systems is given in [chapter 8](chapter8.md).\n[Fateman (1979)](bibliography.md#bb0385), [Martin and Fateman (1971)](bibliography.md#bb0775), and [Davenport et al.\n(1988)](bibliography.md#bb0270) give more details on the MACSYMA system, on which this chapter is loosely based.\n[Fateman (1991)](bibliography.md#bb0390) discusses the `frpoly` benchmark and introduces the vector implementation used in this chapter.\n\n## 15.8 Exercises\n\n**Exercise 15.7 [h]** Implement an extension of the rationals to include logarithmic, exponential, and trigonometric functions.\n\n**Exercise 15.8 [m]** Modify `deriv` to handle the extended rational expressions.\n\n**Exercise 15.9 [d]** Adapt the integration routine from [section 8.6](chapter8.md#s0035) ([page 252](chapter8.md#p252)) to the rational expression representation.\n[Davenport et al.\n1988](bibliography.md#bb0270) may be useful.\n\n**Exercise 15.10 [s]** Give several reasons why constant polynomials, like 3, are represented as integers rather than as vectors.\n\n## 15.9 Answers\n\n**Answer 15.4**\n\n```lisp\n(defun rat*rat (x y)\n  \"Multiply rationals: a/b * c/d = a*c/b*d\"\n  (poly/poly (poly*poly (rat-numerator x)\n                        (rat-numerator y))\n             (poly*poly (rat-denominator x)\n                        (rat-denominator y))))\n\n(defun rat+rat (x y)\n  \"Add rationals: a/b + c/d = (a*d + c*b)/b*d\"\n  ;; Bug fix by dst 4/6/92; b and c were switched\n  (let ((a (rat-numerator x))\n        (b (rat-denominator x))\n        (c (rat-numerator y))\n        (d (rat-denominator y)))\n    (poly/poly (poly+poly (poly*poly a d) (poly*poly c b))\n               (poly*poly b d))))\n\n(defun rat/rat (x y)\n  \"Divide rationals: a/b / c/d = a*d/b*c\"\n  (rat*rat x (make-rat (rat-denominator y) (rat-numerator y))))\n```\n\n**Answer 15.6**\n\n```lisp\n(defun poly/poly (p q)\n \"Divide p by q: if d is the greatest common divisor of p and q\n then p/q = (p/d) / (q/d). Note if q-1. then p/q = p.\"\n (if (eql q 1)\n   p\n   (let ((d (poly-gcd p q)))\n    (make-rat (poly/poly p d)\n        (poly/poly q d)))))\n```\n\n**Answer 15.10** (1) An integer takes less time and space to process.\n(2) Representing numbers as a polynomial would cause an infinite regress, because the coefficients would be numbers.\n(3) Unless a policy was decided upon, the representation would not be canonical, since `#(x 3)` and `#(y 3)` both represent 3.\n\n----------------------\n\n<a id=\"fn15-1\"></a><sup>[1](#tfn15-1)</sup>\nIn fact, the algebraic properties of polynomial arithmetic and its generalizations fit so well with ideas in data abstraction that an extended example (in Scheme) on this topic is provided in *Structure and Interpretation of Computer Programs* by Abelson and Sussman (see section 2.4.3, pages 153-166).\nWe'll pursue a slightly different approach here.\n\n<a id=\"fn15-2\"></a><sup>[2](#tfn15-2)</sup>\nNote: systems that use `\"`cdr-coding`\"` take about the same space for lists that are allocated all at once as for vectors.\nBut cdr-coding is losing favor as RISC chips replace microcoded processors.\n"
  },
  {
    "path": "docs/chapter16.md",
    "content": "# Chapter 16\n## Expert Systems\n\n> An expert is one who knows more and more about less and less.\n\n> -Nicholas Murray Butler (1862-1947)\n\nIn the 1970s there was terrific interest in the area of *knowledge-based expert systems*.\nAn expert system or knowledge-based system is one that solves problems by applying knowledge that has been garnered from one or more experts in a field.\nSince these experts will not in general be programmers, they will very probably express their expertise in terms that cannot immediately be translated into a program.\nIt is the goal of expert-system research to come up with a representation that is flexible enough to handle expert knowledge, but still capable of being manipulated by a computer program to come up with solutions.\n\nA plausible candidate for this representation is as logical facts and rules, as in Prolog.\nHowever, there are three areas where Prolog provides poor support for a general knowledge-based system:\n\n*   Reasoning with uncertainty.\nProlog only deals with the black-and-white world of facts that are clearly true or false (and it doesn't even handle false very well).\nOften experts will express rules of thumb that are \"likely\" or \"90% certain.\"\n\n*   Explanation.\nProlog gives solutions to queries but no indication of how those solutions were derived.\nA system that can explain its solutions to the user in understandable terms will be trusted more.\n\n*   Flexible flow of control.\nProlog works by backward-chaining from the goal.\nIn some cases, we may need more varied control strategy.\nFor example, in medical diagnosis, there is a prescribed order for acquiring certain information about the patient.\nA medical system must follow this order, even if it doesn't fit in with the backward-chaining strategy.\n\nThe early expert systems used a wide variety of techniques to attack these problems.\nEventually, it became clear that certain techniques were being used frequently, and they were captured in *expert-system shells*: specialized programming environments that helped acquire knowledge from the expert and use it to solve problems and provide explanations.\nThe idea was that these shells would provide a higher level of abstraction than just Lisp or Prolog and would make it easy to write new expert systems.\n\nThe MYCIN expert system was one of the earliest and remains one of the best known.\nIt was written by Dr.\nEdward Shortliffe in 1974 as an experiment in medical diagnosis.\nMYCIN was designed to prescribe antibiotic therapy for bacterial blood infections, and when completed it was judged to perform this task as well as experts in the field.\nIts name comes from the common suffix in drugs it prescribes: erythromycin, clindamycin, and so on.\nThe following is a slightly modified version of one of MYCIN's rules, along with an English paraphrase generated by the system:\n\n```lisp\n(defrule 52\n if (site culture is blood)\n  (gram organism is neg)\n  (morphology organism is rod)\n  (burn patient is serious)\n then .4\n  (identity organism is pseudomonas))\nRule 52:\n If\n  1) THE SITE OF THE CULTURE IS BLOOD\n  2) THE GRAM OF THE ORGANISM IS NEG\n  3) THE MORPHOLOGY OF THE ORGANISM IS ROD\n  4) THE BURN OF THE PATIENT IS SERIOUS\n Then there is weakly suggestive evidence (0.4) that\n  1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS\n```\n\nMYCIN lead to the development of the EMYCIN expert-system shell.\nEMYCIN stands for \"essential MYCIN,\" although it is often mispresented as \"empty MYCIN.\"\nEither way, the name refers to the shell for acquiring knowledge, reasoning with it, and explaining the results, without the specific medical knowledge.\n\nEMYCIN is a backward-chaining rule interpreter that has much in common with Prolog.\nHowever, there are four important differences.\nFirst, and most importantly, EMYCIN deals with uncertainty.\nInstead of insisting that all predications be true or false, EMYCIN associates a *certainty factor* with each predication.\nSecond, EMYCIN caches the results of its computations so that they need not be duplicated.\nThird, EMYCIN provides an easy way for the system to ask the user for information.\nFourth, it provides explanations of its behavior.\nThis can be summed up in the equation:\n\n```lisp\nEMYCIN = Prolog + uncertainty + caching + questions + explanations\n```\n\nWe will first cover the ways EMYCIN is different from Prolog.\nAfter that we will return to the main core of EMYCIN, the backward-chaining rule interpreter.\nFinally, we will show how to add some medical knowledge to EMYCIN to reconstruct MYCIN.\nA glossary of the program is in [figure  16.1](#f0010).\n\n| []()                                         |\n|----------------------------------------------|\n| ![f16-01](images/chapter16/f16-01.jpg)       |\n| Figure 16.1: Glossary for the EMYCIN Program |\n\n*(ed: this could be a markdown table)*\n\n## 16.1 Dealing with Uncertainty\n\nEMYCIN deals with uncertainty by replacing the two boolean values, true and false, with a range of values called *certainty factors*.\nThese are numbers from -1 (false) to +1 (true), with 0 representing a complete unknown.\nIn Lisp:\n\n```lisp\n(defconstant true   +1.0)\n(defconstant false  -1.0)\n(defconstant unknown 0.0)\n```\n\nTo define the logic of certainty factors, we need to define the logical operations, such as `and, or`, and `not.` The first operation to consider is the combination of two distinct pieces of evidence expressed as certainty factors.\nSuppose we are trying to determine the chances of a patient having disease &Chi;.\nAssume we have a population of prior patients that have been given two lab tests.\nOne test says that 60% of the patients have the disease and the other says that 40% have it.\nHow should we combine these two pieces of evidence into one?\nUnfortunately, there is no way to answer that question correctly without knowing more about the *dependence* of the two sources on each other.\nSuppose the first test says that 60% of the patients (who all happen to be male) have the disease, and the second says that 40% (who all happen to be female) have it.\nThen we should conclude that 100% have it, because the two tests cover the entire population.\nOn the other hand, if the first test is positive only for patients that are 70 years old or older, and the second is positive only for patients that are 80 or older, then the second is just a subset of the first.\nThis adds no new information, so the correct answer is 60% in this case.\n\nIn [section 16.9](#s0050) we will consider ways to take this kind of reasoning into account.\nFor now, we will present the combination method actually used in EMYCIN.\nIt is defined by the formula:\n\ncombine (A, B) =\n\n<img src=\"images/chapter16/si1_e.svg\"\nonerror=\"this.src='images/chapter16/si1_e.png'; this.onerror=null;\"\nalt=\"A+B$-$AB; & A,B &gt; 0 \\\\\nA+B+AB;   & A,B &lt; 0 \\\\\n$\\dfrac {A + B} {1 - \\textup{min}( \\lvert A \\rvert, \\lvert B \\rvert )}$; & otherwise \\\\\" />\n\nAccording to this formula, combine(.60,.40) = .76, which is a compromise between the extremes of .60 and 1.00.\nIt is the same as the probability p(A or B), assuming that A and B are independent.\n\nHowever, it should be clear that certainty factors are not the same thing as probabilities.\nCertainty factors attempt to deal with disbelief as well as belief, but they do not deal with dependence and independence.\nThe EMYCIN combination function has a number of desirable properties:\n\n*   It always computes a number between -1 and +1.\n\n*   Combining unknown (zero) with anything leaves it unchanged.\n\n*   Combining true with anything (except false) gives true.\n\n*   Combining true and false is an error.\n\n*   Combining two opposites gives unknown.\n\n*   Combining two positives (except true) gives a larger positive.\n\n*   Combining a positive and a negative gives something in between.\n\nSo far we have seen how to combine two separate pieces of evidence for the same hypothesis.\nIn other words, if we have the two rules:\n\nA => C\n\nB => C\n\nand we know A with certainty factor (cf) .6 and B with cf .4, then we can conclude C with cf .76.\nBut consider a rule with a conjunction in the premise:\n\nA and B => C\n\nCombining A and B in this case is quite different from combining them when they are in separate rules.\nEMYCIN chooses to combine conjunctions by taking the minimum of each conjunct's certainty factor.\nIf certainty factors were probabilities, this would be equivalent to assuming dependence between conjuncts in a rule.\n(If the conjuncts were independent, then the product of the probabilities would be the correct answer.) So EMYCIN is making the quite reasonable (but sometimes incorrect) assumption that conditions that are tied together in a single rule will be dependent on one another, while conditions in separate rules are independent.\n\nThe final complication is that rules themselves may be uncertain.\nThat is, MYCIN accommodates rules that look like:\n\nA and B => .9C\n\nto say that A and B imply C with .9 certainty.\nEMYCIN simply multiplies the rule's cf by the combined cf of the premise.\nSo if A has cf .6 and B has cf .4, then the premise as a whole has cf .4 (the minimum of A and B), which is multiplied by .9 to get .36.\nThe .36 is then combined with any existing cf for C.\nIf C is previously unknown, then combining .36 with 0 will give .36.\nIf C had a prior cf of .76, then the new cf would be .36 + .76 - (.36 x .76) = .8464.\n\nHere are the EMYCIN certainty factor combination functions in Lisp:\n\n```lisp\n(defun cf-or (a b)\n  \"Combine the certainty factors for the formula (A or B).\n  This is used when two rules support the same conclusion.\"\n  (cond ((and (> a 0) (> b 0))\n         (+ a b (* -1 a b)))\n        ((and (< a 0) (< b 0))\n         (+ a b (* a b)))\n        (t (/ (+ a b)\n              (- 1 (min (abs a) (abs b)))))))\n\n(defun cf-and (a b)\n  \"Combine the certainty factors for the formula (A and B).\"\n  (min a b))\n```\n\nCertainty factors can be seen as a generalization of truth values.\nEMYCIN is a backward-chaining rule system that combines certainty factors according to the functions laid out above.\nBut if we only used the certainty factors `true` and `false`, then EMYCIN would behave exactly like Prolog, returning only answers that are definitely true.\nIt is only when we provide fractional certainty factors that the additional EMYCIN mechanism makes a difference.\n\nTruth values actually serve two purposes in Prolog.\nThey determine the final answer, yes, but they also determine when to cut off search: if any one of the premises of a rule is false, then there is no sense looking at the other premises.\nIf in EMYCIN we only cut off the search when one of the premises was absolutely false, then we might have to search through a lot of rules, only to yield answers with very low certainty factors.\nInstead, EMYCIN arbitrarily cuts off the search and considers a premise false when it has a certainty factor below .2.\nThe following functions support this arbitrary cutoff point:\n\n```lisp\n(defconstant cf-cut-off 0.2\n  \"Below this certainty we cut off search.\")\n\n(defun true-p (cf)\n  \"Is this certainty factor considered true?\"\n  (and (cf-p cf) (> cf cf-cut-off)))\n\n(defun false-p (cf)\n  \"Is this certainty factor considered false?\"\n  (and (cf-p cf) (< cf (- cf-cut-off 1.0))))\n\n(defun cf-p (x)\n  \"Is X a valid numeric certainty factor?\"\n  (and (numberp x) (<= false x true)))\n```\n\n**Exercise  16.1 [m]** Suppose you read the headline \"Elvis Alive in Kalamazoo\" in a tabloid newspaper to which you attribute a certainty factor of .01.\nIf you combine certainties using EMYCIN's combination rule, how many more copies of the newspaper would you need to see before you were .95 certain Elvis is alive?\n\n## 16.2 Caching Derived Facts\n\nThe second thing that makes EMYCIN different from Prolog is that EMYCIN *caches* all the facts it derives in a data base.\nWhen Prolog is asked to prove the same goal twice, it performs the same computation twice, no matter how laborious.\nEMYCIN performs the computation the first time and just fetches it the second time.\n\nWe can implement a simple data base by providing three functions: `put-db` to add an association between a key and a value, `get-db` to retrieve a value, and `clear-db` to empty the data base and start over:\n\n```lisp\n(let ((db (make-hash-table :test #'equal)))\n  (defun get-db (key) (gethash key db))\n  (defun put-db (key val) (setf (gethash key db) val))\n  (defun clear-db () (clrhash db)))\n```\n\nThis data base is general enough to hold any association between key and value.\nHowever, most of the information we will want to store is more specific.\nEMYCIN is designed to deal with objects (or *instances*) and attributes (or *parameters*) of those objects.\nFor example, each patient has a name parameter.\nPresumably, the value of this parameter will be known exactly.\nOn the other hand, each microscopic organism has an `identity` parameter that is normally not known at the start of the consultation.\nApplying the rules will lead to several possible values for this parameter, each with its own certainty factor.\nIn general, then, the data base will have keys of the form (*parameter instance*) with values of the form ((*val*<sub>1</sub>*cf*<sub>1</sub>) (*val*<sub>2</sub>*cf*<sub>2</sub>)...).\nIn the following code, `get-vals` returns the list of value/cf pairs for a given parameter and instance, `get-cf` returns the certainty factor for a parameter/instance/value triplet, and `update-cf` changes the certainty factor by combining the old one with a new one.\nNote that the first time `update-cf` is called on a given parameter/instance/value triplet, `get-cf` will return `unknown` (zero).\nCombining that with the given `cf` yields `cf` itself.\nAlso note that the data base has to be an equal hash table, because the keys may include freshly consed lists.\n\n```lisp\n(defun get-vals (parm inst)\n  \"Return a list of (val cf) pairs for this (parm inst).\"\n  (get-db (list parm inst)))\n\n(defun get-cf (parm inst val)\n  \"Look up the certainty factor or return unknown.\"\n  (or (second (assoc val (get-vals parm inst)))\n      unknown))\n\n(defun update-cf (parm inst val cf)\n  \"Change the certainty factor for (parm inst is val),\n  by combining the given cf with the old.\"\n  (let ((new-cf (cf-or cf (get-cf parm inst val))))\n    (put-db (list parm inst)\n            (cons (list val new-cf)\n                  (remove val (get-db (list parm inst))\n                          :key #'first)))))\n```\n\nThe data base holds all information related to an instance of a problem.\nFor example, in the medical domain, the data base would hold all information about the current patient.\nWhen we want to consider a new patient, the data base is cleared.\n\nThere are three other sources of information that cannot be stored in this data base, because they have to be maintained from one problem to the next.\nFirst, the *rule base* holds all the rules defined by the expert.\nSecond, there is a structure to define each parameter; these are indexed under the name of each parameter.\nThird, we shall see that the flow of control is managed in part by a list of *contexts* to consider.\nThese are structures that will be passed to the `MYCIN` function.\n\n## 16.3 Asking Questions\n\nThe third way that EMYCIN differs from Prolog is in providing an automatic means of asking the user questions when answers cannot be derived from the rules.\nThis is not a fundamental difference; after all, it is not too hard to write Prolog rules that print a query and read a reply.\nEMYCIN lets the knowledge-base designer write a simple declaration instead of a rule, and will even assume a default declaration if none is provided.\nThe system also makes sure that the same question is never asked twice.\n\nThe following function `ask-vals` prints a query that asks for the parameter of an instance, and reads from the user the value or a list of values with associated certainty factors.\nThe function first looks at the data base to make sure the question has not been asked before.\nIt then checks each value and certainty factor to see if each is of the correct type, and it also allows the user to ask certain questions.\nA `?` reply will show what type answer is expected.\n`Rule` will show the current rule that the system is working on.\n`Why` also shows the current rule, but it explains in more detail what the system knows and is trying to find out.\nFinally, `help` prints the following summary:\n\n```lisp\n(defconstant help-string\n  \"~&Type one of the following:\n ?     - to see possible answers for this parameter\n rule  - to show the current rule\n why   - to see why this question is asked\n help  - to see this list\n xxx   - (for some specific xxx) if there is a definite answer\n (xxx .5 yyy .4) - If there are several answers with\n                   different certainty factors.\")\n```\n\nHere is `ask-vals`.\nNote that the `why` and `rule` options assume that the current rule has been stored in the data base.\nThe functions `print-why`, `parm-type`, and `check-reply` will be defined shortly.\n\n```lisp\n(defun ask-vals (parm inst)\n  \"Ask the user for the value(s) of inst's parm parameter,\n  unless this has already been asked.  Keep asking until the\n  user types UNKNOWN (return nil) or a valid reply (return t).\"\n  (unless (get-db `(asked ,parm ,inst))\n    (put-db `(asked ,parm ,inst) t)\n    (loop\n      (let ((ans (prompt-and-read-vals parm inst)))\n        (case ans\n          (help (format t help-string))\n          (why  (print-why (get-db 'current-rule) parm))\n          (rule (princ (get-db 'current-rule)))\n          ((unk unknown) (RETURN nil))\n          (?    (format t \"~&A ~a must be of type ~a\"\n                        parm (parm-type parm)) nil)\n          (t    (if (check-reply ans parm inst)\n                    (RETURN t)\n                    (format t \"~&Illegal reply.  ~\n                             Type ? to see legal ones.\"))))))))\n```\n\nThe following is `prompt-and-read-vals`, the function that actually asks the query and reads the reply.\nIt basically calls `format` to print a prompt and `read` to get the reply, but there are a few subtleties.\nFirst, it calls `finish-output`.\nSome Lisp implementations buffer output on a line-by-line basis.\nSince the prompt may not end in a newline, `finish-output` makes sure the output is printed before the reply is read.\n\nSo far, all the code that refers to a `parm` is really referring to the name of a parameter-a symbol.\nThe actual parameters themselves will be implemented as structures.\nWe use `get-parm` to look up the structure associated with a symbol, and the selector functions `parm-prompt` to pick out the prompt for each parameter and `parm-reader` to pick out the reader function.\nNormally this will be the function `read`, but `read-line` is appropriate for reading string-valued parameters.\n\nThe macro `defparm` (shown here) provides a way to define prompts and readers for parameters.\n\n```lisp\n(defun prompt-and-read-vals (parm inst)\n  \"Print the prompt for this parameter (or make one up) and\n  read the reply.\"\n  (fresh-line)\n  (format t (parm-prompt (get-parm parm)) (inst-name inst) parm)\n  (princ \" \")\n  (finish-output)\n  (funcall (parm-reader (get-parm parm))))\n\n(defun inst-name (inst)\n  \"The name of this instance.\"\n  ;; The stored name is either like ((\"Jan Doe\" 1.0)) or nil\n  (or (first (first (get-vals 'name inst)))\n      inst))\n```\n\nThe function `check-reply` uses `parse-reply` to convert the user's reply into a canonical form, and then checks that each value is of the right type, and that each certainty factor is valid.\nIf so, the data base is updated to reflect the new certainty factors.\n\n```lisp\n(defun check-reply (reply parm inst)\n  \"If reply is valid for this parm, update the DB.\n  Reply should be a val or (val1 cf1 val2 cf2 ...).\n  Each val must be of the right type for this parm.\"\n  (let ((answers (parse-reply reply)))\n    (when (every #'(lambda (pair)\n                     (and (typep (first pair) (parm-type parm))\n                          (cf-p (second pair))))\n                 answers)\n      ;; Add replies to the data base\n      (dolist (pair answers)\n        (update-cf parm inst (first pair) (second pair)))\n      answers)))\n\n(defun parse-reply (reply)\n  \"Convert the reply into a list of (value cf) pairs.\"\n  (cond ((null reply) nil)\n        ((atom reply) `((,reply ,true)))\n        (t (cons (list (first reply) (second reply))\n                 (parse-reply (rest2 reply))))))\n```\n\nParameters are implemented as structures with six slots: the name (a symbol), the context the parameter is for, the prompt used to ask for the parameter's value, a Boolean that tells if we should ask the user before or after using rules, a type restriction describing the legal values, and finally, the function used to read the value of the parameter.\n\nParameters are stored on the property list of their names under the `parm` property, so getting the `parm-type` of a name requires first getting the parm structure, and then selecting the type restriction field.\nBy default, a parameter is given type `t`, meaning that any value is valid for that type.\nWe also define the type `yes/no`, which comes in handy for Boolean parameters.\n\nWe want the default prompt to be \"What is the PARM of the INST?\" But most user-defined prompts will want to print the inst, and not the parm.\nTo make it easy to write user-defined prompts, `prompt-and-read-vals` makes the instance be the first argument to the format string, with the parm second.\nTherefore, in the default prompt we need to use the format directive `\"~*\"` to skip the instance argument, and `\"~2:*\"` to back up two arguments to get back to the instance.\n(These directives are common in `cerror` calls, where one list of arguments is passed to two format strings.)\n\n`defparm` is a macro that calls `new-parm`, the constructor function defined in the `parm` structure, and stores the resulting structure under the `parm` property of the parameter's name.\n\n```lisp\n(defstruct (parm (:constructor\n                  new-parm (name &optional context type-restriction\n                            prompt ask-first reader)))\n  name (context nil) (prompt \"~&What is the ~*~a of ~2:*~a?\")\n  (ask-first nil) (type-restriction t) (reader 'read))\n\n(defmacro defparm (parm &rest args)\n  \"Define a parameter.\"\n  `(setf (get ',parm 'parm) (apply #'new-parm ',parm ',args)))\n\n(defun parm-type (parm-name)\n  \"What type is expected for a value of this parameter?\"\n  (parm-type-restriction (get-parm parm-name)))\n\n(defun get-parm (parm-name)\n  \"Look up the parameter structure with this name.\"\n  ;; If there is none, make one\n  (or (get parm-name 'parm)\n      (setf (get parm-name 'parm) (new-parm parm-name))))\n\n(deftype yes/no () '(member yes no))\n```\n\n## 16.4 Contexts Instead of Variables\n\nEarlier we gave an equation relating EMYCIN to Prolog.\nThat equation was not quite correct, because EMYCIN lacks one of Prolog's most important features: the logic variable.\nInstead, EMYCIN uses *contexts*.\nSo the complete equation is:\n\nEMYCIN = Prolog + uncertainty + caching + questions + explanations + contexts - variables\n\nA context is defined by the designers of MYCIN as a situation within which the program reasons.\nBut it makes more sense to think of a context simply as a data type.\nSo the list of contexts supplied to the program will determine what types of objects can be reasoned about.\nThe program keeps track of the most recent instance of each type, and the rules can refer to those instances only, using the name of the type.\nIn our version of MYCIN, there are three types or contexts: patients, cultures, and organisms.\nHere is an example of a rule that references all three contexts:\n\n```lisp\n(defrule 52\n if (site culture is blood)\n   (gram organism is neg)\n   (morphology organism is rod)\n   (burn patient is serious)\n then .4\n   (identity organism is pseudomonas))\n```\n\nIgnoring certainty factors for the moment, this MYCIN rule is equivalent to a Prolog rule of the form:\n\n```lisp\n(<- (identity ?o ?pseudomonas)\n (and (culture` ?c) `(site ?c blood)\n  (organism ?o) (gram ?o neg) (morphology ?o rod)\n  (patient ?p) (burn ?p serious)))\n```\n\nThe context mechanism provides sufficient flexibility to handle many of the cases that would otherwise be handled by variables.\nOne important thing that cannot be done is to refer to more than one instance of the same context.\nOnly the most recent instance can be referred to.\nContexts are implemented as structures with the following definition:\n\n```lisp\n(defstruct context\n  \"A context is a sub-domain, a type.\"\n  name (number 0) initial-data goals)\n\n(defmacro defcontext (name &optional initial-data goals)\n  \"Define a context.\"\n  `(make-context :name ',name :initial-data ',initial-data\n                 :goals ',goals))\n```\n\nThe `name` field is something like `patient or organism.` Instances of contexts are numbered; the `number` field holds the number of the most recent instance.\nEach context also has two lists of parameters.\nThe `initial-data` parameters are asked for when each instance is created.\nInitial data parameters are normally known by the user.\nFor example, a doctor will normally know the patient's name, age, and sex, and as a matter of training expects to be asked these questions first, even if they don't factor into every case.\nThe goal parameters, on the other hand, are usually unknown to the user.\nThey are determined through the backward-chaining process.\n\nThe following function creates a new instance of a context, writes a message, and stores the instance in two places in the data base: under the key `current-instance`, and also under the name of the context.\nThe contexts form a tree.\nIn our example, the `patient` context is the root of the tree, and the current patient is stored in the data base under the key `patient.` The next level of the tree is for cultures taken from the patient; the current culture is stored under the `culture` key.\nFinally, there is a level for organisms found in each culture.\nThe current organism is stored under both the `organism` and `current-instance` keys.\nThe context tree is shown in [figure 16.2](#fig-16-02).\n\n\n| <a id=\"fig-16-02\"></a>[]() |\n|---|\n| <img src=\"images/chapter16/fig-16-02.svg\" onerror=\"this.src='images/chapter16/fig-16-02.png'; this.onerror=null;\" alt=\"Figure 16.2\" /> |\n| **Figure 16.2: A Context Tree** |\n\n```lisp\n(defun new-instance (context)\n  \"Create a new instance of this context.\"\n  (let ((instance (format nil \"~a-~d\"\n                          (context-name context)\n                          (incf (context-number context)))))\n  (format t \"~&------ ~a ------~&\" instance)\n    (put-db (context-name context) instance)\n    (put-db 'current-instance instance)))\n```\n\n## 16.5 Backward-Chaining Revisited\n\nNow that we have seen how EMYCIN is different from Prolog, we are ready to tackle the way in which it is the same: the backward-chaining rule interpreter.\nLike Prolog, EMYCIN is given a goal and applies rules that are appropriate to the goal.\nApplying a rule means treating each premise of the rule as a goal and recursively applying rules that are appropriate to each premise.\n\nThere are still some remaining differences.\nIn Prolog, a goal can be any expression, and appropriate rules are those whose heads unify with the goal.\nIf any appropriate rule succeeds, then the goal is known to be true.\nIn EMYCIN, a rule might give a goal a certainty of .99, but we still have to consider all the other rules that are appropriate to the goal, because they might bring the certainty down below the cutoff threshold.\nThus, EMYCIN always gathers all evidence relating to a parameter/instance pair first, and only evaluates the goal after all the evidence is in.\nFor example, if the goal was (`temp patient > 98.6`), EMYCIN would first evaluate all rules with conclusions about the current patient's temperature, and only then compare the temperature to 98.6.\n\nAnother way of looking at it is that Prolog has the luxury of searching depth-first, because the semantics of Prolog rules is such that if any rule says a goal is true, then it is true.\nEMYCIN must search breadth-first, because a goal with certainty of .99 might turn out to be false when more evidence is considered.\n\nWe are now ready to sketch out the design of the EMYCIN rule interpreter: To `find-out` a parameter of an instance: If the value is already stored in the data base, use the known value.\nOtherwise, the two choices are using the rules or asking the user.\nDo these in the order specified for this parameter, and if the first one succeeds, don't bother with the second.\nNote that `ask-vals` (defined above) will not ask the same question twice.\n\nTo `use-rules`, find all the rules that concern the given parameter and evaluate them with `use-rule`.\nAfter each rule has been tried, if any of them evaluate to true, then succeed.\n\nTo `use-rule` a rule, first check if any of the premises can be rejected outright.\nIf we did not have this check, then the system could start asking the user questions that were obviously irrelevant.\nSo we waste some of the program's time (checking each premise twice) to save the more valuable user time.\n(The function `eval-condition` takes an optional argument specifying if we should recursively ask questions in trying to accept or reject a condition.)\n\nIf no premise can be rejected, then evaluate each premise in turn with `evaluate-condition`, keeping track of the accumulated certainty factor with `cf-and` (which is currently just `min`), and cutting off evaluation when the certainty factor drops below threshold.\nIf the premises evaluate true, then add the conclusions to the data base.\nThe calling sequence looks like this.\nNote that the recursive call to `find-out` is what enables chaining to occur:\n\n```lisp\nfind-out                  ;  To find out a parameter for an instance:\n  get-db                  ;    See if it is cached in the data base\n  ask-vals                ;    See if the user knows the answer\n  use-rules               ;    See if there is a rule for it:\n      reject-premise      ;      See if the rule is outright false\n      satisfy-premises    ;      Or see if each condition is true:\n          eval-condition  ;        Evaluate each condition\n            find-out      ;          By finding the parameter's values\n```\n\nBefore showing the interpreter, here is the structure definition for rules, along with the functions to maintain a data base of rules:\n\n```lisp\n(defstruct (rule (:print-function print-rule))\n  number premises conclusions cf)\n\n(let ((rules (make-hash-table)))\n\n  (defun put-rule (rule)\n    \"Put the rule in a table, indexed under each\n    parm in the conclusion.\"\n    (dolist (concl (rule-conclusions rule))\n      (push rule (gethash (first concl) rules)))\n    rule)\n\n  (defun get-rules (parm)\n    \"A list of rules that help determine this parameter.\"\n    (gethash parm rules))\n\n  (defun clear-rules () (clrhash rules)))\n```\n\nHere, then, is the interpreter, `find-out`.\nIt can find out the value(s) of a parameter three ways.\nFirst, it looks to see if the value is already stored in the data base.\nNext, it tries asking the user or using the rules.\nThe order in which these two options are tried depends on the `parm-ask-first` property of the parameter.\nEither way, if an answer is determined, it is stored in the data base.\n\n```lisp\n(defun find-out (parm &optional (inst (get-db 'current-instance)))\n  \"Find the value(s) of this parameter for this instance,\n  unless the values are already known.\n  Some parameters we ask first; others we use rules first.\"\n  (or (get-db `(known ,parm ,inst))\n      (put-db `(known ,parm ,inst)\n              (if (parm-ask-first (get-parm parm))\n                  (or (ask-vals parm inst) (use-rules parm))\n                  (or (use-rules parm) (ask-vals parm inst))))))\n\n(defun use-rules (parm)\n  \"Try every rule associated with this parameter.\n  Return true if one of the rules returns true.\"\n  (some #'true-p (mapcar #'use-rule (get-rules parm))))\n\n(defun use-rule (rule)\n  \"Apply a rule to the current situation.\"\n  ;; Keep track of the rule for the explanation system:\n  (put-db 'current-rule rule)\n  ;; If any premise is known false, give up.\n  ;; If every premise can be proved true,  then\n  ;; draw conclusions (weighted with the certainty factor).\n  (unless (some #'reject-premise (rule-premises rule))\n    (let ((cf (satisfy-premises (rule-premises rule) true)))\n      (when (true-p cf)\n        (dolist (conclusion (rule-conclusions rule))\n          (conclude conclusion (* cf (rule-cf rule))))\n        cf))))\n\n(defun satisfy-premises (premises cf-so-far)\n  \"A list of premises is satisfied if they are all true.\n  A combined cf is returned.\"\n  ;; cf-so-far is an accumulator of certainty factors\n  (cond ((null premises) cf-so-far)\n        ((not (true-p cf-so-far)) false)\n        (t (satisfy-premises\n             (rest premises)\n             (cf-and cf-so-far\n                     (eval-condition (first premises)))))))\n```\n\nThe function `eval-condition` evaluates a single condition, returning its certainty factor.\nIf `find-out-p` is true, it first calls `find-out`, which may either query the user or apply appropriate rules.\nIf `find-out-p` is false, it evaluates the condition using the current state of the data base.\nIt does this by looking at each stored value for the parameter/instance pair and evaluating the operator on it.\nFor example, if the condition is `(temp patient > 98.6)`) and the values for `temp` for the current patient are `((98 .3) (99 .6) (100 .1))`, then `eval-condition` will test each of the values 98, 99, and 100 against 98.6 using the `>` operator.\nThis test will succeed twice, so the resulting certainty factor is .6 + .1 = .7.\n\nThe function `reject-premise` is designed as a quick test to eliminate a rule.\nAs such, it calls `eval-condition` with `find-out-p` nil, so it will reject a premise only if it is clearly false without seeking additional information.\n\nIf a rule's premises are true, then the conclusions are added to the data base by `conclude`.\nNote that `is` is the only operator allowed in conclusions, `is` is just an alias for equal.\n\n```lisp\n(defun eval-condition (condition &optional (find-out-p t))\n  \"See if this condition is true, optionally using FIND-OUT\n  to determine unknown parameters.\"\n  (multiple-value-bind (parm inst op val)\n      (parse-condition condition)\n    (when find-out-p\n      (find-out parm inst))\n    ;; Add up all the (val cf) pairs that satisfy the test\n    (loop for pair in (get-vals parm inst)\n          when (funcall op (first pair) val)\n          sum (second pair))))\n\n(defun reject-premise (premise)\n  \"A premise is rejected if it is known false, without\n  needing to call find-out recursively.\"\n  (false-p (eval-condition premise nil)))\n\n(defun conclude (conclusion cf)\n  \"Add a conclusion (with specified certainty factor) to DB.\"\n  (multiple-value-bind (parm inst op val)\n      (parse-condition conclusion)\n    (update-cf parm inst val cf)))\n\n(defun is (a b) (equal a b))\n```\n\nAll conditions are of the form: (*parameter instance operator value*).\nFor example: `(morphology organism is rod)`.\nThe function `parse-condition` turns a list of this form into four values.\nThe trick is that it uses the data base to return the current instance of the context, rather than the context name itself:\n\n```lisp\n(defun parse-condition (condition)\n  \"A condition is of the form (parm inst op val).\n  So for (age patient is 21), we would return 4 values:\n  (age patient-1 is 21), where patient-1 is the current patient.\"\n  (values (first condition)\n          (get-db (second condition))\n          (third condition)\n          (fourth condition)))\n```\n\nAt this point a call like (`find-out 'identity 'organism-1`) would do the right thing only if we had somehow entered the proper information on the current patient, culture, and organism.\nThe function `get-context-data` makes sure that each context is treated in order.\nFirst an instance is created, then `find-out` is used to determine both the initial data parameters and the goals.\nThe findings for each goal are printed, and the program asks if there is another instance of this context.\nFinally, we also need a top-level function, `emycin`, which just clears the data base before calling `get-context-data`.\n\n```lisp\n(defun emycin (contexts)\n  \"An Expert System Shell.  Accumulate data for instances of each\n  context, and solve for goals.  Then report the findings.\"\n  (clear-db)\n  (get-context-data contexts))\n\n(defun get-context-data (contexts)\n  \"For each context, create an instance and try to find out\n  required data.  Then go on to other contexts, depth first,\n  and finally ask if there are other instances of this context.\"\n  (unless (null contexts)\n    (let* ((context (first contexts))\n           (inst (new-instance context)))\n      (put-db 'current-rule 'initial)\n      (mapc #'find-out (context-initial-data context))\n      (put-db 'current-rule 'goal)\n      (mapc #'find-out (context-goals context))\n      (report-findings context inst)\n      (get-context-data (rest contexts))\n      (when (y-or-n-p \"Is there another ~a?\"\n                      (context-name context))\n        (get-context-data contexts)))))\n```\n\n## 16.6 Interacting with the Expert\n\nAt this point all the serious computational work is done: we have defined a backward-chaining rule mechanism that deals with uncertainty, caching, questions, and contexts.\nBut there is still quite a bit of work to do in terms of input/output interaction.\nA programming language needs only to interface with programmers, so it is acceptable to make the programmer do all the work.\nBut an expert-system shell is supposed to alleviate (if not abolish) the need for programmers.\nExpert-system shells really have two classes of users: the experts use the shell when they are developing the system, and the end users or clients use the resulting expert system when it is completed.\nSometimes the expert can enter knowledge directly into the shell, but more often it is assumed the expert will have the help of a *knowledge engineer*-someone who is trained in the use of the shell and in eliciting knowledge, but who need not be either an expert in the domain or an expert programmer.\n\nIn our version of EMYCIN, we provide only the simplest tools for making the expert's job easier.\nThe macros `defcontext` and `defparm`, defined above, are a little easier than calling `make-context` and `make-parm` explicitly, but not much.\nThe macro `defrule` defines a rule and checks for some obvious errors:\n\n```lisp\n(defmacro defrule (number &body body)\n  \"Define a rule with conditions, a certainty factor, and\n  conclusions.  Example: (defrule R001 if ... then .9 ...)\"\n  (assert (eq (first body) 'if))\n  (let* ((then-part (member 'then body))\n         (premises (ldiff (rest body) then-part))\n         (conclusions (rest2 then-part))\n         (cf (second then-part)))\n    ;; Do some error checking:\n    (check-conditions number premises 'premise)\n    (check-conditions number conclusions 'conclusion)\n    (when (not (cf-p cf))\n      (warn \"Rule ~a: Illegal certainty factor: ~a\" number cf))\n    ;; Now build the rule:\n    `(put-rule\n       (make-rule :number ',number :cf ,cf :premises ',premises\n                  :conclusions ',conclusions))))\n```\n\nThe function `check-conditions` makes sure that each rule has at least one premise and conclusion, that each condition is of the right form, and that the value of the condition is of the right type for the parameter.\nIt also checks that conclusions use only the operator `is`:\n\n```lisp\n(defun check-conditions (rule-num conditions kind)\n  \"Warn if any conditions are invalid.\"\n  (when (null conditions)\n    (warn \"Rule ~a: Missing ~a\" rule-num kind))\n  (dolist (condition conditions)\n    (when (not (consp condition))\n      (warn \"Rule ~a: Illegal ~a: ~a\" rule-num kind condition))\n    (multiple-value-bind (parm inst op val)\n        (parse-condition condition)\n      (declare (ignore inst))\n      (when (and (eq kind 'conclusion) (not (eq op 'is)))\n        (warn \"Rule ~a: Illegal operator (~a) in conclusion: ~a\"\n              rule-num op condition))\n      (when (not (typep val (parm-type parm)))\n        (warn \"Rule ~a: Illegal value (~a) in ~a: ~a\"\n              rule-num val kind condition)))))\n```\n\nThe real EMYCIN had an interactive environment that prompted the expert for each context, parameter, and rule.\nRandall Davis ([1977](bibliography.md#bb0290), [1979](bibliography.md#bb0295), [Davis and Lenat 1982](bibliography.md#bb0300)) describes the TEIRESIAS program, which helped experts enter and debug rules.\n\n## 16.7 Interacting with the Client\n\nOnce the knowledge is in, we need some way to get it out.\nThe client wants to run the system on his or her own problem and see two things: a solution to the problem, and an explanation of why the solution is reasonable.\nEMYCIN provides primitive facilities for both of these.\nThe function `report-findings` prints information on all the goal parameters for a given instance:\n\n```lisp\n(defun report-findings (context inst)\n  \"Print findings on each goal for this instance.\"\n  (when (context-goals context)\n    (format t \"~&Findings for ~a:\" (inst-name inst))\n    (dolist (goal (context-goals context))\n      (let ((values (get-vals goal inst)))\n        ;; If there are any values for this goal,\n        ;; print them sorted by certainty factor.\n        (if values\n            (format t \"~& ~a:~{~{ ~a (~,3f)  ~}~}\" goal\n                    (sort (copy-list values) #'> :key #'second))\n            (format t \"~& ~a: unknown\" goal))))))\n```\n\nThe only explanation facility our version of EMYCIN offers is a way to see the current rule.\nIf the user types `rule` in response to a query, a pseudo-English translation of the current rule is printed.\nHere is a sample rule and its translation:\n\n```lisp\n(defrule 52\n  if (site culture is blood)\n      (gram organism is neg)\n      (morphology organism is rod)\n      (burn patient is serious)\n  then .4\n      (identity organism is pseudomonas))\nRule 52:\n  If\n    1) THE SITE OF THE CULTURE IS BLOOD\n    2) THE GRAM OF THE ORGANISM IS NEG\n    3) THE MORPHOLOGY OF THE ORGANISM IS ROD\n    4) THE BURN OF THE PATIENT IS SERIOUS\n  Then there is weakly suggestive evidence (0.4) that\n    1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS\n```\n\nThe function `print-rule` generates this translation:\n\n```lisp\n(defun print-rule (rule &optional (stream t) depth)\n  (declare (ignore depth))\n  (format stream \"~&Rule ~a:~&  If\" (rule-number rule))\n  (print-conditions (rule-premises rule) stream)\n  (format stream \"~&  Then ~a (~a) that\"\n          (cf->english (rule-cf rule)) (rule-cf rule))\n  (print-conditions (rule-conclusions rule) stream))\n\n(defun print-conditions (conditions &optional\n                         (stream t) (num 1))\n  \"Print a list of numbered conditions.\"\n  (dolist (condition conditions)\n    (print-condition condition stream num)))\n\n(defun print-condition (condition stream number)\n  \"Print a single condition in pseudo-English.\"\n  (format stream \"~&    ~d)~{ ~a~}\" number\n          (let ((parm (first condition))\n                (inst (second condition))\n                (op (third condition))\n                (val (fourth condition)))\n            (case val\n              (YES `(the ,inst ,op ,parm))\n              (NO  `(the ,inst ,op not ,parm))\n              (T   `(the ,parm of the ,inst ,op ,val))))))\n\n(defun cf->english (cf)\n  \"Convert a certainy factor to an English phrase.\"\n  (cond ((= cf  1.0) \"there is certain evidence\")\n        ((> cf   .8) \"there is strongly suggestive evidence\")\n        ((> cf   .5) \"there is suggestive evidence\")\n        ((> cf  0.0) \"there is weakly suggestive evidence\")\n        ((= cf  0.0) \"there is NO evidence either way\")\n        ((< cf  0.0) (concatenate 'string (cf->english (- cf))\n                                  \" AGAINST the conclusion\"))))\n```\n\nIf the user types `why` in response to a query, a more detailed account of the same rule is printed.\nFirst, the premises that are already known are displayed, followed by the remainder of the rule.\nThe parameter being asked for will always be the first premise in the remainder of the rule.\nThe `current-rule` is stored in the data base by `use-rule` whenever a rule is applied, but it is also set by `get-context-data` to the atom `initial` or goal when the system is prompting for parameters.\n`print-why` checks for this case as well.\nNote the use of the `partition-if` function from page 256.\n\n```lisp\n(defun print-why (rule parm)\n  \"Tell why this rule is being used.  Print what is known,\n  what we are trying to find out, and what we can conclude.\"\n  (format t \"~&[Why is the value of ~a being asked for?]\" parm)\n  (if (member rule '(initial goal))\n      (format t \"~&~a is one of the ~a parameters.\"\n              parm rule)\n      (multiple-value-bind (knowns unknowns)\n          (partition-if #'(lambda (premise)\n                            (true-p (eval-condition premise nil)))\n                        (rule-premises rule))\n        (when knowns\n          (format t \"~&It is known that:\")\n          (print-conditions knowns)\n          (format t \"~&Therefore,\"))\n        (let ((new-rule (copy-rule rule)))\n          (setf (rule-premises new-rule) unknowns)\n          (print new-rule)))))\n```\n\nThat completes the definition of `emycin`.\nWe are now ready to apply the shell to a specific domain, yielding the beginnings of an expert system.\n\n## 16.8 **MYCIN**, A Medical Expert System\n\nThis section applies `emycin` to MYCIN's original domain: infectious blood disease.\nIn our version of MYCIN, there are three contexts: first we consider a patient, then any cultures that have been grown from samples taken from the patient, and finally any infectious organisms in the cultures.\nThe goal is to determine the identity of each organism.\nThe real MYCIN was more complex, taking into account any drugs or operations the patient may previously have had.\nIt also went on to decide the real question: what therapy to prescribe.\nHowever, much of this was done by special-purpose procedures to compute optimal dosages and the like, so it is not included here.\nThe original MYCIN also made a distinction between current versus prior cultures, organisms, and drugs.\nAll together, it had ten contexts to consider, while our version only has three:\n\n```lisp\n(defun mycin ()\n  \"Determine what organism is infecting a patient.\"\n  (emycin\n    (list (defcontext patient  (name sex age)  ())\n          (defcontext culture  (site days-old) ())\n          (defcontext organism ()              (identity)))))\n```\n\nThese contexts declare that we will first ask each patient's name, sex, and age, and each culture's site and the number of days ago it was isolated.\nOrganisms have no initial questions, but they do have a goal: to determine the identity of the organism.\n\nThe next step is to declare parameters for the contexts.\nEach parameter is given a type, and most are given prompts to improve the naturalness of the dialogue:\n\n```lisp\n;;; Parameters for patient:\n(defparm name patient t \"Patient's name: \" t read-line)\n(defparm sex patient (member male female) \"Sex:\" t)\n(defparm age patient number \"Age:\" t)\n(defparm burn patient (member no mild serious)\n  \"Is ~a a burn patient?  If so, mild or serious?\" t)\n(defparm compromised-host patient yes/no\n  \"Is ~a a compromised host?\")\n\n;;; Parameters for culture:\n(defparm site culture (member blood)\n  \"From what site was the specimen for ~a taken?\" t)\n(defparm days-old culture number\n  \"How many days ago was this culture (~a) obtained?\" t)\n\n;;; Parameters for organism:\n(defparm identity organism\n  (member pseudomonas klebsiella enterobacteriaceae\n          staphylococcus bacteroides streptococcus)\n  \"Enter the identity (genus) of ~a:\" t)\n(defparm gram organism (member acid-fast pos neg)\n  \"The gram stain of ~a:\" t)\n(defparm morphology organism (member rod coccus)\n  \"Is ~a a rod or coccus (etc.):\")\n(defparm aerobicity organism (member aerobic anaerobic))\n(defparm growth-conformation organism\n  (member chains pairs clumps))\n```\n\nNow we need some rules to help determine the identity of the organisms.\nThe following rules are taken from [Shortliffe 1976](bibliography.md#bb1100).\nThe rule numbers refer to the pages on which they are listed.\nThe real MYCIN had about 400 rules, dealing with a much wider variety of premises and conclusions.\n\n```lisp\n(clear-rules)\n\n(defrule 52\n  if (site culture is blood)\n     (gram organism is neg)\n     (morphology organism is rod)\n     (burn patient is serious)\n  then .4\n     (identity organism is pseudomonas))\n\n(defrule 71\n  if (gram organism is pos)\n     (morphology organism is coccus)\n     (growth-conformation organism is clumps)\n  then .7\n     (identity organism is staphylococcus))\n\n(defrule 73\n  if (site culture is blood)\n     (gram organism is neg)\n     (morphology organism is rod)\n     (aerobicity organism is anaerobic)\n  then .9\n     (identity organism is bacteroides))\n\n(defrule 75\n  if (gram organism is neg)\n     (morphology organism is rod)\n     (compromised-host patient is yes)\n  then .6\n     (identity organism is pseudomonas))\n\n(defrule 107\n  if (gram organism is neg)\n     (morphology organism is rod)\n     (aerobicity organism is aerobic)\n  then .8\n     (identity organism is enterobacteriaceae))\n\n(defrule 165\n  if (gram organism is pos)\n     (morphology organism is coccus)\n     (growth-conformation organism is chains)\n  then .7\n     (identity organism is streptococcus))\n```\n\nHere is an example of the program in use:\n\n```lisp\n> (mycin)\n------ PATIENT-1 ------\nPatient's name: Sylvia Fischer\nSex: female\nAge: 27\n------ CULTURE-1 ------\nFrom what site was the specimen for CULTURE-1 taken? blood\nHow many days ago was this culture (CULTURE-1) obtained? 3\n------ ORGANISM-1 ------\nEnter the identity (genus) of ORGANISM-1: unknown\nThe gram stain of ORGANISM-1: ?\nA GRAM must be of type (MEMBER ACID-FAST POS NEG)\nThe gram stain of ORGANISM-1: neg\n```\n\nThe user typed `?` to see the list of valid responses.\nThe dialog continues:\n\n```lisp\nIs ORGANISM-1 a rod or coccus (etc.): rod\nWhat is the AEROBICITY of ORGANISM-1? Why\n[Why is the value of AEROBICITY being asked for?]\nIt is known that:\n      1) THE GRAM OF THE ORGANISM IS NEG\n      2) THE MORPHOLOGY OF THE ORGANISM IS ROD\nTherefore,\nRule 107:\n  If\n      1) THE AEROBICITY OF THE ORGANISM IS AEROBIC\n  Then there is suggestive evidence (0.8) that\n      1) THE IDENTITY OF THE ORGANISM IS ENTEROBACTERIACEAE\n```\n\nThe user wants to know why the system is asking about the organism's aerobicity.\nThe reply shows the current rule, what is already known about the rule, and the fact that if the organism is aerobic, then we can conclude something about its identity.\nIn this hypothetical case, the organism is in fact aerobic:\n\n```lisp\nWhat is the AEROBICITY of ORGANISM-1? aerobic\nIs Sylvia Fischer a compromised host? yes\nIs Sylvia Fischer a burn patient? If so, mild or serious? why\n[Why is the value of BURN being asked for?]\nIt is known that:\n      1) THE SITE OF THE CULTURE IS BLOOD\n      2) THE GRAM OF THE ORGANISM IS NEG\n      3) THE MORPHOLOGY OF THE ORGANISM IS ROD\nTherefore,\nRule 52:\n If\n   1) THE BURN OF THE PATIENT IS SERIOUS\n Then there is weakly suggestive evidence (0.4) that\n   1) THE IDENTITY OF THE ORGANISM IS PSEUDOMONAS\nIs Sylvia Fischer a burn patient? If so, mild or serious? serious\nFindings for ORGANISM-1:\n  IDENTITY: ENTEROBACTERIACEAE (0.800) PSEUDOMONAS (0.760)\n```\n\nThe system used rule 107 to conclude the identity might be enterobacteriaceae.\nThe certainty is .8, the certainty for the rule itself, because all the conditions were known to be true with certainty.\nRules 52 and 75 both support the hypothesis of pseudomonas.\nThe certainty factors of the two rules, .6 and .4, are combined by the formula .6 + .4 - (.6 x .4) = .76.\nAfter printing the findings for the first organism, the system asks if another organism was obtained from this culture:\n\n```lisp\nIs there another ORGANISM? (Y or N) Y\n------ ORGANISM-2 ------\nEnter the identity (genus) of ORGANISM-2: unknown\nThe gram stain of ORGANISM-2: (neg .8 pos .2)\nIs ORGANISM-2 a rod or coccus (etc.): rod\nWhat is the AEROBICITY of ORGANISM-2? anaerobic\n```\n\nFor the second organism, the lab test was inconclusive, so the user entered a qualified answer indicating that it is probably gram-negative, but perhaps gram-positive.\nThis organism was also a rod but was anaerobic.\nNote that the system does not repeat questions that it already knows the answers to.\nIn considering rules 75 and 52 it already knows that the culture came from the blood, and that the patient is a compromised host and a serious burn patient.\nIn the end, rule 73 contributes to the bacteroides conclusion, and rules 75 and 52 again combine to suggest pseudomonas, although with a lower certainty factor, because the neg finding had a lower certainty factor:\n\n```lisp\nFindings for ORGANISM-2:\n  IDENTITY: BACTEROIDES (0.720) PSEUDOMONAS (0.646)\n```\n\nFinally, the program gives the user the opportunity to extend the context tree with new organisms, cultures, or patients:\n\n```lisp\nIs there another ORGANISM? (Y or N) N\nIs there another CULTURE? (Y or N) N\nIs there another PATIENT? (Y or N) N\n```\n\nThe set of rules listed above do not demonstrate two important features of the system: the ability to backward-chain, and the ability to use operators other than `is` in premises.\n\nIf we add the following three rules and repeat the case shown above, then evaluating rule 75 will back-chain to rule 1, 2, and finally 3 trying to determine if the patient is a compromised host.\nNote that the question asked will be \"What is Sylvia Fischer's white blood cell count?\" and not \"Is the white blood cell count of Sylvia Fischer < 2.5?\" The latter question would suffice for the premise at hand, but it would not be as useful for other rules that might refer to the WBC.\n\n```lisp\n(defparm wbc patient number\n  \"What is ~a's white blood cell count?\")\n(defrule 1\n  if (immunosuppressed patient is yes)\n  then 1.0 (compromised-host patient is yes))\n(defrule 2\n  if (leukopenia patient is yes)\n  then 1.0 (immunosuppressed patient is yes))\n(defrule 3\n  if (wbc patient <  2.5)\n  then .9 (leukopenia patient is yes))\n```\n\n## 16.9 Alternatives to Certainty Factors\n\nCertainty factors are a compromise.\nThe good news is that a system based on rules with certainty factors requires the expert to come up with only a small set of numbers (one for each rule) and will allow fast computation of answers.\nThe bad news is that the answer computed may lead to irrational decisions.\n\nCertainty factors have been justified by their performance (MYCIN performed as well or better than expert doctors) and by intuitive appeal (they satisfy the criteria listed on page 534).\nHowever, they are subject to paradoxes where they compute bizarre results (as in Exercise 16.1, page 536).\nIf the rules that make up the knowledge base are designed in a modular fashion, then problems usually do not arise, but it is certainly worrisome that the answers may be untrustworthy.\n\nBefore MYCIN, most reasoning with uncertainty was done using probability theory.\nThe laws of probability-in particular, Bayes's law-provide a well-founded mathematical formalism that is not subject to the inconsistencies of certainty factors.\nIndeed, probability theory can be shown to be the only formalism that leads to rational behavior, in the sense that if you have to make a series of bets on some uncertain events, combining information with probability theory will give you the highest expected value for your bets.\nDespite this, probability theory was largely set aside in the mid-1970s.\nThe argument made by [Shortliffe and Buchanan (1975)](bibliography.md#bb1105) was that probability theory required too many conditional probabilities, and that people were not good at estimating these.\nThey argued that certainty factors were intuitively easier to deal with.\nOther researchers of the time shared this view.\nShafer, with later refinements by Dempster, created a theory of belief functions that, like certainty factors, represented a combination of the belief for and against an event.\nInstead of representing an event by a single probability or certainty, Dempster-Shafer theory maintains two numbers, which are analogous to the lower and upper bound on the probability.\nInstead of a single number like .5, Dempster-Shafer theory would have an interval like [.4,.6] to represent a range of probabilities.\nA complete lack of knowledge would be represented by the range [0,1].\nA great deal of effort in the late 1970s and early 1980s was invested in these and other nonprobabilistic theories.\nAnother example is Zadeh's fuzzy set theory, which is also based on intervals.\n\nThere is ample evidence that people have difficulty with problems involving probability.\nIn a very entertaining and thought-provoking series of articles, Tversky and Kahneman ([1974](bibliography.md#bb1245), [1983](bibliography.md#bb1250), [1986](bibliography.md#bb1255)) show how people make irrational choices when faced with problems that are quite simple from a mathematical viewpoint.\nThey liken these errors in choice to errors in visual perception caused by optical illusions.\nEven trained doctors and statisticians are subject to these errors.\n\nAs an example, consider the following scenario.\nAdrian and Dominique are to be married.\nAdrian goes for a routine blood test and is told that the results are positive for a rare genetic disorder, one that strikes only 1 in 10,000 people.\nThe doctor says that the test is 99% accurate-it gives a false positive reading in only 1 in 100 cases.\nAdrian is despondent, being convinced that the probability of actually having the disease is 99%.\nFortunately, Dominique happens to be a Bayesian, and quickly reassures Adrian that the chance is more like 1%.\nThe reasoning is as follows: Take 10,001 people at random.\nOf these, only 1 is expected to have the disease.\nThat person could certainly expect to test positive for the disease.\nBut if the other 10,000 people all took the blood test, then 1% of them, or 100 people would also test positive.\nThus, the chance of actually having the disease given that one tests positive is 1/101.\nDoctors are trained in this kind of analysis, but unfortunately many of them continue to reason more like Adrian than Dominique.\n\nIn the late 1980s, the tide started to turn back to subjective Bayesian probability theory.\n[Cheeseman (1985)](bibliography.md#bb0185) showed that, while Dempster-Shafer theory looks like it can, in fact it cannot help you make better decisions than probability theory.\n[Heckerman (1986)](bibliography.md#bb0525) re-examined MYCIN's certainty factors, showing how they could be interpreted as probabilities.\nJudea [Pearl's 1988](bibliography.md#bb0935) book is an eloquent defense of probability theory.\nHe shows that there are efficient algorithms for combining and propagating probabilities, as long as the network of interdependencies does not contain loops.\nIt seems likely that uncertain reasoning in the 1990s will be based increasingly on Bayesian probability theory.\n\n## 16.10 History and References\n\nThe MYCIN project is well documented in [Buchanan and Shortliffe 1984](bibliography.md#bb0145).\nAn earlier book, [Shortliffe 1976](bibliography.md#bb1100), is interesting mainly for historical purposes.\nGood introductions to expert systems in general include [Weiss and Kulikowski 1984](bibliography.md#bb1365), [Waterman 1986](bibliography.md#bb1345), [Luger and Stubblefield 1989](bibliography.md#bb0760), and [Jackson 1990](bibliography.md#bb0580).\n\nDempster-Shafer evidence theory is presented enthusiastically in [Gordon and Shortliffe 1984](bibliography.md#bb0485) and in a critical light in [Pearl 1989](bibliography.md#bb0940)/1978.\nFuzzy set theory is presented in Zadeh 1979 and [Dubois and Prade 1988](bibliography.md#bb0350).\n\n[Pearl (1988)](bibliography.md#bb0935) captures most of the important points that lead to the renaissance of probability theory.\n[Shafer and Pearl 1990](bibliography.md#bb1090) is a balanced collection of papers on all kinds of uncertain reasoning.\n\n## 16.11 Exercises\n\n**Exercise  16.2 [s]** Suppose the rule writer wanted to be able to use symbolic certainty factors instead of numbers.\nWhat would you need to change to support rules like this:\n\n```lisp\n(defrule 100 if ... then true ...)\n(defrule 101 if ... then probably ...)\n```\n\n**Exercise  16.3 [m]** Change `prompt-and-read-vals` so that it gives a better prompt for parameters of type `yes/no`.\n\n**Exercise  16.4 [m]** Currently, the rule writer can introduce a new parameter without defining it first.\nThat is handy for rapid testing, but it means that the user of the system won't be able to see a nice English prompt, nor ask for the type of the parameter.\nIn addition, if the rule writer simply misspells a parameter, it will be treated as a new one.\nMake a simple change to fix these problems.\n\n**Exercise  16.5 [d]** Write rules in a domain you are an expert in, or find and interview an expert in some domain, and write down rules coaxed from the expert.\nEvaluate your resulting system.\nWas it easier to develop your system with EMYCIN than it would have been without it?\n\n**Exercise  16.6 [s]** It is said that an early version of MYCIN asked if the patient was pregnant, even though the patient was male.\nWrite a rule that would fix this problem.\n\n**Exercise  16.7 [m]** To a yes/no question, what is the difference between `yes` and `(no-1)`? What does this suggest?\n\n**Exercise  16.8 [m]** What happens if the user types `why` to the prompt about the patient's name?\nWhat happens if the expert wants to have more than one context with a name parameter?\nIf there is a problem, fix it.\n\nThe remaining exercises discuss extensions that were in the original EMYCIN, but were not implemented in our version.\nImplementing all the extensions will result in a system that is very close to the full power of EMYCIN.\nThese extensions are discussed in chapter 3 of [Buchanan and Shortliffe 1984](bibliography.md#bb0145).\n\n**Exercise  16.9 [h]** Add a spelling corrector to `ask-vals`.\nIf the user enters an invalid reply, and the parameter type is a `member` expression, check if the reply is \"close\" in spelling to one of the valid values, and if so, use that value.\nThat way, the user can type just `entero` instead of `enterobacteriaceae`.\nYou may experiment with the definition of \"close,\" but you should certainly allow for prefixes and at least one instance of a changed, missing, inserted, or transposed letter.\n\n**Exercise  16.10 [m]** Indent the output for each new branch in the context tree.\nIn other words, have the prompts and findings printed like this:\n\n```lisp\n------ PATIENT-1 ------\nPatient's name: Sylvia Fischer\nSex: female\nAge: 27\n   ------ CULTURE-1 ------\n   From what site was the specimen for CULTURE-1 taken? blood\n   How many days ago was this culture (CULTURE-1) obtained? 3\n     ------ ORGANISM-1 ------\n     Enter the identity (genus) of ORGANISM-1: unknown\n     The gram stain of ORGANISM-1: neg\n     ...\n     Findings for ORGANISM-1:\n      IDENTITY: ENTEROBACTERIACEAE (0.800) PSEUDOMONAS (0.760)\n     Is there another ORGANISM? (Y or N) N\n   Is there another CULTURE? (Y or N) N\nIs there another PATIENT? (Y or N) N\n```\n\n**Exercise 16.11 [h]** We said that our `emycin` looks at all possible rules for each parameter, because there is no telling how a later rule may affect the certainty factor.\nActually, that is not quite true.\nIf there is a rule that leads to a conclusion with certainty 1, then no other rules need be considered.\nThis was called a *unity path*.\nModify the program to look for unity paths first.\n\n**Exercise  16.12 [m]** Depending on whether a parameter is in `initial-data` or not, all the relevant rules are run either before or after asking the user for the value of the parameter.\nBut there are some cases when not all initial data parameters should be asked for.\nAs an example, suppose that `identity` and `gram` were initial data parameters of `organism`.\nIf the user gave a positive answer for `identity`, then it would be wasteful to ask for the `gram` parameter, since it could be determined directly from rules.\nAfter receiving complaints about this problem, a system of *antecedent rules* was developed.\nThese rules were always run first, before asking questions.\nImplement antecedent rules.\n\n**Exercise  16.13 [h]** It is useful to be able to write *default rules* that fill in a value after all other rules have failed to determine one.\nA default rule looks like this:\n\n```lisp\n(defrule n if (parm inst unknown) then (parm inst is default))\n```\n\nIt may also have other conjuncts in the premise.\nBeside details like writing the `unknown` operator, the difficult part is in making sure that these rules get run at the right time (after other rules have had a chance to fill in the parameter), and that infinite loops are avoided.\n\n**Exercise  16.14 [h]** The context tree proved to be a limitation.\nEventually, the need arose for a rule that said, \"If any of the organisms in a culture has property X, then the culture has property Y.\" Implement a means of checking for `some` or `every` instance of a context.\n\n**Exercise  16.15 [m]** As the rule base grew, it became increasingly hard to remember the justification for previous rules.\nImplement a mechanism that keeps track of the author and date of creation of each rule, and allows the author to add documentation explaining the rationale for the rule.\n\n**Exercise  16.16 [m]** It is difficult to come up with the perfect prompt for each parameter.\nOne solution is not to insist that one prompt fits all users, but rather to allow the expert to supply three different prompts: a normal prompt, a verbose prompt (or reprompt) for when the user replies with a `?`, and a terse prompt for the experienced user.\nModify `defparm` to accommodate this concept, add a command for the user to ask for the terse prompts, and change `ask-vals` to use the proper prompt.\n\nThe remaining exercises cover three additional replies the user can make: `how`, `stop`, and `change`.\n\n**Exercise  16.17 [d]** In addition to `why` replies, EMYCIN also allowed for `how` questions.\nThe user can ask how the value of a particular parameter/instance pair was determined, and the system will reply with a list of rules and the evidence they supplied for or against each value.\nImplement this mechanism.\nIt will require storing additional information in the data base.\n\n**Exercise  16.18 [m]** There was also a `stop` command that immediately halted the session.\nImplement it.\n\n**Exercise  16.19 [d]** The original EMYCIN also had a `change` command to allow the user to change the answer to certain questions without starting all over.\nEach question was assigned a number, which was printed before the prompt.\nThe command `change`, followed by a list of numbers, causes the system to look up the questions associated with each number and delete the answer to these questions.\nThe system also throws away the entire context tree and all derived parameter values.\nAt that point the entire consultation is restarted, using only the data obtained from the unchanged questions.\nAlthough it may seem wasteful to start over from the beginning, it will not be wasteful of the user's time, since correct answers will not be asked again.\n\nIdentify what needs to be altered to implement change and make the alterations.\n\n**Exercise  16.20 [h]** Change the definition of `cf-and` and `cf-or` to use fuzzy set theory instead of certainty factors.\nDo the same for Dempster-Shafer theory.\n\n## 16.12 Answers\n\n**Answer 16.1** Because EMYCIN assumes independence, each reading of the same headline would increase the certainty factor.\nThe following computation shows that 298 more copies would be needed to reach .95 certainty.\nA more sophisticated reasoner would realize that multiple copies of a newspaper are completely dependent on one another, and would not change the certainty with each new copy.\n\n```lisp\n> (loop for cf = .01 then (cf-or .01 cf)\n      until (> cf .95)\n      count t)\n298\n```\n\n**Answer 16.2** The `defrule` expands to `(make-rule :number '101 :cf true ...)`; that is, the certainty factor is unquoted, so it is already legal to use `true` as a certainty factor!\nTo support `probably` and other hedges, just define new constants.\n\n**Answer 16.4** Just make the default parameter type be `nil` (by changing `t` to `nil` in `parm-type`).\nThen any rule that uses an undefined parameter will automatically generate a warning.\n\n**Answer 16.6**\n\n```lisp\n(defrule 4\n  if (sex patient is male)\n  then -1 (pregnant patient is yes))\n```\n\n**Answer 16.7** Logically, there should be no difference, but to EMYCIN there is a big difference.\nEMYCIN would not complain if you answered `(yes 1 no 1)`.\nThis suggests that the system should have some way of dealing with mutually exclusive answers.\nOne way would be to accept only yes responses for Boolean parameters, but have the input routine translate `no` to `(yes -1)` and `(no` *cf*) to `(yes 1-`*cf*).\nAnother possibility would be to have `update-cf` check to see if any certainty factor on a mutually exclusive value is 1, and if so, change the other values to -1.\n\n**Answer 16.18** Add the clause `(stop (throw 'stop nil))` to the case statement in `ask-vals` and wrap a `(catch 'stop ...)` around the code in `emycin`.\n"
  },
  {
    "path": "docs/chapter17.md",
    "content": "# Chapter 17\n## Line-Diagram Labeling by Constraint Satisfaction\n\n> It is wrong to think of Waltz's work only as a statement of the epistemology of line drawings of polyhedra.\nInstead I think it is an elegant case study of a paradigm we can expect to see again and again.\n>\n> -Patrick Winston\n>\n> The Psychology of Computer Vision (1975)\n\nThis book touches only the areas of AI that deal with abstract reasoning.\nThere is another side of AI, the field of *robotics,* that deals with interfacing abstract reasoning with the real world through sensors and motors.\nA robot receives input from cameras, microphones, sonar, and touch-sensitive devices, and produces \"output\" by moving its appendages or generating sounds.\nThe real world is a messier place than the abstract worlds we have been covering.\nA robot must deal with noisy data, faulty components, and other agents and events in the world that can affect changes in the environment.\n\nComputer vision is the subfield of robotics that deals with interpreting visual information.\nLow-level vision takes its input directly from a camera and detects lines, regions and textures.\nWe will not be concerned with this.\nHigh-level vision uses the findings of the low-level component to build a three-dimensional model of the objects depicted in the scene.\nThis chapter covers one small aspect of high-level vision.\n\n## 17.1 The Line-Labeling Problem\n\nIn this chapter we look at the line-diagram labeling problem: Given a list of lines and the vertexes at which they intersect, how can we determine what the lines represent?\nFor example, given the nine lines in [figure 17.1](#fig-17-01), how can we interpret the diagram as a cube?\n\n\n| <a id=\"fig-17-01\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-01.svg\" onerror=\"this.src='images/chapter17/fig-17-01.png'; this.onerror=null;\" alt=\"Figure 17.1\" /> |\n| **Figure 17.1:  A Cube** |\n\nBefore we can arrive at an interpretation, we have to agree on what the candidates are.\nAfter all, [figure 17.1](#fig-17-01) could be just a hexagon with three lines in the middle.\nFor the purposes of this chapter, we will consider only diagrams that depict one or more *polyhedra-*three-dimensional solid figures whose surfaces are flat faces bounded by straight lines.\nIn addition, we will only allow *trihedral* vertexes.\nThat is, each vertex must be formed by the intersection of three faces, as in the corner of a cube, where the top, front, and side of the cube come together.\nA third restriction on diagrams is that no so-called *accidental* vertexes are allowed.\nFor example, [figure 17.1](#fig-17-01) might be a picture of three different cubes hanging in space, which just happen to line up so that the edge of one is aligned with the edge of another from our viewpoint.\nWe will assume that this is not the case.\n\nGiven a diagram that fits these three restrictions, our goal is to identify each line, placing it in one of three classes:\n\n1.  A convex line separates two visible faces of a polyhedron such that a line from one face to the other would lie inside the polyhedron.\nIt will be marked with a plus sign: `+`.\n\n2.  A concave line separates two faces of two polyhedra such that a line between the two spaces would pass through empty space.\nIt will be marked with a minus sign: `-`.\n\n3.  A boundary line denotes the same physical situation as a convex line, but the diagram is oriented in such a way that only one of the two faces of the polyhedron is visible.\nThus, the line marks the boundary between the polyhedron and the background.\nIt will be marked with an arrow: &rarr;.\nTraveling along the line from the tail to the point of the arrow, the polyhedron is on the right, and the background is on the left.\n\n[Figure 17.2](#f0015) shows a labeling of the cube using these conventions.\nVertex A is the near corner of the cube, and the three lines coming out of it are all convex lines.\nLines GD and DF are concave lines, indicating the junction between the cube and the surface on which it is resting.\nThe remaining lines are boundary lines, indicating that there is no physical connection between the cube and the background there, but that there are other sides of the cube that cannot be seen.\n\n\n| <a id=\"fig-17-02\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-02.svg\" onerror=\"this.src='images/chapter17/fig-17-02.png'; this.onerror=null;\" alt=\"Figure 17.2\" /> |\n| **Figure 17.2: A Line-labeled Cube** |\n\nThe line-labeling technique developed in this chapter is based on a simple idea.\nFirst we enumerate all the possible vertexes, and all the possible labelings for each vertex.\nIt turns out there are only four different vertex types in the trihedral polygon world.\nWe call them L, Y, W, and T vertexes, because of their shape.\nThe Y and W vertexes are also known as forks and arrows, respectively.\nThe vertexes are listed in [figure 17.3](#fig-17-03).\nEach vertex imposes some constraints on the lines that compose it.\nFor example, in a W vertex, the middle line can be labeled with a + or -, but not with an arrow.\n\n| <a id=\"fig-17-03\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-03.svg\" onerror=\"this.src='images/chapter17/fig-17-03.png'; this.onerror=null;\" alt=\"Figure 17.3\" /> |\n| **Figure 17.3: The Possible Vertexes and Labels** |\n\nEach line connects two vertexes, so it must satisfy both constraints.\nThis suggests a simple algorithm for labeling a diagram based on constraint propagation: First, label each vertex with all the possible labelings for the vertex type.\nAn L vertex has six possibilities, Y has five, T has four, and W has three.\nNext, pick a vertex, V.\nConsider a neighboring vertex, N (that is, N and V are connected by a line).\nN will also have a set of possible labelings.\nIf N and V agree on the possible labelings for the line between them, then we have gained nothing.\nBut if the intersection of the two possibility sets is smaller than V's possibility set, then we have found a constraint on the diagram.\nWe adjust N and V's possible labelings accordingly.\nEvery time we add a constraint at a vertex, we repeat the whole process for all the neighboring vertexes, to give the constraint a chance to propagate as far as possible.\nWhen every vertex has been visited at least once and there are no more constraints to propagate, then we are done.\n\n[Figure 17.4](#fig-17-04) illustrates this process.\nOn the left we start with a cube.\nAll vertexes have all possible labelings, except that we know line GD is concave (-), indicating that the cube is resting on a surface.\nThis constrains vertex D in such a way that line DA must be convex (+).\nIn the middle picture the constraint on vertex D has propagated to vertex A, and in the right-hand picture it propagates to vertex B.\nSoon, the whole cube will be uniquely labeled.\n\n\n| <a id=\"fig-17-04\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-04.svg\" onerror=\"this.src='images/chapter17/fig-17-04.png'; this.onerror=null;\" alt=\"Figure 17.4\" /> |\n| **Figure 17.4: Propagating Constraints** |\n\nMany diagrams will be labeled uniquely by this constraint propagation process.\nSome diagrams, however, are ambiguous.\nThey will still have multiple labelings after constraint propagation has finished.\nIn this case, we can search for a solution.\nSimply choose an ambiguous vertex, choose one of the possible labelings for that vertex, and repeat the constraint propagation/search process.\nKeep going until the diagram is either unambiguous or inconsistent.\n\nThat completes the sketch of the line-labeling algorithm.\nWe are now ready to implement a labeling program.\nIts glossary is in [figure 17.5](#fig-17-05).\n\n| []()                                                |\n|-----------------------------------------------------|\n| ![f17-05](images/chapter17/f17-05.jpg)              |\n| Figure 17.5: Glossary for the Line-Labeling Program |\n\n*(ed: should be a markdown table)*\n\nThe two main data structures are the `diagram` and the `vertex`.\nIt would have been possible to implement a data type for `lines`, but it is not necessary: lines are defined implicitly by the two vertexes at their end points.\n\nA diagram is completely specified by its list of vertexes, so the structure `diagram` needs only one slot.\nA vertex, on the other hand, is a more complex structure.\nEach vertex has an identifying name (usually a single letter), a vertex type (L, Y, W, or T), a list of neighboring vertexes, and a list of possible labelings.\nA labeling is a list of line labels.\nFor example, a Y vertex will initially have a list of five possible labelings.\nIf it is discovered that the vertex is the interior of a concave corner, then it will have the single labeling ( - - - ).\nWe give type information on the slots of vertex because it is a complicated data type.\nThe syntax of `defstruct` is such that you cannot specify a `:type` without first specifying a default value.\nWe chose L as the default value for the `type` slot at random, but note that it would have been an error to give `nil` as the default value, because `nil` is not of the right type.\n\n```lisp\n(defstruct diagram \"A diagram is a list of vertexes.\" vertexes)\n\n(defstruct (vertex (:print-function print-vertex))\n  (name      nil :type atom)\n  (type      'L  :type (member L Y W T))\n  (neighbors nil :type list)  ; of vertex\n  (labelings nil :type list)) ; of lists of (member + - L R)))))\n```\n\nAn ambiguous vertex will have several labelings, while an unambiguous vertex has exactly one, and a vertex with no labelings indicates an impossible diagram.\nInitially we don't know which vertexes are what, so they all start with several possible labelings.\nNote that a labeling is a list, not a set: the order of the labels is significant and matches the order of the neighboring vertexes.\nThe function `possible-labelings` gives a list of all possible labelings for each vertex type.\nWe use R and L instead of arrows as labels, because the orientation of the arrows is significant.\nAn R means that as you travel from the vertex to its neighbor, the polyhedron is on the right and the background object is on the left.\nThus, an R is equivalent to an arrow pointing away from the vertex.\nThe L is just the reverse.\n\n```lisp\n(defun ambiguous-vertex-p (vertex)\n  \"A vertex is ambiguous if it has more than one labeling.\"\n  (> (number-of-labelings vertex) 1))\n\n(defun number-of-labelings (vertex)\n  (length (vertex-labelings vertex)))\n\n(defun impossible-vertex-p (vertex)\n  \"A vertex is impossible if it has no labeling.\"\n  (null (vertex-labelings vertex)))\n\n(defun impossible-diagram-p (diagram)\n  \"An impossible diagram is one with an impossible vertex.\"\n  (some #'impossible-vertex-p (diagram-vertexes diagram)))\n\n(defun possible-labelings (vertex-type)\n  \"The list of possible labelings for a given vertex type.\"\n  ;; In these labelings, R means an arrow pointing away from\n  ;; the vertex, L means an arrow pointing towards it.\n  (case vertex-type\n    ((L) '((R L)   (L R)   (+ R)   (L +)   (- L)   (R -)))\n    ((Y) '((+ + +) (- - -) (L R -) (- L R) (R - L)))\n    ((T) '((R L +) (R L -) (R L L) (R L R)))\n    ((W) '((L R +) (- - +) (+ + -)))))\n```\n\n## 17.2 Combining Constraints and Searching\n\nThe main function `print-labelings` takes a diagram as input, reduces the number of labelings on each vertex by constraint propagation, and then searches for all consistent interpretations.\nOutput is printed before and after each step.\n\n```lisp\n(defun print-labelings (diagram)\n  \"Label the diagram by propagating constraints and then\n  searching for solutions if necessary.  Print results.\"\n  (show-diagram diagram \"~&The initial diagram is:\")\n  (every #'propagate-constraints (diagram-vertexes diagram))\n  (show-diagram diagram\n                \"~2&After constraint propagation the diagram is:\")\n  (let* ((solutions (if (impossible-diagram-p diagram)\n                        nil\n                        (search-solutions diagram)))\n         (n (length solutions)))\n    (unless (= n 1)\n      (format t \"~2&There are ~r solution~:p:\" n)\n      (mapc #'show-diagram solutions)))\n  (values))\n```\n\nThe function `propagate-constraints` takes a vertex and considers the constraints imposed by neighboring vertexes to get a list of all the `consistent-labelings` for the vertex.\nIf the number of consistent labelings is less than the number before we started, then the neighbors' constraints have had an effect on this vertex, so we propagate the new-found constraints on this vertex back to each neighbor.\nThe function returns nil and thus immediately stops the propagation if there is an impossible vertex.\nOtherwise, propagation continues until there are no more changes to the labelings.\n\nThe whole propagation algorithm is started by a call to `every` in `print-labelings`, which propagates constraints from each vertex in the diagram.\nBut it is not obvious that this is all that is required.\nAfter propagating from each vertex once, couldn't there be another vertex that needs relabeling?\nThe only vertex that could possibly need relabeling would be one that had a neighbor changed since its last update.\nBut any such vertex would have been visited by `propagate-constraint`, since we propagate to all neighbors.\nThus, a single pass through the vertexes, compounded with recursive calls, will find and apply all possible constraints.\n\nThe next question worth asking is if the algorithm is guaranteed to terminate.\nClearly, it is, because `propagate-constraints` can only produce recursive calls when it removes a labeling.\nBut since there are a finite number of labelings initially (no more than six per vertex), there must be a finite number of calls to `propagate-constraints.`\n\n```lisp\n(defun propagate-constraints (vertex)\n  \"Reduce the labelings on vertex by considering neighbors.\n  If we can reduce, propagate the constraints to each neighbor.\"\n  ;; Return nil only when the constraints lead to an impossibility\n  (let ((old-num (number-of-labelings vertex)))\n    (setf (vertex-labelings vertex) (consistent-labelings vertex))\n    (unless (impossible-vertex-p vertex)\n      (when (< (number-of-labelings vertex) old-num)\n        (every #'propagate-constraints (vertex-neighbors vertex)))\n      t)))\n```\n\nThe function `consistent-labelings` is passed a vertex.\nIt gets all the labels for this vertex from the neighboring vertexes, collecting them in `neighbor-labels`.\nIt then checks all the labels on the current vertex, keeping only the ones that are consistent with all the neighbors' constraints.\nThe auxiliary function `labels-for` finds the labels for a particular neighbor at a vertex, and `reverse-label` accounts for the fact that `L` and `R` labels are interpreted with respect to the vertex they point at.\n\n```lisp\n(defun consistent-labelings (vertex)\n  \"Return the set of labelings that are consistent with neighbors.\"\n  (let ((neighbor-labels\n          (mapcar #'(lambda (neighbor) (labels-for neighbor vertex))\n                  (vertex-neighbors vertex))))\n    ;; Eliminate labelings that don't have all lines consistent\n    ;; with the corresponding line's label from the neighbor.\n    ;; Account for the L-R mismatch with reverse-label.\n    (find-all-if\n      #'(lambda (labeling)\n          (every #'member (mapcar #'reverse-label labeling)\n                 neighbor-labels))\n      (vertex-labelings vertex))))\n```\n\nConstraint propagation is often sufficient to yield a unique interpretation.\nBut sometimes the diagram is still underconstrained, and we will have to search for solutions.\nThe function `search-solutions` first checks to see if the diagram is ambiguous, by seeing if it has an ambiguous vertex, `v`.\nIf the diagram is unambiguous, then it is a solution, and we return it (in a list, since `search-solutions` is designed to return a list of all solutions).\nOtherwise, for each of the possible labelings for the ambiguous vertex, we create a brand new copy of the diagram and set `v`'s labeling in the copy to one of the possible labelings.\nIn effect, we are guessing that a labeling is a correct one.\nWe call `propagate-constraints`; if it fails, then we have guessed wrong, so there are no solutions with this labeling.\nBut if it succeeds, then we call `search-solutions` recursively to give us the list of solutions generated by this labeling.\n\n```lisp\n(defun search-solutions (diagram)\n  \"Try all labelings for one ambiguous vertex, and propagate.\"\n  ;; If there is no ambiguous vertex, return the diagram.\n  ;; If there is one, make copies of the diagram trying each of\n  ;; the possible labelings.  Propagate constraints and append\n  ;; all the solutions together.\n  (let ((v (find-if #'ambiguous-vertex-p\n                    (diagram-vertexes diagram))))\n    (if (null v)\n        (list diagram)\n        (mapcan\n          #'(lambda (v-labeling)\n              (let* ((diagram2 (make-copy-diagram diagram))\n                     (v2 (find-vertex (vertex-name v) diagram2)))\n                (setf (vertex-labelings v2) (list v-labeling))\n                (if (propagate-constraints v2)\n                    (search-solutions diagram2)\n                    nil)))\n          (vertex-labelings v)))))\n```\n\nThat's all there is to the algorithm; all that remains are some auxiliary functions.\nHere are three of them:\n\n```lisp\n(defun labels-for (vertex from)\n  \"Return all the labels for the line going to vertex.\"\n  (let ((pos (position from (vertex-neighbors vertex))))\n    (mapcar #'(lambda (labeling) (nth pos labeling))\n            (vertex-labelings vertex))))\n\n(defun reverse-label (label)\n  \"Account for the fact that one vertex's right is another's left.\"\n  (case label (L 'R) (R 'L) (otherwise label)))\n\n(defun find-vertex (name diagram)\n  \"Find the vertex in the given diagram with the given name.\"\n  (find name (diagram-vertexes diagram) :key #'vertex-name))\n```\n\nHere are the printing functions.\n`print-vertex` prints a vertex in short form.\nIt obeys the `print` convention of returning the first argument.\nThe functions `show-vertex` and `show-diagram` print more detailed forms.\nThey obey the convention for `describe`-like functions of returning no values at all.\n\n```lisp\n(defun print-vertex (vertex stream depth)\n  \"Print a vertex in the short form.\"\n  (declare (ignore depth))\n  (format stream \"~a/~d\" (vertex-name vertex)\n          (number-of-labelings vertex))\n  vertex)\n\n(defun show-vertex (vertex &optional (stream t))\n  \"Print a vertex in a long form, on a new line.\"\n  (format stream \"~&   ~a ~d:\" vertex (vertex-type vertex))\n  (mapc #'(lambda (neighbor labels)\n            (format stream \" ~a~a=[~{~a~}]\" (vertex-name vertex)\n                    (vertex-name neighbor) labels))\n        (vertex-neighbors vertex)\n        (matrix-transpose (vertex-labelings vertex)))\n  (values))\n\n(defun show-diagram (diagram &optional (title \"~2&Diagram:\")\n                             (stream t))\n  \"Print a diagram in a long form.  Include a title.\"\n  (format stream title)\n  (mapc #'show-vertex (diagram-vertexes diagram))\n  (let ((n (reduce #'* (mapcar #'number-of-labelings\n                               (diagram-vertexes diagram)))))\n  (when (> n 1)\n    (format stream \"~&For ~:d interpretation~:p.\" n))\n  (values)))\n```\n\n`Note` that `matrix-transpose` is called by `show-vertex` to turn the matrix of labelings on its side.\nIt works like this:\n\n```lisp\n(possible-labelings 'Y)\n((+ + +)\n  (- - -)\n  (L R -)\n  (- L R)\n  (R - L))\n(matrix-transpose (possible-labelings 'Y))\n((+ - L - R)\n  (+ - R L -)\n  (+ - - R L))\n```\n\nThe implementation of `matrix-transpose` is surprisingly concise.\nIt is an old Lisp trick, and well worth understanding:\n\n```lisp\n(defun matrix-transpose (matrix)\n  \"Turn a matrix on its side.\"\n  (if matrix (apply #'mapcar #'list matrix)))\n```\n\nThe remaining code has to do with creating diagrams.\nWe need some handy way of specifying diagrams.\nOne way would be with a line-recognizing program operating on digitized input from a camera or bitmap display.\nAnother possibility is an interactive drawing program using a mouse and bitmap display.\nBut since there is not yet a Common Lisp standard for interacting with such devices, we will have to settle for a textual description.\nThe macro `defdiagram` defines and names a diagram.\nThe name is followed by a list of vertex descriptions.\nEach description is a list consisting of the name of a vertex, the vertex type (Y, A, L, or T), and the names of the neighboring vertexes.\nHere again is the `defdiagram` description for the cube shown in [figure 17.6](#fig-17-06).\n\n<!-- 17.6 is a copy of 17.1 -->\n| <a id=\"fig-17-06\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-01.svg\" onerror=\"this.src='images/chapter17/fig-17-01.png'; this.onerror=null;\" alt=\"Figure 17.6\" /> |\n| **Figure 17.6: A Cube** |\n\n```lisp\n(defdiagram cube\n  (a Y b c d)\n  (b W g e a)\n  (c W e f a)\n  (d W f g a)\n  (e L c b)\n  (f L d c)\n  (g L b d))\n```\n\nThe macro `defdiagram` calls `construct-diagram` to do the real work.\nIt would be feasible to have `defdiagram` expand into a `defvar,` making the names be special variables.\nBut then it would be the user's responsibility to make copies of such a variable before passing it to a destructive function.\nInstead, I use `put-diagram` and `diagram` to put and get diagrams in a table, `diagram` retrieves the named diagram and makes a copy of it.\nThus, the user cannot corrupt the original diagrams stored in the table.\nAnother possibility would be to have `defdiagram` expand into a function definition for `name` that returns a copy of the diagram.\nI chose to keep the diagram name space separate from the function name space, since names like `cube` make sense in both spaces.\n\n```lisp\n(defmacro defdiagram (name &rest vertex-descriptors)\n  \"Define a diagram.  A copy can be gotten by (diagram name).\"\n  `(put-diagram ',name (construct-diagram\n                         (check-diagram ',vertex-descriptors))))\n\n(let ((diagrams (make-hash-table)))\n\n(defun diagram (name)\n  \"Get a fresh copy of the diagram with this name.\"\n  (make-copy-diagram (gethash name diagrams)))\n\n(defun put-diagram (name diagram)\n  \"Store a diagram under a name.\"\n  (setf (gethash name diagrams) diagram)\n  name))\n```\n\nThe function `construct-diagram` translates each vertex description, using `construct-vertex`, and then fills in the neighbors of each vertex.\n\n```lisp\n(defun construct-diagram (vertex-descriptors)\n  \"Build a new diagram from a set of vertex descriptor.\"\n  (let ((diagram (make-diagram)))\n    ;; Put in the vertexes\n    (setf (diagram-vertexes diagram)\n          (mapcar #'construct-vertex vertex-descriptors))\n    ;; Put in the neighbors for each vertex\n    (dolist (v-d vertex-descriptors)\n      (setf (vertex-neighbors (find-vertex (first v-d) diagram))\n            (mapcar #'(lambda (neighbor)\n                        (find-vertex neighbor diagram))\n                    (v-d-neighbors v-d))))\n    diagram))\n\n(defun construct-vertex (vertex-descriptor)\n  \"Build the vertex corresponding to the descriptor.\"\n  ;; Descriptors are like: (x L y z)\n  (make-vertex\n    :name (first vertex-descriptor)\n    :type (second vertex-descriptor)\n    :labelings (possible-labelings (second vertex-descriptor))))\n\n(defun v-d-neighbors (vertex-descriptor)\n  \"The neighboring vertex names in a vertex descriptor.\"\n  (rest (rest vertex-descriptor)))\n```\n\nThe `defstruct` for `diagram` automatically creates the function `copy-diagram,` but it just copies each field, without copying the contents of each field.\nThus we need `make-copy-diagram` to create a copy that shares no structure with the original.\n\n```lisp\n(defun make-copy-diagram (diagram)\n  \"Make a copy of a diagram, preserving connectivity.\"\n  (let* ((new (make-diagram\n                :vertexes (mapcar #'copy-vertex\n                                  (diagram-vertexes diagram)))))\n    ;; Put in the neighbors for each vertex\n    (dolist (v (diagram-vertexes new))\n      (setf (vertex-neighbors v)\n            (mapcar #'(lambda (neighbor)\n                        (find-vertex (vertex-name neighbor) new))\n                    (vertex-neighbors v))))\n    new))\n```\n\n## 17.3 Labeling Diagrams\n\nWe are now ready to try labeling diagrams.\nFirst the cube:\n\n```lisp\n> (print-labelings (diagram 'cube))\nThe initial diagram is:\n A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n E/6 L: EC=[RL+L-R] EB=[LRR+L-]\n F/6 L: FD=[RL+L-R] FC=[LRR+L-]\n G/6 L: GB=[RL+L-R] GD=[LRR+L-]\nFor 29,160 interpretations.\n\nAfter constraint propagation the diagram is:\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/2 W: BG=[L-] BE=[R-] BA=[++]\n C/2 W: CE=[L-] CF=[R-] CA=[++]\n D/2 W: DF=[L-] DG=[R-] DA=[++]\n E/3 L: EC=[R-R] EB=[LL-]\n F/3 L: FD=[R-R] FC=[LL-]\n G/3 L: GB=[R-R] GD=[LL-]\nFor 216 interpretations.\n\nThere are four solutions:\nDiagram:\n  A/1 Y: AB=[+] AC=[+] AD=[+]\n  B/1 W: BG=[L] BE=[R] BA=[+]\n  C/l W: CE=[L] CF=[R] CA=[+]\n  D/1 W: DF=[L] DG=[R] DA=[+]\n  E/l L: EC=[R] EB=[L]\n  F/1 L: FD=[R] FC=[L]\n  G/1 L: GB=[R] GD=[L]\n\nDiagram:\n  A/1 Y: AD=[+] AC=[+] AD=[+]\n  B/1 W: BG=[L] BE=[R] BA=[+]\n  C/l W: CE=[L] CF=[R] CA=[+]\n  D/1 W: DF=[-] DG=[-] DA=[+]\n  E/l L: EC=[R] EB=[L]\n  F/1 L: FD=[-] FC=[L]\n  G/1 L: GB=[R] GD=[-]\n\nDiagram:\n  A/1 Y: AB=[+] AC=[+] AD=[+]\n  B/1 W: BG=[L] BE=[R] BA=[+]\n  C/l W: CE=[-] CF=[-] CA=[+]\n  D/1 W: DF=[L] DG=[R] DA=[+]\n  E/l L: EC=[-] EB=[L]\n  F/1 L: FD=[R] FC=[-]\n  G/1 L: GB=[R] GD=[L]\n\nDiagram:\n  A/1 Y: AB=[+] AC=[+] AD=[+]\n  B/1 W: BG=[-] BE=[-] BA=[+]\n  C/1 W: CE=[L] CF=[R] CA=[+]\n  D/1 W: DF=[L] DG=[R] DA=[+]\n  E/1 L: EC=[R] EB=[-]\n  F/1 L: FD=[R] FC=[L]\n  G/1 L: GB=[-] GD=[L]\n```\n\nThe four interpretations correspond, respectively, to the cases where the cube is free floating, attached to the floor (GD and DF = -), attached to a wall on the right (EC and CF = -), or attached to a wall on the left (BG and BE = -).\nThese are shown in [figure 17.7](#fig-17-07).\nIt would be nice if we could supply information about where the cube is attached, and see if we can get a unique interpretation.\nThe function `ground` takes a diagram and modifies it by making one or more lines be grounded lines-lines that have a concave (-) label, corresponding to a junction with the ground.\n\n| <a id=\"fig-17-07\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-07.svg\" onerror=\"this.src='images/chapter17/fig-17-07.png'; this.onerror=null;\" alt=\"Figure 17.7\" /> |\n| **Figure 17.7: Four Interpretations of the Cube** |\n\n```lisp\n(defun ground (diagram vertex-a vertex-b)\n  \"Attach the line between the two vertexes to the ground.\n  That is, label the line with a -\"\n  (let* ((A (find-vertex vertex-a diagram))\n         (B (find-vertex vertex-b diagram))\n         (i (position B (vertex-neighbors A))))\n    (assert (not (null i)))\n    (setf (vertex-labelings A)\n          (find-all-if #'(lambda (l) (eq (nth i l) '-))\n                     (vertex-labelings A)))\n    diagram))\n```\n\nWe can see how this works on the cube:\n\n```lisp\n> (print-labelings (ground (diagram 'cube) 'g 'd))\nThe initial diagram is:\n A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n E/6 L: EC=[RL+L-R] EB[LRR+L-]\n F/6 L: FD=[RL+L-R] FC=[LRR+L-]\n G/1 L: GB=[R] GD=[-]\nFor 4,860 interpretations.\n\nAfter constraint propagation the diagram is:\n A/1 Y: AB=[+] AC=[+] AD=[+]\n B/1 W: BG=[L] BE=[R] BA=[+]\n C/1 W: CE=[L] CF=[R] CA=[C +]\n D/1 W: DF=[-] DG=[-] DA=[+]\n E/1 L: EC=[R] EB=[L]\n F/1 L: FD=[-] FC=[L]\n G/1 L: GB=[R] GD=[-]\n```\n\nNote that the user only had to specify one of the two ground lines, GD.\nThe program found that DF is also grounded.\nSimilarly, in programming `ground-line`, we only had to update one of the vertexes.\nThe rest is done by constraint propagation.\n\nThe next example yields the same four interpretations, in the same order (free floating, attached at bottom, attached at right, and attached at left) when interpreted ungrounded.\nThe grounded version yields the unique solution shown in the following output and in [figure 17.9](#fig-17-09).\n\n| <a id=\"fig-17-08\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-08.svg\" onerror=\"this.src='images/chapter17/fig-17-08.png'; this.onerror=null;\" alt=\"Figure 17.8\" /> |\n| **Figure 17.8: Cube on a Plate** |\n\n| <a id=\"fig-17-09\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-09.svg\" onerror=\"this.src='images/chapter17/fig-17-09.png'; this.onerror=null;\" alt=\"Figure 17.9\" /> |\n| **Figure 17.9: Labeled Cube on a Plate** |\n\n```lisp\n(defdiagram cube-on-plate\n  (a Y b c d)\n  (b W g e a)\n  (c W e f a)\n  (d W f g a)\n  (e L c b)\n  (f Y d c i)\n  (g Y b d h)\n  (h W l g j)\n  (i W f m j)\n  (j Y h i k)\n  (k W m l j)\n  (l L h k)\n  (m L k i))\n\n> (print-labelings (ground (diagram 'cube-on-plate) 'k 'm))\nThe initial diagram is:\n A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n E/6 L: EC=[RL+L-R] EB=[LRR+L-]\n F/5 Y: FD=C+-L-R] FC=[+-RL-] FI=[+--RL]\n G/5 Y: GB=[+-L-R] GD=[+-RL-] GH=[+--RL]\n H/3 W: HL=[L-+] HG=[R-+] HJ=[++-]\n I/3 W: IF=[L-+] IM=[R-+] IJ=[++-]\n J/5 Y: JH=[+-L-R] JI=[+-RL-] JK=[+--RL]\n K/1 W: KM=[-] KL=[-] KJ=[+]\n L/6 L: LH=[RL+L-R] LK=[LRR+L-]\n M/6 L: MK=[RL+L-R] MI=[LRR+L-]\nFor 32.805.000 interpretations.\n\nAfter constraint propagation the diagram is\n  A/1 Y: AB=[+] AC=[+] AD=[+]\n  B/2 W: BG=[L-] BE=[R-] BA=[++]\n  C/2 W: CE=[L-] CF=[R-] CA=[++]\n  D/2 W: DF=[L-] DG=[R-] DA=[++]\n  E/1 L: EC=[R] EB=[L]\n  F/1 Y: FD=[-] FC=[L] FI=[R]\n  G/1 Y: GB=[R] GD=[-] GH=[L]\n  H/1 W: HL=[L] HG=[R] HJ=[+]\n  I/1 W: IF=[L] IM=[R] IJ=[+]\n  J/1 Y: JH=[+] JI=[+] JK=[+]\n  K/1 W: KM=[-] KL=[-] KJ=[+]\n  L/1 L: LH=[R] LK=[-]\n  M/1 L: MK=[-] MI=[L]\n```\n\nIt is interesting to try the algorithm on an \"impossible\" diagram.\nIt turns out the algorithm correctly finds no interpretation for this well-known illusion:\n\n```lisp\n(defdiagram poiuyt\n  (a L b g)\n  (b L j a)\n  (c L d l)\n  (d L h c)\n  (e L f i)\n  (f L k e)\n  (g L a l)\n  (h L l d)\n  (i L e k)\n  (j L k b)\n  (k W j i f)\n  (l W h g c))\n\n> (print-labelings (diagram 'poiuyt))\nThe initial diagram is:\n A/6 L: AB=[RL+L-R] AG=[LRR+L-]\n B/6 L: BJ=[RL+L-R] BA=[LRR+L-]\n C/6 L: CD=[RL+L-R] CL=[LRR+L-]\n D/6 L: DH=[RL+L-R] DC=[LRR+L-]\n E/6 L: EF=[RL+L-R] EI=[LRR+L-]\n F/6 L: FK=[RL+L-R] FE=[LRR+L-]\n G/6 L: GA=[RL+L-R] GL=[LRR+L-]\n H/6 L: HL=[RL+L-R] HD=[LRR+L-]\n I/6 L: IE=[RL+L-R] IK=[LRR+L-]\n J/6 L: JK=[RL+L-R] JB=[LRR+L-]\n K/3 W: KJ=[L-+] KI=[R-+] KF=[++-]\n L/3 W: LH=[L-+] LG=[R-+] LC=[++-]\nFor 544,195,584 interpretations.\n\nAfter constraint propagation the diagram is:\n A/5 L: AB=[RL+-R] AG=[LRRL-]\n B/5 L: BJ=[RLL-R] BA=[LR+L-]\n C/2 L: CD=[LR] CL=[+-]\n D/3 L: DH=[RL-] DC=[LRL]\n E/3 L: EF=[RLR] EI=[LR-]\n F/2 L: FK=[+-] FE=[RL]\n G/4 L: GA=[RL-R] GL=[L+L-]\n H/4 L: HL=[R+-R] HD=[LRL-]\n I/4 L: IE=[RL-R] IK=[L+L-]\n J/4 L: JK=[R+-R] JB=[LRL-]\n K/3 W: KJ=[L-+] KI=[R-+] KF=[++-]\n L/3 W: LH=[L-+] LG=[R-+] LC=[++-]\nFor 2,073,600 interpretations.\n\nThere are zero solutions:\n```\n\nNow we try a more complex diagram:\n\n```lisp\n(defdiagram tower\n  (a Y b c d)    (n L q o)\n  (b W g e a)    (o W y j n)\n  (c W e f a)    (P L r i)\n  (d W f g a)    (q W n s w)\n  (e L c b)      (r W s p x)\n  (f Y d c i)    (s L r q)\n  (g Y b d h)    (t W w x z)\n  (h W l g J)    (u W x y z)\n  (i W f m p)    (v W y w z)\n  (j Y h o k)    (w Y t v q)\n  (k W m l j)    (x Y r u t)\n  (l L h k)      (y Y v u o)\n  (m L k i)      (z Y t u v))\n\n> (print-labelings (ground (diagram 'tower) 'l 'k))\nThe initial diagram is:\n  A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]\n  B/3 W: BG=[L-+] BE=[R-+] BA=[++-]\n  C/3 W: CE=[L-+] CF=[R-+] CA=[++-]\n  D/3 W: DF=[L-+] DG=[R-+] DA=[++-]\n  E/6 L: EC[RL+L-R] EB=[LRR+L-]\n  F/5 Y: FD=[+-L-R] FC=[+-RL-] FI=[+--RL]\n  G/5 Y: GB=[+-L-R] GD=[+-RL-] GH=[+--RL]\n  H/3 W: HL=[L-+] HG=[R-+] HJ=[++-]\n  I/3 W: IF=[L-+] IM=[R-+] IP=[++-]\n  J/5 Y: JH=[+-L-R] JO=[+-RL-] JK=[+--RL]\n  K/3 W: KM=[L-+] KL=[R-+] KJ=[++-]\n  L/1 L: LH=[R] LK=[-]\n  M/6 L: MK=[RL+L-R] MI=[LRR+L-]\n  N/6 L: NQ=[RL+L-R] NO=[LRR+L-]\n  O/3 W: OY=[L-+] OJ=[R-+] ON=[++-]\n  P/6 L: PR=[RL+L-R] PI=[LRR+L-]\n  Q/3 W: QN=[L-+] QS=[R-+] QW=[++-]\n  R/3 W: RS=[L-+] RP=[R-+] RX=[++-]\n  S/6 L: SR=[RL+L-R] SQ=[LRR+L-]\n  T/3 W: TW=[L-+] TX=[R-+] TZ=[++-]\n  U/3 W: UX=[L-+] UY=[R-+] UZ=[++-]\n  V/3 W: VY=[L-+] VW=[R-+] VZ=[++-]\n  W/5 Y: WT=[+-L-R] WV=[+-RL-] WQ=[+--RL]\n  X/5 Y: XR=[+-L-R] XU=[+-RL-] XT=[+--RL]\n  Y/5 Y: YV=[+-L-R] YU=[+-RL-] YO=[+--RL]\n  Z/5 Y: ZT=[+-L-R] ZU=[+-RL-] ZV=[+--RL]\nFor 1,614,252,037,500,000 interpretations.\n```\n\nAfter constraint propagation the diagram is:\n\n```lisp\n  A/1 Y: AB=[+] AC=[+] AD=[+]\n  B/1 W: BG=[L] BE=[R] BA=[+]\n  C/1 W: CE=[L] CF=[R] CA=[+]\n  D/1 W: DF=[-] DG=[-] DA=[+]\n  E/1 L: EC=[R] EB=[L]\n  F/1 Y: FD=[-] FC=[L] FI=[R]\n  G/1 Y: GB=[R] GD=[-]GH=[L]\n  H/1 W: HL=[L] HG=[R] HJ=[+]\n  I/1 W: IF=[L] IM=[R] IP=[+]\n  J/1 Y: JH=[+] JO=[+] JK=[+]\n  K/1 W: KM=[-] KL=[-] KJ=[+]\n  L/1 L: LH=[R] LK=[-]\n  M/1 L: MK=[-] MI=[L]\n  N/1 L: NQ=[R] NO[-]\n  O/1 W: OY=[+] OJ=[+] ON=[-]\n  P/1 L: PR=[L] PI=[+]\n  Q/1 W: QN=[L] QS=[R] QW=[+]\n  R/1 W: RS=[L] RP=[R] RX=[+]\n  S/1 L: SR=[R] SQ=[L]\n  T/1 W: TW=[+] TX=[+] TZ=[-]\n  U/1 W: UX=[+] UY=[+] UZ=[-]\n  V/1 W: VY=[+] VW=[+] VZ=[-]\n  W/1 Y: WT=[+] WV=[+] WQ=[+]\n  X/1 Y: XR=[+] XU=[+] XT=[+]\n  Y/1 Y: YV=[+] YU=[+] YO=[+]\n  Z/1 Y: ZT=[-] ZU=[-] ZV=[-]\n```\n\nWe see that the algorithm was able to arrive at a single interpretation.\nMoreover, even though there were a large number of possibilities-over a quadrillion-the computation is quite fast.\nMost of the time is spent printing, so to get a good measurement, we define a function to find solutions without printing anything:\n\n```lisp\n(defun find-labelings (diagram)\n  \"Return a list of all consistent labelings of the diagram.\"\n  (every #'propagate-constraints (diagram-vertexes diagram))\n  (search-solutions diagram))\n```\n\nWhen we time the application of `find-labelings` to the grounded tower and the poiuyt, we find the tower takes 0.11 seconds, and the poiuyt 21 seconds.\nThis is over 180 times longer, even though the poiuyt has only half as many vertexes and only about half a million interpretations, compared to the tower's quadrillion.\nThe poiuyt takes a long time to process because there are few local constraints, so violations are discovered only by considering several widely separated parts of the figure all at the same time.\nIt is interesting that the same fact that makes the processing of the poiuyt take longer is also responsible for its interest as an illusion.\n\n## 17.4 Checking Diagrams for Errors\n\nThis section considers one more example, and considers what to do when there are apparent errors in the input.\nThe example is taken from Charniak and McDermott's *Introduction to Artificial Intelligence*, page 138, and shown in [figure 17.12](#fig-17-12).\n\n| <a id=\"fig-17-10\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-10.svg\" onerror=\"this.src='images/chapter17/fig-17-10.png'; this.onerror=null;\" alt=\"Figure 17.10\" /> |\n| **Figure 17.10: An Impossible Figure (A Poiuyt)** |\n\n| <a id=\"fig-17-11\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-11.svg\" onerror=\"this.src='images/chapter17/fig-17-11.png'; this.onerror=null;\" alt=\"Figure 17.11\" /> |\n| **Figure 17.11: A Tower** |\n\n| <a id=\"fig-17-12\"></a>[]() |\n|---|\n| <img src=\"images/chapter17/fig-17-12.svg\" onerror=\"this.src='images/chapter17/fig-17-12.png'; this.onerror=null;\" alt=\"Figure 17.12\" /> |\n| **Figure 17.12: Diagram of an arch** |\n\n```lisp\n(defdiagram arch\n  (a W e b c)    (p L o q)\n  (b L d a)      (q T P i r)\n  (c Y a d g)    (r T j s q)\n  (d Y c b m)    (s L r t)\n  (e L a f)      (t W v s k)\n  (f T e g n)    (u L t l)\n  (g W h f c)    (v L t l)\n  (h T g i o)    (w W x l y)\n  (i T h j q)    (x L w z)\n  (j T i k r)    (y Y w 2 z)\n  (k T J l t)    (z W 3 x y)\n  (l T k m v)    (l T n o w)\n  (m L l d)      (2 W v 3 y)\n  (n L f 1)      (3 L z 2)\n  (o W P 1 h)    (4 T u l v))\n```\n\nUnfortunately, running this example results in no consistent interpretations after constraint propagation.\nThis seems wrong.\nWorse, when we try to ground the diagram on the line XZ and call `print-labelings` on that, we get the following error:\n\n```lisp\n>>>ERROR: The first argument to NTH was of the wrong type.\nThe function expected a fixnum >= zero.\nWhile in the function LABELS-FOR <= CONSISTENT-LABELINGS\nDebugger entered while in the following function:\n\nLABELS-FOR (P.C. = 23)\n  Arg 0 (VERTEX): U/6\n  Arg 1 (FROM): 4/4\n```\n\nWhat has gone wrong?\nA good guess is that the diagram is somehow inconsistent- somewhere an error was made in transcribing the diagram.\nIt could be that the diagram is in fact impossible, like the poiuyt.\nBut that is unlikely, as it is easy for us to provide an intuitive interpretation.\nWe need to debug the diagram, and it would also be a good idea to handle the error more gracefully.\n\nOne property of the diagram that is easy to check for is that every line should be mentioned twice.\nIf there is a line between vertexes A and B, there should be two entries in the vertex descriptors of the following form:\n\n```lisp\n(A ? ... B ...)\n(B ? ... A ...)\n```\n\nHere the symbol `?` means we aren't concerned about the type of the vertexes, only with the presence of the line in two places.\nThe following code makes this check when a diagram is defined.\nIt also checks that each vertex is one of the four legal types, and has the right number of neighbors.\n\n```lisp\n(defmacro defdiagram (name &rest vertex-descriptors)\n \"Define a diagram. A copy can be gotten by (diagram name).\"\n '(put-diagram '.name (construct-diagram\n          (check-diagram ',vertex-descriptors))))\n(defun check-diagram (vertex-descriptors)\n  \"Check if the diagram description appears consistent.\"\n  (let ((errors 0))\n    (dolist (v-d vertex-descriptors)\n      ;; v-d is like: (a Y b c d)\n      (let ((A (first v-d))\n            (v-type (second v-d)))\n        ;; Check that the number of neighbors is right for\n        ;; the vertex type (and that the vertex type is legal)\n        (when (/= (length (v-d-neighbors v-d))\n                  (case v-type ((W Y T) 3) ((L) 2) (t -1)))\n          (warn \"Illegal type/neighbor combo: ~a\" v-d)\n          (incf errors))\n        ;; Check that each neighbor B is connected to\n        ;; this vertex, A, exactly once\n        (dolist (B (v-d-neighbors v-d))\n          (when (/= 1 (count-if\n                        #'(lambda (v-d2)\n                            (and (eql (first v-d2) B)\n                                 (member A (v-d-neighbors v-d2))))\n                        vertex-descriptors))\n            (warn \"Inconsistent vertex: ~a-~a\" A B)\n            (incf errors)))))\n    (when (> errors 0)\n      (error \"Inconsistent diagram.  ~d total error~:p.\"\n             errors)))\n  vertex-descriptors)\n```\n\nNow let's try the arch again:\n\n```lisp\n(defdiagram arch\n  (a W e b c)    (p L o q)\n  (b L d a)      (q T p i r)\n  (c Y a d g)    (r T j s q)\n  (d Y c b m)    (s L r t)\n  (e L a f)      (t W v s k)\n  (f T e g n)    (u L t l)\n  (g W h f c)    (v L 2 4)\n  (h T g i o)    (w W x l y)\n  (i T h j q)    (x L w z)\n  (j T i k r)    (y Y w 2 z)\n  (k T j l t)    (z W 3 x y)\n  (l T k m v)    (1 T n o w)\n  (m L l d)      (2 W v 3 y)\n  (n L f 1)      (3 L z 2)\n  (o W P 1 h)    (4 T u l v))\nWarning: Inconsistent vertex: T-V\nWarning: Inconsistent vertex: U-T\nWarning: Inconsistent vertex: U-L\nWarning: Inconsistent vertex: L-V\nWarning: Inconsistent vertex: 4-U\nWarning: Inconsistent vertex: 4-L\n```\n\n`>>ERROR: Inconsistent diagram.\n6 total errors.`\n\nThe `defdiagram` was transcribed from a hand-labeled diagram, and it appears that the transcription has fallen prey to one of the oldest problems in mathematical notation: confusing a \"u\" with a \"v.\" The other problem was in seeing the line U-L as a single line, when in fact it is broken up into two segments, U-4 and 4-L.\nRepairing these bugs gives the diagram:\n\n```lisp\n(defdiagram arch\n  (a W e b c)    (P L o q)\n  (b L d a)      (q T P i r)\n  (c Y a d g)    (r T j s q)\n  (d Y c b m)    (s L r t)\n  (e L a f)      (t W u s k)    ;t-u not t-v\n  (f T e g n)    (u L t 4)      ;u-4 not u-l\n  (g W h f c)    (v L 2 4)\n  (h T g i o)    (w W x l y)\n  (i T h j q)    (x L w z)\n  (j T i k r)    (y Y w 2 z)\n  (k T J l t)    (z W 3 x y)\n  (l T k m 4)    (1 T n o w)    ;l-4 not l-v\n  (m L l d)      (2 W v 3 y)\n  (n L f 1)      (3 L z 2)\n  (o W P 1 h)    (4 T u l v))\n```\n\nThis time there are no errors detected by `check-diagram`, but running `print-labelings` again still does not give a solution.\nTo get more information about which constraints are applied, I modified `propagate-constraints` to print out some information:\n\n```lisp\n(defun propagate-constraints (vertex)\n  \"Reduce the number of labelings on vertex by considering neighbors.\n  If we can reduce, propagate the new constraint to each neighbor.\"\n  :: Return nil only when the constraints lead to an impossibility\n  (let ((old-num (number-of-labelings vertex)))\n    (setf (vertex-labelings vertex) (consistent-labelings vertex))\n    (unless (impossible-vertex-p vertex)\n      (when (< (number-of-labelings vertex) old-num)\n        (format t \"~&; ~a: ~14a ~a\" vertex ;***\n                (vertex-neighbors vertex) ;***\n                (vertex-labelings vertex)) ;***\n        (every #'propagate-constraints (vertex-neighbors vertex)))\n      vertex)))\n```\n\nRunning the problem again gives the following trace:\n\n```lisp\n> (print-labelings (ground (diagram 'arch) 'x 'z))\nThe initial diagram is:\n  A/3 W: AE=[L-+] AB-CR-+] AC=[++-]\n  P/6 L: P0=[RL+L-R] PQ=[LRR+L-]\n  B/6 L: BD=[RL+L-R] BA=[LRR+L-]\n  Q/4 T: QP=[RRRR] QI=[LLLL] QR=[+-LR]\n  C/5 Y: CA=[+-L-R] CD=[+-RL-] CG=[+--RL]\n  R/4 T: RJ=[RRRR] RS=[LLLL] RQ=[+-LR]\n  D/5 Y: DC=[+-L-R] DB=[+-RL-] DM=[+--RL]\n  S/6 L: SR=[RL+L-R] ST=[LRR+L-]\n  S/6 L: EA=[RL+L-R] EF=[LRR+L-]\n  T/3 W: TU=[L-+] TS=[R-+] TK=[++-]\n  F/4 T: FE=[RRRR] FG=[LLLL] FN=[+-LR]\n  U/6 L: UT=[RL+L-R] U4=[LRR+L-]\n  G/3 W: GH=[L-+] GF=[R-+] GC=[++-]\n  V/6 L: V2=[RL+L-R] V4=[LRR+L-]\n  H/4 T: HG=[RRRR] HI=[LLLL] Ho=[+-LR]\n  W/3 W: WX=[L-+] W1=[R-+] WY=[++-]\n  I/4 T: IH=[RRRR] IJ=[LLLL] IQ=[+-LR]\n  X/1 L: XW=[R] XZ=[-]\n  J/4 T: JI=[RRRR] JK=[LLLL] JR=[+-LR]\n  Y/5 Y: YW=[+-L-R] Y2=[+-RL-] YZ=[+--RL]\n  K/4 T: KJ=[RRRR] KL=[LLLL] KT=[+-LR]\n  Z/3 W: Z3=[L-+] ZX=[R-+] ZY=[++-]\n  L/4 T: LK=[RRRR] LM=[LLLL] L4=[+-LR]\n  1/4 T: 1N=[RRRR] 10=[LLLL] 1 W=[+-LR]\n  M/6 L: ML=[RL+L-R] MD=[LRR+L-]\n  2/3 W: 2 V=[L-+] 23=[R-+] 2Y=[++-]\n  N/6 L: NF=[RL+L-R] N1=[LRR+L-]\n  3/6 L: 3Z=[RL+L-R] 32=[LRR+L-]\n  0/3 W: 0P=[L-+] 01=[R-+] 0H=[++-]\n  4/4 T: 4U=[RRRR] 4 L=[LLLL] 4 V=[+-LR]\nFor 2,888,816,545,234,944,000 interpretations\n; P/2: (0/3 Q/4)        ((R L) (- L))\n; 0/1: (P/2 1/4 H/4)    ((L R +))\n; P/1: (0/1 Q/4)        ((R L))\n; 1/3: (N/6 0/1 W/3)    ((R L +) (R L -) (R L L))\n; N/2: (F/4 1/3)        ((R L) (- L))\n; F/2: (E/6 G/3 N/2)    ((R L -) (R L L))\n; E/2: (A/3 F/2)      ((R L) (- L))\n; A/2: (E/2 B/6 C/5)    ((L R +) (- - +))\n; B/3: (D/5 A/2)      ((R L) (- L) (R -))\n; D/3: (C/5 B/3 M/6)    ((- - -) (- L R) (R - L))\n; W/1: (X/l 1/3 Y/5)    ((L R +))\n; 1/1: (N/2 0/1 W/l)    ((R L L))\n; Y/1: (W/l 2/3 Z/3)    ((+ + +))\n; 2/2: (V/6 3/6 Y/1)    ((L R +) (- - +))\n; V/3: (2/2 4/4)      ((R L) (- L) (R -))\n; 4/2: (U/6 L/4 V/3)    ((R L -) (R L R))\n; U/2: (T/3 4/2)      ((R L) (- L))\n; T/2: (U/2 S/6 K/4)    ((L R +) (- - +))\n; S/2: (R/4 T/2)      ((R L) (R -))\n; K/1: (J/4 L/4 T/2)    ((R L +))\n; J/1: (1/4 K/1 R/4)    ((R L L))\n; I/1: (H/4 J/1 Q/4)    ((R L R))\n; L/1: (K/l M/6 4/2)    ((R L R))\n; M/2: (L/1 D/3)      ((R L) (R -))\n; 3/3: (Z/3 2/2)      ((R L) (- L) (R -))\n; Z/1 : (3/3 X/1 Y/1)    ((- - +))\n; 3/1: (Z/l 2/2)    ((- L))\n; 2/1: (V/3 3/1 Y/1)    ((L R +))\n; V/2: (2/1 4/2)      ((R L) (R -))\nAfter constraint propagation the diagram is:\n  A/0 W:\n  P/l L: P0=[R] PQ=CL]\n  B/0 L:\n  Q/4 T: QP=[RRRR] QI=[LLLL] QR=[+-LR]\n  C/0 Y:\n  R/4 T: RJ=[RRRR] RS=[LLLL] RQ=[+-LR]\n  D/0 Y:\n  S/2 L: SR=[RR] ST=[L-]\n  E/2 L: EA=[R-] EF=[LL]\n  T/2 W: TU=[L-] TS=CR-] TK=[++]\n  F/2 T: FE=[RR] FG=[LL] FN=[-  L]\n  U/2 L: UT=[R-] U4=[LL]\n  G/0 W:\n  V/2 L: V2=[RR] V4=[L-]\n  H/0 T:\n  W/l W: WX=[L] W1=[R] WY=[+]\n  I/1 T: IH=[R] IJ=[L] IQ=[R]\n  X/1 L: XW=[R] XZ=[-]\n  J/1 T: JI=[R] JK=[L] JR=[L]\n  Y/1 Y: YW=[+] Y2=[+] YZ=[+]\n  K/1 T: KJ=[R] KL=[L] KT=[+]\n  Z/1 W: Z3=[-] ZX=[-] ZY=[+]\n  L/1 T: LK=[R] LM=[L] L4=[R]\n  1/1 T: 1 N=[R] 10=[L] 1 W=[L]\n  M/2 L: ML=[RR] MD=[L-]\n  2/1 W: 2 V=[L] 23=[R] 2Y=[+]\n  N/2 L: NF=[R-] N1=[LL]\n  3/1 L: 3Z=[-] 32=[L]\n  0/1 W: 0P=[L] 01=[R] 0H=[+]\n  4/2 T: 4U=[RR] 4 L=[LL] 4 V=[-  R]\n```\n\nFrom the diagram after constraint propagation we can see that the vertexes A, B, C, D, G, and H have no interpretations, so they are a good place to look first for an error.\nFrom the trace generated by `propagate-constraints` (the lines beginning with a semicolon), we see that constraint propagation started at P and after seven propagations reached some of the suspect vertexes:\n\n```lisp\n; A/2: (E/2 B/6 C/5)    ((L R +) (- - + ))\n; B/3: (D/5 A/2)        ((R L) (- L) (R -))\n; D/3: (C/5 B/3 M/6)    ((- - -) (- L R) (R - L))\n```\n\nA and B look acceptable, but look at the entry for vertex D.\nIt shows three interpretations, and it shows that the neighbors are C, B, and M.\nNote that line DC, the first entry in each of the interpretations, must be either -, - or R.\nBut this is an error, because the \"correct\" interpretation has DC as a + line.\nLooking more closely, we notice that D is in fact a W-type vertex, not a Y vertex as written in the definition.\nWe should have:\n\n```lisp\n(defdiagram arch\n  (a W e b c)    (p L o q)\n  (b L d a)      (q T p i r)\n  (c Y a d g)    (r T j s q)\n  (d W b m c)    (s L r t)          ; d is a W, not Y\n  (e L a f)      (t W u s k)\n  (f T e g n)    (u L t 4)\n  (g W h f c)    (v L 2 4)\n  (h T g i o)    (w W x 1 y)\n  (i T h j q)    (x L w z)\n  (j T i k r)    (y Y w 2 z)\n  (k T J l t)    (z W 3 x y)\n  (1 T k m 4)    (1 T n o w)\n  (m L l d)      (2 W v 3 y)\n  (n L f 1)      (3 L z 2)\n  (o W P 1 h)    (4 T u l v))\n```\n\nBy running the problem again and inspecting the trace output, we soon discover the real root of the problem: the most natural interpretation of the diagram is beyond the scope of the program!\nThere are many interpretations that involve blocks floating in air, but if we ground lines OP, TU and XZ, we run into trouble.\nRemember, we said that we were considering trihedral vertexes only.\nBut vertex 1 would be a quad-hedral vertex, formed by the intersection of four planes: the top and back of the base, and the bottom and left-hand side of the left pillar.\nThe intuitively correct labeling for the diagram would have O1 be a concave (-) line and Al be an occluding line, but our repertoire of labelings for T vertexes does not allow this.\nHence, the diagram cannot be labeled consistently.\n\nLet's go back and consider the error that came up in the first version of the diagram.\nEven though the error no longer occurs on this diagram, we want to make sure that it won't show up in another case.\nHere's the error:\n\n```lisp\n>>>ERROR: The first argument to NTH was of the wrong type.\nThe function expected a fixnum >= zero.\nWhile in the function LABELS-FOR <= CONSISTENT-LABELINGS\nDebugger entered while in the following function:\nLABELS-FOR (P.C. = 23)\n   Arg 0 (VERTEX): U/6\n   Arg 1 (FROM): 4/4\n```\n\nLooking at the definition of `labels-for`, we see that it is looking for the `from` vertex, which in this case is 4, among the neighbors of `U`.\nIt was not found, so `pos` became `nil`, and the function `nth` complained that it was not given an integer as an argument.\nSo this error, if we had pursued it earlier, would have pointed out that 4 was not listed as a neighbor of `U`, when it should have been.\nOf course, we found that out by other means.\nIn any case, there is no bug here to fix - as long as a diagram is guaranteed to be consistent, the `labels-for` bug will not appear again.\n\nThis section has made two points: First, write code that checks the input as thoroughly as possible.\nSecond, even when input checking is done, it is still up to the user to understand the limitations of the program.\n\n## 17.5 History and References\n\n[Guzman (1968)](bibliography.md#bb0500) was one of the first to consider the problem of interpreting line diagrams.\nHe classified vertexes, and defined some heuristics for combining information from adjacent vertexes.\n[Huffman (1971)](bibliography.md#bb0560) and [Clowes (1971)](bibliography.md#bb0215) independently came up with more formal and complete analyses, and David [Waltz (1975)](bibliography.md#bb1300) extended the analysis to handle shadows, and introduced the constraint propagation algorithm to cut down on the need for search.\nThe algorithm is sometimes called \"Waltz filtering\" in his honor.\nWith shadows and nontrihedral angles, there are thousands of vertex labelings instead of 18, but there are also more constraints, so the constraint propagation actually does better than it does in our limited world.\nWaltz's approach and the Huffman-Clowes labels are covered in most introductory AI books, including Rich and Knight 1990, [Charniak and McDermott 1985](bibliography.md#bb0175), and [Winston 1984](bibliography.md#bb1405).\nWaltz's original paper appears in *The Psychology of Computer Vision* ([Winston 1975](bibliography.md#bb1400)), an influential volume collecting early work done at MIT.\nHe also contributed a summary article on Waltz filtering ([Waltz 1990](bibliography.md#bb1305)).\n\nMany introductory AI texts give vision short coverage, but [Charniak and McDermott (1985)](bibliography.md#bb0175) and [Tanimoto (1990)](bibliography.md#bb1220) provide good overviews of the field.\n[Zucker (1990)](bibliography.md#bb1450) provides an overview of low-level vision.\n\n[Ramsey and Barrett (1987)](bibliography.md#bb0975) give an implementation of a line-recognition program.\nIt would make a good project to connect their program to the one presented in this chapter, and thereby go all the way from pixels to 3-D descriptions.\n\n## 17.6 Exercises\n\nThis chapter has solved the problem of line-labeling for polyhedra made of trihedral vertexes.\nThe following exercises extend this solution.\n\n**Exercise  17.1 [h]** Use the line-labeling to produce a face labeling.\nWrite a function that takes a labeled diagram as input and produces a list of the faces (planes) that comprise the diagram.\n\n**Exercise  17.2 [h]** Use the face labeling to produce a polyhedron labeling.\nWrite a function that takes a list of faces and a diagram and produces a list of polyhedra (blocks) that comprise the diagram.\n\n**Exercise  17.3 [d]** Extend the system to include quad-hedral vertexes and/or shadows.\nThere is no conceptual difficulty in this, but it is a very demanding task to find all the possible vertex types and labelings for them.\nConsult [Waltz 1975](bibliography.md#bb1300).\n\n**Exercise  17.4 [d]** Implement a program to recognize lines from pixels.\n\n**Exercise  17.5 [d]** If you have access to a workstation with a graphical interface, implement a program to allow a user to draw diagrams with a mouse.\nHave the program generate output in the form expected by `construct-diagram`.\n\n"
  },
  {
    "path": "docs/chapter18.md",
    "content": "# Chapter 18\n## Search and the Game of Othello\n\n> In the beginner's mind there are endless possibilities; in the expert's there are few.\n\n> -Suzuki Roshi, Zen Master\n\nGame playing has been the target of much early work in AI for three reasons.\nFirst, the rules of most games are formalized, and they can be implemented in a computer program rather easily.\nSecond, in many games the interface requirements are trivial.\nThe computer need only print out its moves and read in the opponent's moves.\nThis is true for games like chess and checkers, but not for ping-pong and basketball, where vision and motor skills are crucial.\nThird, playing a good game of chess is considered by many an intellectual achievement.\nNewell, Shaw, and Simon say, \"Chess is the intellectual game *par excellence*,\" and Donald Michie called chess the \"*Drosophila melanogaster* of machine intelligence,\" meaning that chess is a relatively simple yet interesting domain that can lead to advances in AI, just as study of the fruit fly served to advance biology.\n\nToday there is less emphasis on game playing in AI.\nIt has been realized that techniques that work well in the limited domain of a board game do not necessarily lead to intelligent behavior in other domains.\nAlso, as it turns out, the techniques that allow computers to play well are not the same as the techniques that good human players use.\nHumans are capable of recognizing abstract patterns learned from previous games, and formulating plans of attack and defense.\nWhile some computer programs try to emulate this approach, the more successful programs work by rapidly searching thousands of possible sequences of moves, making fairly superficial evaluations of the worth of each sequence.\n\nWhile much previous work on game playing has concentrated on chess and checkers, this chapter demonstrates a program to play the game of Othello.<a id=\"tfn18-1\"></a><sup>[1](#fn18-1)</sup>\nOthello is a variation on the nineteenth-century game Reversi.\nIt is an easy game to program because the rules are simpler than chess.\nOthello is also a rewarding game to program, because a simple search technique can yield an excellent player.\nThere are two reasons for this.\nFirst, the number of legal moves per turn is low, so the search is not too explosive.\nSecond, a single Othello move can flip a dozen or more opponent pieces.\nThis makes it difficult for human players to visualize the long-range consequences of a move.\nSearch-based programs are not confused, and thus do well relative to humans.\n\nThe very name \"Othello\" derives from the fact that the game is so unpredictable, like the Moor of Venice.\nThe name may also be an allusion to the line, \"Your daughter and the Moor are now making the beast with two backs,\"<a id=\"tfn18-2\"></a><sup>[2](#fn18-2)</sup>\n since the game pieces do indeed have two backs, one white and one black.\nIn any case, the association between the game and the play carries over to the name of several programs: Cassio, Iago, and Bill.\nThe last two will be discussed in this chapter.\nThey are equal to or better than even champion human players.\nWe will be able to develop a simplified version that is not quite a champion but is much better than beginning players.\n\n## 18.1 The Rules of the Game\n\nOthello is played on a 8-by-8 board, which is initially set up with four pieces in the center, as shown in [figure 18.1](#f0010).\nThe two players, black and white, alternate turns, with black playing first.\nOn each turn, a player places a single piece of his own color on the board.\nNo piece can be moved once it is placed, but subsequent moves may flip a piece from one color to another.\nEach piece must be placed so that it *brackets* one or more opponent pieces.\nThat is, when black plays a piece there must be a line (horizontal, vertical, or diagonal) that goes through the piece just played, then through one or more white pieces, and then to another black piece.\nThe intervening white pieces are flipped over to black.\nIf there are bracketed white pieces in more than one direction, they are all flipped.\n[Figure 18.2 (a)](#f0015) indicates the legal moves for black with small dots.\n[Figure 18.2 (b)](#f0015) shows the position after black moves to square b4.\nPlayers alternate turns, except that a player who has no legal moves must pass.\nWhen neither player has any moves, the game is over, and the player with the most pieces on the board wins.\nThis usually happens because there are no empty squares left, but it occasionally happens earlier in the game.\n\n| <a id=\"fig-18-01\"></a>[]() |\n|---|\n| <img src=\"images/chapter18/fig-18-01.svg\" onerror=\"this.src='images/chapter18/fig-18-01.png'; this.onerror=null;\" alt=\"Figure 18.1\" /> |\n| **Figure 18.1: The Othello Board** |\n\n| <a id=\"fig-18-02\"></a>[]() |\n|---|\n| <img src=\"images/chapter18/fig-18-02.svg\" onerror=\"this.src='images/chapter18/fig-18-02.png'; this.onerror=null;\" alt=\"Figure 18.2\" /> |\n| **Figure 18.2: Legal Othello Moves** |\n\n## 18.2 Representation Choices\n\nIn developing an Othello program, we will want to test out various strategies, playing those strategies against each other and against human players.\nWe may also want our program to allow two humans to play a game.\nTherefore, our main function, `othello`, will be a monitoring function that takes as arguments two strategies.\nIt uses these strategies to get each player's moves, and then applies these moves to a representation of the game board, perhaps printing out the board as it goes.\n\nThe first choice to make is how to represent the board and the pieces on it.\nThe board is an 8-by-8 square, and each square can be filled by a black or white piece or can be empty.\nThus, an obvious representation choice is to make the board an 8-by-8 array, where each element of the array is the symbol `black, white,` or `nil`.\n\nNotice what is happening here: we are following the usual Lisp convention of implementing an *enumerated type* (the type of pieces that can fill a square) as a set of symbols.\nThis is an appropriate representation because it supports the primary operation on elements of an enumerated type: test for equality using eq.\nIt also supports input and output quite handily.\n\nIn many other languages (such as C or Pascal), enumerated types are implemented as integers.\nIn Pascal one could declare:\n\n```lisp\ntype piece = (black, white, empty);\n```\n\nto define `piece` as a set of three elements that is treated as a subtype of the integers.\nThe language does not allow for direct input and output of such types, but equality can be checked.\nAn advantage of this approach is that an element can be packed into a small space.\nIn the Othello domain, we anticipate that efficiency will be important, because one way to pick a good move is to look at a large number of possible sequences of moves, and choose a sequence that leads toward a favorable result.\nThus, we are willing to look hard at alternative representations to find an efficient one.\nIt takes only two bits to represent one of the three possible types, while it takes many more (perhaps 32) to represent a symbol.\nThus, we may save space by representing pieces as small integers rather than symbols.\n\nNext, we consider the board.\nThe two-dimensional array seems like such an obvious choice that it is hard to imagine a better representation.\nWe could consider an 8-element list of 8-element lists, but this would just waste space (for the cons cells) and time (in accessing the later elements of the lists).\nHowever, we will have to implement two other abstract data types that we have not yet considered: the square and the direction.\nWe will need, for example, to represent the square that a player chooses to move into.\nThis will be a pair of integers, such as 4,5.\nWe could represent this as a two-element list, or more compactly as a cons cell, but this still means that we may have to generate garbage (create a cons cell) every time we want to refer to a new square.\nSimilarly, we need to be able to scan in a given direction from a square, looking for pieces to flip.\nDirections will be represented as a pair of integers, such as +1,-1.\nOne clever possibility is to use complex numbers for both squares and directions, with the real component mapped to the horizontal axis and the imaginary component mapped to the vertical axis.\nThen moving in a given direction from a square is accomplished by simply adding the direction to the square.\nBut in most implementations, creating new complex numbers will also generate garbage.\n\nAnother possibility is to represent squares (and directions) as two distinct integers, and have the routines that manipulate them accept two arguments instead of one.\nThis would be efficient, but it is losing an important abstraction: that squares (and directions) are conceptually single objects.\n\nA way out of this dilemma is to represent the board as a one-dimensional vector.\nSquares are represented as integers in the range 0 to 63.\nIn most implementations, small integers (fixnums) are represented as immediate data that can be manipulated without generating garbage.\nDirections can also be implemented as integers, representing the numerical difference between adjacent squares along that direction.\nTo get a feel for this, take a look at the board:\n\n```lisp\n 0  1  2  3  4  5  6  7\n 8  9 10 11 12 13 14 15\n16 17 18 19 20 21 22 23\n24 25 26 27 28 29 30 31\n32 33 34 35 36 37 38 39\n40 41 42 43 44 45 46 47\n48 49 50 51 52 53 54 55\n56 57 58 59 60 61 62 63\n```\n\nYou can see that the direction +1 corresponds to movement to the right, +7 corresponds to diagonal movement downward and to the left, +8 is downward, and +9 is diagonally downward and to the right.\nThe negations of these numbers (-1, -7, -8, -9) represent the opposite directions.\n\nThere is one complication with this scheme: we need to know when we hit the edge of the board.\nStarting at square 0, we can move in direction +1 seven times to arrive at the right edge of the board, but we aren't allowed to move in that direction yet again to arrive at square 8.\nIt is possible to check for the edge of the board by considering quotients and remainders modulo 8, but it is somewhat complicated and expensive to do so.\n\nA simpler solution is to represent the edge of the board explicitly, by using a 100-element vector instead of a 64-element vector.\nThe outlying elements are filled with a marker indicating that they are outside the board proper.\nThis representation wastes some space but makes edge detection much simpler.\nIt also has the minor advantage that legal squares are represented by numbers in the range 11-88, which makes them easier to understand while debugging.\nHere's the new 100-element board:\n\n```lisp\n 0  1  2  3  4  5  6  7  8  9\n10 11 12 13 14 15 16 17 18 19\n20 21 22 23 24 25 26 27 28 29\n30 31 32 33 34 35 36 37 38 39\n40 41 42 43 44 45 46 47 48 49\n50 51 52 53 54 55 56 57 58 59\n60 61 62 63 64 65 66 67 68 69\n70 71 72 73 74 75 76 77 78 79\n80 81 82 83 84 85 86 87 88 89\n90 91 92 93 94 95 96 97 98 99\n```\n\nThe horizontal direction is now &plusmn;1, vertical is &plusmn;10, and the diagonals are &plusmn;9 and &plusmn;11.\nWe'll tentatively adopt this latest representation, but leave open the possibility of changing to another format.\nWith this much decided, we are ready to begin.\n[Figure 18.3](#f0020) is the glossary for the complete program.\nA glossary for a second version of the program is on [page 623](#p623).\n\n| []()                                          |\n|-----------------------------------------------|\n| ![f18-03](images/chapter18/f18-03.jpg)        |\n| Figure 18.3: Glossary for the Othello Program |\n\n*(ed: this should be a markdown table)*\n\nWhat follows is the code for directions and pieces.\nWe explicitly define the type `piece` to be a number from `empty` to `outer` (0 to 3), and define the function `name-of` to map from a piece number to a character: a dot for empty, `@` for black, `0` for white, and a question mark (which should never be printed) for `outer`.\n\n```lisp\n(defconstant all-directions '(-11 -10 -9 -1 1 9 10 11))\n\n(defconstant empty 0 \"An empty square\")\n(defconstant black 1 \"A black piece\")\n(defconstant white 2 \"A white piece\")\n(defconstant outer 3 \"Marks squares outside the 8x8 board\")\n\n(deftype piece () `(integer ,empty ,outer))\n\n(defun name-of (piece) (char \".@O?\" piece))\n\n(defun opponent (player) (if (eql player black) white black))\n```\n\nAnd here is the code for the board.\nNote that we introduce the function `bref`, for \"board reference\" rather than using the built-in function `aref`.\nThis facilitates possible changes to the representation of boards.\nAlso, even though there is no contiguous range of numbers that represents the legal squares, we can define the constant `all-squares` to be a list of the 64 legal squares, computed as those numbers from 11 to 88 whose value mod 10 is between 1 and 8.\n\n```lisp\n(deftype board () '(simple-array piece (100)))\n\n(defun bref (board square) (aref board square))\n(defsetf bref (board square) (val)\n  `(setf (aref ,board ,square) ,val))\n\n(defun copy-board (board)\n  (copy-seq board))\n\n(defconstant all-squares\n  (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i))\n\n(defun initial-board ()\n  \"Return a board, empty except for four pieces in the middle.\"\n  ;; Boards are 100-element vectors, with elements 11-88 used,\n  ;; and the others marked with the sentinel OUTER.  Initially\n  ;; the 4 center squares are taken, the others empty.\n  (let ((board (make-array 100 :element-type 'piece\n                           :initial-element outer)))\n    (dolist (square all-squares)\n      (setf (bref board square) empty))\n    (setf (bref board 44) white   (bref board 45) black\n          (bref board 54) black   (bref board 55) white)\n    board))\n\n(defun print-board (&optional (board *board*) clock)\n  \"Print a board, along with some statistics.\"\n  ;; First print the header and the current score\n  (format t \"~2&    a b c d e f g h   [~c=~2a ~c=~2a (~@d)]\"\n          (name-of black) (count black board)\n          (name-of white) (count white board)\n          (count-difference black board))\n  ;; Print the board itself\n  (loop for row from 1 to 8 do\n        (format t \"~&  ~d \" row)\n        (loop for col from 1 to 8\n              for piece = (bref board (+ col (* 10 row)))\n              do (format t \"~c \" (name-of piece))))\n  ;; Finally print the time remaining for each player\n  (when clock\n    (format t \"  [~c=~a ~c=~a]~2&\"\n            (name-of black) (time-string (elt clock black))\n            (name-of white) (time-string (elt clock white)))))\n\n(defun count-difference (player board)\n  \"Count player's pieces minus opponent's pieces.\"\n  (- (count player board)\n     (count (opponent player) board)))\n```\n\nNow let's take a look at the initial board, as it is printed by `print-board`, and by a raw `write` (I added the line breaks to make it easier to read):\n\n```lisp\n> (write (initial-board)\n         :array t)\n  #(3 3 3 3 3 3 3 3 3 3\n    3 0 0 0 0 0 0 0 0 3\n    3 0 0 0 0 0 0 0 0 3\n    3 0 0 0 0 0 0 0 0 3\n    3 0 0 0 2 1 0 0 0 3\n    3 0 0 0 1 2 0 0 0 3\n    3 0 0 0 0 0 0 0 0 3\n    3 0 0 0 0 0 0 0 0 3\n    3 0 0 0 0 0 0 0 0 3\n    3 3 3 3 3 3 3 3 3 3)\n#<ART-2B-100 -72570734>\n\n> (print-board (initial-board))\n     1 2 3 4 5 6 7 8 [@=2 0=2 (+0)]\n  10 . . . . . . . .\n  20 . . . . . . . .\n  30 . . . . . . . .\n  40 . . . 0 @ . . .\n  50 . . . @ 0 . . .\n  60 . . . . . . . .\n  70 . . . . . . . .\n  80 . . . . . . . .\n\nNIL\n```\n\nNotice that `print-board` provides some additional information: the number of pieces that each player controls, and the difference between these two counts.\n\nThe next step is to handle moves properly: given a board and a square to move to, update the board to reflect the effects of the player moving to that square.\nThis means flipping some of the opponent's pieces.\nOne design decision is whether the procedure that makes moves, `make-move`, will be responsible for checking for error conditions.\nMy choice is that `make-move` assumes it will be passed a legal move.\nThat way, a strategy can use the function to explore sequences of moves that are known to be valid without slowing `make-move` down.\nOf course, separate procedures will have to insure that a move is legal.\nHere we introduce two terms: a *valid* move is one that is syntactically correct: an integer from 11 to 88 that is not off the board.\nA *legal* move is a valid move into an empty square that will flip at least one opponent.\nHere's the code:\n\n```lisp\n(defun valid-p (move)\n  \"Valid moves are numbers in the range 11-88 that end in 1-8.\"\n  (and (integerp move) (<= 11 move 88) (<= 1 (mod move 10) 8)))\n\n(defun legal-p (move player board)\n  \"A Legal move must be into an empty square, and it must\n  flip at least one opponent piece.\"\n  (and (eql (bref board move) empty)\n       (some #'(lambda (dir) (would-flip? move player board dir))\n             all-directions)))\n\n(defun make-move (move player board)\n  \"Update board to reflect move by player\"\n  ;; First make the move, then make any flips\n  (setf (bref board move) player)\n  (dolist (dir all-directions)\n    (make-flips move player board dir))\n  board)\n```\n\nNow all we need is to `make-flips`.\nTo do that, we search in all directions for a *bracketing* piece: a piece belonging to the player who is making the move, which sandwiches a string of opponent pieces.\nIf there are no opponent pieces in that direction, or if an empty or outer piece is hit before the player's piece, then no flips are made.\nNote that `would-flip?` is a semipredicate that returns false if no flips would be made in the given direction, and returns the square of the bracketing piece if there is one.\n\n```lisp\n(defun make-flips (move player board dir)\n  \"Make any flips in the given direction.\"\n  (let ((bracketer (would-flip? move player board dir)))\n    (when bracketer\n      (loop for c from (+ move dir) by dir until (eql c bracketer)\n            do (setf (bref board c) player)))))\n\n(defun would-flip? (move player board dir)\n  \"Would this move result in any flips in this direction?\n  If so, return the square number of the bracketing piece.\"\n  ;; A flip occurs if, starting at the adjacent square, c, there\n  ;; is a string of at least one opponent pieces, bracketed by\n  ;; one of player's pieces\n  (let ((c (+ move dir)))\n    (and (eql (bref board c) (opponent player))\n         (find-bracketing-piece (+ c dir) player board dir))))\n\n(defun find-bracketing-piece (square player board dir)\n  \"Return the square number of the bracketing piece.\"\n  (cond ((eql (bref board square) player) square)\n        ((eql (bref board square) (opponent player))\n         (find-bracketing-piece (+ square dir) player board dir))\n        (t nil)))\n```\n\nFinally we can write the function that actually monitors a game.\nBut first we are faced with one more important choice: how will we represent a player?\nWe have already distinguished between black and white's pieces, but we have not decided how to ask black or white for their moves.\nI choose to represent player's strategies as functions.\nEach function takes two arguments: the color to move (black or white) and the current board.\nThe function should return a legal move number.\n\n```lisp\n(defun othello (bl-strategy wh-strategy\n                &optional (print t) (minutes 30))\n  \"Play a game of othello.  Return the score, where a positive\n  difference means black, the first player, wins.\"\n  (let ((board (initial-board))\n        (clock (make-array (+ 1 (max black white))\n                           :initial-element\n                           (* minutes 60\n                              internal-time-units-per-second))))\n    (catch 'game-over\n      (loop for *move-number* from 1\n            for player = black then (next-to-play board player print)\n            for strategy = (if (eql player black)\n                               bl-strategy\n                               wh-strategy)\n            until (null player)\n            do (get-move strategy player board print clock))\n      (when print\n        (format t \"~&The game is over.  Final result:\")\n        (print-board board clock))\n      (count-difference black board))))\n```\n\nWe need to be able to determine who plays next at any point.\nThe rules say that players alternate turns, but if one player has no legal moves, the other can move again.\nWhen neither has a legal move, the game is over.\nThis usually happens because there are no empty squares left, but it sometimes happens earlier in the game.\nThe player with more pieces at the end of the game wins.\nIf neither player has more, the game is a draw.\n\n```lisp\n(defun next-to-play (board previous-player print)\n  \"Compute the player to move next, or NIL if nobody can move.\"\n  (let ((opp (opponent previous-player)))\n    (cond ((any-legal-move? opp board) opp)\n          ((any-legal-move? previous-player board)\n           (when print\n             (format t \"~&~c has no moves and must pass.\"\n                     (name-of opp)))\n           previous-player)\n          (t nil))))\n\n(defun any-legal-move? (player board)\n  \"Does player have any legal moves in this position?\"\n  (some #'(lambda (move) (legal-p move player board))\n        all-squares))\n```\n\nNote that the argument `print` (of `othello`, `next-to-play`, and below, `get-move`) determines if information about the progress of the game will be printed.\nFor an interactive game, `print` should be true, but it is also possible to play a \"batch\" game with `print` set to false.\n\nIn `get-move` below, the player's strategy function is called to determine his move.\nIllegal moves are detected, and proper moves are reported when `print` is true.\nThe strategy function is passed a number representing the player to move (black or white) and a copy of the board.\nIf we passed the *real* game board, the function could cheat by changing the pieces on the board!\n\n```lisp\n(defun get-move (strategy player board print)\n  \"Call the player's strategy function to get a move.\n  Keep calling until a legal move is made.\"\n  (when print (print-board board))\n  (let ((move (funcall strategy player (copy-board board))))\n    (cond\n      ((and (valid-p move) (legal-p move player board))\n       (when print\n         (format t \"~&~c moves to ~d.\" (name-of player) move))\n       (make-move move player board))\n      (t (warn \"Illegal move: ~d\" move)\n         (get-move strategy player board print)))))\n```\n\nHere we define two simple strategies:\n\n```lisp\n(defun human (player board)\n  \"A human player for the game of Othello\"\n  (declare (ignore board))\n  (format t \"~&~c to move: \" (name-of player))\n  (read))\n\n(defun random-strategy (player board)\n  \"Make any legal move.\"\n  (random-elt (legal-moves player board)))\n\n(defun legal-moves (player board)\n  \"Returns a list of legal moves for player\"\n  (loop for move in all-squares\n     when (legal-p move player board) collect move))\n```\n\nWe are now in a position to play the game.\nThe expression\n\n`(othello #'human #'human)` will let two people play against each other.\nAlternately, `(othello #'random-strategy #'human)` will allow us to match our wits against a particularly poor strategy.\nThe rest of this chapter shows how to develop a better strategy.\n\n## 18.3 Evaluating Positions\n\nThe random-move strategy is, of course, a poor one.\nWe would like to make a good move rather than a random move, but so far we don't know what makes a good move.\nThe only positions we are able to evaluate for sure are final positions: when the game is over, we know that the player with the most pieces wins.\nThis suggests a strategy: choose the move that maximizes `count-difference`, the piece differential.\nThe function `maximize-difference` does just that.\nIt calls `maximizer`, a higher-order function that chooses the best move according to an arbitrary evaluation function.\n\n```lisp\n(defun maximize-difference (player board)\n  \"A strategy that maximizes the difference in pieces.\"\n  (funcall (maximizer #'count-difference) player board))\n\n(defun maximizer (eval-fn)\n  \"Return a strategy that will consider every legal move,\n  apply EVAL-FN to each resulting board, and choose\n  the move for which EVAL-FN returns the best score.\n  FN takes two arguments: the player-to-move and board\"\n  #'(lambda (player board)\n      (let* ((moves (legal-moves player board))\n             (scores (mapcar #'(lambda (move)\n         (funcall\n          eval-fn\n          player\n          (make-move move player\n               (copy-board board))))\n                             moves))\n             (best  (apply #'max scores)))\n        (elt moves (position best scores)))))\n```\n\n**Exercise  18.1** Play some games with `maximize-difference` against `random-strategy` and `human`.\nHow good is `maximize-difference`?\n\nThose who complete the exercise will quickly see that the `maximize-difference` player does better than random, and may even beat human players in their first game or two.\nBut most humans are able to improve, learning to take advantage of the overly greedy play of `maximize-difference`.\nHumans learn that the edge squares, for example, are valuable because the player dominating the edges can surround the opponent, while it is difficult to recapture an edge.\nThis is especially true of corner squares, which can never be recaptured.\n\nUsing this knowledge, a clever player can temporarily sacrifice pieces to obtain edge and corner squares in the short run, and win back pieces in the long run.\nWe can approximate some of this reasoning with the `weighted-squares` evaluation function.\nLike `count-difference`, it adds up all the player's pieces and subtracts the opponents, but each piece is weighted according to the square it occupies.\nEdge squares are weighted highly, corner squares higher still, and squares adjacent to the corners and edges have negative weights, because occupying these squares often gives the opponent a means of capturing the desirable square.\n[Figure 18.4](#f0025) shows the standard nomenclature for edge squares: X, A, B, and C.\nIn general, X and C squares are to be avoided, because taking them gives the opponent a chance to take the corner.\nThe `weighted-squares` evaluation function reflects this.\n\n| <a id=\"fig-18-04\"></a>[]() |\n|---|\n| <img src=\"images/chapter18/fig-18-04.svg\" onerror=\"this.src='images/chapter18/fig-18-04.png'; this.onerror=null;\" alt=\"Figure 18.4\" /> |\n| **Figure 18.4: Names for Edge Squares** |\n\n```lisp\n(defparameter *weights*\n  '#(0   0   0  0  0  0  0   0   0 0\n     0 120 -20 20  5  5 20 -20 120 0\n     0 -20 -40 -5 -5 -5 -5 -40 -20 0\n     0  20  -5 15  3  3 15  -5  20 0\n     0   5  -5  3  3  3  3  -5   5 0\n     0   5  -5  3  3  3  3  -5   5 0\n     0  20  -5 15  3  3 15  -5  20 0\n     0 -20 -40 -5 -5 -5 -5 -40 -20 0\n     0 120 -20 20  5  5 20 -20 120 0\n     0   0   0  0  0  0  0   0   0 0))\n\n(defun weighted-squares (player board)\n  \"Sum of the weights of player's squares minus opponent's.\"\n  (let ((opp (opponent player)))\n    (loop for i in all-squares\n          when (eql (bref board i) player)\n          sum (aref *weights* i)\n          when (eql (bref board i) opp)\n          sum (- (aref *weights* i)))))\n```\n\n**Exercise  18.2** Compare strategies by evaluating the two forms below.\nWhat happens?\nIs this a good test to determine which strategy is better?\n\n```lisp\n(othello (maximizer #'weighted-squares)\n                  (maximizer #'count-difference) nil)\n(othello (maximizer #'count-difference)\n                  (maximizer #'weighted-squares) nil)\n```\n\n## 18.4 Searching Ahead: Minimax\n\nEven the weighted-squares strategy is no match for an experienced player.\nThere are two ways we could improve the strategy.\nFirst, we could modify the evaluation function to take more information into account.\nBut even without changing the evaluation function, we can improve the strategy by searching ahead.\nInstead of choosing the move that leads immediately to the highest score, we can also consider the opponent's possible replies, our replies to those replies, and so on.\nBy searching through several levels of moves, we can steer away from potential disaster and find good moves that were not immediately apparent.\n\nAnother way to look at the `maximizer` function is as a search function that searches only one level, or *ply*, deep:\n\n<a id=\"diagram-18-01\"></a>\n<img src=\"images/chapter18/diagram-18-01.svg\"\n  onerror=\"this.src='images/chapter18/diagram-18-01.png'; this.onerror=null;\"\n  alt=\"Diagram 18.1\" />\n\nThe top of the tree is the current board position, and the squares below that indicate possible moves.\nThe `maximizer` function evaluates each of these and picks the best move, which is underlined in the diagram.\n\nNow let's see how a 3-ply search might go.\nThe first step is to apply `maximizer` to the positions just above the bottom of the tree.\nSuppose we get the following values:\n\n<a id=\"diagram-18-02\"></a>\n<img src=\"images/chapter18/diagram-18-02.svg\"\n  onerror=\"this.src='images/chapter18/diagram-18-02.png'; this.onerror=null;\"\n  alt=\"Diagram 18.2\" />\n\nEach position is shown as having two possible legal moves, which is unrealistic but makes the diagram fit on the page.\nIn a real game, five to ten legal moves per position is typical.\nThe values at the leaves of the tree were computed by applying the evaluation function, while the values one level up were computed by `maximizer`.\nThe result is that we know what our best move is for any of the four positions just above the bottom of the tree.\n\nGoing up a level, it is the opponent's turn to move.\nWe can assume the opponent will choose the move that results in the minimal value to us, which would be the maximal value to the opponent.\nThus, the opponent's choices would be the 10- and 9-valued positions, avoiding the 20- and 23-valued positions.\n\n<a id=\"diagram-18-03\"></a>\n<img src=\"images/chapter18/diagram-18-03.svg\"\n  onerror=\"this.src='images/chapter18/diagram-18-03.png'; this.onerror=null;\"\n  alt=\"Diagram 18.3\" />\n\nNow it is our turn to move again, so we apply `maximizer` once again to get the final value of the top-level position:\n\n<a id=\"diagram-18-04\"></a>\n<img src=\"images/chapter18/diagram-18-04.svg\"\n  onerror=\"this.src='images/chapter18/diagram-18-04.png'; this.onerror=null;\"\n  alt=\"Diagram 18.4\" />\n\nIf the opponent plays as expected, we will always follow the left branch of the tree and end up at the position with value 10.\nIf the opponent plays otherwise, we will end up at a position with a better value.\n\nThis kind of search is traditionally called a *minimax* search, because of the alternate application of the `maximizer` and a hypothetical `minimizer` function.\nNotice that only the leaf positions in the tree are looked at by the evaluation function.\nThe value of all other positions is determined by minimizing and maximizing.\n\nWe are almost ready to code the minimax algorithm, but first we have to make a few design decisions.\nFirst, we could write two functions, `minimax` and `maximin`, which correspond to the two players' analyses.\nHowever, it is easier to write a single function that maximizes the value of a position for a particular player.\nIn other words, by adding the player as a parameter, we avoid having to write two otherwise identical functions.\n\nSecond, we have to decide if we are going to write a general minimax searcher or an Othello-specific searcher.\nI decided on the latter for efficiency reasons, and because there are some Othello-specific complications that need to be accounted for.\nFirst, it is possible that a player will not have any legal moves.\nIn that case, we want to continue the search with the opponent to move.\nIf the opponent has no moves either, then the game is over, and the value of the position can be determined with finality by counting the pieces.\n\nThird, we need to decide the interaction between the normal evaluation function and this final evaluation that occurs when the game is over.\nWe could insist that each evaluation function determine when the game is over and do the proper computation.\nBut that overburdens the evaluation functions and may lead to wasteful checking for the end of game.\nInstead, I implemented a separate `final-value` evaluation function, which returns 0 for a draw, a large positive number for a win, and a large negative number for a loss.\nBecause fixnum arithmetic is most efficient, the constants `most-positive-fixnum` and `most-negative-fixnum` are used.\nThe evaluation functions must be careful to return numbers that are within this range.\nAll the evaluation functions in this chapter will be within range if fixnums are 20 bits or more.\n\nIn a tournament, it is not only important who wins and loses, but also by how much.\nIf we were trying to maximize the margin of victory, then `final-value` would be changed to include a small factor for the final difference.\n\n```lisp\n(defconstant winning-value most-positive-fixnum)\n(defconstant losing-value  most-negative-fixnum)\n\n(defun final-value (player board)\n  \"Is this a win, loss, or draw for player?\"\n  (case (signum (count-difference player board))\n    (-1 losing-value)\n    ( 0 0)\n    (+1 winning-value)))\n```\n\nFourth, and finally, we need to decide on the parameters for the minimax function.\nLike the other evaluation functions, it needs the player to move and the current board as parameters.\nIt also needs an indication of how many ply to search, and the static evaluation function to apply to the leaf positions.\nThus, minimax will be a function of four arguments.\nWhat will it return?\nIt needs to return the best move, but it also needs to return the value of that move, according to the static evaluation function.\nWe use multiple values for this.\n\n```lisp\n(defun minimax (player board ply eval-fn)\n  \"Find the best move, for PLAYER, according to EVAL-FN,\n  searching PLY levels deep and backing up values.\"\n  (if (= ply 0)\n      (funcall eval-fn player board)\n      (let ((moves (legal-moves player board)))\n        (if (null moves)\n            (if (any-legal-move? (opponent player) board)\n                (- (minimax (opponent player) board\n                            (- ply 1) eval-fn))\n                (final-value player board))\n            (let ((best-move nil)\n                  (best-val nil))\n              (dolist (move moves)\n                (let* ((board2 (make-move move player\n                                          (copy-board board)))\n                       (val (- (minimax\n                                 (opponent player) board2\n                                 (- ply 1) eval-fn))))\n                  (when (or (null best-val)\n                            (> val best-val))\n                    (setf best-val val)\n                    (setf best-move move))))\n              (values best-val best-move))))))\n```\n\nThe `minimax` function cannot be used as a strategy function as is, because it takes too many arguments and returns too many values.\nThe functional `minimax-searcher` returns an appropriate strategy.\nRemember that a strategy is a function of two arguments: the player and the board.\n`get-move` is responsible for passing the right arguments to the function, so the strategy need not worry about where the arguments come from.\n\n```lisp\n(defun minimax-searcher (ply eval-fn)\n  \"A strategy that searches PLY levels and then uses EVAL-FN.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value move)\n          (minimax player board ply eval-fn)\n        (declare (ignore value))\n        move)))\n```\n\nWe can test the minimax strategy, and see that searching ahead 3 ply is indeed better than looking at only 1 ply.\nI show only the final result, which demonstrates that it is indeed an advantage to be able to look ahead:\n\n```lisp\n> (othello (minimax-searcher 3 #'count-difference)\n                  (maximizer #'count-difference))\n...\nThe game is over. Final result:\n   1 2 3 4 5 6 7 8   [@=53 0=0 (+53)]\n10 @ @ @ @ @ @ @ @\n20 @ @ @ @ @ @ @ @\n30 @ @ @ @ @ @ @ @\n40 @ @ @ @ @ @ @ @\n50 @ @ @ @ @ @ @ @\n60 . . @ @ @ @ @ @\n70 . . . @ @ @ @ @\n80 . . . . @ @ . .\n```\n\n## 18.5 Smarter Searching: Alpha-Beta Search\n\nThe problem with a full minimax search is that it considers too many positions.\nIt looks at every line of play, including many improbable ones.\nFortunately, there is a way to find the optimal line of play without looking at every possible position.\nLet's go back to our familiar search tree:\n\n<a id=\"diagram-18-05\"></a>\n<img src=\"images/chapter18/diagram-18-05.svg\"\n  onerror=\"this.src='images/chapter18/diagram-18-05.png'; this.onerror=null;\"\n  alt=\"Diagram 18.5\" />\n\nHere we have marked certain positions with question marks.\nThe idea is that the whole search tree evaluates to 10 regardless of the value of the positions labeled ?<sub>*i*</sub>.\nConsider the position labeled ?<sub>1</sub>.\nIt does not matter what this position evaluates to, because the opponent will always choose to play toward the 10-position, to avoid the possibility of the 15.\nThus, we can cut off the search at this point and not consider the ?-position.\nThis kind of cutoff has historically been called a *beta* cutoff.\n\nNow consider the position labeled ?<sub>4</sub>.\nIt does not matter what this position evaluates to, because we will always prefer to choose the 10 position at the left branch, rather than giving the opponent a chance to play to the 9-position.\nThis is an *alpha* cutoff.\nNotice that it cuts off a whole subtree of positions below it (labeled ?<sub>2</sub> and ?<sub>3</sub>).\n\nIn general, we keep track of two parameters that bound the true value of the current position.\nThe lower bound is a value we know we can achieve by choosing a certain line of play.\nThe idea is that we need not even consider moves that will lead to a value lower than this.\nThe lower bound has traditionally been called *alpha,* but we will name it `achievable`.\nThe upper bound represents a value the opponent can achieve by choosing a certain line of play.\nIt has been called *beta*, but we will call it `cutoff`.\nAgain, the idea is that we need not consider moves with a higher value than this (because then the opponent would avoid the move that is so good for us).\nThe alpha-beta algorithm is just minimax, but with some needless evaluations pruned by these two parameters.\n\nIn deeper trees with higher branching factors, many more evaluations can be pruned.\nIn general, a tree of depth *d* and branching factor *b* requires *b<sup>d</sup>* evaluations for full minimax, and as few as *b*<sup>*d*/2</sup> evaluations with alpha-beta minimax.\n\nTo implement alpha-beta search, we add two more parameters to the function `minimax` and rename it `alpha-beta`.\n`achievable` is the best score the player can achieve; it is what we want to maximize.\nThe `cutoff` is a value that, when exceeded, will make the opponent choose another branch of the tree, thus making the rest of the current level of the tree irrelevant.\nThe test `until (>= achievable cutoff)` in the penultimate line of `minimax` does the cutoff; all the other changes just involve passing the parameters around properly.\n\n```lisp\n(defun alpha-beta (player board achievable cutoff ply eval-fn)\n  \"Find the best move, for PLAYER, according to EVAL-FN,\n  searching PLY levels deep and backing up values,\n  using cutoffs whenever possible.\"\n  (if (= ply 0)\n      (funcall eval-fn player board)\n      (let ((moves (legal-moves player board)))\n        (if (null moves)\n            (if (any-legal-move? (opponent player) board)\n                (- (alpha-beta (opponent player) board\n                               (- cutoff) (- achievable)\n                               (- ply 1) eval-fn))\n                (final-value player board))\n            (let ((best-move (first moves)))\n              (loop for move in moves do\n                (let* ((board2 (make-move move player\n                                          (copy-board board)))\n                       (val (- (alpha-beta\n                                 (opponent player) board2\n                                 (- cutoff) (- achievable)\n                                 (- ply 1) eval-fn))))\n                  (when (> val achievable)\n                    (setf achievable val)\n                    (setf best-move move)))\n                until (>= achievable cutoff))\n              (values achievable best-move))))))\n\n(defun alpha-beta-searcher (depth eval-fn)\n  \"A strategy that searches to DEPTH and then uses EVAL-FN.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value move)\n          (alpha-beta player board losing-value winning-value\n                      depth eval-fn)\n        (declare (ignore value))\n        move)))\n```\n\nIt must be stressed that `alpha-beta` computes the exact same result as the full-search version of `minimax`.\nThe only advantage of the cutoffs is making the search go faster by considering fewer positions.\n\n## 18.6 An Analysis of Some Games\n\nNow is a good time to stop and analyze where we have gone.\nWe've demonstrated a program that can play a *legal* game of Othello, and some strategies that may or may not play a *good* game.\nFirst, we'll look at some individual games to see the mistakes made by some strategies, and then we'll generate some statistics for series of games.\n\nIs the weighted-squares measure a good one?\nWe can compare it to a strategy of maximizing the number of pieces.\nSuch a strategy would of course be perfect if it could look ahead to the end of the game, but the speed of our computers limits us to searching only a few ply, even with cutoffs.\nConsider the following game, where black is maximizing the difference in the number of pieces, and white is maximizing the weighted sum of squares.\nBoth search to a depth of 4 ply:\n\n```lisp\n> (othello (alpha-beta-searcher 4 #'count-difference)\n                      (alpha-beta-searcher 4 #'weighted-squares))\n```\n\nBlack is able to increase the piece difference dramatically as the game progresses.\nAfter 17 moves, white is down to only one piece:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=20 0=1 (+19)]\n  10 0 @ . . . . . .\n  20 . @ . . . @ @ .\n  30 @ @ @ @ @ @ . .\n  40 . @ . @ @ . . .\n  50 @ @ @ @ @ @ . .\n  60 . . @ . . . . .\n  70 . . . . . . . .\n  80 . . . . . . . .\n```\n\nAlthough behind by 19 points, white is actually in a good position, because the piece in the corner is safe and threatens many of black's pieces.\nWhite is able to maintain good position while being numerically far behind black, as shown in these positions later in the game:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=32 0=15 (+17)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 @ @ @ @ @\n  30 @ @ 0 0 @ 0 @ @\n  40 0 0 @ @ @ @ @ @\n  50 @ 0 @ @ @ @ . .\n  60 @ @ 0 @ @ 0 . .\n  70 @ . . @ @ . . .\n  80 . . . . . . . .\n```\n\n```\n     1 2 3 4 5 6 7 8  [@=34 0=19 (+15)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 @ @ @ @ @\n  30 @ @ 0 0 @ 0 @ @\n  40 0 @ 0 @ @ @ @ @\n  50 0 @ 0 @ @ @ @ .\n  60 0 @ 0 @ @ @ . .\n  70 0 @ @ @ @ . . .\n  80 0 @ 0 . . . . .\n```\n\nAfter some give-and-take, white gains the advantage for good by capturing eight pieces on a move to square 85 on the third-to-last move of the game:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=31 0=30 (+1)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ @ @ @ 0\n  70 0 @ @ @ @ @ 0 0\n  80 0 @ @ @ . . . 0\n\n0 moves to 85.\n```\n\n```\n     1 2 3 4 5 6 7 8  [@=23 0=39 (-16)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ 0 @ 0 0\n  70 0 @ @ 0 0 0 0 0\n  80 0 0 0 0 0 . . 0\n\n@ moves to 86.\n```\n\n```\n     1 2 3 4 5 6 7 8  [@=26 0=37 (-11)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ 0 @ 0 0\n  70 0 @ @ 0 @ @ 0 0\n  80 0 0 0 0 0 @ . 0\n\n0 moves to 87.\n```\n\n```\nThe game is over. Final result:\n\n     1 2 3 4 5 6 7 8  [@=24 0=40 (-16)]\n  10 0 0 0 0 @ @ 0 0\n  20 @ @ 0 0 @ @ @ 0\n  30 @ @ 0 0 0 @ @ 0\n  40 0 @ 0 0 0 @ @ 0\n  50 0 @ 0 @ 0 @ @ 0\n  60 0 @ 0 @ 0 @ 0 0\n  70 0 @ @ 0 @ 0 0 0\n  80 0 0 0 0 0 0 0 0\n-16\n```\n\nWhite ends up winning by 16 pieces.\nBlack's strategy was too greedy: black was willing to give up position (all four corners and all but four of the edge squares) for temporary gains in material.\n\nIncreasing the depth of search does not compensate for a faulty evaluation function.\nIn the following game, black's search depth is increased to 6 ply, while white's is kept at 4.\nThe same things happen, although black's doom takes a bit longer to unfold.\n\n```lisp\n> (othello (alpha-beta-searcher 6 #'count-difference)\n           (alpha-beta-searcher 4 #'weighted-squares))\n```\n\nBlack slowly builds up an advantage:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=21 0=8 (+13)]\n  10 . . @ @ @ @ @ .\n  20 . @ . @ 0 @ . .\n  30 0 @ @ 0 @ 0 0 .\n  40 . @ . @ 0 @ 0 .\n  50 . @ @ @ @ @ . .\n  60 . @ . @ . 0 . .\n  70 . . . . . . . .\n  80 . . . . . . . .\n```\n\nBut at this point white has clear access to the upper left corner, and through that corner threatens to take the whole top edge.\nStill, black maintains a material edge as the game goes on:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=34 0=11 (+23)]\n  10 0 . @ @ @ @ @ .\n  20 . 0 0 @ @ @ . .\n  30 0 @ 0 0 @ @ @ @\n  40 @ @ @ @ 0 @ @ .\n  50 @ @ @ @ @ 0 @ .\n  60 @ @ @ @ @ @ 0 0\n  70 @ . . @ . . @ 0\n  80 . . . . . . . .\n```\n\nBut eventually white's weighted-squares strategy takes the lead:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=23 0=27 (-4)]\n  10 0 0 0 0 0 0 0 0\n  20 @ @ 0 @ @ @ . .\n  30 0 @ 0 0 @ @ @ @\n  40 0 @ 0 @ 0 @ @ .\n  50 0 @ 0 @ @ 0 @ .\n  60 0 0 0 @ @ @ 0 0\n  70 0 . 0 @ . . @ 0\n  80 0 . . . . . . .\n```\n\nand is able to hold on to win:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=24 0=40 (-16)]\n  10 0 0 0 0 0 0 0 0\n  20 @ @ 0 @ 0 0 @ @\n  30 0 @ 0 0 @ @ @ @\n  40 0 @ 0 0 @ @ @ 0\n  50 0 0 @ @ 0 @ 0 0\n  60 0 0 0 @ 0 @ @ 0\n  70 0 0 0 0 @ @ 0 0\n  80 0 0 0 0 0 @ @ 0\n-16\n```\n\nThis shows that brute-force searching is not a panacea.\nWhile it is helpful to be able to search deeper, greater gains can be made by making the evaluation function more accurate.\nThere are many problems with the weighted-squares evaluation function.\nConsider again this position from the first game above:\n\n```lisp\n     1 2 3 4 5 6 7 8  [@=20 0=1 (+19)]\n  10 0 @ . . . . . .\n  20 . @ . . . @ @ .\n  30 @ @ @ @ @ @ . .\n  40 . @ . @ @ . . .\n  50 @ @ @ @ @ @ . .\n  60 . @ . . . . . .\n  70 . . . . . . . .\n  80 . . . . . . . .\n```\n\nHere white, playing the weighted-squares strategy, chose to play 66.\nThis is probably a mistake, as 13 would extend white's dominance of the top edge, and allow white to play again (since black would have no legal moves).\nUnfortunately, white rejects this move, primarily because square 12 is weighted as -20.\nThus, there is a disincentive to taking this square.\nBut 12 is weighted -20 because it is a bad idea to take such a square when the corner is empty-the opponent will then have a chance to capture the corner, regaining the 12 square as well.\nThus, we want squares like 12 to have a negative score when the corner is empty, but not when it is already occupied.\nThe `modified-weighted-squares` evaluation function does just that.\n\n```lisp\n(defun modified-weighted-squares (player board)\n  \"Like WEIGHTED-SQUARES, but don't take off for moving\n  near an occupied corner.\"\n  (let ((w (weighted-squares player board)))\n    (dolist (corner '(11 18 81 88))\n      (when (not (eql (bref board corner) empty))\n        (dolist (c (neighbors corner))\n          (when (not (eql (bref board c) empty))\n            (incf w (* (- 5 (aref *weights* c))\n                       (if (eql (bref board c) player)\n                           +1 -1)))))))\n    w))\n\n(let ((neighbor-table (make-array 100 :initial-element nil)))\n  ;; Initialize the neighbor table\n  (dolist (square all-squares)\n    (dolist (dir all-directions)\n      (if (valid-p (+ square dir))\n          (push (+ square dir)\n                (aref neighbor-table square)))))\n\n  (defun neighbors (square)\n    \"Return a list of all squares adjacent to a square.\"\n    (aref neighbor-table square)))\n```\n\n## 18.7 The Tournament Version of Othello\n\nWhile the `othello` function serves as a perfectly good moderator for casual play, there are two points that need to be fixed for tournament-level play.\nFirst, tournament games are played under a strict time limit: a player who takes over 30 minutes total to make all the moves forfeits the game.\nSecond, the standard notation for Othello games uses square names in the range al to h8, rather than in the 11 to 88 range that we have used so far.\na1 is the upper left corner, a8 is the lower left corner, and h8 is the lower right corner.\nWe can write routines to translate between this notation and the one we were using by creating a table of square names.\n\n```lisp\n(let ((square-names\n        (cross-product #'symbol\n                       '(? a b c d e f g h ?)\n                       '(? 1 2 3 4 5 6 7 8 ?))))\n\n  (defun h8->88 (str)\n    \"Convert from alphanumeric to numeric square notation.\"\n    (or (position (string str) square-names :test #'string-equal)\n        str))\n\n  (defun 88->h8 (num)\n    \"Convert from numeric to alphanumeric square notation.\"\n    (if (valid-p num)\n        (elt square-names num)\n        num)))\n\n(defun cross-product (fn xlist ylist)\n  \"Return a list of all (fn x y) values.\"\n  (mappend #'(lambda (y)\n               (mapcar #'(lambda (x) (funcall fn x y))\n                       xlist))\n           ylist))\n```\n\nNote that these routines return their input unchanged when it is not one of the expected values.\nThis is to allow commands other than moving to a particular square.\nFor example, we will add a feature that recognizes `resign` as a move.\n\nThe `human` player needs to be changed slightly to read moves in this format.\nWhile we're at it, we'll also print the list of possible moves:\n\n```lisp\n(defun human (player board)\n  \"A human player for the game of Othello\"\n  (format t \"~&~c to move ~a: \" (name-of player)\n          (mapcar #'88->h8 (legal-moves player board)))\n  (h8->88 (read)))\n```\n\n| []()                                                        |\n|-------------------------------------------------------------|\n| ![f18-05](images/chapter18/f18-05.jpg)                      |\n| Figure 18.5: Glossary for the Tournament Version of Othello |\n\n*(ed: should be a markdown table)*\n\nThe `othello` function needn't worry about notation, but it does need to monitor the time.\nWe make up a new data structure, the clock, which is an array of integers saying how much time (in internal units) each player has left.\nFor example, (`aref clock black`) is the amount of time black has left to make all his moves.\nIn Pascal, we would declare the clock array as `array[black..white]`, but in Common Lisp all arrays are zero-based, so we need an array of three elements to allow the subscript `black`, which is 2.\n\nThe clock is passed to `get-move` and `print-board` but is otherwise unused.\nI could have complicated the main game loop by adding tests for forfeits because of expired time and, as we shall see later, resignation by either player.\nHowever, I felt that would add a great deal of complexity for rarely used options.\nInstead, I wrap the whole game loop, along with the computation of the final score, in a `catch` special form.\nThen, if `get-move` encounters a forfeit or resignation, it can `throw` an appropriate final score: 64 or -64, depending on which player forfeits.\n\n```lisp\n(defvar *move-number* 1 \"The number of the move to be played\")\n\n(defun othello (bl-strategy wh-strategy\n                &optional (print t) (minutes 30))\n  \"Play a game of othello.  Return the score, where a positive\n  difference means black, the first player, wins.\"\n  (let ((board (initial-board))\n        (clock (make-array (+ 1 (max black white))\n                           :initial-element\n                           (* minutes 60\n                              internal-time-units-per-second))))\n    (catch 'game-over\n      (loop for *move-number* from 1\n            for player = black then (next-to-play board player print)\n            for strategy = (if (eql player black)\n                               bl-strategy\n                               wh-strategy)\n            until (null player)\n            do (get-move strategy player board print clock))\n      (when print\n        (format t \"~&The game is over.  Final result:\")\n        (print-board board clock))\n      (count-difference black board))))\n```\n\nStrategies now have to comply with the time-limit rule, so they may want to look at the time remaining.\nRather than passing the clock in as an argument to the strategy, I decided to store the clock in the special variable `*clock*`.\nThe new version of `othello` also keeps track of the `*move-number*`.\nThis also could have been passed to the strategy functions as a parameter.\nBut adding these extra arguments would require changes to all the strategies we have developed so far.\nBy storing the information in special variables, strategies that want to can look at the clock or the move number, but other strategies don't have to know about them.\n\nWe still have the security problem-we don't want a strategy to be able to set the opponent's remaining time to zero and thereby win the game.\nThus, we use `*clock*` only as a copy of the \"real\" game clock.\nThe function `replace` copies the real clock into `*clock*`, and also copies the real board into `*board*`.\n\n```lisp\n(defvar *clock* (make-array 3) \"A copy of the game clock\")\n(defvar *board* (initial-board) \"A copy of the game board\")\n\n(defun get-move (strategy player board print clock)\n  \"Call the player's strategy function to get a move.\n  Keep calling until a legal move is made.\"\n  ;; Note we don't pass the strategy function the REAL board.\n  ;; If we did, it could cheat by changing the pieces on the board.\n  (when print (print-board board clock))\n  (replace *clock* clock)\n  (let* ((t0 (get-internal-real-time))\n         (move (funcall strategy player (replace *board* board)))\n         (t1 (get-internal-real-time)))\n    (decf (elt clock player) (- t1 t0))\n    (cond\n      ((< (elt clock player) 0)\n       (format t \"~&~c has no time left and forfeits.\"\n               (name-of player))\n       (THROW 'game-over (if (eql player black) -64 64)))\n      ((eq move 'resign)\n       (THROW 'game-over (if (eql player black) -64 64)))\n      ((and (valid-p move) (legal-p move player board))\n       (when print\n         (format t \"~&~c moves to ~a.\"\n                 (name-of player) (88->h8 move)))\n       (make-move move player board))\n      (t (warn \"Illegal move: ~a\" (88->h8 move))\n         (get-move strategy player board print clock)))))\n```\n\nFinally, the function `print-board` needs to print the time remaining for each player; this requires an auxiliary function to get the number of minutes and seconds from an internal-format time interval.\nNote that we make the arguments optional, so that in debugging one can say just (`print-board`) to see the current situation.\nAlso note the esoteric format option: `\"~2, '0d\"` prints a decimal number using at least two places, padding on the left with zeros.\n\n```lisp\n(defun print-board (&optional (board *board*) clock)\n  \"Print a board, along with some statistics.\"\n  ;; First print the header and the current score\n  (format t \"~2&    a b c d e f g h   [~c=~2a ~c=~2a (~@d)]\"\n          (name-of black) (count black board)\n          (name-of white) (count white board)\n          (count-difference black board))\n  ;; Print the board itself\n  (loop for row from 1 to 8 do\n        (format t \"~&  ~d \" row)\n        (loop for col from 1 to 8\n              for piece = (bref board (+ col (* 10 row)))\n              do (format t \"~c \" (name-of piece))))\n  ;; Finally print the time remaining for each player\n  (when clock\n    (format t \"  [~c=~a ~c=~a]~2&\"\n            (name-of black) (time-string (elt clock black))\n            (name-of white) (time-string (elt clock white)))))\n\n(defun time-string (time)\n  \"Return a string representing this internal time in min:secs.\"\n  (multiple-value-bind (min sec)\n      (floor (round time internal-time-units-per-second) 60)\n    (format nil \"~2d:~2,'0d\" min sec)))\n```\n\n## 18.8 Playing a Series of Games\n\nA single game is not enough to establish that one strategy is better than another.\nThe following function allows two strategies to compete in a series of games:\n\n```lisp\n(defun othello-series (strategy1 strategy2 n-pairs)\n  \"Play a series of 2*n-pairs games, swapping sides.\"\n  (let ((scores\n          (loop repeat n-pairs\n             for random-state = (make-random-state)\n             collect (othello strategy1 strategy2 nil)\n             do (setf *random-state* random-state)\n             collect (- (othello strategy2 strategy1 nil)))))\n    ;; Return the number of wins (1/2 for a tie),\n    ;; the total of the point differences, and the\n    ;; scores themselves, all from strategy1's point of view.\n    (values (+ (count-if #'plusp scores)\n               (/ (count-if #'zerop scores) 2))\n            (apply #'+ scores)\n            scores)))\n```\n\nLet's see what happens when we use it to pit the two weighted-squares functions against each other in a series of ten games:\n\n```lisp\n>(othello-series\n        (alpha-beta-searcher 2 #'modified-weighted-squares)\n        (alpha-beta-searcher 2 #'weighted-squares) 5)\n0\n60\n(-28 40 -28 40 -28 40 -28 40 -28 40)\n```\n\nSomething is suspicious here-the same scores are being repeated.\nA little thought reveals why: neither strategy has a random component, so the exact same game was played five times with one strategy going first, and another game was played five times when the other strategy goes first!\nA more accurate appraisal of the two strategies' relative worth would be gained by starting each game from some random position and playing from there.\n\nThink for a minute how you would design to run a series of games starting from a random position.\nOne possibility would be to change the function `othello` to accept an optional argument indicating the initial state of the board.\nThen `othello-series` could be changed to somehow generate a random board and pass it to `othello`.\nWhile this approach is feasible, it means changing two existing working functions, as well as writing another function, `generate-random-board`.\nBut we couldn't generate just any random board: it would have to be a legal board, so it would have to call `othello` and somehow get it to stop before the game was over.\n\nAn alternative is to leave both `othello` and `othello-series` alone and build another function on top of it, one that works by passing in two new strategies: strategies that make a random move for the first few moves and then revert to the normal specified behavior.\nThis is a better solution because it uses existing functions rather than modifying them, and because it requires no new functions besides `switch-strategies`, which could prove useful for other purposes, and `random-othello-series`, which does nothing more than call `othello-series` with the proper arguments.\n\n```lisp\n(defun random-othello-series (strategy1 strategy2\n                              n-pairs &optional (n-random 10))\n  \"Play a series of 2*n games, starting from a random position.\"\n  (othello-series\n    (switch-strategies #'random-strategy n-random strategy1)\n    (switch-strategies #'random-strategy n-random strategy2)\n    n-pairs))\n\n(defun switch-strategies (strategy1 m strategy2)\n  \"Make a new strategy that plays strategy1 for m moves,\n  then plays according to strategy2.\"\n  #'(lambda (player board)\n      (funcall (if (<= *move-number* m) strategy1 strategy2)\n               player board)))\n```\n\nThere is a problem with this kind of series: it may be that one of the strategies just happens to get better random positions.\nA fairer test would be to play two games from each random position, one with the each strategy playing first.\nOne way to do that is to alter `othello-series` so that it saves the random state before playing the first game of a pair, and then restores the saved random state before playing the second game.\nThat way the same random position will be duplicated.\n\n```lisp\n(defun othello-series (strategy1 strategy2 n-pairs)\n  \"Play a series of 2*n-pairs games, swapping sides.\"\n  (let ((scores\n          (loop repeat n-pairs\n             for random-state = (make-random-state)\n             collect (othello strategy1 strategy2 nil)\n             do (setf *random-state* random-state)\n             collect (- (othello strategy2 strategy1 nil)))))\n    ;; Return the number of wins (1/2 for a tie),\n    ;; the total of the point differences, and the\n    ;; scores themselves, all from strategy1's point of view.\n    (values (+ (count-if #'plusp scores)\n               (/ (count-if #'zerop scores) 2))\n            (apply #'+ scores)\n            scores)))\n```\n\nNow we are in a position to do a more meaningful test.\nIn the following, the weighted-squares strategy wins 4 out of 10 games against the modified strategy, losing by a total of 76 pieces, with the actual scores indicated.\n\n```lisp\n> (random-othello-series\n        (alpha-beta-searcher 2 #'weighted-squares)\n        (alpha-beta-searcher 2#'modified-weighted-squares)\n        5)\n4\n-76\n(-8 -40 22 -30 10 -10 12 -18 4 -18)\n```\n\nThe `random-othello-series` function is useful for comparing two strategies.\nWhen there are more than two strategies to be compared at the same time, the following function can be useful:\n\n```lisp\n(defun round-robin (strategies n-pairs &optional\n                    (n-random 10) (names strategies))\n  \"Play a tournament among the strategies.\n  N-PAIRS = games each strategy plays as each color against\n  each opponent.  So with N strategies, a total of\n  N*(N-1)*N-PAIRS games are played.\"\n  (let* ((N (length strategies))\n         (totals (make-array N :initial-element 0))\n         (scores (make-array (list N N)\n                             :initial-element 0)))\n    ;; Play the games\n    (dotimes (i N)\n      (loop for j from (+ i 1) to (- N 1) do\n          (let* ((wins (random-othello-series\n                         (elt strategies i)\n                         (elt strategies j)\n                         n-pairs n-random))\n                 (losses (- (* 2 n-pairs) wins)))\n            (incf (aref scores i j) wins)\n            (incf (aref scores j i) losses)\n            (incf (aref totals i) wins)\n            (incf (aref totals j) losses))))\n    ;; Print the results\n    (dotimes (i N)\n      (format t \"~&~a~20T ~4f: \" (elt names i) (elt totals i))\n      (dotimes (j N)\n        (format t \"~4f \" (if (= i j) '---\n                             (aref scores i j)))))))\n```\n\nHere is a comparison of five strategies that search only 1 ply:\n\n```lisp\n(defun mobility (player board)\n  \"The number of moves a player has.\"\n  (length (legal-moves player board)))\n\n> (round-robin\n    (list (maximizer #'count-difference)\n                (maximizer #'mobility)\n                (maximizer #'weighted-squares)\n                (maximizer #'modified-weighted-squares)\n                #'random-strategy)\n    5 10\n    '(count-difference mobility weighted modified-weighted random))\nCOUNT-DIFFERENCE   12.5:  --- 3.0 2.5 0.0 7.0\nMOBILITY           20.5:  7.0 --- 1.5 5.0 7.0\nWEIGHTED           28.0:  7.5 8.5 --- 3.0 9.0\nMODIFIED-WEIGHTED  31.5: 10.0 5.0 7.0 --- 9.5\nRANDOM              7.5:  3.0 3.0 1.0 0.5 ---\n```\n\nThe parameter `n-pairs` is 5, meaning that each strategy plays five games as black and five as white against each of the other four strategies, for a total of 40 games for each strategy and 100 games overall.\nThe first line of output says that the count-difference strategy won 12.5 of its 40 games, including 3 against the mobility strategy, 2.5 against the weighted strategy, none against the modified weighted, and 7 against the random strategy.\nThe fact that the random strategy manages to win 7.5 out of 40 games indicates that the other strategies are not amazingly strong.\nNow we see what happens when the search depth is increased to 4 ply (this will take a while to run):\n\n```lisp\n> (round-robin\n  (list (alpha-beta-searcher 4 #'count-difference)\n        (alpha-beta-searcher 4 #'weighted-squares)\n        (alpha-beta-searcher 4 #'modified-weighted-squares)\n        #'random-strategy)\n  5 10\n  '(count-difference weighted modified-weighted random))\nCOUNT-DIFFERENCE   12.0:  --- 2.0 0.0 10.0\nWEIGHTED           23.5:  8.0 --- 5.5 10.0\nMODIFIED-WEIGHTED  24.5: 10.0 4.5 --- 10.0\nRANDOM              0.0:  0.0 0.0 0.0  ---\n```\n\nHere the random strategy does not win any games-an indication that the other strategies are doing something right.\nNotice that the modified weighted-squares has only a slight advantage over the weighted-squares, and in fact it lost their head-to-head series, four games to five, with one draw.\nSo it is not clear which strategy is better.\n\nThe output does not break down wins by black or white, nor does it report the numerical scores.\nI felt that that would clutter up the output too much, but you're welcome to add this information.\nIt turns out that white wins 23 (and draws 1) of the 40 games played between 4-ply searching strategies.\nUsually, Othello is a fairly balanced game, because black has the advantage of moving first but white usually gets to play last.\nIt is clear that these strategies do not play well in the opening game, but for the last four ply they play perfectly.\nThis may explain white's slight edge, or it may be a statistical aberration.\n\n## 18.9 More Efficient Searching\n\nThe alpha-beta cutoffs work when we have established a good move and another move proves to be not as good.\nThus, we will be able to make cutoffs earlier if we ensure that good moves are considered first.\nOur current algorithm loops through the list of `legal-moves`, but `legal-moves` makes no attempt to order the moves in any way.\nWe will call this the *random-ordering* strategy (even though the ordering is not random at all-square 11 is always considered first, then 12, etc.).\n\nOne way to try to generate good moves first is to search highly weighted squares first.\nSince `legal-moves` considers squares in the order defined by `all-squares`, all we have to do is redefine the list `all-squares`<a id=\"tfn18-3\"></a><sup>[3](#fn18-3)</sup>\n:\n\n```lisp\n(defconstant all-squares\n    (sort (loop for i from 11 to 88\n                  when (<= 1 (mod i 10) 8) collect i)\n            #'> :key #'(lambda (sq) (elt *weights* sq))))\n```\n\nNow the corner squares will automatically be considered first, followed by the other highly weighted squares.\nWe call this the s*tatic-ordering* strategy, because the ordering is not random, but it does not change depending on the situation.\n\nA more informed way to try to generate good moves first is to sort the moves according to the evaluation function.\nThis means making more evaluations.\nPreviously, only the boards at the leaves of the search tree were evaluated.\nNow we need to evaluate every board.\nIn order to avoid evaluating a board more than once, we make up a structure called a `node`, which holds a board, the square that was taken to result in that board, and the evaluation value of that board.\nThe search is the same except that nodes are passed around instead of boards, and the nodes are sorted by their value.\n\n```lisp\n(defstruct (node) square board value)\n\n(defun alpha-beta-searcher2 (depth eval-fn)\n  \"Return a strategy that does A-B search with sorted moves.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value node)\n          (alpha-beta2\n            player (make-node :board board\n                              :value (funcall eval-fn player board))\n            losing-value winning-value depth eval-fn)\n        (declare (ignore value))\n        (node-square node))))\n\n(defun alpha-beta2 (player node achievable cutoff ply eval-fn)\n  \"A-B search, sorting moves by eval-fn\"\n  ;; Returns two values: achievable-value and move-to-make\n  (if (= ply 0)\n      (values (node-value node) node)\n      (let* ((board (node-board node))\n             (nodes (legal-nodes player board eval-fn)))\n        (if (null nodes)\n            (if (any-legal-move? (opponent player) board)\n                (values (- (alpha-beta2 (opponent player)\n                                        (negate-value node)\n                                        (- cutoff) (- achievable)\n                                        (- ply 1) eval-fn))\n                        nil)\n                (values (final-value player board) nil))\n            (let ((best-node (first nodes)))\n              (loop for move in nodes\n                    for val = (- (alpha-beta2\n                                   (opponent player)\n                                   (negate-value move)\n                                   (- cutoff) (- achievable)\n                                   (- ply 1) eval-fn))\n                    do (when (> val achievable)\n                         (setf achievable val)\n                         (setf best-node move))\n                    until (>= achievable cutoff))\n              (values achievable best-node))))))\n\n(defun negate-value (node)\n  \"Set the value of a node to its negative.\"\n  (setf (node-value node) (- (node-value node)))\n  node)\n\n(defun legal-nodes (player board eval-fn)\n  \"Return a list of legal moves, each one packed into a node.\"\n  (let ((moves (legal-moves player board)))\n    (sort (map-into\n            moves\n            #'(lambda (move)\n                (let ((new-board (make-move move player\n                                            (copy-board board))))\n                  (make-node\n                    :square move :board new-board\n                    :value (funcall eval-fn player new-board))))\n            moves)\n          #'> :key #'node-value)))\n```\n\n(Note the use of the function `map-into`.\nThis is part of ANSI Common Lisp, but if it is not a part of your implementation, a definition is provided on [page 857](chapter24.md#p857).)\n\nThe following table compares the performance of the random-ordering strategy, the sorted-ordering strategy and the static-ordering strategy in the course of a single game.\nAll strategies search 6 ply deep.\nThe table measures the number of boards investigated, the number of those boards that were evaluated (in all cases the evaluation function was `modified-weighted-squares`) and the time in seconds to compute a move.\n\n| random order |         |        | sorted order |         |        | static order |         |        |\n|--------------|---------|--------|--------------|---------|--------|--------------|---------|--------|\n| *boards*     | *evals* | *secs* | *boards*     | *evals* | *secs* | *boards*     | *evals* | *secs* |\n| 13912        | 10269   | 69     | 5556         | 5557    | 22     | 2365         | 1599    | 19     |\n| 9015         | 6751    | 56     | 6571         | 6572    | 25     | 3081         | 2188    | 18     |\n| 9820         | 7191    | 46     | 11556        | 11557   | 45     | 5797         | 3990    | 31     |\n| 4195         | 3213    | 20     | 5302         | 5303    | 17     | 2708         | 2019    | 15     |\n| 10890        | 7336    | 60     | 10709        | 10710   | 38     | 3743         | 2401    | 23     |\n| 13325        | 9679    | 63     | 6431         | 6432    | 24     | 4222         | 2802    | 24     |\n| 13163        | 9968    | 58     | 9014         | 9015    | 32     | 6657         | 4922    | 31     |\n| 16642        | 12588   | 70     | 9742         | 9743    | 33     | 10421        | 7488    | 51     |\n| 18016        | 13366   | 80     | 11002        | 11003   | 37     | 9508         | 7136    | 41     |\n| 23295        | 17908   | 104    | 15290        | 15291   | 48     | 26435        | 20282   | 111    |\n| 34120        | 25895   | 143    | 22994        | 22995   | 75     | 20775        | 16280   | 78     |\n| 56117        | 43230   | 224    | 46883        | 46884   | 150    | 48415        | 36229   | 203    |\n| 53573        | 41266   | 209    | 62252        | 62253   | 191    | 37803        | 28902   | 148    |\n| 43943        | 33184   | 175    | 31039        | 31040   | 97     | 33180        | 24753   | 133    |\n| 51124        | 39806   | 193    | 45709        | 45710   | 135    | 19297        | 15064   | 69     |\n| 24743        | 18777   | 105    | 20003        | 20004   | 65     | 15627        | 11737   | 66     |\n| 1.0          | 1.0     | 1.0    | .81          | 1.07    | .62    | .63          | .63     | .63    |\n\nThe last two lines of the table give the averages and the averages normalized to the random-ordering strategy's performance.\nThe sorted-ordering strategy takes only 62% of the time of the random-ordering strategy, and the static-ordering takes 63%.\nThese times are not to be trusted too much, because a large-scale garbage collection was taking place during the latter part of the game, and it may have thrown off the times.\nThe board and evaluation count may be better indicators, and they both show the static-ordering strategy doing the best.\n\nWe have to be careful how we evaluate these results.\nEarlier I said that alpha-beta search makes more cutoffs when it is presented first with better moves.\nThe actual truth is that it makes more cutoffs when presented first with moves that *the evaluation function thinks* are better.\nIn this case the evaluation function and the static-ordering strategy are in strong agreement on what are the best moves, so it is not surprising that static ordering does so well.\nAs we develop evaluation functions that vary from the weighted-squares approach, we will have to run experiments again to see if the static-ordering is still the best.\n\n## 18.10 It Pays to Precycle\n\nThe progressive city of Berkeley, California, has a strong recycling program to reclaim glass, paper, and aluminum that would otherwise be discarded as garbage.\nIn 1989, Berkeley instituted a novel program of *precycling:* consumers are encouraged to avoid buying products that come in environmentally wasteful packages.\n\nYour Lisp system also has a recycling program: the Lisp garbage collector automatically recycles any unused storage.\nHowever, there is a cost to this program, and you the consumer can get better performance by precycling your data.\nDon't buy wasteful data structures when simpler ones can be used or reused.\nYou, the Lisp programmer, may not be able to save the rain forests or the ozone layer, but you can save valuable processor time.\n\nWe saw before that the search routines look at tens of thousands of boards per move.\nCurrently, each board position is created anew by `copy-board` and discarded soon thereaf ter.\nWe could avoid generating all this garbage by reusing the same board at each ply.\nWe'd still need to keep the board from the previous ply for use when the search backs up.\nThus, a vector of boards is needed.\nIn the following we assume that we will never search deeper than 40 ply.\nThis is a safe assumption, as even the fastest Othello programs can only search about 15 ply before running out of time.\n\n```lisp\n(defvar *ply-boards*\n  (apply #'vector (loop repeat 40 collect (initial-board))))\n```\n\nNow that we have sharply limited the number of boards needed, we may want to reevaluate the implementation of boards.\nInstead of having the board as a vector of pieces (to save space), we may want to implement boards as vectors of bytes or full words.\nIn some implementations, accessing elements of such vectors is faster.\n(In other implementations, there is no difference.)\n\nAn implementation using the vector of boards will be done in the next section.\nNote that there is another alternative: use only one board, and update it by making and retracting moves.\nThis is a good alternative in a game like chess, where a move only alters two squares.\nIn Othello, many squares can be altered by a move, so copying the whole board over and making the move is not so bad.\n\nIt should be mentioned that it is worth looking into the problem of copying a position from one board to another.\nThe function `replace` copies one sequence (or part of it) into another, but it is a generic function that may be slow.\nIn particular, if each element of a board is only 2 bits, then it may be much faster to use displaced arrays to copy 32 bits at a time.\nThe advisability of this approach depends on the implementation, and so it is not explored further here.\n\n## 18.11 Killer Moves\n\nIn [section 18.9](#s0050), we considered the possibility of searching moves in a different order, in an attempt to search the better moves first, thereby getting more alpha-beta pruning.\nIn this section, we consider the *killer heuristic,* which states that a move that has proven to be a good one in one line of play is also likely to be a good one in another line of play.\nTo use chess as perhaps a more familiar example, suppose I consider one move, and it leads to the opponent replying by capturing my queen.\nThis is a killer move, one that I would like to avoid.\nTherefore, when I consider other possible moves, I want to immediately consider the possibility of the opponent making that queen-capturing move.\n\nThe function `alpha-beta3` adds the parameter `killer`, which is the best move found so far at the current level.\nAfter we determine the `legal-moves`, we use `put-first` to put the killer move first, if it is in fact a legal move.\nWhen it comes time to search the next level, we keep track of the best move in `killer2`.\nThis requires keeping track of the value of the best move in `killer2-val`.\nEverything else is unchanged, except that we get a new board by recycling the `*ply-boards*` vector rather than by allocating fresh ones.\n\n```lisp\n(defun alpha-beta3 (player board achievable cutoff ply eval-fn\n                    killer)\n  \"A-B search, putting killer move first.\"\n  (if (= ply 0)\n      (funcall eval-fn player board)\n      (let ((moves (put-first killer (legal-moves player board))))\n        (if (null moves)\n            (if (any-legal-move? (opponent player) board)\n                (- (alpha-beta3 (opponent player) board\n                                (- cutoff) (- achievable)\n                                (- ply 1) eval-fn nil))\n                (final-value player board))\n            (let ((best-move (first moves))\n                  (new-board (aref *ply-boards* ply))\n                  (killer2 nil)\n                  (killer2-val winning-value))\n              (loop for move in moves\n                    do (multiple-value-bind (val reply)\n                           (alpha-beta3\n                             (opponent player)\n                             (make-move move player\n                                        (replace new-board board))\n                             (- cutoff) (- achievable)\n                             (- ply 1) eval-fn killer2)\n                         (setf val (- val))\n                         (when (> val achievable)\n                           (setf achievable val)\n                           (setf best-move move))\n                         (when (and reply (< val killer2-val))\n                           (setf killer2 reply)\n                           (setf killer2-val val)))\n                    until (>= achievable cutoff))\n              (values achievable best-move))))))\n\n(defun alpha-beta-searcher3 (depth eval-fn)\n  \"Return a strategy that does A-B search with killer moves.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value move)\n          (alpha-beta3 player board losing-value winning-value\n                       depth eval-fn nil)\n        (declare (ignore value))\n        move)))\n\n(defun put-first (killer moves)\n  \"Move the killer move to the front of moves,\n  if the killer move is in fact a legal move.\"\n  (if (member killer moves)\n      (cons killer (delete killer moves))\n      moves))\n```\n\nAnother experiment on a single game reveals that adding the killer heuristic to static-ordering search (again at 6-ply) cuts the number of boards and evaluations, and the total time, all by about 20%.\nTo summarize, alpha-beta search at 6 ply with random ordering takes 105 seconds per move (in our experiment), adding static-ordering cuts it to 66 seconds, and adding killer moves to that cuts it again to 52 seconds.\nThis doesn't include the savings that alpha-beta cutoffs give over full minimax search.\nAt 6 ply with a branching factor of 7, full minimax would take about nine times longer than static ordering with killers.\nThe savings increase with increased depth.\nAt 7 ply and a branching factor of 10, a small experiment shows that static-ordering with killers looks at only 28,000 boards in about 150 seconds.\nFull minimax would evaluate 10 million boards and take 350 times longer.\nThe times for full minimax are estimates based on the number of boards per second, not on an actual experiment.\n\nThe algorithm in this section just keeps track of one killer move.\nIt is of course possible to keep track of more than one.\nThe Othello program Bill ([Lee and Mahajan 1990b](bibliography.md#bb0715)) merges the idea of killer moves with legal move generation: it keeps a list of possible moves at each level, sorted by their value.\nThe legal move generator then goes down this list in sorted order.\n\nIt should be stressed once again that all this work on alpha-beta cutoffs, ordering, and killer moves has not made any change at all in the moves that are selected.\nWe still end up choosing the same move that would be made by a full minimax search to the given depth, we are just doing it faster, without looking at possibilities that we can prove are not as good.\n\n## 18.12 Championship Programs: Iago and Bill\n\nAs mentioned in the introduction, the unpredictability of Othello makes it a difficult game for humans to master, and thus programs that search deeply can do comparatively well.\nIn fact, in 1981 the reigning champion, Jonathan Cerf, proclaimed \"In my opinion the top programs ... are now equal (if not superior) to the best human players.\" In discussing Rosenbloom's Iago program (1982), Cerf went on to say \"I understand Paul Rosenbloom is interested in arranging a match against me.\nUnfortunately my schedule is very full, and I'm going to see that it remains that way for the foreseeable future.\"\n\nIn 1989, another program, Bill ([Lee and Mahajan 1990](bibliography.md#bb0715)) beat the highest rated American Othello player, Brian Rose, by a score of 56-8.\nBill's evaluation function is fast enough to search 6-8 ply under tournament conditions, yet it is so accurate that it beats its creator, Kai-Fu Lee, searching only 1 ply.\n(However, Lee is only a novice Othello player; his real interest is in speech recognition; see [Waibel and Lee 1991](bibliography.md#bb1285).)\nThere are other programs that also play at a high level, but they have not been written up in the AI literature as Iago and Bill have.\n\nIn this section we present an evaluation function based on Iago's, although it also contains elements of Bill, and of an evaluation function written by Eric Wefald in 1989.\nThe evaluation function makes use of two main features: *mobility and edge stability*.\n\n### Mobility\n\nBoth Iago and Bill make heavy use of the concept of *mobility*.\nMobility is a measure of the ability to make moves; basically, the more moves one can make, the better.\nThis is not quite true, because there is no advantage in being able to make bad moves, but it is a useful heuristic.\nWe define *current mobility* as the number of legal moves available to a player, and *potential mobility* as the number of blank squares that are adjacent to opponent's pieces.\nThese include the legal moves.\nA better measure of mobility would try to count only good moves.\nThe following function computes both current and potential mobility for a player:\n\n```lisp\n(defun mobility (player board)\n  \"Current Mobility is the number of legal moves.\n  Potential mobility is the number of blank squares\n  adjacent to an opponent that are not legal moves.\n  Returns current and potential mobility for player.\"\n  (let ((opp (opponent player))\n        (current 0)    ; player's current mobility\n        (potential 0)) ; player's potential mobility\n    (dolist (square all-squares)\n      (when (eql (bref board square) empty)\n        (cond ((legal-p square player board)\n               (incf current))\n              ((some #'(lambda (sq) (eql (bref board sq) opp))\n                     (neighbors square))\n               (incf potential)))))\n    (values current (+ current potential))))\n```\n\n### Edge Stability\n\nSuccess at Othello often hinges around edge play, and both Iago and Bill evaluate the edges carefully.\nEdge analysis is made easier by the fact that the edges are fairly independent of the interior of the board: once a piece is placed on the edge, no interior moves can flip it.\nThis independence allows a simplifying assumption: to evaluate a position's edge strength, evaluate each of the four edges independently, without consideration of the interior of the board.\nThe evaluation can be made more accurate by considering the X-squares to be part of the edge.\n\nEven evaluating a single edge is a time-consuming task, so Bill and Iago compile away the evaluation by building a table of all possible edge positions.\nAn \"edge\" according to Bill is ten squares: the eight actual edge squares and the two X-squares.\nSince each square can be black, white, or empty, there are 3<sup>10</sup> or 59,049 possible edge positions-a large but manageable number.\n\nThe value of each edge position is determined by a process of successive approximation.\nJust as in a minimax search, we will need a static edge evaluation function to determine the value of a edge position without search.\nThis static edge evaluation function is applied to every possible edge position, and the results are stored in a 59,049 element vector.\nThe static evaluation is just a weighted sum of the occupied squares, with different weights given depending on if the piece is stable or unstable.\n\nEach edge position's evaluation can be improved by a process of search.\nIago uses a single ply search: given a position, consider all moves that could be made (including no move at all).\nSome moves will be clearly legal, because they flip pieces on the edge, but other moves will only be legal if there are pieces in the interior of the board to flip.\nSince we are only considering the edge, we don't know for sure if these moves are legal.\nThey will be assigned probabilities of legality.\nThe updated evaluation of a position is determined by the values and probabilities of each move.\nThis is done by sorting the moves by value and then summing the product of the value times the probability that the move can be made.\nThis process of iterative approximation is repeated five times for each position.\nAt that point, Rosenbloom reports, the values have nearly converged.\n\nIn effect, this extends the depth of the normal alpha-beta search by including an edge-only search in the evaluation function.\nSince each edge position with *n* pieces is evaluated as a function of the positions with *n* + 1 pieces, the search is complete-it is an implicit 10-ply search.\n\nCalculating edge stability is a bit more complicated than the other features.\nThe first step is to define a variable, `*edge-table*`, which will hold the evaluation of each edge position, and a constant, `edge-and-x-lists`, which is a list of the squares on each of the four edges.\nEach edge has ten squares because the X-squares are included.\n\n```lisp\n(defvar *edge-table* (make-array (expt 3 10))\n  \"Array of values to player-to-move for edge positions.\")\n\n(defconstant edge-and-x-lists\n  '((22 11 12 13 14 15 16 17 18 27)\n    (72 81 82 83 84 85 86 87 88 77)\n    (22 11 21 31 41 51 61 71 81 72)\n    (27 18 28 38 48 58 68 78 88 77))\n  \"The four edges (with their X-squares).\")\n```\n\nNow for each edge we can compute an index into the edge table by building a 10-digit base-3 number, where each digit is 1 if the corresponding edge square is occupied by the player, 2 if by the opponent, and 0 if empty.\nThe function `edge-index` computes this, and `edge-stability` sums the values of the four edge indexes.\n\n```lisp\n(defun edge-index (player board squares)\n  \"The index counts 1 for player; 2 for opponent,\n  on each square---summed as a base 3 number.\"\n  (let ((index 0))\n    (dolist (sq squares)\n      (setq index (+ (* index 3)\n                     (cond ((eql (bref board sq) empty) 0)\n                           ((eql (bref board sq) player) 1)\n                           (t 2)))))\n    index))\n\n(defun edge-stability (player board)\n  \"Total edge evaluation for player to move on board.\"\n  (loop for edge-list in edge-and-x-lists\n        sum (aref *edge-table*\n                  (edge-index player board edge-list))))\n```\n\nThe function `edge-stability` is all we will need in Iago's evaluation function, but we still need to generate the edge table.\nSince this needs to be done only once, we don't have to worry about efficiency.\nIn particular, rather than invent a new data structure to represent edges, we will continue to use complete boards, even though they will be mostly empty.\nThe computations for the edge table will be made on the top edge, from the point of view of black, with black to play.\nBut the same table can be used for white, or for one of the other edges, because of the way the edge index is computed.\n\nEach position in the table is first initialized to a static value computed by a kind of weighted-squares metric, but with different weights depending on if a piece is in danger of being captured.\nAfter that, each position is updated by considering the possible moves that can be made from the position, and the values of each of these moves.\n\n```lisp\n(defconstant top-edge (first edge-and-x-lists))\n\n(defun init-edge-table ()\n  \"Initialize *edge-table*, starting from the empty board.\"\n  ;; Initialize the static values\n  (loop for n-pieces from 0 to 10 do\n        (map-edge-n-pieces\n          #'(lambda (board index)\n              (setf (aref *edge-table* index)\n                    (static-edge-stability black board)))\n          black (initial-board) n-pieces top-edge 0))\n  ;; Now iterate five times trying to improve:\n  (dotimes (i 5)\n    ;; Do the indexes with most pieces first\n    (loop for n-pieces from 9 downto 1 do\n          (map-edge-n-pieces\n            #'(lambda (board index)\n                (setf (aref *edge-table* index)\n                      (possible-edge-moves-value\n                        black board index)))\n            black (initial-board) n-pieces top-edge 0))))\n```\n\nThe function `map-edge-n-pieces` iterates through all edge positions with a total of `n` pieces (of either color), applying a function to each such position.\nIt also keeps a running count of the edge index as it goes.\nThe function should accept two arguments: the board and the index.\nNote that a single board can be used for all the positions because squares are reset after they are used.\nThe function has three cases: if the number of squares remaining is less than `n`, then it will be impossible to place `n` pieces on those squares, so we give up.\nIf there are no more squares then `n` must also be zero, so this is a valid position, and the function `fn` is called.\nOtherwise we first try leaving the current square blank, then try filling it with player's piece, and then with the opponent's piece, in each case calling `map-edge-n-pieces` recursively.\n\n```lisp\n(defun map-edge-n-pieces (fn player board n squares index)\n  \"Call fn on all edges with n pieces.\"\n  ;; Index counts 1 for player; 2 for opponent\n  (cond\n    ((< (length squares) n) nil)\n    ((null squares) (funcall fn board index))\n    (t (let ((index3 (* 3 index))\n             (sq (first squares)))\n         (map-edge-n-pieces fn player board n (rest squares) index3)\n         (when (and (> n 0) (eql (bref board sq) empty))\n           (setf (bref board sq) player)\n           (map-edge-n-pieces fn player board (- n 1) (rest squares)\n                              (+ 1 index3))\n           (setf (bref board sq) (opponent player))\n           (map-edge-n-pieces fn player board (- n 1) (rest squares)\n                              (+ 2 index3))\n           (setf (bref board sq) empty))))))\n```\n\nThe function `possible-edge-moves-value` searches through all possible moves to determine an edge value that is more accurate than a static evaluation.\nIt loops through every empty square on the edge, calling `possible-edge-move` to return a (*probability value*) pair.\nSince it is also possible for a player not to make any move at all on an edge, the pair (`1.0` *current-value*) is also included.\n\n```lisp\n(defun possible-edge-moves-value (player board index)\n  \"Consider all possible edge moves.\n  Combine their values into a single number.\"\n  (combine-edge-moves\n    (cons\n      (list 1.0 (aref *edge-table* index)) ;; no move\n      (loop for sq in top-edge             ;; possible moves\n            when (eql (bref board sq) empty)\n            collect (possible-edge-move player board sq)))\n    player))\n```\n\nThe value of each position is determined by making the move on the board, then looking up in the table the value of the resulting position for the opponent, and negating it (since we are interested in the value to us, not to our opponent).\n\n```lisp\n(defun possible-edge-move (player board sq)\n  \"Return a (prob val) pair for a possible edge move.\"\n  (let ((new-board (replace (aref *ply-boards* player) board)))\n    (make-move sq player new-board)\n    (list (edge-move-probability player board sq)\n          (- (aref *edge-table*\n                   (edge-index (opponent player)\n                               new-board top-edge))))))\n```\n\nThe possible moves are combined with `combine-edge-moves`, which sorts the moves best-first.\n(Since `init-edge-table` started from black's perspective, black tries to maximize and white tries to minimize scores.) We then go down the moves, increasing the total value by the value of each move times the probability of the move, and decreasing the remaining probability by the probability of the move.\nSince there will always be a least one move (pass) with probability 1.0, this is guaranteed to converge.\nIn the end we round off the total value, so that we can do the run-time calculations with fixnums.\n\n```lisp\n(defun combine-edge-moves (possibilities player)\n  \"Combine the best moves.\"\n  (let ((prob 1.0)\n        (val 0.0)\n        (fn (if (eql player black) #'> #'<)))\n    (loop for pair in (sort possibilities fn :key #'second)\n          while (>= prob 0.0)\n          do (incf val (* prob (first pair) (second pair)))\n             (decf prob (* prob (first pair))))\n    (round val)))\n```\n\nWe still need to compute the probability that each possible edge move is legal.\nThese probabilities should reflect things such as the fact that it is easy to capture a corner if the opponent is in the adjacent X-square, and very difficult otherwise.\nFirst we define some functions to recognize corner and X-squares and relate them to their neighbors:\n\n```lisp\n(let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77))))\n  (defun corner-p (sq) (assoc sq corner/xsqs))\n  (defun x-square-p (sq) (rassoc sq corner/xsqs))\n  (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))\n  (defun corner-for (xsq) (car (rassoc xsq corner/xsqs))))\n```\n\nNow we consider the probabilities.\nThere are four cases.\nFirst, since we don't know anything about the interior of the board, we assume each player has a 50% chance of being able to play in an X-square.\nSecond, if we can show that a move is legal (because it flips opponent pieces on the edge) then it has 100% probability.\nThird, for the corner squares, we assign a 90% chance if the opponent occupies the X-square, 10% if it is empty, and only .1% if we occupy it.\nOtherwise, the probability is determined by the two neighboring squares: if a square is next to one or more opponents it is more likely we can move there; if it is next to our pieces it is less likely.\nIf it is legal for the opponent to move into the square, then the chances are cut in half (although we may still be able to move there, since we move first).\n\n```lisp\n(defun edge-move-probability (player board square)\n  \"What's the probability that player can move to this square?\"\n  (cond\n    ((x-square-p square) .5) ;; X-squares\n    ((legal-p square player board) 1.0) ;; immediate capture\n    ((corner-p square) ;; move to corner depends on X-square\n     (let ((x-sq (x-square-for square)))\n       (cond\n         ((eql (bref board x-sq) empty) .1)\n         ((eql (bref board x-sq) player) 0.001)\n         (t .9))))\n    (t (/ (aref\n            '#2A((.1  .4 .7)\n                 (.05 .3  *)\n                 (.01  *  *))\n            (count-edge-neighbors player board square)\n            (count-edge-neighbors (opponent player) board square))\n          (if (legal-p square (opponent player) board) 2 1)))))\n\n(defun count-edge-neighbors (player board square)\n  \"Count the neighbors of this square occupied by player.\"\n  (count-if #'(lambda (inc)\n                (eql (bref board (+ square inc)) player))\n            '(+1 -1)))\n```\n\nNow we return to the problem of determining the static value of an edge position.\nThis is computed by a weighted-squares metric, but the weights depend on the *stability* of each piece.\nA piece is called stable if it cannot be captured, unstable if it is in immediate danger of being captured, and semistable otherwise.\nA table of weights follows for each edge square and stability.\nNote that corner squares are always stable, and X-squares we will call semistable if the adjacent corner is taken, and unstable otherwise.\n\n```lisp\n(defparameter *static-edge-table*\n  '#2A(;stab  semi    un\n       (   *    0 -2000) ; X\n       ( 700    *     *) ; corner\n       (1200  200   -25) ; C\n       (1000  200    75) ; A\n       (1000  200    50) ; B\n       (1000  200    50) ; B\n       (1000  200    75) ; A\n       (1200  200   -25) ; C\n       ( 700    *     *) ; corner\n       (   *    0 -2000) ; X\n       ))\n```\n\nThe static evaluation then just sums each piece's value according to this table:\n\n```lisp\n(defun static-edge-stability (player board)\n  \"Compute this edge's static stability\"\n  (loop for sq in top-edge\n        for i from 0\n        sum (cond\n              ((eql (bref board sq) empty) 0)\n              ((eql (bref board sq) player)\n               (aref *static-edge-table* i\n                     (piece-stability board sq)))\n              (t (- (aref *static-edge-table* i\n                          (piece-stability board sq)))))))\n```\n\nThe computation of stability is fairly complex.\nIt centers around finding the two \"pieces,\" `p1` and `p2`, which lay on either side of the piece in question and which are not of the same color as the piece.\nThese \"pieces\" may be empty, or they may be off the board.\nA piece is unstable if one of the two is empty and the other is the opponent; it is semistable if there are opponents on both sides and at least one empty square to play on, or if it is surrounded by empty pieces.\nFinally, if either `p1` or `p2` is nil then the piece is stable, since it must be connected by a solid wall of pieces to the corner.\n\n```lisp\n(let ((stable 0) (semi-stable 1) (unstable 2))\n\n  (defun piece-stability (board sq)\n    (cond\n      ((corner-p sq) stable)\n      ((x-square-p sq)\n       (if (eql (bref board (corner-for sq)) empty)\n           unstable semi-stable))\n      (t (let* ((player (bref board sq))\n                (opp (opponent player))\n                (p1 (find player board :test-not #'eql\n                          :start sq :end 19))\n                (p2 (find player board :test-not #'eql\n                          :start 11 :end sq\n                          :from-end t)))\n           (cond\n             ;; unstable pieces can be captured immediately\n             ;; by playing in the empty square\n             ((or (and (eql p1 empty) (eql p2 opp))\n                  (and (eql p2 empty) (eql p1 opp)))\n              unstable)\n             ;; Semi-stable pieces might be captured\n             ((and (eql p1 opp) (eql p2 opp)\n                   (find empty board :start 11 :end 19))\n              semi-stable)\n             ((and (eql p1 empty) (eql p2 empty))\n              semi-stable)\n             ;; Stable pieces can never be captured\n             (t stable)))))))\n```\n\nThe edge table can now be built by a call to `init-edge-table`.\nAfter the table is built once, it is a good idea to save it so that we won't need to repeat the initialization.\nWe could write simple routines to dump the table into a file and read it back in, but it is faster and easier to use existing tools that already do this job quite well: `compile-file` and `load`.\nAll we have to do is create and compile a file containing the single line:\n\n```lisp\n(setf *edge-table* '#.*edge-table*)\n```\n\nThe `#.` read macro evaluates the following expression at read time.\nThus, the compiler will see and compile the current edge table.\nIt will be able to store this more compactly and `load` it back in more quickly than if we printed the contents of the vector in decimal (or any other base).\n\n### Combining the Factors\n\nNow we have a measure of the three factors: current mobility, potential mobility, and edge stability.\nAll that remains is to find a good way to combine them into a single evaluation metric.\nThe combination function used by [Rosenbloom (1982)](bibliography.md#bb1000) is a linear combination of the three factors, but each factor's coefficient is dependent on the move number.\nRosenbloom's features are normalized to the range [-1000, 1000]; we normalize to the range [-1, 1] by doing a division after multiplying by the coefficient.\nThat allows us to use fixnums for the coefficients.\nSince our three factors are not calculated in quite the same way as Rosenbloom's, it is not surprising that his coefficients are not the best for our program.\nThe edge coefficient was doubled and the potential coefficient cut by a factor of five.\n\n```lisp\n(defun Iago-eval (player board)\n  \"Combine edge-stability, current mobility and\n  potential mobility to arrive at an evaluation.\"\n  ;; The three factors are multiplied by coefficients\n  ;; that vary by move number:\n  (let ((c-edg (+ 312000 (* 6240 *move-number*)))\n        (c-cur (if (< *move-number* 25)\n                   (+ 50000 (* 2000 *move-number*))\n                   (+ 75000 (* 1000 *move-number*))))\n        (c-pot 20000))\n    (multiple-value-bind (p-cur p-pot)\n        (mobility player board)\n      (multiple-value-bind (o-cur o-pot)\n          (mobility (opponent player) board)\n        ;; Combine the three factors into one sum:\n        (+ (round (* c-edg (edge-stability player board)) 32000)\n           (round (* c-cur (- p-cur o-cur)) (+ p-cur o-cur 2))\n           (round (* c-pot  (- p-pot o-pot)) (+ p-pot o-pot 2)))))))\n```\n\nFinally, we are ready to code the `Iago` function.\nGiven a search depth, `Iago` returns a strategy that will do alpha-beta search to that depth using the `Iago-eval` evaluation function.\nThis version of Iago was able to defeat the modified weighted-squares strategy in 8 of 10 games at 3 ply, and 9 of 10 at 4 ply.\nOn an Explorer II, 4-ply search takes about 20 seconds per move.\nAt 5 ply, many moves take over a minute, so the program runs the risk of forfeiting.\nAt 3 ply, the program takes only a few seconds per move, but it still was able to defeat the author in five straight games, by scores of 50-14, 64-0, 51-13, 49-15 and 36-28.\nDespite these successes, it is likely that the evaluation function could be improved greatly with a little tuning of the parameters.\n\n```lisp\n(defun Iago (depth)\n  \"Use an approximation of Iago's evaluation function.\"\n  (alpha-beta-searcher3 depth #'iago-eval))\n```\n\n## 18.13 Other Techniques\n\nThere are many other variations that can be tried to speed up the search and improve play.\nUnfortunately, choosing among the techniques is a bit of a black art.\nYou will have to experiment to find the combination that is best for each domain and each evaluation function.\nMost of the following techniques were incorporated, or at least considered and rejected, in Bill.\n\n### Iterative Deepening\n\nWe have seen that the average branching factor for Othello is about 10.\nThis means that searching to depth *n* + 1 takes roughly 10 times longer than search to depth *n*.\nThus, we should be willing to go to a lot of overhead before we search one level deeper, to assure two things: that search will be done efficiently, and that we won't forfeit due to running out of time.\nA by-now familiar technique, iterative deepening (see [chapters 6](chapter6.md) and [14](chapter14.md)), serves both these goals.\n\nIterative deepening is used as follows.\nThe strategy determines how much of the remaining time to allocate to each move.\nA simple strategy could allocate a constant amount of time for each move, and a more sophisticated strategy could allocate more time for moves at crucial points in the game.\nOnce the time allocation is determined for a move, the strategy starts an iterative deepening alpha-beta search.\nThere are two complications: First, the search at *n* ply keeps track of the best moves, so that the search at *n* + 1 ply will have better ordering information.\nIn many cases it will be faster to do both the *n* and *n* + 1 ply searches with the ordering information than to do only the *n* + 1 ply search without it.\nSecond, we can monitor how much time has been taken searching each ply, and cut off the search when searching one more ply would exceed the allocated time limit.\nThus, iterative-deepening search degrades gracefully as time limits are imposed.\nIt will give a reasonable answer even with a short time allotment, and it will rarely exceed the allotted time.\n\n### Forward Pruning\n\nOne way to cut the number of positions searched is to replace the legal move generator with a *plausible* move generator: in other words, only consider good moves, and never even look at moves that seem clearly bad.\nThis technique is called *forward pruning*.\nIt has fallen on disfavor because of the difficulty in determining which moves are plausible.\nFor most games, the factors that would go into a plausible move generator would be duplicated in the static evaluation function anyway, so forward pruning would require more effort without much gain.\nWorse, forward pruning could rule out a brilliant sacrifice-a move that looks bad initially but eventually leads to a gain.\n\nFor some games, forward pruning is a necessity.\nThe game of Go, for example, is played on a 19 by 19 board, so the first player has 361 legal moves, and a 6-ply search would involve over 2 quadrillion positions.\nHowever, many good Go programs can be viewed as not doing forward pruning but doing abstraction.\nThere might be 30 empty squares in one portion of the board, and the program would treat a move to any of these squares equivalently.\n\nBill uses forward pruning in a limited way to rule out certain moves adjacent to the corners.\nIt does this not to save time but because the evaluation function might lead to such a move being selected, even though it is in fact a poor move.\nIn other words, forward pruning is used to correct a bug in the evaluation function cheaply.\n\n### Nonspeculative Forward Pruning\n\nThis technique makes use of the observation that there are limits in the amount the evaluation function can change from one position to the next.\nFor example, if we are using the count difference as the evaluation function, then the most a move can change the evaluation is +37 (one for placing a piece in the corner, and six captures in each of the three directions).\nThe smallest change is 0 (if the player is forced to pass).\nThus, if there are 2 ply left in the search, and the backed-up value of position *A* has been established as 38 points better than the static value of position *B*, then it is useless to expand position *B*.\nThis assumes that we are evaluating every position, perhaps to do sorted ordering or iterative deepening.\nIt also assumes that no position in the search tree is a final position, because then the evaluation could change by more than 37 points.\nIn conclusion, it seems that nonspeculative forward pruning is not very useful for Othello, although it may play a role in other games.\n\n### Aspiration Search\n\nAlpha-beta search is initated with the `achievable` and `cutoff` boundaries set to `losing-value` and `winning-value`, respectively.\nIn other words, the search assumes nothing: the final position may be anything from a loss to a win.\nBut suppose we are in a situation somewhere in the mid-game where we are winning by a small margin (say the static evaluation for the current position is 50).\nIn most cases, a single move will not change the evaluation by very much.\nTherefore, if we invoked the alpha-beta search with a window defined by boundaries of, say, 0 and 100, two things can happen: if the actual backed-up evaluation for this position is in fact in the range 0 to 100, then the search will find it, and it will be found quickly, because the reduced window will cause more pruning.\nIf the actual value is not in the range, then the value returned will reflect that, and we can search again using a larger window.\nThis is called aspiration search, because we aspire to find a value within a given window.\nIf the window is chosen well, then often we will succeed and will have saved some search time.\n\n[Pearl (1984)](bibliography.md#bb0930) suggests an alternative called zero-window search.\nAt each level, the first possible move, which we'll call *m*, is searched using a reasonably wide window to determine its exact value, which we'll call *v*.\nThen the remaining possible moves are searched using *v* as both the lower and upper bounds of the window.\nThus, the result of the search will tell if each subsequent move is better or worse than *m*, but won't tell how much better or worse.\nThere are three outcomes for zero-window search.\nIf no move turns out to be better than *m*, then stick with *m*.\nIf a single move is better, then use it.\nIf several moves are better than *m*, then they have to be searched again using a wider window to determine which is best.\n\nThere is always a trade-off between time spent searching and information gained.\nZero-window search makes an attractive trade-off: we gain some search time by losing information about the value of the best move.\nWe are still guaranteed of finding the best move, we just don't know its exact value.\n\nBill's zero-window search takes only 63% of the time taken by full alpha-beta search.\nIt is effective because Bill's move-ordering techniques ensure that the first move is often best.\nWith random move ordering, zero-window search would not be effective.\n\n### Think-Ahead\n\nA program that makes its move and then waits for the opponent's reply is wasting half the time available to it.\nA better use of time is to compute, or *think-ahead* while the opponent is moving.\nThink-ahead is one factor that helps Bill defeat Iago.\nWhile many programs have done think-ahead by choosing the most likely move by the opponent and then starting an iterative-deepening search assuming that move, Bill's algorithm is somewhat more complex.\nIt can consider more than one move by the opponent, depending on how much time is available.\n\n### Hashing and Opening Book Moves\n\nWe have been treating the search space as a tree, but in general it is a directed acyclic graph (dag): there may be more than one way to reach a particular position, but there won't be any loops, because every move adds a new piece.\nThis raises the question we explored briefly in [section 6.4](chapter6.md#s0025): should we treat the search space as a tree or a graph?\nBy treating it as a graph we eliminate duplicate evaluations, but we have the overhead of storing all the previous positions, and of checking to see if a new position has been seen before.\nThe decision must be based on the proportion of duplicate positions that are actually encountered in play.\nOne compromise solution is to store in a hash table a partial encoding of each position, encoded as, say, a single fixnum (one word) instead of the seven or so words needed to represent a full board.\nAlong with the encoding of each position, store the move to try first.\nThen, for each new position, look in the hash table, and if there is a hit, try the corresponding move first.\nThe move may not even be legal, if there is an accidental hash collision, but there is a good chance that the move will be the right one, and the overhead is low.\n\nOne place where it is clearly worthwhile to store information about previous positions is in the opening game.\nSince there are fewer choices in the opening, it is a good idea to compile an opening \"book\" of moves and to play by it as long as possible, until the opponent makes a move that departs from the book.\nBook moves can be gleaned from the literature, although not very much has been written about Othello (as compared to openings in chess).\nHowever, there is a danger in following expert advice: the positions that an expert thinks are advantageous may not be the same as the positions from which our program can play well.\nIt may be better to compile the book by playing the program against itself and determining which positions work out best.\n\n### The End Game\n\nIt is also a good idea to try to save up time in the midgame and then make an all-out effort to search the complete game tree to completion as soon as feasible.\nBill can search to completion from about 14 ply out.\nOnce the search is done, of course, the most promising lines of play should be saved so that it won't be necessary to solve the game tree again.\n\n### Metareasoning\n\nIf it weren't for the clock, Othello would be a trivial game: just search the complete game tree all the way to the end, and then choose the best move.\nThe clock imposes a complication: we have to make all our moves before we run out of time.\nThe algorithms we have seen so far manage the clock by allocating a certain amount of time to each move, such that the total time is guaranteed (or at least very likely) to be less than the allotted time.\nThis is a very crude policy.\nA finer-grained way of managing time is to consider computation itself as a possible move.\nThat is, at every tick of the clock, we need to decide if it is better to stop and play the best move we have computed so far or to continue and try to compute a better move.\nIt will be better to compute more only in the case where we eventually choose a better move; it will be better to stop and play only in the case where we would otherwise forfeit due to time constraints, or be forced to make poor choices later in the game.\nAn algorithm that includes computation as a possible move is called a metareasoning system, because it reasons about how much to reason.\n\n[Russell and Wefald (1989)](bibliography.md#bb1025) present an approach based on this view.\nIn addition to an evaluation function, they assume a variance function, which gives an estimate of how much a given position's true value is likely to vary from its static value.\nAt each step, their algorithm compares the value and variance of the best move computed so far and the second best move.\nIf the best move is clearly better than the second best (taking variance into account), then there is no point computing any more.\nAlso, if the top two moves have similar values but both have very low variance, then computing will not help much; we can just choose one of the two at random.\n\nFor example, if the board is in a symmetric position, then there may be two symmetric moves that will have identical value.\nBy searching each move's subtree more carefully, we soon arrive at a low variance for both moves, and then we can choose either one, without searching further.\nOf course, we could also add special-case code to check for symmetry, but the metareasoning approach will work for nonsymmetric cases as well as symmetric ones.\nIf there is a situation where two moves both lead to a clear win, it won't waste time choosing between them.\n\nThe only situation where it makes sense to continue computing is when there are two moves with high variance, so that it is uncertain if the true value of one exceeds the other.\nThe metareasoning algorithm is predicated on devoting time to just this case.\n\n### Learning\n\nFrom the earliest days of computer game playing, it was realized that a championship program would need to learn to improve itself.\n[Samuel (1959)](bibliography.md#bb1040) describes a program that plays checkers and learns to improve its evaluation function.\nThe evaluation function is a linear combination of features, such as the number of pieces for each player, the number of kings, the number of possible forks, and so on.\nLearning is done by a hill-climbing search procedure: change one of the coefficients for one of the features at random, and then see if the changed evaluation function is better than the original one.\n\nWithout some guidance, this hill-climbing search would be very slow.\nFirst, the space is very large-Samuel used 38 different features, and although he restricted the coefficients to be a power of two between 0 and 20, that still leaves 21<sup>38</sup> possible evaluation functions.\nSecond, the obvious way of determining the relative worth of two evaluation functions-playing a series of games between them and seeing which wins more often-is quite time-consuming.\n\nFortunately, there is a faster way of evaluating an evaluation function.\nWe can apply the evaluation function to a position and compare this static value with the backed-up value determined by an alpha-beta search.\nIf the evaluation function is accurate, the static value should correlate well with the backed-up value.\nIf it does not correlate well, the evaluation function should be changed in such a way that it does.\nThis approach still requires the trial-and-error of hill-climbing, but it will converge much faster if we can gain information from every position, rather than just from every game.\n\nIn the past few years there has been increased interest in learning by a process of guided search.\n*Neural nets* are one example of this.\nThey have been discussed elsewhere.\nAnother example is *genetic learning* algorithms.\nThese algorithms start with several candidate solutions.\nIn our case, each candidate would consist of a set of coefficients for an evaluation function.\nOn each generation, the genetic algorithm sees how well each candidate does.\nThe worst candidates are eliminated, and the best ones \"mate\" and \"reproduce\"-two candidates are combined in some way to yield a new one.\nIf the new offspring has inherited both its parents' good points, then it will prosper; if it has inherited both its parents' bad points, then it will quickly die out.\nEither way, the idea is that natural selection will eventually yield a high-quality solution.\nTo increase the chances of this, it is a good idea to allow for mutations: random changes in the genetic makeup of one of the candidates.\n\n## 18.14 History and References\n\n[Lee and Mahajan (1986,](bibliography.md#bb0710)[1990)](bibliography.md#bb0715) present the current top Othello program, Bill.\nTheir description outlines all the techniques used but does not go into enough detail to allow the reader to reconstruct the program.\nBill is based in large part on Rosenbloom's Iago program.\nRosenbloom's article (1982) is more thorough.\nThe presentation in this chapter is based largely on this article, although it also contains some ideas from Bill and from other sources.\n\nThe journal *Othello Quarterly* is the definitive source for reports on both human and computer Othello games and strategies.\n\nThe most popular game for computer implementation is chess.\n[Shannon (1950a,](bibliography.md#bb1070)[b)](bibliography.md#bb1075) speculated that a computer might play chess.\nIn a way, this was one of the boldest steps in the history of AI.\nToday, writing a chess program is a challenging but feasible project for an undergraduate.\nBut in 1950, even suggesting that such a program might be possible was a revolutionary step that changed the way people viewed these arithmetic calculating devices.\nShannon introduced the ideas of a game tree search, minimaxing, and evaluation functions-ideas that remain intact to this day.\n[Marsland (1990)](bibliography.md#bb0770) provides a good short introduction to computer chess, and David Levy has two books on the subject (1976, 1988).\nIt was Levy, an international chess master, who in 1968 accepted a bet from John McCarthy, Donald Michie, and others that a computer chess program would not beat him in the next ten years.\nLevy won the bet.\nLevy's *Heuristic Programming* (1990) and *Computer Games* (1988) cover a variety of computer game playing programs.\nThe studies by [DeGroot (1965,](bibliography.md#bb0305)[1966)](bibliography.md#bb0310) give a fascinating insight into the psychology of chess masters.\n\n[Knuth and Moore (1975)](bibliography.md#bb0630) analyze the alpha-beta algorithm, and Pearl's book *Heuristics* (1984) covers all kinds of heuristic search, games included.\n\n[Samuel (1959)](bibliography.md#bb1040) is the classic work on learning evaluation function parameters.\nIt is based on the game of checkers.\n[Lee and Mahajan (1990)](bibliography.md#bb0715) present an alternative learning mechanism, using Bayesian classification to learn an evaluation function that optimally distinguishes winning positions from losing positions.\nGenetic algorithms are discussed by L.\n[Davis (1987,](bibliography.md#bb0280) [1991)](bibliography.md#bb0285) and [Goldberg (1989)](bibliography.md#bb0480).\n\n## 18.15 Exercises\n\n**Exercise  18.3 [s]** How many different Othello positions are there?\nWould it be feasible to store the complete game tree and thus have a perfect player?\n\n**Exercise  18.4 [m]** At the beginning of this chapter, we implemented pieces as an enumerated type.\nThere is no built-in facility in Common Lisp for doing this, so we had to introduce a series of `defconstant` forms.\nDefine a macro for defining enumerated types.\nWhat else should be provided besides the constants?\n\n**Exercise  18.5 [h]** Add fixnum and speed declarations to the Iago evaluation function and the alpha-beta code.\nHow much does this speed up Iago?\nWhat other efficiency measures can you take?\n\n**Exercise  18.6 [h]** Implement an iterative deepening search that allocates time for each move and checks between each iteration if the time is exceeded.\n\n**Exercise  18.7 [h]** Implement zero-window search, as described in [section 18.13](#s0085).\n\n**Exercise  18.8 [d]** Read the references on Bill ([Lee and Mahajan 1990](bibliography.md#bb0715), and [1986](bibliography.md#bb0710) if you can get it), and reimplement Bill's evaluation function as best you can, using the table-based approach.\nIt will also be helpful to read [Rosenbloom 1982](bibliography.md#bb1000).\n\n**Exercise  18.9 [d]** Improve the evaluation function by tuning the parameters, using one of the techniques described in [section 18.13](#s0085).\n\n**Exercise  18.10 [h]** Write move-generation and evaluation functions for another game, such as chess or checkers.\n\n## 18.16 Answers\n\n**Answer 18.2** The `weighted-squares` strategy wins the first game by 20 pieces, but when `count-difference` plays first, it captures all the pieces on its fifth move.\nThese two games alone are not enough to determine the best strategy; the function `othello-series` on [page 626](#p626) shows a better comparison.\n\n**Answer 18.3** 3<sup>64</sup> = 3,433,683,820,292,512,484,657,849,089,281.\nNo.\n\n**Answer 18.4** Besides the constants, we provide a `deftype` for the type itself, and conversion routines between integers and symbols:\n\n```lisp\n(defmacro define-enumerated-type (type &rest elements)\n    \"Represent an enumerated type with integers 0-n.\"\n    '(progn\n        (deftype ,type () '(integer 0 , (- (length elements) 1)))\n        (defun ,(symbol type '->symbol) (,type)\n            (elt ',elements ,type))\n        (defun ,(symbol 'symbol-> type) (symbol)\n            (position symbol ',elements))\n        ,@(loop for element in elements\n                for i from 0\n                collect '(defconstant ,element ,i))))\n```\n\nHere's how the macro would be used to define the piece data type, and the code produced:\n\n```lisp\n> (macroexpand\n        '(define-enumerated-type piece\n            empty black white outer))\n(PROGN\n    (DEFTYPE PIECE () '(INTEGER 0 3))\n    (DEFUN PIECE->SYMBOL (PIECE)\n        (ELT '(EMPTY BLACK WHITE OUTER) PIECE))\n    (DEFUN SYMBOL->PIECE (SYMBOL)\n        (POSITION SYMBOL '(EMPTY BLACK WHITE OUTER)))\n    (DEFCONSTANT EMPTY 0)\n    (DEFCONSTANT BLACK 1)\n    (DEFCONSTANT WHITE 2)\n    (DEFCONSTANT OUTER 3))\n```\n\nA more general facility would, like `defstruct`, provide for several options.\nFor example, it might allow for a documentation string for the type and each constant, and for a `:conc-name`, so the constants could have names like `piece-empty` instead of `empty`.\nThis would avoid conflicts with other types that wanted to use the same names.\nThe user might also want the ability to start the values at some number other than zero, or to assign specific values to some of the symbols.\n\n----------------------\n\n<a id=\"fn18-1\"></a><sup>[1](#tfn18-1)</sup>\nOthello is a registered trademark of CBS Inc.\nGameboard design @ 1974 CBS Inc.\n\n<a id=\"fn18-2\"></a><sup>[2](#tfn18-2)</sup>\n*Othello,* [I. i. 117] William Shakespeare.\n\n<a id=\"fn18-3\"></a><sup>[3](#tfn18-3)</sup>\nRemember, when a constant is redefined, it may be necessary to recompile any functions that use the constant.\n\n"
  },
  {
    "path": "docs/chapter19.md",
    "content": "# Chapter 19\n## Introduction to Natural Language\n\n> Language is everywhere.\nIt permeates our thoughts, mediates our relations with others, and even creeps into our dreams.\nThe overwhelming bulk of human knowledge is stored and transmitted in language.\nLanguage is so ubiquitous that we take it for granted but without it, society as we know it would be impossible.\n>\n> -Ronand Langacker\n>\n> Language and its Structure (1967)\n\nA natural language is a language spoken by people, such as English, German, or Tagalog.\nThis is in opposition to artificial languages like Lisp, FORTRAN, or Morse code.\nNatural language processing is an important part of AI because language is intimately connected to thought.\nOne measure of this is the number of important books that mention language and thought in the title: in AI, Schank and Colby's *Computer Models of Thought and Language;* in linguistics, Whorf's *Language, Thought, and Reality* (and Chomsky's *Language and Mind;)* in philosophy, Fodor's *The Language of Thought;* and in psychology, Vygotsky's *Thought and Language* and John Anderson's *Language, Memory, and Thought.* Indeed, language is the trait many think of as being the most characteristic of humans.\nMuch controversy has been generated over the question of whether animals, especially primates and dolphins, can use and \"understand\" language.\nSimilar controversy surrounds the same question asked of computers.\n\nThe study of language has been traditionally separated into two broad classes: syntax, or grammar, and semantics, or meaning.\nHistorically, syntax has achieved the most attention, largely because on the surface it is more amenable to formal and semiformal methods.\nAlthough there is evidence that the boundary between the two is at best fuzzy, we still maintain the distinction for the purposes of these notes.\nWe will cover the \"easier\" part, syntax, first, and then move on to semantics.\n\nA good artificial language, like Lisp or C, is unambiguous.\nThere is only one interpretation for a valid Lisp expression.\nOf course, the interpretation may depend on the state of the current state of the Lisp world, such as the value of global variables.\nBut these dependencies can be explicitly enumerated, and once they are spelled out, then there can only be one meaning for the expression.<a id=\"tfn19-1\"></a><sup>[1](#fn19-1)</sup>\n\nNatural language does not work like this.\nNatural expressions are inherently ambiguous, depending on any number of factors that can never be quite spelled out completely.\nIt is perfectly reasonable for two people to disagree on what some other person meant by a natural language expression.\n(Lawyers and judges make their living largely by interpreting natural language expressions-laws-that are meant to be unambiguous but are not.)\n\nThis chapter is a brief introduction to natural language processing.\nThe next chapter gives a more thorough treatment from the point of view of logic grammars, and the chapter after that puts it all together into a full-fledged system.\n\n## 19.1 Parsing with a Phrase-Structure Grammar\n\nTo parse a sentence means to recover the constituent structure of the sentence-to discover what sequence of generation rules could have been applied to come up with the sentence.\nIn general, there may be several possible derivations, in which case we say the sentence is grammatically ambiguous.\nIn certain circles, the term \"parse\" means to arrive at an understanding of a sentence's meaning, not just its grammatical form.\nWe will attack that more difficult question later.\n\nWe start with the grammar defined on [page 39](chapter2.md#p39) for the `generate` program:\n\n```lisp\n(defvar *grammar* nil \"The grammar used by GENERATE.\")\n\n(defparameter *grammarl*\n      '((Sentence -> (NP VP))\n          (NP -> (Art Noun))\n          (VP -> (Verb NP))\n          (Art -> the a)\n          (Noun -> man ball woman table)\n          (Verb -> hit took saw liked)))\n```\n\nOur parser takes as input a list of words and returns a structure containing the parse tree and the unparsed words, if any.\nThat way, we can parse the remaining words under the next category to get compound rules.\nFor example, in parsing \"the man saw the table,\" we would first parse \"the man,\" returning a structure representing the noun phrase, with the remaining words \"saw the table.\" This remainder would then be parsed as a verb phrase, returning no remainder, and the two phrases could then be joined to form a parse that is a complete sentence with no remainder.\n\nBefore proceeding, I want to make a change in the representation of grammar rules.\nCurrently, rules have a left-hand side and a list of alternative right-hand sides.\nBut each of these alternatives is really a separate rule, so it would be more modular to write them separately.\nFor the `generate` program it was fine to have them all together, because that made processing choices easier, but now I want a more flexible representation.\nLater on we will want to add more information to each rule, like the semantics of the assembled left-hand side, and constraints between constituents on the right-hand side, so the rules would become quite large indeed if we didn't split up the alternatives.\nI also take this opportunity to clear up the confusion between words and category symbols.\nThe convention is that a right-hand side can be either an atom, in which case it is a word, or a list of symbols, which are then all interpreted as categories.\nTo emphasize this, I include \"noun\" and \"verb\" as nouns in the grammar `*grammar3*`, which is otherwise equivalent to the previous `*grammar1*`.\n\n```lisp\n(defparameter *grammar3*\n  '((Sentence -> (NP VP))\n    (NP -> (Art Noun))\n    (VP -> (Verb NP))\n    (Art -> the) (Art -> a)\n    (Noun -> man) (Noun -> ball) (Noun -> woman) (Noun -> table)\n    (Noun -> noun) (Noun -> verb)\n    (Verb -> hit) (Verb -> took) (Verb -> saw) (Verb -> liked)))\n\n(setf *grammar* *grammar3*)\n```\n\nI also define the data types `rule`, `parse`, and `tree`, and some functions for getting at the rules.\nRules are defined as structures of type list with three slots: the left-hand side, the arrow (which should always be represented as the literal `->`) and the right-hand side.\nCompare this to the treatment on [page 40](chapter2.md#p40).\n\n```lisp\n(defstruct (rule (:type list)) lhs -> rhs sem)\n\n(defstruct (parse) \"A parse tree and a remainder.\" tree rem)\n\n;; Trees are of the form: (lhs . rhs)\n(defun new-tree (cat rhs) (cons cat rhs))\n(defun tree-lhs (tree) (first tree))\n(defun tree-rhs (tree) (rest tree))\n\n(defun parse-lhs (parse) (tree-lhs (parse-tree parse)))\n\n(defun lexical-rules (word)\n  \"Return a list of rules with word on the right hand side.\"\n  (or (find-all word *grammar* :key #'rule-rhs :test #'equal)\n      (mapcar #'(lambda (cat) `(,cat -> ,word)) *open-categories*)))\n\n(defun rules-starting-with (cat)\n  \"Return a list of rules where cat starts the rhs.\"\n  (find-all cat *grammar*\n            :key #'(lambda (rule) (first-or-nil (rule-rhs rule)))))\n\n(defun first-or-nil (x)\n  \"The first element of x if it is a list; else nil.\"\n  (if (consp x) (first x) nil))\n```\n\nNow we're ready to define the parser.\nThe main function `parser` takes a list of words to parse.\nIt calls `parse`, which returns a list of all parses that parse some subsequence of the words, starting at the beginning.\n`parser` keeps only the parses with no remainder - that is, the parses that span all the words.\n\n```lisp\n(defun parser (words)\n  \"Return all complete parses of a list of words.\"\n  (mapcar #'parse-tree (complete-parses (parse words))))\n\n(defun complete-parses (parses)\n  \"Those parses that are complete (have no remainder).\"\n  (find-all-if #'null parses :key #'parse-rem))\n```\n\nThe function `parse` looks at the first word and considers each category it could be.\nIt makes a parse of the first word under each category, and calls `extend-parse` to try to continue to a complete parse.\n`parse` uses `mapcan` to append together all the resulting parses.\nAs an example, suppose we are trying to parse \"the man took the ball.\"\n`parse` would find the single lexical rule for \"the\" and call `extend-parse` with a parse with tree `(Art the)` and remainder \"man took the ball,\" with no more categories needed.\n\n`extend-parse` has two cases.\nIf the partial parse needs no more categories to be complete, then it returns the parse itself, along with any parses that can be formed by extending parses starting with the partial parse.\nIn our example, there is one rule starting with `Art`, namely `(NP -> (Art Noun))`, so the function would try to extend the parse tree (`NP (Art the))` with remainder \"man took the ball,\" with the category `Noun` needed.\nThat call to `extend-parse` represents the second case.\nWe first parse \"man took the ball,\" and for every parse that is of category `Noun` (there will be only one), we combine with the partial parse.\nIn this case we get `(NP (Art the) (Noun man))`.\nThis gets extended as a sentence with a VP needed, and eventually we get a parse of the complete list of words.\n\n```lisp\n(defun parse (words)\n  \"Bottom-up parse, returning all parses of any prefix of words.\"\n  (unless (null words)\n    (mapcan #'(lambda (rule)\n                (extend-parse (rule-lhs rule) (list (first words))\n                              (rest words) nil))\n            (lexical-rules (first words)))))\n\n(defun extend-parse (lhs rhs rem needed)\n  \"Look for the categories needed to complete the parse.\"\n  (if (null needed)\n      ;; If nothing needed, return parse and upward extensions\n      (let ((parse (make-parse :tree (new-tree lhs rhs) :rem rem)))\n        (cons parse\n              (mapcan\n                #'(lambda (rule)\n                    (extend-parse (rule-lhs rule)\n                                  (list (parse-tree parse))\n                                  rem (rest (rule-rhs rule))))\n                (rules-starting-with lhs))))\n      ;; otherwise try to extend rightward\n      (mapcan\n        #'(lambda (p)\n            (if (eq (parse-lhs p) (first needed))\n                (extend-parse lhs (append1 rhs (parse-tree p))\n                              (parse-rem p) (rest needed))))\n        (parse rem))))\n```\n\nThis makes use of the auxiliary function `append1`:\n\n```lisp\n(defun append1 (items item)\n  \"Add item to end of list of items.\"\n  (append items (list item)))\n```\n\nSome examples of the parser in action are shown here:\n\n```lisp\n> (parser '(the table))\n((NP (ART THE) (NOUN TABLE)))\n> (parser '(the ball hit the table))\n((SENTENCE (NP (ART THE) (NOUN BALL))\n           (VP (VERB HIT)\n               (NP (ART THE) (NOUN TABLE)))))\n> (parser '(the noun took the verb))\n((SENTENCE (NP (ART THE) (NOUN NOUN))\n           (VP (VERB TOOK)\n               (NP (ART THE) (NOUN VERB)))))\n```\n\n## 19.2 Extending the Grammar and Recognizing Ambiguity\n\nOverall, the parser seems to work fine, but the range of sentences we can parse is quite limited with the current grammar.\nThe following grammar includes a wider variety of linguistic phenomena: adjectives, prepositional phrases, pronouns, and proper names.\nIt also uses the usual linguistic conventions for category names, summarized in the table below:\n\n|      | Category                         | Examples                   |\n|------|----------------------------------|----------------------------|\n| S    | Sentence                         | *John likes Mary*          |\n| NP   | Noun Phrase                      | *John; a blue table*       |\n| VP   | Verb Phrase                      | *likes Mary; hit the ball* |\n| PP   | Prepositional Phrase             | *to Mary; with the man*    |\n| A    | Adjective                        | *little; blue*             |\n| A  + | A list of one or more adjectives | *little blue*              |\n| D    | Determiner                       | *the; a*                   |\n| N    | Noun                             | *ball; table*              |\n| Name | Proper Name                      | *John; Mary*               |\n| P    | Preposition                      | *to; with*                 |\n| Pro  | Pronoun                          | *you; me*                  |\n| V    | Verb                             | *liked; hit*               |\n\nHere is the grammar:\n\n```lisp\n(defparameter *grammar4*\n  '((S -> (NP VP))\n    (NP -> (D N))\n    (NP -> (D A+ N))\n    (NP -> (NP PP))\n    (NP -> (Pro))\n    (NP -> (Name))\n    (VP -> (V NP))\n    (VP -> (V))\n    (VP -> (VP PP))\n    (PP -> (P NP))\n    (A+ -> (A))\n    (A+ -> (A A+))\n    (Pro -> I) (Pro -> you) (Pro -> he) (Pro -> she)\n    (Pro -> it) (Pro -> me) (Pro -> him) (Pro -> her)\n    (Name -> John) (Name -> Mary)\n    (A -> big) (A -> little) (A -> old) (A -> young)\n    (A -> blue) (A -> green) (A -> orange) (A -> perspicuous)\n    (D -> the) (D -> a) (D -> an)\n    (N -> man) (N -> ball) (N -> woman) (N -> table) (N -> orange)\n    (N -> saw) (N -> saws) (N -> noun) (N -> verb)\n    (P -> with) (P -> for) (P -> at) (P -> on) (P -> by) (P -> of) (P -> in)\n    (V -> hit) (V -> took) (V -> saw) (V -> liked) (V -> saws)))\n\n(setf *grammar* *grammar4*)\n```\n\nNow we can parse more interesting sentences, and we can see a phenomenon that was not present in the previous examples: ambiguous sentences.\nThe sentence \"The man hit the table with the ball\" has two parses, one where the ball is the thing that hits the table, and the other where the ball is on or near the table.\n`parser` finds both of these parses (although of course it assigns no meaning to either parse):\n\n```lisp\n> (parser '(The man hit the table with the ball))\n((S (NP (D THE) (N MAN))\n      (VP (VP (V HIT) (NP (D THE) (N TABLE)))\n          (PP (P WITH) (NP (DTHE) (N BALL)))))\n(S (NP (D THE) (N MAN))\n      (VP (V HIT)\n          (NP (NP (D THE) (N TABLE))\n                        (PP (P WITH) (NP (DTHE) (N BALL)))))))\n```\n\nSentences are not the only category that can be ambiguous, and not all ambiguities have to be between parses in the same category.\nHere we see a phrase that is ambiguous between a sentence and a noun phrase:\n\n```lisp\n> (parser '(the orange saw))\n((S (NP (D THE) (N ORANGE)) (VP (V SAW)))\n  (NP (D THE) (A  + (A ORANGE)) (N SAW)))\n```\n\n## 19.3 More Efficient Parsing\n\nWith more complex grammars and longer sentences, the parser starts to slow down.\nThe main problem is that it keeps repeating work.\nFor example, in parsing \"The man hit the table with the ball,\" it has to reparse \"with the ball\" for both of the resulting parses, even though in both cases it receives the same analysis, a PP.\nWe have seen this problem before and have already produced an answer: memoization (see [section 9.6](#s0035)).\nTo see how much memoization will help, we need a benchmark:\n\n```lisp\n> (setf s (generate 's))\n(THE PERSPICUOUS BIG GREEN BALL BY A BLUE WOMAN WITH A BIG MAN\n    HIT A TABLE BY THE SAW BY THE GREEN ORANGE)\n> (time (length (parser s)))\nEvaluation of (LENGTH (PARSER S)) took 33.11 Seconds of elapsed time.\n10\n```\n\nThe sentence S has 10 parses, since there are two ways to parse the subject NP and five ways to parse the VP.\nIt took 33 seconds to discover these 10 parses with the parse function as it was written.\n\nWe can improve this dramatically by memoizing `parse` (along with the table-lookup functions).\nBesides memoizing, the only change is to clear the memoization table within parser.\n\n```lisp\n(memoize 'lexical-rules)\n(memoize 'rules-starting-with)\n(memoize 'parse :test #'eq)\n\n(defun parser (words)\n  \"Return all complete parses of a list of words.\"\n  (clear-memoize 'parse) ;***\n  (mapcar #'parse-tree (complete-parses (parse words))))\n```\n\nIn normal human language use, memoization would not work very well, since the interpretation of a phrase depends on the context in which the phrase was uttered.\nBut with context-free grammars we have a guarantee that the context cannot affect the interpretation.\nThe call `(parse words)` must return all possible parses for the words.\nWe are free to choose between the possibilities based on contextual information, but context can never supply a new interpretation that is not in the context-free list of parses.\n\nThe function `use` is introduced to tell the table-lookup functions that they are out of date whenever the grammar changes:\n\n```lisp\n(defun use (grammar)\n  \"Switch to a new grammar.\"\n  (clear-memoize 'rules-starting-with)\n  (clear-memoize 'lexical-rules)\n  (length (setf *grammar* grammar)))\n```\n\nNow we run the benchmark again with the memoized version of `parse`:\n\n```lisp\n> (time (length (parser s)))\nEvaluation of (LENGTH (PARSER S 's)) took .13 Seconds of elapsed time.\n10\n```\n\nBy memoizing `parse` we reduce the parse time from 33 to .13 seconds, a 250-fold speed-up.\nWe can get a more systematic comparison by looking at a range of examples.\nFor example, consider sentences of the form \"The man hit the table [with the ball]\\*\" for zero or more repetitions of the PP \"with the ball.\"\nIn the following table we record N, the number of repetitions of the PP, along with the number of resulting parses,<a id=\"tfn19-2\"></a><sup>[2](#fn19-2)</sup> and for both memoized and unmemoized versions of parse, the number of seconds to produce the parse, the number of parses per second (PPS), and the number of recursive calls to `parse`.\nThe performance of the memoized version is quite acceptable; for N=5, a 20-word sentence is parsed into 132 possibilities in .68 seconds, as opposed to the 20 seconds it takes in the unmemoized version.\n\n|     |          | Memoized |       |         | Unmemoized |       |         |\n|-----|----------|----------|-------|---------|------------|-------|---------|\n| *N* | *Parses* | *Secs*   | *PPS* | *Calls* | *Secs*     | *PPS* | *Calls* |\n| 0   | 1        | 0.02     | 60    | 4       | 0.02       | 60    | 17      |\n| 1   | 2        | 0.02     | 120   | 11      | 0.07       | 30    | 96      |\n| 2   | 5        | 0.05     | 100   | 21      | 0.23       | 21    | 381     |\n| 3   | 14       | 0.10     | 140   | 34      | 0.85       | 16    | 1388    |\n| 4   | 42       | 0.23     | 180   | 50      | 3.17       | 13    | 4999    |\n| 5   | 132      | 0.68     | 193   | 69      | 20.77      | 6     | 18174   |\n| 6   | 429      | 1.92     | 224   | 91      | -          |       |         |\n| 7   | 1430     | 5.80     | 247   | 116     | -          |       |         |\n| 8   | 4862     | 20.47    | 238   | 144     | -          |       |         |\n\n**Exercise  19.1 [h]** It seems that we could be more efficient still by memoizing with a table consisting of a vector whose length is the number of words in the input (plus one).\nImplement this approach and see if it entails less overhead than the more general hash table approach.\n\n## 19.4 The Unknown-Word Problem\n\nAs it stands, the parser cannot deal with unknown words.\nAny sentence containing a word that is not in the grammar will be rejected, even if the program can parse all the rest of the words perfectly.\nOne way of treating unknown words is to allow them to be any of the \"open-class\" categories-nouns, verbs, adjectives, and names, in our grammar.\nAn unknown word will not be considered as one of the \"closed-class\" categories-prepositions, determiners, or pronouns.\nThis can be programmed very simply by having `lexical-rules` return a list of these open-class rules for every word that is not already known.\n\n```lisp\n(defparameter *open-categories* '(N V A Name)\n  \"Categories to consider for unknown words\")\n\n(defun lexical-rules (word)\n  \"Return a list of rules with word on the right hand side.\"\n  (or (find-all word *grammar* :key #'rule-rhs :test #'equal)\n      (mapcar #'(lambda (cat) `(,cat -> ,word)) *open-categories*)))\n```\n\nWith memoization of `lexical-rules`, this means that the lexicon is expanded every time an unknown word is encountered.\nLet's try this out:\n\n```lisp\n> (parser '(John liked Mary))\n((S (NP (NAME JOHN))\n            (VP (V LIKED) (NP (NAME MARY)))))\n> (parser '(Dana liked Dale))\n((S (NP (NAME DANA))\n            (VP (V LIKED) (NP (NAME DALE)))))\n> (parser '(the rab zaggled the woogly quax))\n((S (NP (D THE) (N RAB))\n            (VP (V ZAGGLED) (NP (D THE) (A  + (A WOOGLY)) (N QUAX)))))\n```\n\nWe see the parser works as well with words it knows (John and Mary) as with new words (Dana and Dale), which it can recognize as names because of their position in the sentence.\nIn the last sentence in the example, it recognizes each unknown word unambiguously.\nThings are not always so straightforward, unfortunately, as the following examples show:\n\n```lisp\n> (parser '(the slithy toves gymbled))\n((S (NP (D THE) (N SLITHY)) (VP (V TOVES) (NP (NAME GYMBLED))))\n  (S (NP (D THE) (A  + (A SLITHY)) (N TOVES)) (VP (V GYMBLED)))\n  (NP (D THE) (A  + (A SLITHY) (A  + (A TOVES))) (N GYMBLED)))\n> (parser '(the slithy toves gymbled on the wabe))\n((S (NP (D THE) (N SLITHY))\n      (VP (VP (V TOVES) (NP (NAME GYMBLED)))\n            PP (P ON) (NP (D THE) (N WABE)))))\n(S (NP (D THE) (N SLITHY))\n      (VP (V TOVES) (NP (NP (NAME GYMBLED))\n            (PP (P ON) (NP (D THE) (N WABE))))))\n(S (NP (D THE) (A  + (A SLITHY)) (N TOVES))\n        (VP (VP (V GYMBLED)) (PP (P ON) (NP (D THE) (N WABE)))))\n(NP (NP (D THE) (A  + (A SLITHY) (A  + (A TOVES))) (N GYMBLED))\n        (PP (P ON) (NP (D THE) (N WABE)))))\n```\n\nIf the program knew morphology-that a *y* at the end of a word often signals an adjective, an *s* a plural noun, and an *ed* a past-tense verb-then it could do much better.\n\n## 19.5 Parsing into a Semantic Representation\n\nSyntactic parse trees of a sentence may be interesting, but by themselves they're not very useful.\nWe use sentences to communicate ideas, not to display grammatical structures.\nTo explore the idea of the semantics, or meaning, of a phrase, we need a domain to talk about.\nImagine the scenario of a compact disc player capable of playing back selected songs based on their track number.\nImagine further that this machine has buttons on the front panel indicating numbers, as well as words such as \"play,\" \"to,\" \"and,\" and \"without.\" If you then punch in the sequence of buttons \"play 1 to 5 without 3,\" you could reasonably expect the machine to respond by playing tracks 1, 2, 4, and 5.\nAfter a few such successful interactions, you might say that the machine \"understands\" a limited language.\nThe important point is that the utility of this machine would not be enhanced much if it happened to display a parse tree of the input.\nOn the other hand, you would be justifiably annoyed if it responded to \"play 1 to 5 without 3\" by playing 3 or skipping 4.\n\nNow let's stretch the imagination one more time by assuming that this CD player comes equipped with a full Common Lisp compiler, and that we are now in charge of writing the parser for its input language.\nLet's first consider the relevant data structures.\nWe need to add a component for the semantics to both the rule and tree structures.\nOnce we've done that, it is clear that trees are nothing more than instances of rules, so their definitions should reflect that.\nThus, I use an `:include` defstruct to define trees, and I specify no copier function, because `copy-tree` is already a Common Lisp function, and I don't want to redefine it.\nTo maintain consistency with the old new-tree function (and to avoid having to put in all those keywords) I define the constructor `new-tree`.\nThis option to `defstruct` makes `(new-tree a b c)` equivalent to `(make-tree :lhs a :sem b :rhs c)`.\n\n```lisp\n(defstruct (rule (:type list)) lhs -> rhs sem)\n\n(defstruct (tree (:type list) (:include rule) (:copier nil)\n                 (:constructor new-tree (lhs sem rhs))))\n```\n\nWe will adopt the convention that the semantics of a word can be any Lisp object.\nFor example, the semantics of the word \"1\" could be the object 1, and the semantics of \"without\" could be the function `set-difference`.\nThe semantics of a tree is formed by taking the semantics of the rule that generated the tree and applying it (as a function) to the semantics of the constituents of the tree.\nThus, the grammar writer must insure that the semantic component of rules are functions that expect the right number of arguments.\nFor example, given the rule\n\n```lisp\n(NP -> (NP CONJ NP) infix-funcall)\n```\n\nthen the semantics of the phrase \"1 to 5 without 3\" could be determined by first determining the semantics of \"1 to 5\" to be `(1 2 3 4 5)`, of \"without\" to be `set-difference`, and of \"3\" to be (3).\nAfter these sub-constituents are determined, the rule is applied by calling the function `infix-funcall` with the three arguments `(1 2 3 4 5)`, `set-difference`, and `(3)`.\nAssuming that `infix-funcall` is defined to apply its second argument to the other two arguments, the result will be `(1 2 4 5)`.\n\nThis may make more sense if we look at a complete grammar for the CD player problem:\n\n```lisp\n(use\n  '((NP -> (NP CONJ NP) infix-funcall)\n    (NP -> (N)          list)\n    (NP -> (N P N)      infix-funcall)\n    (N ->  (DIGIT)      identity)\n    (P ->  to           integers)\n    (CONJ -> and        ordered-union)\n    (CONJ -> without    ordered-set-difference)\n    (N -> 1 1) (N -> 2 2) (N -> 3 3) (N -> 4 4) (N -> 5 5)\n    (N -> 6 6) (N -> 7 7) (N -> 8 8) (N -> 9 9) (N -> 0 0)))\n\n(defun integers (start end)\n  \"A list of all the integers in the range [start...end] inclusive.\"\n  (if (> start end) nil\n      (cons start (integers (+ start 1) end))))\n\n(defun infix-funcall (arg1 function arg2)\n  \"Apply the function to the two arguments\"\n  (funcall function arg1 arg2))\n```\n\nConsider the first three grammar rules, which are the only nonlexical rules.\nThe first says that when two NPs are joined by a conjunction, we assume the translation of the conjunction will be a function, and the translation of the phrase as a whole is derived by calling that function with the translations of the two NPs as arguments.\nThe second rule says that a single noun (whose translation should be a number) translates into the singleton list consisting of that number.\nThe third rule is similar to the first, but concerns joining Ns rather than NPs.\nThe overall intent is that the translation of an NP will always be a list of integers, representing the songs to play.\n\nAs for the lexical rules, the conjunction \"and\" translates to the `union` function, \"without\" translates to the function that subtracts one set from another, and \"to\" translates to the function that generates a list of integers between two end points.\nThe numbers \"0\" to \"9\" translate to themselves.\nNote that both lexical rules like \"`CONJ -> and`\" and nonlexical rules like \"`NP -> (N P N)`\" can have functions as their semantic translations; in the first case, the function will just be returned as the semantic translation, whereas in the second case the function will be applied to the list of constituents.\n\nOnly minor changes are needed to `parse` to support this kind of semantic processing.\nAs we see in the following, we add a `sem` argument to `extend-parse` and arrange to pass the semantic components around properly.\nWhen we have gathered all the right-hand-side components, we actually do the function application.\nAll changes are marked with `***`.\nWe adopt the convention that the semantic value `nil` indicates failure, and we discard all such parses.\n\n```lisp\n(defun parse (words)\n  \"Bottom-up parse, returning all parses of any prefix of words.\n  This version has semantics.\"\n  (unless (null words)\n    (mapcan #'(lambda (rule)\n                (extend-parse (rule-lhs rule) (rule-sem rule) ;***\n                              (list (first words)) (rest words) nil))\n            (lexical-rules (first words)))))\n\n(defun extend-parse (lhs sem rhs rem needed) ;***\n  \"Look for the categories needed to complete the parse.\n  This version has semantics.\"\n  (if (null needed)\n      ;; If nothing is needed, return this parse and upward extensions,\n      ;; unless the semantics fails\n      (let ((parse (make-parse :tree (new-tree lhs sem rhs) :rem rem)))\n        (unless (null (apply-semantics (parse-tree parse))) ;***\n          (cons parse\n                (mapcan\n                  #'(lambda (rule)\n                      (extend-parse (rule-lhs rule) (rule-sem rule) ;***\n                                    (list (parse-tree parse)) rem\n                                    (rest (rule-rhs rule))))\n                  (rules-starting-with lhs)))))\n      ;; otherwise try to extend rightward\n      (mapcan\n        #'(lambda (p)\n            (if (eq (parse-lhs p) (first needed))\n                (extend-parse lhs sem (append1 rhs (parse-tree p)) ;***\n                              (parse-rem p) (rest needed))))\n        (parse rem))))\n```\n\nWe need to add some new functions to support this:\n\n```lisp\n(defun apply-semantics (tree)\n  \"For terminal nodes, just fetch the semantics.\n  Otherwise, apply the sem function to its constituents.\"\n  (if (terminal-tree-p tree)\n      (tree-sem tree)\n      (setf (tree-sem tree)\n            (apply (tree-sem tree)\n                   (mapcar #'tree-sem (tree-rhs tree))))))\n\n(defun terminal-tree-p (tree)\n  \"Does this tree have a single word on the rhs?\"\n  (and (length=1 (tree-rhs tree))\n       (atom (first (tree-rhs tree)))))\n\n(defun meanings (words)\n  \"Return all possible meanings of a phrase.  Throw away the syntactic part.\"\n  (remove-duplicates (mapcar #'tree-sem (parser words)) :test #'equal))\n```\n\nHere are some examples of the meanings that the parser can extract:\n\n```\n> (meanings '(1 to 5 without 3))\n((1 2 4 5))\n\n> (meanings '(1 to 4 and 7 to 9))\n((1 2 3 4 7 8 9))\n\n> (meanings '(1 to 6 without 3 and 4))\n((1 2 4 5 6)\n (1 2 5 6))\n```\n\nThe example \"(1 to 6 without 3 and 4)\" is ambiguous.\nThe first reading corresponds to \"((1 to 6) without 3) and 4,\" while the second corresponds to \"(1 to 6) without (3 and 4).\" The syntactic ambiguity leads to a semantic ambiguity-the two meanings have different lists of numbers in them.\nHowever, it seems that the second reading is somehow better, in that it doesn't make a lot of sense to talk of adding 4 to a set that already includes it, which is what the first translation does.\n\nWe can upgrade the lexicon to account for this.\nThe following lexicon insists that \"and\" conjoins disjoint sets and that \"without\" removes only elements that were already in the first argument.\nIf these conditions do not hold, then the translation will return nil, and the parse will fail.\nNote that this also means that an empty list, such as \"3 to 2,\" will also fail.\n\nThe previous grammar only allowed for the numbers 0 to 9.\nWe can allow larger numbers by stringing together digits.\nSo now we have two rules for numbers: a number is either a single digit, in which case the value is the digit itself (the `identity` function), or it is a number followed by another digit, in which case the value is 10 times the number plus the digit.\nWe could alternately have specified a number to be a digit followed by a number, or even a number followed by a number, but either of those formulations would require a more complex semantic interpretation.\n\n```lisp\n(use\n  '((NP -> (NP CONJ NP) infix-funcall)\n    (NP -> (N)          list)\n    (NP -> (N P N)      infix-funcall)\n    (N ->  (DIGIT)      identity)\n    (N ->  (N DIGIT)    10*N+D)\n    (P ->  to           integers)\n    (CONJ -> and        union*)\n    (CONJ -> without    set-diff)\n    (DIGIT -> 1 1) (DIGIT -> 2 2) (DIGIT -> 3 3)\n    (DIGIT -> 4 4) (DIGIT -> 5 5) (DIGIT -> 6 6)\n    (DIGIT -> 7 7) (DIGIT -> 8 8) (DIGIT -> 9 9)\n    (DIGIT -> 0 0)))\n\n(defun union* (x y) (if (null (intersection x y)) (append x y)))\n(defun set-diff (x y) (if (subsetp y x) (ordered-set-difference x y)))\n(defun 10*N+D (N D) (+ (* 10 N) D))\n```\n\nWith this new grammar, we can get single interpretations out of most reasonable inputs:\n\n```lisp\n> (meanings '(1 to 6 without 3 and 4))\n((1 2 5 6))\n\n> (meanings '(1 and 3 to 7 and 9 without 5 and 6))\n((1 3 4 7 9))\n\n> (meanings '(1 and 3 to 7 and 9 without 5 and 2))\n((1 3 4 6 7 9 2))\n\n> (meanings '(1 9 8 to 2 0 1))\n((198 199 200 201))\n\n> (meanings '(1 2 3))\n(123 (123))\n```\n\nThe example \"1 2 3\" shows an ambiguity between the number 123 and the list (123), but all the others are unambiguous.\n\n## 19.6 Parsing with Preferences\n\nOne reason we have unambiguous interpretations is that we have a very limited domain of interpretation: we are dealing with sets of numbers, not lists.\nThis is perhaps typical of the requests faced by a CD player, but it does not account for all desired input.\nFor example, if you had a favorite song, you couldn't hear it three times with the request \"1 and 1 and 1\" under this grammar.\nWe need some compromise between the permissive grammar, which generated all possible parses, and the restrictive grammar, which eliminates too many parses.\nTo get the \"best\" interpretation out of an arbitrary input, we will not only need a new grammar, we will also need to modify the program to compare the relative worth of candidate interpretations.\nIn other words, we will assign each interpretation a numeric score, and then pick the interpretation with the highest score.\n\nWe start by once again modifying the rule and tree data types to include a score component.\nAs with the `sem` component, this will be used to hold first a function to compute a score and then eventually the score itself.\n\n```lisp\n(defstruct (rule (:type list)\n                 (:constructor rule (lhs -> rhs &optional sem score)))\n  lhs -> rhs sem score)\n\n(defstruct (tree (:type list) (:include rule) (:copier nil)\n                 (:constructor new-tree (lhs sem score rhs))))\n```\n\nNote that we have added the constructor function `rule`.\nThe intent is that the `sem` and `score` component of grammar rules should be optional.\nThe user does not have to supply them, but the function `use` will make sure that the function `rule` is called to fill in the missing `sem` and `score` values with nil.\n\n```lisp\n(defun use (grammar)\n  \"Switch to a new grammar.\"\n  (clear-memoize 'rules-starting-with)\n  (clear-memoize 'lexical-rules)\n  (length (setf *grammar*\n                (mapcar #'(lambda (r) (apply #'rule r))\n                        grammar))))\n```\n\nNow we modify the parser to keep track of the score.\nThe changes are again minor, and mirror the changes needed to add semantics.\nThere are two places where we put the score into trees as we create them, and one place where we apply the scoring function to its arguments.\n\n```lisp\n(defun parse (words)\n  \"Bottom-up parse, returning all parses of any prefix of words.\"\n  This version has semantics and preference scores.\"\n  (unless (null words)\n    (mapcan #'(lambda (rule)\n                (extend-parse (rule-lhs rule) (rule-sem rule)\n                              (rule-score rule) (list (first words)) ;***\n                              (rest words) nil))\n            (lexical-rules (first words)))))\n\n(defun extend-parse (lhs sem score rhs rem needed) ;***\n  \"Look for the categories needed to complete the parse.\n  This version has semantics and preference scores.\"\n  (if (null needed)\n      ;; If nothing is needed, return this parse and upward extensions,\n      ;; unless the semantics fails\n      (let ((parse (make-parse :tree (new-tree lhs sem score rhs) ;***\n                               :rem rem)))\n        (unless (null (apply-semantics (parse-tree parse)))\n          (apply-scorer (parse-tree parse)) ;***\n          (cons parse\n                (mapcan\n                  #'(lambda (rule)\n                      (extend-parse\n                        (rule-lhs rule) (rule-sem rule)\n                        (rule-score rule) (list (parse-tree parse)) ;***\n                        rem (rest (rule-rhs rule))))\n                  (rules-starting-with lhs)))))\n      ;; otherwise try to extend rightward\n      (mapcan\n        #'(lambda (p)\n            (if (eq (parse-lhs p) (first needed))\n                (extend-parse lhs sem score\n                              (append1 rhs (parse-tree p)) ;***\n                              (parse-rem p) (rest needed))))\n        (parse rem))))\n```\n\nAgain we need some new functions to support this.\nMost important is `apply-scorer`, which computes the score for a tree.\nIf the tree is a terminal (a word), then the function just looks up the score associated with that word.\nIn this grammar all words have a score of 0, but in a grammar with ambiguous words it would be a good idea to give lower scores for infrequently used senses of ambiguous words.\nIf the tree is a nonterminal, then the score is computed in two steps.\nFirst, all the scores of the constituents of the tree are added up.\nThen, this is added to a measure for the tree as a whole.\nThe rule associated with each tree will have either a number attached to it, which is added to the sum, or a function.\nIn the latter case, the function is applied to the tree, and the result is added to obtain the final score.\nAs a final special case, if the function returns nil, then we assume it meant to return zero.\nThis will simplify the definition of some of the scoring functions.\n\n```lisp\n(defun apply-scorer (tree)\n  \"Compute the score for this tree.\"\n  (let ((score (or (tree-score tree) 0)))\n    (setf (tree-score tree)\n          (if (terminal-tree-p tree)\n              score\n              ;; Add up the constituent's scores,\n              ;; along with the tree's score\n              (+ (sum (tree-rhs tree) #'tree-score-or-0)\n                 (if (numberp score)\n                     score\n                     (or (apply score (tree-rhs tree)) 0)))))))\n```\n\nHere is an accessor function to pick out the score from a tree:\n\n```lisp\n(defun tree-score-or-0 (tree)\n    (if (numberp (tree-score tree)) (tree-score tree) 0))\n```\n\nHere is the updated grammar.\nFirst, I couldn't resist the chance to add more features to the grammar.\nI added the postnominal adjectives \"shuffled,\" which randomly permutes the list of songs, and \"reversed,\" which reverses the order of play.\nI also added the operator \"repeat,\" as in \"1 to 3 repeat 5,\" which repeats a list a certain number of times.\nI also added brackets to allow input that says explicitly how it should be parsed.\n\n```lisp\n(use\n  '((NP -> (NP CONJ NP) infix-funcall  infix-scorer)\n    (NP -> (N P N)      infix-funcall  infix-scorer)\n    (NP -> (N)          list)\n    (NP -> ([ NP ])     arg2)\n    (NP -> (NP ADJ)     rev-funcall    rev-scorer)\n    (NP -> (NP OP N)    infix-funcall)\n    (N  -> (D)          identity)\n    (N  -> (N D)        10*N+D)\n    (P  -> to           integers       prefer<)\n    ([  -> [            [)\n    (]  -> ]            ])\n    (OP -> repeat       repeat)\n    (CONJ -> and        append         prefer-disjoint)\n    (CONJ -> without    ordered-set-difference prefer-subset)\n    (ADJ -> reversed    reverse        inv-span)\n    (ADJ -> shuffled    permute        prefer-not-singleton)\n    (D -> 1 1) (D -> 2 2) (D -> 3 3) (D -> 4 4) (D -> 5 5)\n    (D -> 6 6) (D -> 7 7) (D -> 8 8) (D -> 9 9) (D -> 0 0)))\n```\n\nThe following scoring functions take trees as inputs and compute bonuses or penalties for those trees.\nThe scoring function `prefer<`, used for the word \"to,\" gives a one-point penalty for reversed ranges: \"5 to 1\" gets a score of -1, while \"1 to 5\" gets a score of 0.\nThe scorer for \"and,\" `prefer-disjoint`, gives a one-point penalty for intersecting lists: \"1 to 3 and 7 to 9\" gets a score of 0, while \"1 to 4 and 2 to 5\" gets -1.\nThe \"x without y\" scorer, `prefer-subset`, gives a three-point penalty when the y list has elements that aren't in the x list.\nIt also awards points in inverse proportion to the length (in words) of the x phrase.\nThe idea is that we should prefer to bind \"without\" tightly to some small expression on the left.\nIf the final scores come out as positive or as nonintegers, then this scoring component is responsible, since all the other components are negative intgers.\nThe \"x shuffled\" scorer, `prefer-not-singleton`, is similar, except that there the penalty is for shuffling a list of less than two songs.\n\n```lisp\n(defun prefer< (x y) (if (>= (sem x) (sem y)) -1))\n\n(defun prefer-disjoint (x y) (if (intersection (sem x) (sem y)) -1))\n\n(defun prefer-subset (x y)\n  (+ (inv-span x) (if (subsetp (sem y) (sem x)) 0 -3)))\n\n(defun prefer-not-singleton (x)\n  (+ (inv-span x) (if (< (length (sem x)) 2) -4 0)))\n```\n\nThe `infix-scorer` and `rev-scorer` functions don't add anything new, they just assure that the previously mentioned scoring functions will get applied in the right place.\n\n```lisp\n(defun infix-scorer (arg1 scorer arg2)\n  (funcall (tree-score scorer) arg1 arg2))\n\n(defun rev-scorer (arg scorer) (funcall (tree-score scorer) arg))\n```\n\nHere are the functions mentioned in the grammar, along with some useful utilities:\n\n```lisp\n(defun arg2 (a1 a2 &rest a-n) (declare (ignore a1 a-n)) a2)\n\n(defun rev-funcall (arg function) (funcall function arg))\n\n(defun repeat (list n)\n  \"Append list n times.\"\n  (if (= n 0)\n      nil\n      (append list (repeat list (- n 1)))))\n\n(defun span-length (tree)\n  \"How many words are in tree?\"\n  (if (terminal-tree-p tree) 1\n      (sum (tree-rhs tree) #'span-length)))\n\n(defun inv-span (tree) (/ 1 (span-length tree)))\n\n(defun sem (tree) (tree-sem tree))\n\n(defun integers (start end)\n  \"A list of all the integers in the range [start...end] inclusive.\n  This version allows start > end.\"\n  (cond ((< start end) (cons start (integers (+ start 1) end)))\n        ((> start end) (cons start (integers (- start 1) end)))\n        (t (list start))))\n\n(defun sum (numbers &optional fn)\n  \"Sum the numbers, or sum (mapcar fn numbers).\"\n  (if fn\n      (loop for x in numbers sum (funcall fn x))\n      (loop for x in numbers sum x)))\n\n(defun permute (bag)\n  \"Return a random permutation of the given input list.\"\n  (if (null bag)\n      nil\n      (let ((e (random-elt bag)))\n        (cons e (permute (remove e bag :count 1 :test #'eq))))))\n```\n\nWe will need a way to show off the preference rankings:\n\n```lisp\n(defun all-parses (words)\n  (format t \"~%Score  Semantics~25T~a\" words)\n  (format t \"~%=====  =========~25T============================~%\")\n  (loop for tree in (sort (parser words) #'> :key #'tree-score)\n    do (format t \"~5,1f  ~9a~25T~a~%\" (tree-score tree) (tree-sem tree)\n               (bracketing tree)))\n  (values))\n\n(defun bracketing (tree)\n  \"Extract the terminals, bracketed with parens.\"\n  (cond ((atom tree) tree)\n        ((length=1 (tree-rhs tree))\n         (bracketing (first (tree-rhs tree))))\n        (t (mapcar #'bracketing (tree-rhs tree)))))\n```\n\nNow we can try some examples:\n\n```lisp\n> (all-parses '(1 to 6 without 3 and 4))\nScore  Semantics         (1 TO 6 WITHOUT 3 AND 4)\n=====  ===========       ========================\n0.3    (12 5 6)          ((1 TO 6) WITHOUT (3 AND 4))\n-0.7   (12 4 5 6 4)      (((1 TO 6) WITHOUT 3) AND 4)\n```\n\n```\n> (all-parses '(1 and 3 to 7 and 9 without 5 and 6))\nScore  Semantics         (1 AND 3 TO 7 AND 9 WITHOUT 5 AND 6)\n=====  ===========       =================================\n0.2    (1 3 4 7 9)       (1 AND (((3 TO 7) AND 9) WITHOUT (5 AND 6)))\n0.1    (1 3 4 7 9)       (((1 AND (3 TO 7)) AND 9) WITHOUT (5 AND 6))\n0.1    (1 3 4 7 9)       ((1 AND ((3 TO 7) AND 9)) WITHOUT (5 AND 6))\n-0.8   (1 3 4 6 7 9 6)   ((1 AND (((3 TO 7) AND 9) WITHOUT 5)) AND 6)\n-0.8   (1 3 4 6 7 9 6)   (1 AND ((((3 TO 7) AND 9) WITHOUT 5) AND 6))\n-0.9   (1 3 4 6 7 9 6)   ((((1 AND (3 TO 7)) AND 9) WITHOUT 5) AND 6)\n-0.9   (1 3 4 6 7 9 6)   (((1 AND ((3 TO 7) AND 9)) WITHOUT 5) AND 6)\n-2.0   (1 3 4 5 6 7 9)   ((1 AND (3 TO 7)) AND (9 WITHOUT (5 AND 6)))\n-2.0   (1 3 4 5 6 7 9)   (1 AND ((3 TO 7) AND (9 WITHOUT (5 AND 6))))\n-3.0   (1 3 4 5 6 7 9 6) (((1 AND (3 TO 7)) AND (9 WITHOUT 5)) AND 6)\n-3.0   (1 3 4 5 6 7 9 6) ((1 AND (3 TO 7)) AND ((9 WITHOUT 5) AND 6))\n-3.0   (1 3 4 5 6 7 9 6) ((1 AND ((3 TO 7) AND (9 WITHOUT 5))) AND 6)\n-3.0   (1 3 4 5 6 7 9 6) (1 AND (((3 TO 7) AND (9 WITHOUT 5)) AND 6))\n-3.0   (1 3 4 5 6 7 9 6) (1 AND ((3 TO 7) AND ((9 WITHOUT 5) AND 6)))\n```\n\n```\n> (all-parses '(1 and 3 to 7 and 9 without 5 and 2))\nScore   Semantics         (1 AND 3 TO 7 AND 9 WITHOUT 5 AND 2)\n=====   ================  ===================================\n0.2     (1 3 4 6 7 9 2)   ((1 AND (((3 TO 7) AND 9) WITHOUT 5)) AND 2)\n0.2     (1 3 4 6 7 9 2)   (1 AND ((((3 TO 7) AND 9) WITHOUT 5) AND 2))\n0.1     (1 3 4 6 7 9 2)   ((((1 AND (3 TO 7)) AND 9) WITHOUT 5) AND 2)\n0.1     (1 3 4 6 7 9 2)   (((1 AND ((3 TO 7) AND 9)) WITHOUT 5) AND 2)\n-2.0    (1 3 4 5 6 7 9 2) (((1 AND (3 TO 7)) AND (9 WITHOUT 5)) AND 2)\n-2.0    (1 3 4 5 6 7 9 2) ((1 AND (3 TO 7)) AND ((9 WITHOUT 5) AND 2))\n-2.0    (1 3 4 5 6 7 9)   ((1 AND (3 TO 7)) AND (9 WITHOUT (5 AND 2)))\n-2.0    (1 3 4 5 6 7 9 2) ((1 AND ((3 TO 7) AND (9 WITHOUT 5))) AND 2)\n-2.0    (1 3 4 5 6 7 9 2) (1 AND (((3 TO 7) AND (9 WITHOUT 5)) AND 2))\n-2.0    (1 3 4 5 6 7 9 2) (1 AND ((3 TO 7) AND ((9 WITHOUT 5) AND 2)))\n-2.0    (1 3 4 5 6 7 9)   (1 AND ((3 TO 7) AND (9 WITHOUT (5 AND 2))))\n-2.8    (1 3 4 6 7 9)     (1 AND (((3 TO 7) AND 9) WITHOUT (5 AND 2)))\n-2.9    (1 3 4 6 7 9)     (((1 AND (3 TO 7)) AND 9) WITHOUT (5 AND 2))\n-2.9    (1 3 4 6 7 9)     ((1 AND ((3 TO 7) AND 9)) WITHOUT (5 AND 2))\n```\n\nIn each case, the preference rules are able to assign higher scores to more reasonable interpretations.\nIt turns out that, in each case, all the interpretations with positive scores represent the same set of numbers, while interpretations with negative scores seem worse.\nSeeing all the scores in gory detail may be of academic interest, but what we really want is something to pick out the best interpretation.\nThe following code is appropriate for many situations.\nIt picks the top scorer, if there is a unique one, or queries the user if several interpretations tie for the best score, and it complains if there are no valid parses at all.\nThe `query-user` function may be useful in many applications, but note that `meaning` uses it only as a default; a program that had some automatic way of deciding could supply another `tie-breaker` function to `meaning`.\n\n```lisp\n(defun meaning (words &optional (tie-breaker #'query-user))\n  \"Choose the single top-ranking meaning for the words.\"\n  (let* ((trees (sort (parser words) #'> :key #'tree-score))\n         (best-score (if trees (tree-score (first trees)) 0))\n         (best-trees (delete best-score trees\n                             :key #'tree-score :test-not #'eql))\n         (best-sems (delete-duplicates (mapcar #'tree-sem best-trees)\n                                       :test #'equal)))\n    (case (length best-sems)\n      (0 (format t \"~&Sorry, I didn't understand that.\") nil)\n      (1 (first best-sems))\n      (t (funcall tie-breaker best-sems)))))\n\n(defun query-user (choices &optional\n                           (header-str \"~&Please pick one:\")\n                           (footer-str \"~&Your choice? \"))\n  \"Ask user to make a choice.\"\n  (format *query-io* header-str)\n  (loop for choice in choices for i from 1 do\n        (format *query-io* \"~&~3d: ~a\" i choice))\n  (format *query-io* footer-str)\n  (nth (- (read) 1) choices))\n```\n\nHere we see some final examples:\n\n```lisp\n> (meaning '(1 to 5 without 3 and 4))\n(1 2 5)\n> (meaning '(1 to 5 without 3 and 6))\n(1 2 4 5 6)\n> (meaning '(1 to 5 without 3 and 6 shuffled))\n(6 4 1 2 5)\n> (meaning '([ 1 to 5 without [ 3 and 6 ] ] reversed))\n(5 4 2 1)\n> (meaning '(1 to 5 to 9))\nSorry. I didn't understand that.\nNIL\n> (meaning '(1 to 5 without 3 and 7 repeat 2))\nPlease pick one:\n   1: (12 4 5 7 12 4 5 7)\n   2: (12 4 5 7 7)\nYour choice? 1\n(1 2 4 5 7 1 2 4 5 7)\n```\n\n```\n> (all-parses '(1 to 5 without 3 and 7 repeat 2))\nScore  Semantics              (1 TO 5 WITHOUT 3 AND 7 REPEAT 2)\n=====  =========              ============================\n0.3    (1 2 4 5 7 1 2 4 5 7)  ((((1 TO 5) WITHOUT 3) AND 7) REPEAT 2)\n0.3    (1 2 4 5 7 7)          (((1 TO 5) WITHOUT 3) AND (7 REPEAT 2))\n-2.7   (1 2 4 5 1 2 4 5)      (((1 TO 5) WITHOUT (3 AND 7)) REPEAT 2)\n-2.7   (1 2 4 5)              ((1 TO 5) WITHOUT ((3 AND 7) REPEAT 2))\n-2.7   (1 2 4 5)              ((1 TO 5) WITHOUT (3 AND (7 REPEAT 2)))\n```\n\nThis last example points out a potential problem: I wasn't sure what was a good scoring function for \"repeat\", so I left it blank, it defaulted to 0, and we end up with two parses with the same score.\nThis example suggests that \"repeat\" should probably involve `inv-span` like the other modifiers, but perhaps other factors should be involved as well.\nThere can be a complicated interplay between phrases, and it is not always clear where to assign the score.\nFor example, it doesn't make much sense to repeat a \"without\" phrase; that is, the bracketing `(x without (y repeat n))` is probably a bad one.\nBut the scorer for \"without\" nearly handles that already.\nIt assigns a penalty if its right argument is not a subset of its left.\nUnfortunately, repeated elements are not counted in sets, so for example, the list `(1 2 3 1 2 3)` is a subset of `(1 2 3 4)`.\nHowever, we could change the scorer for \"without\" to test for `sub-bag-p` (not a built-in Common Lisp function) instead, and then \"repeat\" would not have to be concerned with that case.\n\n## 19.7 The Problem with Context-Free Phrase-Structure Rules\n\nThe fragment of English grammar we specified in [section 19.2](#s0015) admits a variety of ungrammatical phrases.\nFor example, it is equally happy with both \"I liked her\" and \"me liked she.\" Only the first of these should be accepted; the second should be ruled out.\nSimilarly, our grammar does not state that verbs have to agree with their subjects in person and number.\nAnd, since the grammar has no notion of meaning, it will accept sentences that are semantically anomalous (or at least unusual), such as \"the table liked the man.\"\n\nThere are also some technical problems with context-free grammars.\nFor example, it can be shown that no context-free grammar can be written to account for the language consisting of just the strings ABC, AABBCC, AAABBBCCC, and so forth, where each string has an equal number of As, Bs, and Cs.\nYet sentences roughly of that form show up (admittedly rarely) in natural languages.\nAn example is \"Robin and Sandy loved and hated Pat and Kim, respectively.\" While there is still disagreement over whether it is possible to generate natural languages with a context-free grammar, clearly it is much easier to use a more powerful grammatical formalism.\nFor example, consider solving the subject-predicate agreement problem.\nIt is possible to do this with a context-free language including categories like singular-NP, plural-NP, singular-VP, and plural-VP, but it is far easier to augment the grammatical formalism to allow passing features between constituents.\n\nIt should be noted that context-free phrase-structure rules turned out to be very useful for describing programming languages.\nStarting with Algol 60, the formalism has been used under the name *Backus-Naur Form* (BNF) by computer scientists.\nIn this book we are more interested in natural languages, so in the next chapter we will see a more powerful formalism known as *unification grammar* that can handle the problem of agreement, as well as other difficulties.\nFurthermore, *unification grammars* allow a natural way of attaching semantics to a parse.\n\n## 19.8 History and References\n\nThere is a class of parsing algorithms known as *chart parsers* that explicitly cache partial parses and reuse them in constructing larger parses.\nEarley's algorithm (1970) is the first example, and Martin [Kay (1980)](bibliography.md#bb0605) gives a good overview of the field and introduces a data structure, the *chart*, for storing substrings of a parse.\n[Winograd (1983)](bibliography.md#bb1395) gives a complex (five-page) specification of a chart parser.\nNone of these authors have noticed that one can achieve the same results by augmenting a simple (one-page) parser with memoization.\nIn fact, it is possible to write a top-down parser that is even more succinct.\n(See [exercise 19.3](#p2455) below.)\n\nFor a general overview of natural language processing, my preferences (in order) are [Allen 1987](bibliography.md#bb0030), [Winograd 1983](bibliography.md#bb1395) or [Gazdar and Mellish 1989](bibliography.md#bb0445).\n\n## 19.9 Exercises\n\n**Exercise  19.2 [m-h]** Experiment with the grammar and the parser.\nFind sentences it cannot parse correctly, and try to add new syntactic rules to account for them.\n\n**Exercise  19.3 [m-h]** The parser works in a bottom-up fashion.\nWrite a top-down parser, and compare it to the bottom-up version.\nCan both parsers work with the same grammar?\nIf not, what constraints on the grammar does each parsing strategy impose?\n\n**Exercise  19.4 [h]** Imagine an interface to a dual cassette deck.\nWhereas the CD player had one assumed verb, \"play,\" this unit has three explicit verb forms: \"record,\" \"play,\" and \"erase.\" There should also be modifiers \"from\" and \"to,\" where the object of a \"to\" is either 1 or 2, indicating which cassette to use, and the object of a \"from\" is either 1 or 2, or one of the symbols PHONO, CD, or AUX.\nIt's up to you to design the grammar, but you should allow input something like the following, where I have chosen to generate actual Lisp code as the meaning:\n\n```lisp\n> (meaning '(play 1 to 5 from CD shuffled and\n             record 1 to 5 from CD and 1 and 3 and 7 from 1))\n(PROGN (PLAY '(1 5 2 3 4) :FROM 'CD)\n       (RECORD '(1 2 3 4 5) :FROM 'CD)\n       (RECORD '(1 3 7) :FROM '1))\n```\n\nThis assumes that the functions `play` and `record` take keyword arguments (with defaults) for `:from` and `:to`.\nYou could also extend the grammar to accommodate an automatic timer, with phrases like \"at 3:00.\"\n\n**Exercise  19.5 [m]** In the definition of `permute`, repeated here, why is the `:test #'eq` needed?\n\n```lisp\n(defun permute (bag)\n      \"Return a random permutation of the given input list.\"\n      (if (null bag)\n              nil\n              (let ((e (random-elt bag)))\n                  (cons e (permute (remove e bag :count 1 :test #'eq))))))\n```\n\n**Exercise 19.6 [m]** The definition of `permute` takes *O*(*n*<sup>2</sup>).\nReplace it by an *O*(*n*) algorithm.\n\n## 19.10 Answers\n\n**Answer 19.1**\n\n```lisp\n(defun parser (words)\n  \"Return all complete parses of a list of words.\"\n  (let* ((table (make-array (+ (length words) 1) :initial-element 0))\n                (parses (parse words (length words) table)))\n    (mapcar #'parse-tree (complete-parses parses))))\n\n(defun parse (words num-words table)\n   \"Bottom-up parse. returning all parses of any prefix of words.\"\n   (unless (null words)\n     (let ((ans (aref table num-words)))\n       (if (not (eq ans 0))\n           ans\n           (setf (aref table num-words)\n                (mapcan #'(lambda (rule)\n                             (extend-parse (rule-lhs rule)\n                                           (list (firstwords))\n                                           (rest words) nil\n                                           (- num-words 1) table))\n                         (lexical-rules (first words))))))))\n\n(defun extend-parse (lhs rhs rem needed num-words table)\n  \"Look for the categories needed to complete the parse.\"\n  (if (null needed)\n      ;; If nothing is needed, return this parse and upward extensions\n      (let ((parse (make-parse :tree (new-tree lhs rhs) :rem rem)))\n        (cons parse\n              (mapcan\n                #'(lambda (rule)\n                    (extend-parse (rule-lhs rule)\n                                  (list (parse-tree parse))\n                                  rem (rest (rule-rhs rule))\n                                  num-words table))\n                    (rules-starting-with lhs))))\n        ;; otherwise try to extend rightward\n        (mapcan\n          #'(lambda (p)\n              (if (eq (parse-lhs p) (first needed))\n                  (extend-parse lhs (appendl rhs (parse-tree p))\n                                (parse-rem p) (rest needed)\n                                (length (parse-rem p)) table)))\n          (parse rem num-words table))))\n```\n\nIt turns out that, for the Lisp system used in the timings above, this version is no faster than normal memoization.\n\n**Answer 19.3** Actually, the top-down parser is a little easier (shorter) than the bottom-up version.\nThe problem is that the most straightforward way of implementing a top-down parser does not handle so-called *left recursive* rules-rules of the form `(X -> (X ...))`.\nThis includes rules we've used, like `(NP -> (NP and NP))`.\nThe problem is that the parser will postulate an `NP`, and then postulate that it is of the form `(NP and NP)`, and that the first `NP` of that expression is of the form `(NP and NP)`, and so on.\nAn infinite structure of `NP`s is explored before even the first word is considered.\n\nBottom-up parsers are stymied by rules with null right-hand sides: `(X -> O)`.\nNote that I was careful to exclude such rules in my grammars earlier.\n\n```lisp\n(defun parser (words &optional (cat 's))\n  \"Parse a list of words; return only parses with no remainder.\"\n  (mapcar #'parse-tree (complete-parses (parse words cat))))\n\n(defun parse (tokens start-symbol)\n  \"Parse a list of tokens, return parse trees and remainders.\"\n  (if (eq (first tokens) start-symbol)\n      (list (make-parse :tree (first tokens) :rem (rest tokens)))\n      (mapcan #'(lambda (rule)\n                  (extend-parse (lhs rule) nil tokens (rhs rule)))\n              (rules-for start-symbol))))\n\n(defun extend-parse (lhs rhs rem needed)\n  \"Parse the remaining needed symbols.\"\n  (if (null needed)\n      (list (make-parse :tree (cons lhs rhs) :rem rem))\n      (mapcan\n        #'(lambda (p)\n            (extend-parse lhs (append rhs (list (parse-tree p)))\n                          (parse-rem p) (rest needed)))\n        (parse rem (first needed)))))\n\n(defun rules-for (cat)\n  \"Return all the rules with category on lhs\"\n  (find-all cat *grammar* :key #'rule-lhs))\n```\n\n**Answer 19.5** If it were omitted, then `:test` would default to `#'eql`, and it would be possible to remove the \"wrong\" element from the list.\nConsider the list `(1.0 1.0)` in an implementation where floating-point numbers are `eql` but not `eq`.\nIf `random-elt` chooses the first 1.0 first, then everything is satisfactory-the result list is the same as the input list.\nHowever, if `random-elt` chooses the second 1.0, then the second 1.0 will be the first element of the answer, but `remove` will remove the wrong 1.0!\nIt will remove the first 1.0, and the final answer will be a list with two pointers to the second 1.0 and none to the first.\nIn other words, we could have:\n\n```lisp\n  > (member (first x) (permute x) :test #'eq)\n  NIL\n```\n\n**Answer 19.6**\n\n```lisp\n(defun permute (bag)\n  \"Return a random permutation of the bag.\"\n  ;; It is done by converting the bag to a vector, but the\n  ;; result is always the same type as the input bag.''\n  (let ((bag-copy (replace (make-array (length bag)) bag))\n        (bag-type (if (listp bag) 'list (type-of bag))))\n    (coerce (permute-vector! bag-copy) bag-type)))\n\n(defun permute-vector! (vector)\n  \"Destructively permute (shuffle) the vector.\"\n  (loop for i from (length vector) downto 2 do\n        (rotatef (aref vector (- i 1))\n                 (aref vector (random i))))\n  vector)\n```\n\nThe answer uses `rotatef`, a relative of `setf` that swaps 2 or more values.\nThat is, `(rotatef a b)` is like:\n\n```lisp\n(let ((temp a))\n  (setf a b)\n  (setf b temp)\n  nil)\n```\n\nRarely, `rotatef` is used with more than two arguments, `(rotatef a b c)` is like:\n\n```lisp\n(let ((temp a))\n  (setf a b)\n  (setf b c)\n  (setf c temp)\n  nil)\n```\n\n----------------------\n\n<a id=\"fn19-1\"></a><sup>[1](#tfn19-1)</sup>\nSome erroneous expressions are underspecified and may return different results in different implementations, but we will ignore that problem.\n\n<a id=\"fn19-2\"></a><sup>[2](#tfn19-2)</sup>\nThe number of parses of sentences of this kind is the same as the number of bracketings of a arithmetic expression, or the number of binary trees with a given number of leaves.\nThe resulting sequence (1, 2, 5, 14, 42, ...) is known as the Catalan Numbers.\nThis kind of ambiguity is discussed by [Church and Patil (1982)](bibliography.md#bb0200) in their article *Coping with Syntactic Ambiguity, or How to Put the Block in the Box on the Table.*\n\n"
  },
  {
    "path": "docs/chapter2.md",
    "content": "# Chapter 2\n## A Simple Lisp Program\n\n> *Certum quod factum.* \\\n> (One is certain of only what one builds.)\n\n> -Giovanni Battista Vico (1668-1744) \\\n> Italian royal historiographer\n\nYou will never become proficient in a foreign language by studying vocabulary lists.\nRather, you must hear and speak (or read and write) the language to gain proficiency.\nThe same is true for learning computer languages.\n\nThis chapter shows how to combine the basic functions and special forms of Lisp into a complete program.\nIf you can learn how to do that, then acquiring the remaining vocabulary of Lisp (as outlined in [chapter 3](chapter3.md)) will be easy.\n\n## 2.1 A Grammar for a Subset of English\n\nThe program we will develop in this chapter generates random English sentences.\nHere is a simple grammar for a tiny portion of English:\n\n> *Sentence* => *Noun-Phrase + Verb-Phrase* \\\n> *Noun-Phrase* => *Article + Noun* \\\n> *Verb-Phrase* => *Verb + Noun-Phrase* \\\n> *Article* => *the, a,...* \\\n> *Noun* => *man, ball, woman, table...* \\\n> *Verb* => *hit, took, saw, liked...*\n\nTo be technical, this description is called a *context-free phrase-structure grammar*, and the underlying paradigm is called *generative syntax*.\nThe idea is that anywhere we want a sentence, we can generate a noun phrase followed by a verb phrase.\nAnywhere a noun phrase has been specified, we generate instead an article followed by a noun.\nAnywhere an article has been specified, we generate either \"the,\" \"a,\" or some other article.\nThe formalism is \"context-free\" because the rules apply anywhere regardless of the surrounding words, and the approach is \"generative\" because the rules as a whole define the complete set of sentences in a language (and by contrast the set of nonsentences as well).\nIn the following we show the derivation of a single sentence using the rules:\n\n\n* To get a *Sentence,* append a *Noun-Phrase* and a *Verb-Phrase*\n  * To get a *Noun-Phrase*, append an *Article* and a *Noun*\n    * Choose *\"the\"* for the *Article*\n    * Choose *\"man\"* for the *Noun*\n  * The resulting *Noun-Phrase* is *\"the man\"*\n  * To get a *Verb-Phrase,* append a *Verb* and a *Noun-Phrase*\n    * Choose *\"hit\"* for the *Verb*\n    * To get a *Noun-Phrase*, append an *Article* and a *Noun*\n      * Choose *\"the\"* for the *Article*\n      * Choose *\"ball\"* for the *Noun*\n    * The resulting *Noun-Phrase* is *\"the ball\"*\n  * The resulting *Verb-Phrase* is *\"hit the ball\"*\n* The resulting *Sentence* is *\"The man hit the ball\"*\n\n## 2.2 A Straightforward Solution\n\nWe will develop a program that generates random sentences from a phrase-structure grammar.\nThe most straightforward approach is to represent each grammar rule by a separate Lisp function:\n\n```lisp\n(defun sentence ()    (append (noun-phrase) (verb-phrase)))\n(defun noun-phrase () (append (Article) (Noun)))\n(defun verb-phrase () (append (Verb) (noun-phrase)))\n(defun Article ()     (one-of '(the a)))\n(defun Noun ()        (one-of '(man ball woman table)))\n(defun Verb ()        (one-of '(hit took saw liked)))\n```\n\nEach of these function definitions has an empty parameter list, `()`.\nThat means the functions take no arguments.\nThis is unusual because, strictly speaking, a function with no arguments would always return the same thing, so we would use a constant instead.\nHowever, these functions make use of the `random` function (as we will see shortly), and thus can return different results even with no arguments.\nThus, they are not functions in the mathematical sense, but they are still called functions in Lisp, because they return a value.\n\nAll that remains now is to define the function `one-of`.\nIt takes a list of possible choices as an argument, chooses one of these at random, and returns a one-element list of the element chosen.\nThis last part is so that all functions in the grammar will return a list of words.\nThat way, we can freely apply `append` to any category.\n\n```lisp\n(defun one-of (set)\n  \"Pick one element of set, and make a list of it.\"\n  (list (random-elt set)))\n\n(defun random-elt (choices)\n  \"Choose an element from a list at random.\"\n  (elt choices (random (length choices))))\n```\n\nThere are two new functions here, `elt` and `random`.\n`elt` picks an element out of a list.\nThe first argument is the list, and the second is the position in the list.\nThe confusing part is that the positions start at 0, so `(elt choices 0)` is the first element of the list, and `(elt choices 1)` is the second.\nThink of the position numbers as telling you how far away you are from the front.\nThe expression `(random n)` returns an integer from 0 to n-1, so that `(random 4)` would return either 0, 1, 2, or 3.\n\nNow we can test the program by generating a few random sentences, along with a noun phrase and a verb phrase:\n\n```lisp\n> (sentence) => (THE WOMAN HIT THE BALL)\n\n> (sentence) => (THE WOMAN HIT THE MAN)\n\n> (sentence) => (THE BALL SAW THE WOMAN)\n\n> (sentence) => (THE BALL SAW THE TABLE)\n\n> (noun-phrase) => (THE MAN)\n\n> (verb-phrase) => (LIKED THE WOMAN)\n\n> (trace sentence noun-phrase verb-phrase article noun verb) =>\n(SENTENCE NOUN-PHRASE VERB-PHRASE ARTICLE NOUN VERB)\n\n> (sentence) =>\n(1 ENTER SENTENCE)\n  (1 ENTER NOUN-PHRASE)\n    (1 ENTER ARTICLE)\n    (1 EXIT ARTICLE: (THE))\n    (1 ENTER NOUN)\n    (1 EXIT NOUN: (MAN))\n  (1 EXIT NOUN-PHRASE: (THE MAN))\n  (1 ENTER VERB-PHRASE)\n    (1 ENTER VERB)\n    (1 EXIT VERB: (HIT))\n    (1 ENTER NOUN-PHRASE)\n      (1 ENTER ARTICLE)\n      (1 EXIT ARTICLE: (THE))\n      (1 ENTER NOUN)\n      (1 EXIT NOUN: (BALL))\n    (1 EXIT NOUN-PHRASE: (THE BALL))\n  (1 EXIT VERB-PHRASE: (HIT THE BALL))\n(1 EXIT SENTENCE: (THE MAN HIT THE BALL))\n(THE MAN HIT THE BALL)\n```\n\nThe program works fine, and the trace looks just like the sample derivation above, but the Lisp definitions are a bit harder to read than the original grammar rules.\nThis problem will be compounded as we consider more complex rules.\nSuppose we wanted to allow noun phrases to be modified by an indefinite number of adjectives and an indefinite number of prepositional phrases.\nIn grammatical notation, we might have the following rules:\n\n> *Noun-Phrase => Article + Adj\\* + Noun + PP\\* \\\n> Adj\\* => &#x2205;, Adj + Adj\\* \\\n> PP\\* => &#x2205;, PP + PP\\* \\\n> PP => Prep + Noun-Phrase \\\n> Adj => big, little, blue, green, ... \\\n> Prep => to, in, by, with, ...*\n\nIn this notation, &#x2205; indicates a choice of nothing at all, a comma indicates a choice of several alternatives, and the asterisk is nothing special-as in Lisp, it's just part of the name of a symbol.\nHowever, the convention used here is that names ending in an asterisk denote zero or more repetitions of the underlying name.\nThat is, *PP\\** denotes zero or more repetitions of *PP*.\n<a id=\"tfn02-1\"></a>\nThis is known as \"Kleene star\" notation (pronounced \"clean-E\") after the mathematician Stephen Cole Kleene.<sup>[1](#fn02-1)</sup>\n\nThe problem is that the rules for *Adj\\** and *PP\\** contain choices that we would have to represent as some kind of conditional in Lisp.\nFor example:\n\n```lisp\n(defun Adj* ()\n  (if (= (random 2) 0)\n      nil\n      (append (Adj) (Adj*))))\n\n(defun PP* ()\n  (if (random-elt '(t nil))\n      (append (PP) (PP*))\n      nil))\n\n(defun noun-phrase () (append (Article) (Adj*) (Noun) (PP*)))\n(defun PP () (append (Prep) (noun-phrase)))\n(defun Adj () (one-of '(big little blue green adiabatic)))\n(defun Prep () (one-of '(to in by with on)))\n```\n\nI've chosen two different implementations for `Adj*` and `PP*`; either approach would work in either function.\nWe have to be careful, though; here are two approaches that would not work:\n\n```lisp\n(defun Adj* ()\n  \"Warning - incorrect definition of Adjectives.\"\n  (one-of '(nil (append (Adj) (Adj*)))))\n(defun Adj* ()\n  \"Warning - incorrect definition of Adjectives.\"\n  (one-of (list nil (append (Adj) (Adj*)))))\n```\n\nThe first definition is wrong because it could return the literal expression `((append (Adj) (Adj*)))` rather than a list of words as expected.\nThe second definition would cause infinite recursion, because computing the value of `(Adj*)` always involves a recursive call to `(Adj*)`.\nThe point is that what started out as simple functions are now becoming quite complex.\nTo understand them, we need to know many Lisp conventions-`defun, (), case, if`, `quote`, and the rules for order of evaluation-when ideally the implementation of a grammar rule should use only *linguistic* conventions.\nIf we wanted to develop a larger grammar, the problem could get worse, because the rule-writer might have to depend more and more on Lisp.\n\n## 2.3 A Rule-Based Solution\n\nAn alternative implementation of this program would concentrate on making it easy to write grammar rules and would worry later about how they will be processed.\nLet's look again at the original grammar rules:\n\n> *Sentence => Noun-Phrase + Verb-Phrase \\\n> Noun-Phrase => Article + Noun \\\n> Verb-Phrase => Verb + Noun-Phrase \\\n> Article => the, a, ... \\\n> Noun => man, ball, woman, table... \\\n> Verb => hit, took, saw, liked...*\n\nEach rule consists of an arrow with a symbol on the left-hand side and something on the right-hand side.\nThe complication is that there can be two kinds of right-hand sides: a concatenated list of symbols, as in \"*Noun-Phrase => Article+Noun*,\" or a list of alternate words, as in \"*Noun => man, ball, ...*\"\nWe can account for these possibilities by deciding that every rule will have a list of possibilities on the right-hand side, and that a concatenated list, *for example \"Article+Noun,\"* will be represented as a Lisp list, *for example* \"(`Article Noun`)\".\nThe list of rules can then be represented as follows:\n\n```lisp\n(defparameter *simple-grammar*\n  '((sentence -> (noun-phrase verb-phrase))\n    (noun-phrase -> (Article Noun))\n    (verb-phrase -> (Verb noun-phrase))\n    (Article -> the a)\n    (Noun -> man ball woman table)\n    (Verb -> hit took saw liked))\n  \"A grammar for a trivial subset of English.\")\n\n(defvar *grammar* *simple-grammar*\n  \"The grammar used by generate.  Initially, this is\n  *simple-grammar*, but we can switch to other grammars.\")\n```\n\nNote that the Lisp version of the rules closely mimics the original version.\nIn particular, I include the symbol \"->\", even though it serves no real purpose; it is purely decorative.\n\nThe special forms `defvar` and `defparameter` both introduce special variables and assign a value to them; the difference is that a *variable*, like `*grammar*,` is routinely changed during the course of running the program.\nA *parameter*, like `*simple-grammar*`, on the other hand, will normally stay constant.\nA change to a parameter is considered a change *to* the program, not a change *by* the program.\n\nOnce the list of rules has been defined, it can be used to find the possible rewrites of a given category symbol.\nThe function `assoc` is designed for just this sort of task.\nIt takes two arguments, a \"key\" and a list of lists, and returns the first element of the list of lists that starts with the key.\nIf there is none, it returns `nil`.\nHere is an example:\n\n```lisp\n> (assoc 'noun *grammar*) => (NOUN -> MAN BALL WOMAN TABLE)\n```\n\nAlthough rules are quite simply implemented as lists, it is a good idea to impose a layer of abstraction by defining functions to operate on the rules.\nWe will need three functions: one to get the right-hand side of a rule, one for the left-hand side, and one to look up all the possible rewrites (right-hand sides) for a category.\n\n```lisp\n(defun rule-lhs (rule)\n  \"The left-hand side of a rule.\"\n  (first rule))\n\n(defun rule-rhs (rule)\n  \"The right-hand side of a rule.\"\n  (rest (rest rule)))\n\n(defun rewrites (category)\n  \"Return a list of the possible rewrites for this category.\"\n  (rule-rhs (assoc category *grammar*)))\n```\n\nDefining these functions will make it easier to read the programs that use them, and it also makes changing the representation of rules easier, should we ever decide to do so.\n\nWe are now ready to address the main problem: defining a function that will generate sentences (or noun phrases, or any other category).\nWe will call this function `generate`.\nIt will have to contend with three cases:\n(1) In the simplest case, `generate` is passed a symbol that has a set of rewrite rules associated with it.\nWe choose one of those at random, and then generate from that.\n(2) If the symbol has no possible rewrite rules, it must be a terminal symbol-a word, rather than a grammatical category-and we want to leave it alone.\nActually, we return the list of the input word, because, as in the previous program, we want all results to be lists of words.\n(3) In some cases, when the symbol has rewrites, we will pick one that is a list of symbols, and try to generate from that.\nThus, `generate` must also accept a list as input, in which case it should generate each element of the list, and then append them all together.\nIn the following, the first clause in `generate` handles this case, while the second clause handles (1) and the third handles (2).\nNote that we used the `mappend` function from section 1.7 (page 18).\n\n```lisp\n(defun generate (phrase)\n  \"Generate a random sentence or phrase\"\n  (cond ((listp phrase)\n         (mappend #'generate phrase))\n        ((rewrites phrase)\n         (generate (random-elt (rewrites phrase))))\n        (t (list phrase))))\n```\n\nLike many of the programs in this book, this function is short, but dense with information: the craft of programming includes knowing what *not* to write, as well as what to write.\n\nThis style of programming is called *data-driven* programming, because the data (the list of rewrites associated with a category) drives what the program does next.\nIt is a natural and easy-to-use style in Lisp, leading to concise and extensible programs, because it is always possible to add a new piece of data with a new association without having to modify the original program.\n\nHere are some examples of `generate` in use:\n\n```lisp\n> (generate 'sentence) => (THE TABLE SAW THE BALL)\n\n> (generate 'sentence) => (THE WOMAN HIT A TABLE)\n\n> (generate 'noun-phrase) => (THE MAN)\n\n> (generate 'verb-phrase) => (TOOK A TABLE)\n```\n\nThere are many possible ways to write `generate`.\nThe following version uses `if` instead of `cond`:\n\n```lisp\n(defun generate (phrase)\n  \"Generate a random sentence or phrase\"\n  (if (listp phrase)\n      (mappend #'generate phrase)\n      (let ((choices (rewrites phrase)))\n        (if (null choices)\n            (list phrase)\n            (generate (random-elt choices))))))\n```\n\nThis version uses the special form `let`, which introduces a new variable (in this case, `choices`) and also binds the variable to a value.\nIn this case, introducing the variable saves us from calling the function `rewrites` twice, as was done in the `cond` version of `generate`.\nThe general form of a `let` form is:\n\n```lisp\n    `(let` ((*var value*)...)\n        *body-containing-vars*)\n```\n\n`let` is the most common way of introducing variables that are not parameters of functions.\nOne must resist the temptation to use a variable without introducing it:\n\n```lisp\n(defun generate (phrase)\n  (setf choices ...)         ;; wrong!\n  ... choices ...)\n```\nThis is wrong because the symbol `choices` now refers to a special or global variable, one that may be shared or changed by other functions.\nThus, the function `generate` is not reliable, because there is no guarantee that `choices` will retain the same value from the time it is set to the time it is referenced again.\nWith `let` we introduce a brand new variable that nobody else can access; therefore it is guaranteed to maintain the proper value.\n\n&#9635; **Exercise  2.1 [m]** Write a version of `generate` that uses `cond` but avoids calling `rewrites` twice.\n\n&#9635; **Exercise  2.2 [m]** Write a version of `generate` that explicitly differentiates between terminal symbols (those with no rewrite rules) and nonterminal symbols.\n\n## 2.4 Two Paths to Follow\n\nThe two versions of the preceding program represent two alternate approaches that come up time and time again in developing programs: (1) Use the most straightforward mapping of the problem description directly into Lisp code.\n(2) Use the most natural notation available to solve the problem, and then worry about writing an interpreter for that notation.\n\nApproach (2) involves an extra step, and thus is more work for small problems.\nHowever, programs that use this approach are often easier to modify and expand.\nThis is especially true in a domain where there is a lot of data to account for.\nThe grammar of natural language is one such domain-in fact, most AI problems fit this description.\nThe idea behind approach (2) is to work with the problem as much as possible in its own terms, and to minimize the part of the solution that is written directly in Lisp.\n\nFortunately, it is very easy in Lisp to design new notations-in effect, new programming languages.\nThus, Lisp encourages the construction of more robust programs.\nThroughout this book, we will be aware of the two approaches.\nThe reader may notice that in most cases, we choose the second.\n\n## 2.5 Changing the Grammar without Changing the Program\n\nWe show the utility of approach (2) by defining a new grammar that includes adjectives, prepositional phrases, proper names, and pronouns.\nWe can then apply the `generate` function without modification to this new grammar.\n\n```lisp\n(defparameter *bigger-grammar*\n  '((sentence -> (noun-phrase verb-phrase))\n    (noun-phrase -> (Article Adj* Noun PP*) (Name) (Pronoun))\n    (verb-phrase -> (Verb noun-phrase PP*))\n    (PP* -> () (PP PP*))\n    (Adj* -> () (Adj Adj*))\n    (PP -> (Prep noun-phrase))\n    (Prep -> to in by with on)\n    (Adj -> big little blue green adiabatic)\n    (Article -> the a)\n    (Name -> Pat Kim Lee Terry Robin)\n    (Noun -> man ball woman table)\n    (Verb -> hit took saw liked)\n    (Pronoun -> he she it these those that)))\n\n(setf *grammar* *bigger-grammar*)\n\n> (generate 'sentence)\n(A TABLE ON A TABLE IN THE BLUE ADIABATIC MAN SAW ROBIN\n WITH A LITTLE WOMAN)\n\n> (generate 'sentence)\n(TERRY SAW A ADIABATIC TABLE ON THE GREEN BALL BY THAT WITH KIM\n IN THESE BY A GREEN WOMAN BY A LITTLE ADIABATIC TABLE IN ROBIN\n ON LEE)\n\n> (generate 'sentence)\n(THE GREEN TABLE HIT IT WITH HE)\n```\n\nNotice the problem with case agreement for pronouns: the program generated \"with he,\" although \"with him\" is the proper grammatical form.\nAlso, it is clear that the program does not distinguish sensible from silly output.\n\n## 2.6 Using the Same Data for Several Programs\n\nAnother advantage of representing information in a declarative form-as rules or facts rather than as Lisp functions-is that it can be easier to use the information for multiple purposes.\nSuppose we wanted a function that would generate not just the list of words in a sentence but a representation of the complete syntax of a sentence.\nFor example, instead of the list `(a woman took a ball)`, we want to get the nested list:\n\n```lisp\n(SENTENCE (NOUN-PHRASE (ARTICLE A) (NOUN WOMAN))\n          (VERB-PHRASE (VERB TOOK)\n                       (NOUN-PHRASE (ARTICLE A) (NOUN BALL))))\n```\n\nThis corresponds to the tree that linguists draw as in figure 2.1.\n\n| <a id=\"fig-02-01\"></a>[]() |\n|---|\n| <img src=\"images/chapter2/fig-02-01.svg\" onerror=\"this.src='images/chapter2/fig-02-01.png'; this.onerror=null;\" alt=\"Figure 2.1\" /> |\n| **Figure 2.1: Sentence Parse Tree** |\n\nUsing the \"straightforward functions\" approach we would be stuck; we'd have to rewrite every function to generate the additional structure.\nWith the \"new notation\" approach we could keep the grammar as it is and just write one new function: a version of `generate` that produces nested lists.\nThe two changes are to `cons` the category onto the front of each rewrite, and then not to `append` together the results but rather just list them with `mapcar`:\n\n```lisp\n(defun generate-tree (phrase)\n  \"Generate a random sentence or phrase,\n  with a complete parse tree.\"\n  (cond ((listp phrase)\n         (mapcar #'generate-tree phrase))\n        ((rewrites phrase)\n         (cons phrase\n               (generate-tree (random-elt (rewrites phrase)))))\n        (t (list phrase))))\n```\n\nHere are some examples:\n\n```lisp\n> (generate-tree 'Sentence)\n(SENTENCE (NOUN-PHRASE (ARTICLE A)\n                       (ADJ*)\n                       (NOUN WOMAN)\n                       (PP*))\n      (VERB-PHRASE (VERB HIT)\n                       (NOUN-PHRASE (PRONOUN HE))\n                       (PP*)))\n\n> (generate-tree 'Sentence)\n(SENTENCE (NOUN-PHRASE (ARTICLE A)\n                       (NOUN WOMAN))\n          (VERB-PHRASE (VERB TOOK)\n                       (NOUN-PHRASE (ARTICLE A) (NOUN BALL))))\n```\n\nAs another example of the one-data/multiple-program approach, we can develop a function to generate all possible rewrites of a phrase.\nThe function `generate-all` returns a list of phrases rather than just one, and we define an auxiliary function, `combine-all`, to manage the combination of results.\nAlso, there are four cases instead of three, because we have to check for nil explicitly.\nStill, the complete program is quite simple:\n\n```lisp\n(defun generate-all (phrase)\n  \"Generate a list of all possible expansions of this phrase.\"\n  (cond ((null phrase) (list nil))\n        ((listp phrase)\n         (combine-all (generate-all (first phrase))\n                      (generate-all (rest phrase))))\n        ((rewrites phrase)\n         (mappend #'generate-all (rewrites phrase)))\n        (t (list (list phrase)))))\n\n(defun combine-all (xlist ylist)\n  \"Return a list of lists formed by appending a y to an x.\n  E.g., (combine-all '((a) (b)) '((1) (2)))\n  -> ((A 1) (B 1) (A 2) (B 2)).\"\n  (mappend #'(lambda (y)\n               (mapcar #'(lambda (x) (append x y)) xlist))\n           ylist))\n```\n\nWe can now use `generate-all` to test our original little grammar.\nNote that a serious drawback of `generate-all` is that it can't deal with recursive grammar rules like 'Adj\\* => Adj + Adj\\*' that appear in `*bigger-grammar*,` since these lead to an infinite number of outputs.\nBut it works fine for finite languages, like the language generated by `*simple-grammar*`:\n\n```lisp\n> (generate-all 'Article)\n\n((THE) (A))\n\n> (generate-all 'Noun)\n\n((MAN) (BALL) (WOMAN) (TABLE))\n\n> (generate-all 'noun-phrase)\n((A MAN) (A BALL) (A WOMAN) (A TABLE)\n (THE MAN) (THE BALL) (THE WOMAN) (THE TABLE))\n\n> (length (generate-all 'sentence))\n256\n```\n\nThere are 256 sentences because every sentence in this language has the form Article-Noun-Verb-Article-Noun, and there are two articles, four nouns and four verbs (2 x 4 x 4 x 2 x 4 = 256).\n\n## 2.7 Exercises\n\n&#9635; **Exercise  2.3 [h]** Write a trivial grammar for some other language.\nThis can be a natural language other than English, or perhaps a subset of a computer language.\n\n&#9635; **Exercise  2.4 [m]** One way of describing `combine-all` is that it calculates the cross-product of the function `append` on the argument lists.\nWrite the higher-order function `cross-product`, and define `combine-all` in terms of it.\n\nThe moral is to make your code as general as possible, because you never know what you may want to do with it next.\n\n## 2.8 Answers\n\n### Answer 2.1\n\n```lisp\n  (defun generate (phrase)\n  \"Generate a random sentence or phrase\"\n  (let ((choices nil))\n    (cond ((listp phrase)\n        (mappend #'generate phrase))\n       ((setf choices (rewrites phrase))\n        (generate (random-elt choices)))\n       (t (list phrase)))))\n```\n\n### Answer 2.2\n\n```lisp\n(defun generate (phrase)\n  \"Generate a random sentence or phrase\"\n  (cond ((listp phrase)\n         (mappend #'generate phrase))\n        ((non-terminal-p phrase)\n         (generate (random-elt (rewrites phrase))))\n        (t (list phrase))))\n\n(defun non-terminal-p (category)\n  \"True if this is a category in the grammar.\"\n  (not (null (rewrites category))))\n```\n\n### Answer 2.4\n\n```lisp\n(defun cross-product (fn xlist ylist)\n  \"Return a list of all (fn x y) values.\"\n  (mappend #'(lambda (y)\n               (mapcar #'(lambda (x) (funcall fn x y))\n                       xlist))\n           ylist))\n\n(defun combine-all (xlist ylist)\n  \"Return a list of lists formed by appending a y to an x\"\n  (cross-product #'append xlist ylist))\n```\n\nNow we can use the `cross-product` in other ways as well:\n\n```\n> (cross-product #'+ '(1 2 3) '(10 20 30))\n(11 12 13\n 21 22 23\n 31 32 33)\n\n> (cross-product #'list '(a b c d e f g h)\n                        '(1 2 3 4 5 6 7 8))\n((A 1) (B 1) (C 1) (D 1) (E 1) (F 1) (G 1) (H 1)\n (A 2) (B 2) (C 2) (D 2) (E 2) (F 2) (G 2) (H 2)\n (A 3) (B 3) (C 3) (D 3) (E 3) (F 3) (G 3) (H 3)\n (A 4) (B 4) (C 4) (D 4) (E 4) (F 4) (G 4) (H 4)\n (A 5) (B 5) (C 5) (D 5) (E 5) (F 5) (G 5) (H 5)\n (A 6) (B 6) (C 6) (D 6) (E 6) (F 6) (G 6) (H 6)\n (A 7) (B 7) (C 7) (D 7) (E 7) (F 7) (G 7) (H 7)\n (A 8) (B 8) (C 8) (D 8) (E 8) (F 8) (G 8) (H 8))\n```\n\n----------------------\n\n<a id=\"fn02-1\"></a><sup>[1](#tfn02-1)</sup>\nWe will soon see \"Kleene plus\" notation, wherein *PP+* denotes one or more repetition of *PP*.\n"
  },
  {
    "path": "docs/chapter20.md",
    "content": "# Chapter 20\n## Unification Grammars\n\nProlog was invented because Alain Colmerauer wanted a formalism to describe the grammar of French.\nHis intuition was that the combination of Horn clauses and unification resulted in a language that was just powerful enough to express the kinds of constraints that show up in natural languages, while not as powerful as, for example, full predicate calculus.\nThis lack of power is important, because it enables efficient implementation of Prolog, and hence of the language-analysis programs built on top of it.\n\nOf course, Prolog has evolved and is now used for many applications besides natural language, but Colmerauer's underlying intuition remains a good one.\nThis chapter shows how to view a grammar as a set of logic programming clauses.\nThe clauses define what is a legal sentence and what isn't, without any explicit reference to the process of parsing or generation.\nThe amazing thing is that the clauses can be defined in a way that leads to a very efficient parser.\nFurthermore, the same grammar can be used for both parsing and generation (at least in some cases).\n\n## 20.1 Parsing as Deduction\n\nHere's how we could express the grammar rule \"A sentence can be composed of a noun phrase followed by a verb phrase\" in Prolog:\n\n```lisp\n(<- (S ?s)\n   (NP ?np)\n   (VP ?vp)\n   (concat ?np ?vp ?s))\n```\n\nThe variables represent strings of words.\nAs usual, they will be implemented as lists of symbols.\nThe rule says that a given string of words `?s` is a sentence if there is a string that is noun phrase and one that is a verb phrase, and if they can be concatenated to form `?s`.\nLogically, this is fine, and it would work as a program to generate random sentences.\nHowever, it is a very inefficient program for parsing sentences.\nIt will consider all possible noun phrases and verb phrases, without regard to the input words.\nOnly when it gets to the `concat` goal (defined on [page 411](chapter12.md#p411)) will it test to see if the two constituents can be concatenated together to make up the input string.\nThus, a better order of evaluation for parsing is:\n\n```lisp\n(<- (S ?s)\n   (concat ?np ?vp ?s)\n   (NP ?np)\n   (VP ?vp))\n```\n\nThe first version had `NP` and `VP` guessing strings to be verified by `concat`.\nIn most grammars, there will be a very large or infinite number of `NPs` and `VPs`.\nThis second version has `concat` guessing strings to be verified by `NP` and `VP`.\nIf there are *n* words in the sentence, then concat can only make *n* + 1 guesses, quite an improvement.\nHowever, it would be better still if we could in effect have `concat` and `NP` work together to make a more constrained guess, which would then be verified by `VP`.\n\nWe have seen this type of problem before.\nIn Lisp, the answer is to return multiple values.\n`NP` would be a function that takes a string as input and returns two values: an indication of success or failure, and a remainder string of words that have not yet been parsed.\nWhen the first value indicates success, then `VP` would be called with the remaining string as input.\nIn Prolog, return values are just extra arguments.\nSo each predicate will have two parameters: an input string and a remainder string.\nFollowing the usual Prolog convention, the output parameter comes after the input.\nIn this approach, no calls to concat are necessary, no wild guesses are made, and Prolog's backtracking takes care of the necessary guessing:\n\n```lisp\n(<- (S ?s0 ?s2)\n       (NP ?s0 ?sl)\n       (VP ?sl ?s2))\n```\n\nThis rule can be read as \"The string from *s*<sub>0</sub> to *s*<sub>2</sub> is a sentence if there is an *s*<sub>1</sub> such that the string from s<sub>0</sub> to *s*<sub>1</sub> is a noun phrase and the string from *s*<sub>1</sub> to *s*<sub>2</sub> is a verb phrase.\"\n\nA sample query would be `(?- (S (The boy ate the apple) ())).` With suitable definitions of `NP` and `VP`, this would succeed, with the following bindings holding within `S`:\n\n```lisp\n?s0 = (The boy ate the apple)\n?sl =         (ate the apple)\n?s2 =                      ()\n```\n\nAnother way of reading the goal `(NP ?s0 ?sl)`, for example, is as \"`IS` the list `?s0` minus the list `?sl` a noun phrase?\" In this case, `?s0` minus `?sl` is the list `(The boy)`.\nThe combination of two arguments, an input list and an output list, is often called a *difference list*, to emphasize this interpretation.\nMore generally, the combination of an input parameter and output parameter is called an *accumulator.*\nAccumulators, particularly difference lists, are an important technique throughout logic programming and are also used in functional programming, as we saw on [page 63](chapter3.md#p63).\n\nIn our rule for `S`, the concatenation of difference lists was implicit.\nIf we prefer, we could define a version of `concat` for difference lists and call it explicitly:\n\n```lisp\n(<- (S ?s-in ?s-rem)\n       (NP ?np-in ?np-rem)\n       (VP ?vp-in ?vp-rem)\n       (concat ?np-in ?np-rem ?vp-in ?vp-rem ?s-in ?s-rem))\n(<- (concat ?a ?b ?b ?c ?a ?c))\n```\n\nBecause this version of `concat` has a different arity than the old version, they can safely coexist.\nIt states the difference list equation *(a - b) + (b - c) = (a - c)*.\n\nIn the last chapter we stated that context-free phrase-structure grammar is inconvenient for expressing things like agreement between the subject and predicate of a sentence.\nWith the Horn-clause-based grammar formalism we are developing here, we can add an argument to the predicates NP and VP to represent agreement.\nIn English, the agreement rule does not have a big impact.\nFor all verbs except *be,* the difference only shows up in the third-person singular of the present tense:\n\n|               | Singular |        | Plural |       |\n|---------------|----------|--------|--------|-------|\n| first person  | I        | sleep  | we     | sleep |\n| second person | you      | sleep  | you    | sleep |\n| third person  | he/she   | sleeps | they   | sleep |\n\nThus, the agreement argument will take on one of the two values `3sg` or `~3sg` to indicate third-person-singular or not-third-person-singular.\nWe could write:\n\n```lisp\n(<- (S ?s0 ?s2)\n       (NP ?agr ?s0 ?sl)\n       (VP ?agr ?sl ?s2))\n(<- (NP 3sg (he . ?s) ?s))\n(<- (NP ~3sg (they . ?s) ?s))\n(<- (VP 3sg (sleeps . ?s) ?s))\n(<- (VP ~3sg (sleep . ?s) ?s))\n```\n\nThis grammar parses just the right sentences:\n\n```lisp\n> (?- (S (He sleeps) ()))\nYes.\n> (?- (S (He sleep) ()))\nNo.\n```\n\nLet's extend the grammar to allow common nouns as well as pronouns:\n\n```lisp\n(<- (NP ?agr ?s0 ?s2)\n       (Det ?agr ?s0 ?sl)\n       (N ?agr ?sl ?s2))\n(<- (Det ?any (the . ?s) ?s))\n(<- (N 3sg (boy . ?s) ?s))\n(<- (N 3sg (girl . ?s) ?s))\n```\n\nThe same grammar rules can be used to generate sentences as well as parse.\nHere are all possible sentences in this trivial grammar:\n\n```lisp\n> (?- (S ?words ()))\n?WORDS = (HE SLEEPS);\n?WORDS = (THEY SLEEP);\n?WORDS = (THE BOY SLEEPS);\n?WORDS = (THE GIRL SLEEPS);\nNo.\n```\n\nSo far all we have is a recognizer: a predicate that can separate sentences from nonsentences.\nBut we can add another argument to each predicate to build up the semantics.\nThe result is not just a recognizer but a true parser:\n\n```lisp\n(<- (S (?pred ?subj) ?s0 ?s2)\n       (NP ?agr ?subj ?s0 ?sl)\n        (VP ?agr ?pred ?sl ?s2))\n(<- (NP 3sg (the male) (he . ?s) ?s))\n(<- (NP ~3sg (some objects) (they . ?s) ?s))\n(<- (NP ?agr (?det ?n) ?s0 ?s2)\n        (Det ?agr ?det ?s0 ?sl)\n        (N ?agr ?n ?sl ?s2))\n(<- (VP 3sg sleep (sleeps . ?s) ?s))\n(<- (VP ~3sg sleep (sleep . ?s) ?s))\n(<- (Det ?any the (the . ?s) ?s))\n(<- (N 3sg (young male human) (boy . ?s) ?s))\n(<- (N 3sg (young female human) (girl . ?s) ?s))\n```\n\nThe semantic translations of individual words is a bit capricious.\nIn fact, it is not too important at this point if the translation of `boy` is `(young male human)` or just `boy`.\nThere are two properties of a semantic representation that are important.\nFirst, it should be unambiguous.\nThe representation of *orange* the fruit should be different from *orange* the color (although the representation of the fruit might well refer to the color, or vice versa).\nSecond, it should express generalities, or allow them to be expressed elsewhere.\nSo either *sleep* and *sleeps* should have the same or similar representation, or there should be an inference rule relating them.\nSimilarly, if the representation of *boy* does not say so explicitly, there should be some other rule saying that a boy is a male and a human.\n\nOnce the semantics of individual words is decided, the semantics of higher-level categories (sentences and noun phrases) is easy.\nIn this grammar, the semantics of a sentence is the application of the predicate (the verb phrase) to the subject (the noun phrase).\nThe semantics of a compound noun phrase is the application of the determiner to the noun.\n\nThis grammar returns the semantic interpretation but does not build a syntactic tree.\nThe syntactic structure is implicit in the sequence of goals: `S` calls `NP` and `VP`, and `NP` can call `Det` and `N`.\nIf we want to make this explicit, we can provide yet another argument to each nonterminal:\n\n```lisp\n(<- (S (?pred ?subj) (s ?np ?vp) ?s0 ?s2)\n       (NP ?agr ?subj ?np ?s0 ?sl)\n        (VP ?agr ?pred ?vp ?sl ?s2))\n(<- (NP 3sg (the male) (np he) (he . ?s) ?s))\n(<- (NP ~3sg (some objects) (np they) (they . ?s) ?s))\n(<- (NP ?agr (?det ?n) (np ?det-syn ?n-syn)?s0 ?s2)\n        (Det ?agr ?det ?det-syn ?s0 ?sl)\n        (N ?agr ?n ?n-syn ?sl ?s2))\n(<- (VP 3sg sleep (vp sleeps)(sleeps . ?s) ?s))\n(<- (VP ~3sg sleep (vp sleep) (sleep . ?s) ?s))\n(<- (Det ?any the (det the) (the . ?s) ?s))\n(<- (N 3sg (young male human) (n boy) (boy . ?s) ?s))\n(<- (N 3sg (young female human) (n girl) (girl . ?s) ?s))\n```\n\nThis grammar can still be used to parse or generate sentences, or even to enumerate all syntax/semantics/sentence triplets:\n\n```lisp\n;; Parsing:\n> (?- (S ?sem ?syn (He sleeps) ()))\n?SEM = (SLEEP (THE MALE))\n?SYN = (S (NP HE) (VP SLEEPS)).\n;; Generating:\n> (?- (S (sleep (the male)) ? ?words ()))\n?WORDS = (HE SLEEPS)\n;; Enumerating:\n> (?- (S ?sem ?syn ?words ()))\n?SEM = (SLEEP (THE MALE))\n?SYN = (S (NP HE) (VP SLEEPS))\n?WORDS = (HE SLEEPS);\n?SEM = (SLEEP (SOME OBJECTS))\n?SYN = (S (NP THEY) (VP SLEEP))\n?WORDS = (THEY SLEEP);\n?SEM = (SLEEP (THE (YOUNG MALE HUMAN)))\n?SYN = (S (NP (DET THE) (N BOY)) (VP SLEEPS))\n?WORDS = (THE BOY SLEEPS);\n?SEM = (SLEEP (THE (YOUNG FEMALE HUMAN)))\n?SYN = (S (NP (DET THE) (N GIRL)) (VP SLEEPS))\n?WORDS = (THE GIRL SLEEPS);\nNo.\n```\n\n## 20.2 Definite Clause Grammars\n\nWe now have a powerful and efficient tool for parsing sentences.\nHowever, it is getting to be a very messy tool-there are too many arguments to each goal, and it is hard to tell which arguments represent syntax, which represent semantics, which represent in/out strings, and which represent other features, like agreement.\nSo, we will take the usual step when our bare programming language becomes messy: define a new language.\n\nEdinburgh Prolog recognizes assertions called *definite clause grammar* (DCG) rules.\nThe term *definite clause* is just another name for a Prolog clause, so DCGs are also called \"logic grammars.\" They could have been called \"Horn clause grammars\" or \"Prolog grammars\" as well.\n\nDCG rules are clauses whose main functor is an arrow, usually written `-->`.\nThey compile into regular Prolog clauses with extra arguments.\nIn normal DCG rules, only the string arguments are automatically added.\nBut we will see later how this can be extended to add other arguments automatically as well.\n\nWe will implement DCG rules with the macro `rule` and an infix arrow.\nThus, we want the expression:\n\n```lisp\n(rule (S) --> (NP) (VP))\n```\n\nto expand into the clause:\n\n```lisp\n(<- (S ?s0 ?s2)\n       (NP ?s0 ?sl)\n       (VP ?sl ?s2))\n```\n\nWhile we're at it, we may as well give `rule` the ability to deal with different types of rules, each one represented by a different type of arrow.\nHere's the `rule` macro:\n\n```lisp\n(defmacro rule (head &optional (arrow ':-) &body body)\n  \"Expand one of several types of logic rules into pure Prolog.\"\n  ;; This is data-driven, dispatching on the arrow\n  (funcall (get arrow 'rule-function) head body))\n```\n\nAs an example of a rule function, the arrow `:-` will be used to represent normal Prolog clauses.\nThat is, the form (`rule` *head* `:-` *body*) will be equivalent to (`<-` *head body*).\n\n```lisp\n(setf (get ':- 'rule-function)\n      #'(lambda (head body) `(<- ,head .,body)))\n```\n\nBefore writing the rule function for DCG rules, there are two further features of the DCG formalism to consider.\nFirst, some goals in the body of a rule may be normal Prolog goals, and thus do not require the extra pair of arguments.\nIn Edinburgh Prolog, such goals are surrounded in braces.\nOne would write:\n\n```lisp\ns(Sem) --> np(Subj), vp(Pred),\n           {combine(Subj,Pred,Sem)}.\n```\n\nwhere the idea is that `combine` is not a grammatical constituent, but rather a Prolog predicate that could do some calculations on `Subj` and `Pred` to arrive at the proper semantics, `Sem`.\nWe will mark such a test predicate not by brackets but by a list headed by the keyword `:test`, as in:\n\n```lisp\n(rule (S ?sem) --> (NP ?subj) (VP ?pred)\n   (:test (combine ?subj ?pred ?sem)))\n```\n\nSecond, we need some way of introducing individual words on the right-hand side, as opposed to categories of words.\nIn Prolog, brackets are used to represent a word or list of words on the right-hand side:\n\n```lisp\nverb --> [sleeps].\n```\n\nWe will use a list headed by the keyword `:word:`\n\n```lisp\n(rule (NP (the male) 3sg) --> (:word he))\n(rule (VP sleeps 3sg) --> (:word sleeps))\n```\n\nThe following predicates test for these two special cases.\nNote that the cut is also allowed as a normal goal.\n\n```lisp\n(defun dcg-normal-goal-p (x) (or (starts-with x :test) (eq x '!)))\n\n(defun dcg-word-list-p (x) (starts-with x ':word))\n```\n\nAt last we are in a position to present the rule function for DCG rules.\nThe function `make-dcg` inserts variables to keep track of the strings that are being parsed.\n\n```lisp\n(setf (get '--> 'rule-function) 'make-dcg)\n\n(defun make-dcg (head body)\n  (let ((n (count-if (complement #'dcg-normal-goal-p) body)))\n    `(<- (,@head ?s0 ,(symbol '?s n))\n         .,(make-dcg-body body 0))))\n\n(defun make-dcg-body (body n)\n  \"Make the body of a Definite Clause Grammar (DCG) clause.\n  Add ?string-in and -out variables to each constituent.\n  Goals like (:test goal) are ordinary Prolog goals,\n  and goals like (:word hello) are literal words to be parsed.\"\n  (if (null body)\n      nil\n      (let ((goal (first body)))\n        (cond\n          ((eq goal '!) (cons '! (make-dcg-body (rest body) n)))\n          ((dcg-normal-goal-p goal)\n           (append (rest goal)\n                   (make-dcg-body (rest body) n)))\n          ((dcg-word-list-p goal)\n           (cons\n             `(= ,(symbol '?s n)\n                 (,@(rest goal) .,(symbol '?s (+ n 1))))\n             (make-dcg-body (rest body) (+ n 1))))\n          (t (cons\n               (append goal\n                       (list (symbol '?s n)\n                             (symbol '?s (+ n 1))))\n               (make-dcg-body (rest body) (+ n 1))))))))\n```\n\n**Exercise  20.1 [m]** `make-dcg` violates one of the cardinal rules of macros.\nWhat does it do wrong?\nHow would you fix it?\n\n## 20.3 A Simple Grammar in DCG Format\n\nHere is the trivial grammar from [page 688](chapter20.xhtml#p688) in DCG format.\n\n```lisp\n(rule (S (?pred ?subj)) -->\n   (NP ?agr ?subj)\n   (VP ?agr ?pred))\n(rule (NP ?agr (?det ?n)) -->\n   (Det ?agr ?det)\n   (N ?agr ?n))\n(rule (NP 3sg (the male))          --> (:word he))\n(rule (NP ~3sg (some objects))      --> (:word they))\n(rule (VP 3sg sleep)               --> (:word sleeps))\n(rule (VP ~3sg sleep)               --> (:word sleep))\n(rule (Det ?any the)               --> (:word the))\n(rule (N 3sg (young male human))   --> (:word boy))\n(rule (N 3sg (young female human)) --> (:word girl))\n```\n\nThis grammar is quite limited, generating only four sentences.\nThe first way we will extend it is to allow verbs with objects: in addition to \"The boy sleeps,\" we will allow \"The boy meets the girl.\" To avoid generating ungrammatical sentences like \"* The boy meets,\"<a id=\"tfn20-1\"></a><sup>[1](#fn20-1)</sup> we will separate the category of verb into two *subcategories*: transitive verbs, which take an object, and intransitive verbs, which don't.\n\nTransitive verbs complicate the semantic interpretation of sentences.\nWe would like the interpretation of \"Terry kisses Jean\" to be `(kiss Terry Jean)`.\nThe interpretation of the noun phrase \"Terry\" is just `Terry`, but then what should the interpretation of the verb phrase \"kisses Jean\" be?\nTo fit our predicate application model, it must be something equivalent to `(lambda (x) (kiss x Jean))`.\nWhen applied to the subject, we want to get the simplification:\n\n```lisp\n((lambda (x) (kiss x Jean)) Terry) => (kiss Terry Jean)\n```\n\nSuch simplification is not done automatically by Prolog, but we can write a predicate to do it.\nWe will call it `funcall`, because it is similar to the Lisp function of that name, although it only handles replacement of the argument, not full evaluation of the body.\n(Technically, this is the lambda-calculus operation known as *beta-reduction.)* The predicate `funcall` is normally used with two input arguments, a function and its argument, and one output argument, the resulting reduction:\n\n```lisp\n(<- (funcall (lambda (?x) ?body) ?x ?body))\n```\n\nWith this we could write our rule for sentences as:\n\n```lisp\n(rule (S ?sem) -->\n   (NP ?agr ?subj)\n   (VP ?agr ?pred)\n   (:test (funcall ?pred ?subj ?sem)))\n```\n\nAn alternative is to, in effect, compile away the call to `funcall`.\nInstead of having the semantic representation of `VP` be a single lambda expression, we can represent it as two arguments: an input argument, `?subj`, which acts as a parameter to the output argument, `?pred`, which takes the place of the body of the lambda expression.\nBy explicitly manipulating the parameter and body, we can eliminate the call to `funcall`.\nThe trick is to make the parameter and the subject one and the same:\n\n```lisp\n(rule (S ?pred) -->\n   (NP ?agr ?subj)\n   (VP ?agr ?subj ?pred))\n```\n\nOne way of reading this rule is \"To parse a sentence, parse a noun phrase followed by a verb phrase.\nIf they have different agreement features then fail, but otherwise insert the interpretation of the noun phrase, `?subj`, into the proper spot in the interpretation of the verb phrase, `?pred`, and return `?pred` as the final interpretation of the sentence.\"\n\nThe next step is to write rules for verb phrases and verbs.\nTransitive verbs are listed under the predicate `Verb/tr`, and intransitive verbs are listed as `Verb/intr`.\nThe semantics of tenses (past and present) has been ignored.\n\n```lisp\n(rule (VP ?agr ?subj ?pred) -->\n   (Verb/tr ?agr ?subj ?pred ?obj)\n   (NP ?any-agr ?obj))\n(rule (VP ?agr ?subj ?pred) -->\n   (Verb/intr ?agr ?subj ?pred))\n(rule (Verb/tr ~3sg ?x (kiss ?x ?y) ?y) --> (:word kiss))\n(rule (Verb/tr 3sg ?x (kiss ?x ?y) ?y) --> (:word kisses))\n(rule (Verb/tr ?any ?x (kiss ?x ?y) ?y) --> (:word kissed))\n(rule (Verb/intr ~3sg ?x (sleep ?x)) --> (:word sleep))\n(rule (Verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps))\n(rule (Verb/intr ?any ?x (sleep ?x)) --> (:word slept))\n```\n\nHere are the rules for noun phrases and nouns:\n\n```lisp\n(rule (NP ?agr ?sem) -->\n   (Name ?agr ?sem))\n(rule (NP ?agr (?det-sem ?noun-sem)) -->\n   (Det ?agr ?det-sem)\n   (Noun ?agr ?noun-sem))\n(rule (Name 3sg Terry) --> (:word Terry))\n(rule (Name 3sg Jean) --> (:word Jean))\n(rule (Noun 3sg (young male human)) --> (:word boy))\n(rule (Noun 3sg (young female human)) --> (:word girl))\n(rule (Noun ~3sg (group (young male human))) --> (:word boys))\n(rule (Noun ~3sg (group (young female human))) --> (:word girls))\n(rule (Det ?any the) --> (:word the))\n(rule (Det 3sg a) --> (:word a))\n```\n\nThis grammar and lexicon generates more sentences, although it is still rather limited.\nHere are some examples:\n\n```lisp\n> (?- (S ?sem (The boys kiss a girl) ()))\n?SEM = (KISS (THE (GROUP (YOUNG MALE HUMAN)))\n                       (A (YOUNG FEMALE HUMAN))).\n> (?- (S ?sem (The girls kissed the girls) ()))\n?SEM = (KISS (THE (GROUP (YOUNG FEMALE HUMAN)))\n                       (THE (GROUP (YOUNG FEMALE HUMAN)))).\n> (?- (S ?sem (Terry kissed the girl) ()))\n?SEM = (KISS TERRY (THE (YOUNG FEMALE HUMAN))).\n> (?- (S ?sem (The girls kisses the boys) ()))\nNo.\n> (?- (S ?sem (Terry kissed a girls) ()))\nNo.\n> (?- (S ?sem (Terry sleeps Jean) ()))\nNo.\n```\n\nThe first three examples are parsed correctly, while the final three are correctly rejected.\nThe inquisitive reader may wonder just what is going on in the interpretation of a sentence like \"The girls kissed the girls.\" Do the subject and object represent the same group of girls, or different groups?\nDoes everyone kiss everyone, or are there fewer kissings going on?\nUntil we define our representation more carefully, there is no way to tell.\nIndeed, it seems that there is a potential problem in the representation, in that the predicate `kiss` sometimes has individuals as its arguments, and sometimes groups.\nMore careful representations of \"The girls kissed the girls\" include the following candidates, using predicate calculus:\n\n> &forall;`x`&forall;`y x` &isin; `girls` &and; `y` &isin; `girls => kiss(x,y)`\n\n> &forall;`x` &forall;`y x` &isin; `girls` &and; `y`&epsilon;`girls` &and; `x`&ne;`y => kiss(x,y)`\n\n> &forall;`x`&exist;`y,z x`&isin; `girls` &and; `y`&isin; `girls` &and; `z`&isin; `girls => kiss(x,y)` &and; `kiss(z,x)`\n\n> &forall;`x`&exist;`y x`&isin; `girls` &and; `y`&isin; `girls => kiss(x,y)`&or; `kiss(y,x)`\n\nThe first of these says that every girl kisses every other girl.\nThe second says the same thing, except that a girl need not kiss herself.\nThe third says that every girl kisses and is kissed by at least one other girl, but not necessarily all of them, and the fourth says that everybody is in on at least one kissing.\nNone of these interpretations says anything about who \"the girls\" are.\n\nClearly, the predicate calculus representations are less ambiguous than the representation produced by the current system.\nOn the other hand, it would be wrong to choose one of the representations arbitrarily, since in different contexts, \"The girls kissed the girls\" can mean different things.\nMaintaining ambiguity in a concise form is useful, as long as there is some way eventually to recover the proper meaning.\n\n## 20.4 A DCG Grammar with Quantifiers\n\nThe problem in the representation we have been using becomes more acute when we consider other determiners, such as \"every.\" Consider the sentence \"Every picture paints a story.\" The preceding DCG, if given the right vocabulary, would produce the interpretation:\n\n```lisp\n(paints (every picture) (a story))\n```\n\nThis can be considered ambiguous between the following two meanings, in predicate calculus form:\n\n&forall; x picture(x) => &exist; y story(y) &and; paint(x,y)\n\n&exist; y story (y) &and; &forall; x picture(x) => paint(x,y)\n\nThe first says that for each picture, there is a story that it paints.\nThe second says that there is a certain special story that every picture paints.\nThe second is an unusual interpretation for this sentence, but for \"Every U.S.\ncitizen has a president,\" the second interpretation is perhaps the preferred one.\nIn the next section, we will see how to produce representations that can be transformed into either interpretation.\nFor now, it is a useful exercise to see how we could produce just the first representation above, the interpretation that is usually correct.\nFirst, we need to transcribe it into Lisp:\n\n```lisp\n(all ?x (-> (picture ?x) (exists ?y (and (story ?y) (paint ?x ?y)))))\n```\n\nThe first question is how the `all` and `exists` forms get in there.\nThey must come from the determiners, \"every\" and \"a.\" Also, it seems that `all` is followed by an implication arrow, `->`, while `exists` is followed by a conjunction, `and`.\nSo the determiners will have translations looking like this:\n\n```lisp\n(rule (Det ?any ?x ?p ?q (the ?x (and ?p ?q)))   --> (:word the))\n(rule (Det 3sg ?x ?p ?q (exists ?x (and ?p ?q))) --> (:word a))\n(rule (Det 3sg ?x ?p ?q (all ?x (-> ?p ?q)))     --> (:word every))\n```\n\nOnce we have accepted these translations of the determiners, everything else follows.\nThe formulas representing the determiners have two holes in them, `?p` and `?q`.\nThe first will be filled by a predicate representing the noun, and the latter will be filled by the predicate that is being applied to the noun phrase as a whole.\nNotice that a curious thing is happening.\nPreviously, translation to logical form was guided by the sentence's verb.\nLinguisticly, the verb expresses the main predicate, so it makes sense that the verb's logical translation should be the main part of the sentence's translation.\nIn linguistic terms, we say that the verb is the *head* of the sentence.\n\nWith the new translations for determiners, we are in effect turning the whole process upside down.\nNow the subject's determiner carries the weight of the whole sentence.\nThe determiner's interpretation is a function of two arguments; it is applied to the noun first, yielding a function of one argument, which is in turn applied to the verb phrase's interpretation.\nThis primacy of the determiner goes against intuition, but it leads directly to the right interpretation.\n\nThe variables `?p` and `?q` can be considered holes to be filled in the final interpretation, but the variable `?x` fills a quite different role.\nAt the end of the parse, `?x` will not be filled by anything; it will still be a variable.\nBut it will be referred to by the expressions filling `?p` and `?q`.\nWe say that `?x` is a *metavariable,* because it is a variable in the representation, not a variable in the Prolog implementation.\nIt just happens that Prolog variables can be used to implement these metavariables.\n\nHere are the interpretations for each word in our target sentence and for each intermediate constituent:\n\n```lisp\nEvery          = (all ?x (-> ?pl ?ql))\npicture        = (picture ?x)\npaints         = (paint ?x ?y)\na              = (exists ?y (and ?p2 ?q2))\nstory          = (story ?y)\nEvery picture  = (all ?x (-> (picture ?x) ?ql))\na story        = (exists ?y (and (story ?y) ?q2))\npaints a story = (exists ?y (and (story ?y) (paint ?x ?y)))\n```\n\nThe semantics of a noun has to fill the `?p` hole of a determiner, possibly using the metavariable `?x`.\nThe three arguments to the Noun predicate are the agreement, the metavariable `?x`, and the assertion that the noun phrase makes about `?x`:\n\n```lisp\n(rule (Noun 3sg ?x (picture ?x)) --> (:word picture))\n(rule (Noun 3sg ?x (story ?x)) --> (:word story))\n(rule (Noun 3sg ?x (and (young ?x) (male ?x) (human ?x))) -->\n   (:word boy))\n```\n\nThe NP predicate is changed to take four arguments.\nFirst is the agreement, then the metavariable `?x`.\nThird is a predicate that will be supplied externally, by the verb phrase.\nThe final argument returns the interpretation of the NP as a whole.\nAs we have stated, this comes from the determiner:\n\n```lisp\n(rule (NP ?agr ?x ?pred ?pred) -->\n   (Name ?agr ?name))\n;(rule (NP ?agr ?x ?pred ?np) -->\n; (Det ?agr ?x ?noun ?pred ?np)\n; (Noun ?agr ?x ?noun))\n```\n\nThe rule for an NP with determiner is commented out because it is convenient to introduce an extended rule to replace it at this point.\nThe new rule accounts for certain relative clauses, such as \"the boy that paints a picture\":\n\n```lisp\n(rule (NP ?agr ?x ?pred ?np) -->\n   (Det ?agr ?x ?noun&rel ?pred ?np)\n   (Noun ?agr ?x ?noun)\n   (rel-clause ?agr ?x ?noun ?noun&rel))\n(rule (rel-clause ?agr ?x ?np ?np) --> )\n(rule (rel-clause ?agr ?x ?np (and ?np ?rel)) -->\n   (:word that)\n   (VP ?agr ?x ?rel))\n```\n\nThe new rule does not account for relative clauses where the object is missing, such as \"the picture that the boy paints.\" Nevertheless, the addition of relative clauses means we can now generate an infinite language, since we can always introduce a relative clause, which introduces a new noun phrase, which in turn can introduce yet another relative clause.\n\nThe rules for relative clauses are not complicated, but they can be difficult to understand.\nOf the four arguments to `rel-clause,` the first two hold the agreement features of the head noun and the metavariable representing the head noun.\nThe last two arguments are used together as an accumulator for predications about the metavariable: the third argument holds the predications made so far, and the fourth will hold the predications including the relative clause.\nSo, the first rule for `rel-clause` says that if there is no relative clause, then what goes in to the accumulator is the same as what goes out.\nThe second rule says that what goes out is the conjunction of what comes in and what is predicated in the relative clause itself.\n\nVerbs apply to either one or two metavariables, just as they did before.\nSo we can use the definitions of `Verb/tr` and `Verb/intr` unchanged.\nFor variety, I've added a few more verbs:\n\n```lisp\n(rule (Verb/tr ~3sg ?x ?y (paint ?x ?y)) --> (:word paint))\n(rule (Verb/tr 3sg ?x ?y (paint ?x ?y)) --> (:word paints))\n(rule (Verb/tr ?any ?x ?y (paint ?x ?y)) --> (:word painted))\n(rule (Verb/intr ~3sg ?x (sleep ?x)) --> (:word sleep))\n(rule (Verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps))\n(rule (Verb/intr ?any ?x (sleep ?x)) --> (:word slept))\n(rule (Verb/intr 3sg ?x (sells ?x)) --> (:word sells))\n(rule (Verb/intr 3sg ?x (stinks ?x)) --> (:word stinks))\n```\n\nVerb phrases and sentences are almost as before.\nThe only difference is in the call to `NP`, which now has extra arguments:\n\n```lisp\n(rule (VP ?agr ?x ?vp) -->\n   (Verb/tr ?agr ?x ?obj ?verb)\n   (NP ?any-agr ?obj ?verb ?vp))\n(rule (VP ?agr ?x ?vp) -->\n   (Verb/intr ?agr ?x ?vp))\n(rule (S ?np) -->\n   (NP ?agr ?x ?vp ?np)\n   (VP ?agr ?x ?vp))\n```\n\nWith this grammar, we get the following correspondence between sentences and logical forms:\n\n```lisp\nEvery picture paints a story.\n(ALL ?3 (-> (PICTURE ?3)\n            (EXISTS ?14 (AND (STORY ?14) (PAINT ?3 ?14)))))\n\nEvery boy that paints a picture sleeps.\n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3))\n                 (EXISTS ?19 (AND (PICTURE ?19)\n                                  (PAINT ?3 ?19))))\n            (SLEEP ?3)))\n\nEvery boy that sleeps paints a picture.\n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3))\n                 (SLEEP ?3))\n            (EXISTS ?22 (AND (PICTURE ?22) (PAINT ?3 ?22)))))\n\nEvery boy that paints a picture that sells\npaints a picture that stinks.\n(ALL ?3 (-> (AND (AND (YOUNG ?3) (MALE ?3) (HUMAN ?3))\n                 (EXISTS ?19 (AND (AND (PICTURE ?19) (SELLS ?19))\n                                  (PAINT ?3 ?19))))\n            (EXISTS ?39 (AND (AND (PICTURE ?39) (STINKS ?39))\n                             (PAINT ?3 ?39)))))\n```\n\n## 20.5 Preserving Quantifier Scope Ambiguity\n\nConsider the simple sentence \"Every man loves a woman.\" This sentence is ambiguous between the following two interpretations:\n\n&forall;m&exist;w man(m) &and; woman(w) &and; loves(m,w)\n\n&exist;w&forall;m man(m) &and; woman(w) &and; loves(m,w)\n\nThe first interpretation is that every man loves some woman-his wife, perhaps.\nThe second interpretation is that there is a certain woman whom every man loves-Natassja Kinski, perhaps.\nThe meaning of the sentence is ambiguous, but the structure is not; there is only one syntactic parse.\n\nIn the last section, we presented a parser that would construct one of the two interpretations.\nIn this section, we show how to construct a single interpretation that preserves the ambiguity, but can be disambiguated by a postsyntactic process.\nThe basic idea is to construct an intermediate logical form that leaves the scope of quantifiers unspecified.\nThis intermediate form can then be rearranged to recover the final interpretation.\n\nTo recap, here is the interpretation we would get for \"Every man loves a woman,\" given the grammar in the previous section:\n\n```lisp\n(all ?m (-> (man ?m) (exists ?w) (and (woman ?w) (loves ?m ?w))))\n```\n\nWe will change the grammar to produce instead the intermediate form:\n\n```lisp\n(and (all ?m (man ?m))\n         (exists ?w (wowan ?w))\n         (loves ?m ?w))\n```\n\nThe difference is that logical components are produced in smaller chunks, with unscoped quantifiers.\nThe typical grammar rule will build up an interpretation by conjoining constituents with `and`, rather than by fitting pieces into holes in other pieces.\nHere is the complete grammar and a just-large-enough lexicon in the new format:\n\n```lisp\n(rule (S (and ?np ?vp)) -->\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n(rule (VP ?agr ?x (and ?verb ?obj)) -->\n   (Verb/tr ?agr ?x ?o ?verb)\n   (NP ?any-agr ?o ?obj))\n(rule (VP ?agr ?x ?verb) -->\n   (Verb/intr ?agr ?x ?verb))\n(rule (NP ?agr ?name t) -->\n   (Name ?agr ?name))\n(rule (NP ?agr ?x ?det) -->\n   (Det ?agr ?x (and ?noun ?rel) ?det)\n   (Noun ?agr ?x ?noun)\n   (rel-clause ?agr ?x ?rel))\n(rule (rel-clause ?agr ?x t) --> )\n(rule (rel-clause ?agr ?x ?rel) -->\n   (:word that)\n   (VP ?agr ?x ?rel))\n(rule (Name 3sg Terry)                    --> (:word Terry))\n(rule (Name 3sg Jean)                     --> (:word Jean))\n(rule (Det 3sg ?x ?restr (all ?x ?restr)) --> (:word every))\n(rule (Noun 3sg ?x (man ?x))              --> (:word man))\n(rule (Verb/tr 3sg ?x ?y (love ?x ?y))    --> (:word loves))\n(rule (Verb/intr 3sg ?x (lives ?x))       --> (:word lives))\n(rule (Det 3sg ?x ?res (exists ?x ?res))  --> (:word a))\n(rule (Noun 3sg ?x (woman ?x))            --> (:word woman))\n```\n\nThis gives us the following parse for \"Every man loves a woman\":\n\n```lisp\n(and (all ?4 (and (man ?4) t))\n        (and (love ?4 ?12) (exists ?12 (and (woman ?12) t))))\n```\n\nIf we simplified this, eliminating the `t`s and joining `and`s, we would get the desired representation:\n\n```lisp\n(and (all ?m (man ?m))\n        (exists ?w (wowan ?w))\n        (loves ?m ?w))\n```\n\nFrom there, we could use what we know about syntax, in addition to what we know about men, women, and loving, to determine the most likely final interpretation.\nThis will be covered in the next chapter.\n\n## 20.6 Long-Distance Dependencies\n\nSo far, every syntactic phenomena we have considered has been expressible in a rule that imposes constraints only at a single level.\nFor example, we had to impose the constraint that a subject agree with its verb, but this constraint involved two immediate constituents of a sentence, the noun phrase and verb phrase.\nWe didn't need to express a constraint between, say, the subject and a modifier of the verb's object.\nHowever, there are linguistic phenomena that require just these kinds of constraints.\n\nOur rule for relative clauses was a very simple one: a relative clause consists of the word \"that\" followed by a sentence that is missing its subject, as in \"every man that loves a woman.\"\nNot all relative clauses follow this pattern.\nIt is also possible to form a relative clause by omitting the object of the embedded sentence: \"every man that a woman loves &blank;.\"\nIn this sentence, the symbol &blank; indicates a gap, which is understood as being filled by the head of the complete noun phrase, the man.\nThis has been called a *filler-gap dependency.*\nIt is also known as a *long-distance dependency,* because the gap can occur arbitrarily far from the filler.\nFor example, all of the following are valid noun phrases:\n\nThe person that Lee likes &blank;\n\nThe person that Kim thinks Lee likes &blank;\n\nThe person that Jan says Kim thinks Lee likes &blank;\n\nIn each case, the gap is filled by the head noun, the person.\nBut any number of relative clauses can intervene between the head noun and the gap.\n\nThe same kind of filler-gap dependency takes place in questions that begin with \"who,\" \"what,\" \"where,\" and other interrogative pronouns.\nFor example, we can ask a question about the subject of a sentence, as in \"Who likes Lee?\", or about the object, as in \"Who does Kim like &blank;?\"\n\nHere is a grammar that covers relative clauses with gapped subjects or objects.\nThe rules for `S, VP,` and `NP` are augmented with a pair of arguments representing an accumulator for gaps.\nLike a difference list, the first argument minus the second represents the presence or absence of a gap.\nFor example, in the first two rules for noun phrases, the two arguments are the same, `?g0` and `?g0`.\nThis means that the rule as a whole has no gap, since there can be no difference between the two arguments.\nIn the third rule for NP, the first argument is of the form `(gap ...),` and the second is `nogap.` This means that the right-hand side of the rule, an empty constituent, can be parsed as a gap.\n(Note that if we had been using true difference lists, the two arguments would be `((gap ...) ?g0)` and `?g0`.\nBut since we are only dealing with one gap per rule, we don't need true difference lists.)\n\nThe rule for `S` says that a noun phrase with gap `?g0` minus `?gl` followed by a verb phrase with gap `?gl` minus `?g2` comprise a sentence with gap `?g0` minus `?g2`.\nThe rule for relative clauses finds a sentence with a gap anywhere; either in the subject position or embedded somewhere in the verb phrase.\nHere's the complete grammar:\n\n```lisp\n(rule (S ?g0 ?g2 (and ?np ?vp)) -->\n   (NP ?g0 ?gl ?agr ?x ?np)\n   (VP ?gl ?g2 ?agr ?x ?vp))\n(rule (VP ?g0 ?gl ?agr ?x (and ?obj ?verb)) -->\n   (Verb/tr ?agr ?x ?o ?verb)\n   (NP ?g0 ?gl ?any-agr ?o ?obj))\n(rule (VP ?g0 ?g0 ?agr ?x ?verb) -->\n   (Verb/intr ?agr ?x ?verb))\n(rule (NP ?g0 ?g0 ?agr ?name t) -->\n   (Name ?agr ?name))\n(rule (NP ?g0 ?g0 ?agr ?x ?det) -->\n   (Det ?agr ?x (and ?noun ?rel) ?det)\n   (Noun ?agr ?x ?noun)\n   (rel-clause ?agr ?x ?rel))\n(rule (NP (gap NP ?agr ?x) nogap ?agr ?x t) --> )\n(rule (rel-clause ?agr ?x t) --> )\n(rule (rel-clause ?agr ?x ?rel) -->\n   (:word that)\n   (S (gap NP ?agr ?x) nogap ?rel))\n```\n\nHere are some sentence/parse pairs covered by this grammar:\n\n`Every man that` &blank; `loves a woman likes a person.`\n\n```lisp\n(AND (ALL ?28 (AND (MAN ?28)\n      (AND T (AND (LOVE ?28 ?30)\n         (EXISTS ?30 (AND (WOMAN ?30)\n               T))))))\n   (AND (EXISTS ?39 (AND (PERSON ?39) T)) (LIKE ?28 ?39)))\n```\n\n`Every man that a woman loves` &blank; `likes a person.`\n\n```lisp\n(AND (ALL ?37 (AND (MAN ?37)\n      (AND (EXISTS ?20 (AND (WOMAN ?20) T))\n        (AND T (LOVE ?20 ?37)))))\n   (AND (EXISTS ?39 (AND (PERSON ?39) T)) (LIKE ?37 ?39)))\n```\n\n`Every man that loves a bird that` &blank; `flies likes a person.`\n\n```lisp\n(AND (ALL ?28 (AND (MAN ?28)\n      (AND T (AND (EXISTS ?54\n         (AND (BIRD ?54)\n             (AND T (FLY ?54))))\n        (LOVE ?28 ?54)))))\n   (AND (EXISTS ?60 (AND (PERSON ?60) T)) (LIKE ?28 ?60)))\n```\n\nActually, there are limitations on the situations in which gaps can appear.\nIn particular, it is rare to have a gap in the subject of a sentence, except in the case of a relative clause.\nIn the next chapter, we will see how to impose additional constraints on gaps.\n\n## 20.7 Augmenting DCG Rules\n\nIn the previous section, we saw how to build up a semantic representation of a sentence by conjoining the semantics of the components.\nOne problem with this approach is that the semantic interpretation is often something of the form `(and (and t` *a) b),* when we would prefer `(and` *a b)*.\nThere are two ways to correct this problem: either we add a step that takes the final semantic interpretation and simplifies it, or we complicate each individual rule, making it generate the simplified form.\nThe second choice would be slightly more efficient, but would be very ugly and error prone.\nWe should be doing all we can to make the rules simpler, not more complicated; that is the whole point of the DCG formalism.\nThis suggests a third approach: change the rule interpreter so that it automatically generates the semantic interpretation as a conjunction of the constituents, unless the rule explicitly says otherwise.\nThis section shows how to augment the DCG rules to handle common cases like this automatically.\n\nConsider again a rule from [section 20.4](#s0025):\n\n```lisp\n(rule (S (and ?np ?vp)) -->\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n```\n\nIf we were to alter this rule to produce a simplified semantic interpretation, it would look like the following, where the predicate `and*` simplifies a list of conjunctions into a single conjunction:\n\n```lisp\n(rule (S ?sem) -->\n   (np ?agr ?x ?np)\n   (vp ?agr ?x ?vp)\n   (:test (and*(?np ?vp) ?sem)))\n```\n\nMany rules will have this form, so we adopt a simple convention: if the last argument of the constituent on the left-hand side of a rule is the keyword `:sem`, then we will build the semantics by replacing `:sem` with a conjunction formed by combining all the last arguments of the constituents on the right-hand side of the rule.\nA `==>` arrow will be used for rules that follow this convention, so the following rule is equivalent to the one above:\n\n```lisp\n(rule (S :sem) ==>\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n```\n\nIt is sometimes useful to introduce additional semantics that does not come from one of the constituents.\nThis can be indicated with an element of the right-hand side that is a list starting with `:sem`.\nFor example, the following rule adds to the semantics the fact that `?x` is the topic of the sentence:\n\n```lisp\n(rule (S :sem) ==>\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp)\n   (:sem (topic ?x)))\n```\n\nBefore implementing the rule function for the `==>` arrow, it is worth considering if there are other ways we could make things easier for the rule writer.\nOne possibility is to provide a notation for describing examples.\nExamples make it easier to understand what a rule is designed for.\nFor the `S` rule, we could add examples like this:\n\n```lisp\n(rule (S :sem) ==>\n   (:ex \"John likes Mary\" \"He sleeps\")\n   (NP ?agr ?x ?np)\n   (VP ?agr ?x ?vp))\n```\n\nThese examples not only serve as documentation for the rule but also can be stored under `S` and subsequently run when we want to test if `S` is in fact implemented properly.\n\nAnother area where the rule writer could use help is in handling left-recursive rules.\nConsider the rule that says that a sentence can consist of two sentences joined by a conjunction:\n\n```lisp\n(rule (S (?conj ?sl ?s2)) ==>\n   (:ex \"John likes Mary and Mary likes John\")\n   (S ?sl)\n   (Conj ?conj)\n   (S ?s2))\n```\n\nWhile this rule is correct as a declarative statement, it will run into difficulty when run by the standard top-down depth-first DCG interpretation process.\nThe top-level goal of parsing an `S` will lead immediately to the subgoal of parsing an `S`, and the result will be an infinite loop.\n\nFortunately, we know how to avoid this kind of infinite loop: split the offending predicate, `S`, into two predicates: one that supports the recursion, and one that is at a lower level.\nWe will call the lower-level predicate `S_`.\nThus, the following rule says that a sentence can consist of two sentences, where the first one is not conjoined and the second is possibly conjoined:\n\n```lisp\n(rule (S (?conj ?sl ?s2)) ==>\n   (S_ ?sl)\n   (Conj ?conj)\n   (S ?s2))\n```\n\nWe also need a rule that says that a possibly conjoined sentence can consist of a nonconjoined sentence:\n\n```lisp\n(rule (S ?sem) ==> (S_ ?sem))\n```\n\nTo make this work, we need to replace any mention of `S` in the left-hand side of a rule with `S_`.\nReferences to `S` in the right-hand side of rules remain unchanged.\n\n```lisp\n(rule (S_ ?sem) ==>...)\n```\n\nTo make this all automatic, we will provide a macro, `conj-rule`, that declares a category to be one that can be conjoined.\nSuch a declaration will automatically generate the recursive and nonrecursive rules for the category, and will insure that future references to the category on the left-hand side of a rule will be replaced with the corresponding lower-level predicate.\n\nOne problem with this approach is that it imposes a right-branching parse on multiple conjoined phrases.\nThat is, we will get parses like \"spaghetti and (meatballs and salad)\" not \"(spaghetti and meatballs) and salad.\" Clearly, that is the wrong interpretation for this sentence.\nStill, it can be argued that it is best to produce a single canonical parse, and then let the semantic interpretation functions worry about rearranging the parse in the right order.\nWe will not attempt to resolve this debate but will provide the automatic conjunction mechanism as a tool that can be convenient but has no cost for the user who prefers a different solution.\n\nWe are now ready to implement the extended DCG rule formalism that handles `:sem, :ex,` and automatic conjunctions.\nThe function `make-augmented-dcg,` stored under the arrow `==>`, will be used to implement the formalism:\n\n```lisp\n(setf (get '==> 'rule-function) 'make-augmented-dcg)\n\n(defun make-augmented-dcg (head body)\n  \"Build an augmented DCG rule that handles :sem, :ex,\n  and automatic conjunctiontive constituents.\"\n  (if (eq (last1 head) :sem)\n      ;; Handle :sem\n      (let* ((?sem (gensym \"?SEM\")))\n        (make-augmented-dcg\n          `(,@(butlast head) ,?sem)\n          `(,@(remove :sem body :key #'first-or-nil)\n            (:test ,(collect-sems body ?sem)))))\n      ;; Separate out examples from body\n      (multiple-value-bind (exs new-body)\n          (partition-if #'(lambda (x) (starts-with x :ex)) body)\n        ;; Handle conjunctions\n        (let ((rule `(rule ,(handle-conj head) --> ,@new-body)))\n          (if (null exs)\n              rule\n              `(progn (:ex ,head .,(mappend #'rest exs))\n                      ,rule))))))\n```\n\nFirst we show the code that collects together the semantics of each constituent and conjoins them when `:sem` is specified.\nThe function `collect-sems` picks out the semantics and handles the trivial cases where there are zero or one constituents on the right-hand side.\nIf there are more than one, it inserts a call to the predicate `and*`.\n\n```lisp\n(defun collect-sems (body ?sem)\n  \"Get the semantics out of each constituent in body,\n  and combine them together into ?sem.\"\n  (let ((sems (loop for goal in body\n                    unless (or (dcg-normal-goal-p goal)\n                               (dcg-word-list-p goal)\n                               (starts-with goal :ex)\n                               (atom goal))\n                    collect (last1 goal))))\n    (case (length sems)\n      (0 `(= ,?sem t))\n      (1 `(= ,?sem ,(first sems)))\n      (t `(and* ,sems ,?sem)))))\n```\n\nWe could have implemented `and*` with Prolog clauses, but it is slightly more efficient to do it directly in Lisp.\nA call to `conjuncts` collects all the conjuncts, and we then add an `and` if necessary:\n\n```lisp\n(defun and*/2 (in out cont)\n  \"IN is a list of conjuncts that are conjoined into OUT.\"\n  ;; E.g.: (and* (t (and a b) t (and c d) t) ?x) ==>\n  ;;        ?x = (and a b c d)\n  (if (unify! out (maybe-add 'and (conjuncts (cons 'and in)) t))\n      (funcall cont)))\n\n(defun conjuncts (exp)\n  \"Get all the conjuncts from an expression.\"\n  (deref exp)\n  (cond ((eq exp t) nil)\n        ((atom exp) (list exp))\n        ((eq (deref (first exp)) 'nil) nil)\n        ((eq (first exp) 'and)\n         (mappend #'conjuncts (rest exp)))\n        (t (list exp))))\n```\n\nThe next step is handling example phrases.\nThe code in `make-augmented-dcg` turns examples into expressions of the form:\n\n```lisp\n(:ex (S ?sem) \"John likes Mary\" \"He sleeps\")\n```\n\nTo make this work, `:ex` will have to be a macro:\n\n```lisp\n(defmacro :ex ((category . args) &body examples)\n  \"Add some example phrases, indexed under the category.\"\n  `(add-examples ',category ',args ',examples))\n```\n\n`:ex` calls `add-examples` to do all the work.\nEach example is stored in a hash table indexed under the the category.\nEach example is transformed into a two-element list: the example phrase string itself and a call to the proper predicate with all arguments supplied.\nThe function `add-examples` does this transformation and indexing, and `run-examples` retrieves the examples stored under a category, prints each phrase, and calls each goal.\nThe auxiliary functions `get-examples` and `clear-examples` are provided to manipulate the example table, and `remove-punction, punctuation-p` and `string->list` are used to map from a string to a list of words.\n\n```lisp\n(defvar *examples* (make-hash-table :test #'eq))\n(defun get-examples (category) (gethash category *examples*))\n(defun clear-examples () (clrhash *examples*))\n\n(defun add-examples (category args examples)\n  \"Add these example strings to this category,\n  and when it comes time to run them, use the args.\"\n  (dolist (example examples)\n    (when (stringp example)\n      (let ((ex `(,example\n                  (,category ,@args\n                   ,(string->list\n                      (remove-punctuation example)) ()))))\n        (unless (member ex (get-examples category)\n                        :test #'equal)\n          (setf (gethash category *examples*)\n                (nconc (get-examples category) (list ex))))))))\n\n(defun run-examples (&optional category)\n  \"Run all the example phrases stored under a category.\n  With no category, run ALL the examples.\"\n  (prolog-compile-symbols)\n  (if (null category)\n      (maphash #'(lambda (cat val)\n                   (declare (ignore val))\n                   (format t \"~2&Examples of ~a:~&\" cat)\n                   (run-examples cat))\n               *examples*)\n      (dolist (example (get-examples category))\n        (format t \"~2&EXAMPLE: ~{~a~&~9T~a~}\" example)\n        (top-level-prove (cdr example)))))\n\n(defun remove-punctuation (string)\n  \"Replace punctuation with spaces in string.\"\n  (substitute-if #\\space #'punctuation-p string))\n\n(defun string->list (string)\n  \"Convert a string to a list of words.\"\n  (read-from-string (concatenate 'string \"(\" string \")\")))\n\n(defun punctuation-p (char) (find char \"*_.,;:`!?#-()\\\\\\\"\"))\n```\n\nThe final part of our augmented DCG formalism is handling conjunctive constituents automatically.\nWe already arranged to translate category symbols on the left-hand side of rules into the corresponding conjunctive category, as specified by the function `handle-conj`.\nWe also want to generate automatically (or as easily as possible) rules of the following form:\n\n```lisp\n(rule (S (?conj ?sl ?s2)) ==>\n   (S_ ?sl)\n   (Conj ?conj)\n   (S ?s2))\n(rule (S ?sem) ==> (S_ ?sem))\n```\n\nBut before we generate these rules, let's make sure they are exactly what we want.\nConsider parsing a nonconjoined sentence with these two rules in place.\nThe first rule would parse the entire sentence as a `S_`, and would then fail to see a `Conj`, and thus fail.\nThe second rule would then duplicate the entire parsing process, thus doubling the amount of time taken.\nIf we changed the order of the two rules we would be able to parse nonconjoined sentences quickly, but would have to backtrack on conjoined sentences.\n\nThe following shows a better approach.\nA single rule for `S` parses a sentence with `S_`, and then calls `Conj_S`, which can be read as \"either a conjunction followed by a sentence, or nothing.\" If the first sentence is followed by nothing, then we just use the semantics of the first sentence; if there is a conjunction, we have to form a combined semantics.\nI have added ... to show where arguments to the predicate other than the semantic argument fit in.\n\n```lisp\n(rule (S ... ?s-combined) ==>\n   (S_ ... ?seml)\n   (Conj_S ?seml ?s-combined))\n(rule (Conj_S ?seml (?conj ?seml ?sem2)) ==>\n   (Conj ?conj)\n   (S ... ?sem2))\n(rule (Conj_S ?seml ?seml) ==>)\n```\n\nNow all we need is a way for the user to specify that these three rules are desired.\nSince the exact method of building up the combined semantics and perhaps even the call to `Conj` may vary depending on the specifics of the grammar being defined, the rules cannot be generated entirely automatically.\nWe will settle for a macro, `conj-rule`, that looks very much like the second of the three rules above but expands into all three, plus code to relate `S_` to `S`.\nSo the user will type:\n\n```lisp\n(conj-rule (Conj_S ?seml (?conj ?seml ?sem2)) ==>\n   (Conj ?conj)\n   (S ?a ?b ?c ?sem2))\n```\n\nHere is the macro definition:\n\n```lisp\n(defmacro conj-rule ((conj-cat sem1 combined-sem) ==>\n                     conj (cat . args))\n  \"Define this category as an automatic conjunction.\"\n  (assert (eq ==> '==>))\n  `(progn\n     (setf (get ',cat 'conj-cat) ',(symbol cat '_))\n     (rule (,cat ,@(butlast args) ?combined-sem) ==>\n       (,(symbol cat '_) ,@(butlast args) ,sem1)\n       (,conj-cat ,sem1 ?combined-sem))\n     (rule (,conj-cat ,sem1 ,combined-sem) ==>\n       ,conj\n       (,cat ,@args))\n     (rule (,conj-cat ?sem1 ?sem1) ==>)))\n```\n\nand here we define `handle-conj` to substitute `S_` for `S` in the left-hand side of rules:\n\n```lisp\n(defun handle-conj (head)\n  \"Replace (Cat ...) with (Cat_ ...) if Cat is declared\n  as a conjunctive category.\"\n  (if (and (listp head) (conj-category (predicate head)))\n      (cons (conj-category (predicate head)) (args head))\n      head))\n\n(defun conj-category (predicate)\n  \"If this is a conjunctive predicate, return the Cat_ symbol.\"\n  (get predicate 'conj-category))\n```\n\n## 20.8 History and References\n\nAs we have mentioned, Alain Colmerauer invented Prolog to use in his grammar of French (1973).\nHis *metamorphosis grammar* formalism was more expressive but much less efficient than the standard DCG formalism.\n\nThe grammar in [section 20.4](#s0025) is essentially the same as the one presented in Fernando Pereira and David H.\nD.\nWarren's 1980 paper, which introduced the Definite Clause Grammar formalism as it is known today.\nThe two developed a much more substantial grammar and used it in a very influential question-answering system called Chat-80 ([Warren and Pereira, 1982](bibliography.md#bb1340)).\nPereira later teamed with Stuart Shieber on an excellent book covering logic grammars in more depth: *Prolog and Natural-Language Analysis* (1987).\nThe book has many strong points, but unfortunately it does not present a grammar anywhere near as complete as the Chat-80 grammar.\n\nThe idea of a compositional semantics based on mathematical logic owes much to the work of the late linguist Richard Montague.\nThe introduction by [Dowty, Wall, and Peters (1981)](bibliography.md#bb0335) and the collection by [Rich Thomason (1974)](bibliography.md#bb1235) cover Montague's approach.\n\nThe grammar in [section 20.5](#s0030) is based loosely on Michael McCord's modular logic grammar, as presented in [Walker et al.\n1990](bibliography.md#bb1295).\n\nIt should be noted that logic grammars are by no means the only approach to natural language processing.\n[Woods (1970)](bibliography.md#bb1425) presents an approach based on the *augmented transition network*, or ATN.\nA transition network is like a context-free grammar.\nThe *augmentation* is a way of manipulating features and semantic values.\nThis is just like the extra arguments in DCGs, except that the basic operations are setting and testing variables rather than unification.\nSo the choice between ATNs and DCGs is largely a matter of what programming approach you are most comfortable with: procedural for ATNs and declarative for DCGs.\nMy feeling is that unification is a more suitable primitive than assignment, so I chose to present DCGs, even though this required bringing in Prolog's backtracking and unification mechanisms.\n\nIn either approach, the same linguistic problems must be addressed-agreement, long-distance dependencies, topicalization, quantifier-scope ambiguity, and so on.\nComparing [Woods's (1970)](bibliography.md#bb1425) ATN grammar to [Pereira and Warren's (1980)](bibliography.md#bb0950) DCG grammar, the careful reader will see that the solutions have much in common.\nThe analysis is more important than the notation, as it should be.\n\n## 20.9 Exercises\n\n**Exercise  20.2 [m]** Modify the grammar (from [section 20.4](#s0025), [20.5](#s0030), [or 20.6](#s0035)) to allow for adjectives before a noun.\n\n**Exercise  20.3 [m]** Modify the grammar to allow for prepositional phrase modifiers on verb and noun phrases.\n\n**Exercise  20.4 [m]** Modify the grammar to allow for ditransitive verbs-verbs that take two objects, as in \"give the dog a bone.\"\n\n**Exercise  20.5** Suppose we wanted to adopt the Prolog convention of writing DCG tests and words in brackets and braces, respectively.\nWrite a function that will alter the readtable to work this way.\n\n**Exercise  20.6 [m]** Define a rule function for a new type of DCG rule that automatically builds up a syntactic parse of the input.\nFor example, the two rules:\n\n```lisp\n(rule (s) => (np) (vp))\n(rule (np) => (:word he))\n```\n\nshould be equivalent to:\n\n```lisp\n(rule (s (s ?1 ?2)) --> (np ?1) (vp ?2))\n(rule (np (np he)) --> (:word he))\n```\n\n**Exercise  20.7 [m]** There are advantages and disadvantages to the approach that Prolog takes in dividing predicates into clauses.\nThe advantage is that it is easy to add a new clause.\nThe disadvantage is that it is hard to alter an existing clause.\nIf you edit a clause and then evaluate it, the new clause will be added to the end of the clause list, when what you really wanted was for the new clause to take the place of the old one.\nTo achieve that effect, you have to call `clear-predicate`, and then reload all the clauses, not just the one that has been changed.\n\nWrite a macro `named-rule` that is just like `rule`, except that it attaches names to clauses.\nWhen a named rule is reloaded, it replaces the old clause rather than adding a new one.\n\n**Exercise 20.8 [h]** Extend the DCG rule function to allow or goals in the right-hand side.\nTo make this more useful, also allow `and` goals.\nFor example:\n\n```lisp\n(rule (A) --> (B) (or (C) (and (D) (E))) (F))\n```\n\nshould compile into the equivalent of :\n\n```lisp\n(<- (A ?S0 ?S4)\n   (B ?S0 ?S1)\n   (OR (AND (C ?S1 ?S2) (= ?S2 ?S3))\n  (AND (D ?S1 ?S2) (E ?S2 ?S3)))\n   (F ?S3 ?S4))\n```\n\n## 20.10 Answers\n\n**Answer 20.1** It uses local variables `(?s0, ?sl ...)` that are not guaranteed to be unique.\nThis is a problem if the grammar writer wants to use these symbols anywhere in his or her rules.\nThe fix is to `gensym` symbols that are guaranteed to be unique.\n\n### Answer 20.5\n\n```lisp\n(defun setup-braces Uoptional (on? t) (readtable *readtable*))\n   \"Make [a b] read as (:word a b) and {a b} as (:test a b c) if ON? is true; otherwise revert {[]} to normal.\"\n   if ON? is true; otherwise revert {[]} to normal.\"\n   (if (not on?)\n   (map nil #'(lambda (c)\n       (set-macro-character c (get-macro-character #\\a)\n            t readtable))\n    \"{[]}\")\n   (progn\n    (set-macro-character\n     #\\] (get-macro-character #\\)) nil readtable)\n    (set-macro-character\n     #\\} (get-macro-character #\\)) nil readtable)\n    (set-macro-character\n     #\\[ #'(lambda (s ignore)\n         (cons :word (read-delimited-1ist #\\] s t)))\n     nil readtable)\n    (set-macro-character\n     #\\{ #'(lambda (s ignore)\n         (cons :test (read-delimited-1ist #\\} s t)))\n     nil readtable))))\n```\n\n----------------------\n\n<a id=\"fn20-1\"></a><sup>[1](#tfn20-1)</sup>\nThe asterisk at the start of a sentence is the standard linguistic notation for an utterance that is ungrammatical or otherwise ill-formed.\n"
  },
  {
    "path": "docs/chapter21.md",
    "content": "# Chapter 21\n## A Grammar of English\n\n> Prefer geniality to grammar.\n\n> -Henry Watson Fowler\n\n> *The King's English* (1906)\n\nThe previous two chapters outline techniques for writing grammars and parsers based on those grammars.\nIt is quite straightforward to apply these techniques to applications like the CD player problem where input is limited to simple sentences like \"Play 1 to 8 without 3.\" But it is a major undertaking to write a grammar for unrestricted English input.\nThis chapter develops a grammar that covers all the major syntactic constructions of English.\nIt handles sentences of much greater complexity, such as \"Kim would not have been persuaded by Lee to look after the dog.\" The grammar is not comprehensive enough to handle sentences chosen at random from a book, but when augmented by suitable vocabulary it is adequate for a wide variety of applications.\n\nThis chapter is organized as a tour through the English language.\nWe first cover noun phrases, then verb phrases, clauses, and sentences.\nFor each category we introduce examples, analyze them linguistically, and finally show definite clause grammar rules that correspond to the analysis.\n\nAs the last chapter should have made clear, analysis more often results in complication than in simplification.\nFor example, starting with a simple rule like `(S --> NP VP)`, we soon find that we have to add arguments to handle agreement, semantics, and gapping information.\n[Figure 21.1](#f0010) lists the grammatical categories and their arguments.\nNote that the semantic argument, `sem`, is always last, and the gap accumulators, `gap1` and `gap2`, are next-to-last whenever they occur.\nAll single-letter arguments denote metavariables; for example, each noun phrase (category NP) will have a semantic interpretation, `sem`, that is a conjunction of relations involving the variable `x`.\nSimilarly, the `hin modifiers` is a variable that refers to the head-the thing that is being modified.\nThe other arguments and categories will be explained in turn, but it is handy to have this figure to refer back to.\n\n| []()                                                    |\n|---------------------------------------------------------|\n| ![f21-01](images/chapter21/f21-01.jpg)                  |\n| Figure 21.1: Grammatical Categories and their Arguments |\n\n*(ed: should be a markdown table)*\n\n## 21.1 Noun Phrases\n\nThe simplest noun phrases are names and pronouns, such as \"Kim\" and \"them.\" The rules for these cases are simple: we build up a semantic expression from a name or pronoun, and since there can be no gap, the two gap accumulator arguments are the same `(?g1)`.\nPerson and number agreement is propagated in the variable `?agr`, and we also keep track of the *case* of the noun phrase.\nEnglish has three cases that are reflected in certain pronouns.\nIn the first person singular, \"I\" is the *nominative* or *subjective* case, \"me\" is the *accusative* or *objective* case, and \"my\" is the *genitive* case.\nTo distinguish them from the genitive, we refer to the nominative and the objective cases as the *common* cases.\nAccordingly, the three cases will be marked by the expressions `(common nom)`, `(common obj)`, and `gen`, respectively.\nMany languages of the world have suffixes that mark nouns as being one case or another, but English does not.\nThus, we use the expression `(common ?)` to mark nouns.\n\nWe also distinguish between noun phrases that can be used in questions, like \"who,\" and those that cannot.\nThe `?wh` variable has the value  `+wh` for noun phrases like \"who\" or \"which one\" and `-wh` for nonquestion phrases.\nHere, then, are the rules for names and pronouns.\nThe predicates name and `pronoun` are used to look up words in the lexicon.\n\n```lisp\n(rule (NP ?agr (common ?) -wh ?x ?g1 ?g1 (the ?x (name ?name ?x))) ==>\n  (name ?agr ?name))\n\n(rule (NP ?agr ?case ?wh ?x ?g1 ?g1 ?sem) ==>\n  (pronoun ?agr ?case ?wh ?x ?sem))\n```\n\nPlural nouns can stand alone as noun phrases, as in \"dogs,\" but singular nouns need a determiner, as in \"the dog\" or \"Kim's friend's biggest dog.\" Plural nouns can also take a determiner, as in \"the dogs.\" The category Det is used for determiners, and NP2 is used for the part of a noun phrase after the determiner:\n\n```lisp\n(rule (NP (- - - +) ?case -wh ?x ?g1 ?g2 (group ?x ?sem)) ==>\n  (:ex \"dogs\") ; Plural nouns don't need a determiner\n  (NP2 (- - - +) ?case ?x ?g1 ?g2 ?sem))\n\n(rule (NP ?agr (common ?) ?wh ?x ?g1 ?g2 ?sem) ==>\n  (:ex \"Every man\" \"The dogs on the beach\")\n  (Det ?agr ?wh ?x ?restriction ?sem)\n  (NP2 ?agr (common ?) ?x ?g1 ?g2 ?restriction))\n```\n\nFinally, a noun phrase may appear externally to a construction, in which case the noun phrase passed in by the first gap argument will be consumed, but no words from the input will be.\nAn example is the &blank; in \"Whom does Kim like &blank;?\"\n\n```lisp\n(rule (NP ?agr ?case ?wh ?x (gap (NP ?agr ?case ?x)) (gap nil) t)\n  ==> ;; Gapped NP\n  )\n```\n\nNow we address the heart of the noun phrase, the `NP2` category.\nThe lone rule for `NP2` says that it consists of a noun, optionally preceded and followed by modifiers:\n\n```lisp\n(rule (NP2 ?agr (common ?) ?x ?g1 ?g2 :sem) ==>\n  (modifiers pre noun ?agr () ?x (gap nil) (gap nil) ?pre)\n  (noun ?agr ?slots ?x ?noun)\n  (modifiers post noun ?agr ?slots ?x ?g1 ?g2 ?post))\n```\n\n## 21.2 Modifiers\n\nModifiers are split into type types: *Complements* are modifiers that are expected by the head category that is being modified; they cannot stand alone.\n*Adjuncts* are modifiers that are not required but bring additional information.\nThe distinction is clearest with verb modifiers.\nIn \"Kim visited Lee yesterday,\" \"visited\" is the head verb, \"Lee\" is a complement, and \"yesterday\" is an adjunct.\nReturning to nouns, in \"the former mayor of Boston,\" \"mayor\" is the head noun, \"of Boston\" is a complement (although an optional one) and \"former\" is an adjunct.\n\nThe predicate `modifiers` takes eight arguments, so it can be tricky to understand them all.\nThe first two arguments tell if we are before or after the head (`pre` or `post`) and what kind of head we are modifying (`noun`, `verb`, or whatever).\nNext is an argument that passes along any required information-in the case of nouns, it is the agreement feature.\nThe fourth argument is a list of expected complements, here called `?slots`.\nNext is the metavariable used to refer to the head.\nThe final three arguments are the two gap accumulators and the semantics, which work the same way here as we have seen before.\nNotice that the lexicon entry for each `Noun` can have a list of complements that are considered as postnoun modifiers, but there can be only adjuncts as prenoun modifiers.\nAlso note that gaps can appear in the postmodifiers but not in the premodifiers.\nFor example, we can have \"What is Kevin the former mayor of &blank;?,\" where the answer might be \"Boston.\"\nBut even though we can construct a noun phrase like \"the education president,\" where \"education\" is a prenoun modifier of \"president,\" we cannot construct \"* What is George the &blank; president?,\" intending that the answer be \"education.\"\n\nThere are four cases for modification.\nFirst, a complement is a kind of modifier.\nSecond, if a complement is marked as optional, it can be skipped.\nThird, an adjunct can appear in the input.\nFourth, if there are no complements expected, then there need not be any modifiers at all.\nThe following rules implement these four cases:\n\n```lisp\n(rule (modifiers ?pre/post ?cat ?info (?slot . ?slots) ?h\n                 ?g1 ?g3 :sem) ==>\n  (complement ?cat ?info ?slot ?h ?g1 ?g2 ?mod)\n  (modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods))\n\n(rule (modifiers ?pre/post ?cat ?info ((? (?) ?) . ?slots) ?h\n                 ?g1 ?g2 ?mods) ==>\n  (modifiers ?pre/post ?cat ?info ?slots ?h ?g1 ?g2 ?mods))\n\n(rule (modifiers ?pre/post ?cat ?info ?slots ?h ?g1 ?g3 :sem) ==>\n  (adjunct ?pre/post ?cat ?info ?h ?g1 ?g2 ?adjunct)\n  (modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods))\n\n(rule (modifiers ? ? ? () ? ?g1 ?g1 t) ==> )\n```\n\nWe need to say more about the list of complements, or slots, that can be associated with words in the lexicon.\nEach slot is a list of the form (*role number form),* where the role refers to some semantic relation, the number indicates the ordering of the complements, and the form is the type of constituent expected: noun phrase, verb phrase, or whatever.\nThe details will be covered in the following section on verb phrases, and `complement` will be covered in the section on XPs.\nFor now, we give a single example.\nThe complement list for one sense of the verb \"visit\" is:\n\n```lisp\n((agt 1 (NP ?)) (obj 2 (NP ?)))\n```\n\nThis means that the first complement, the subject, is a noun phrase that fills the agent role, and the second complement is also a noun phrase that fills the object role.\n\n## 21.3 Noun Modifiers\n\nThere are two main types of prenoun adjuncts.\nMost common are adjectives, as in \"big slobbery dogs.\" Nouns can also be adjuncts, as in \"water meter\" or \"desk lamp.\" Here it is clear that the second noun is the head and the first is the modifier: a desk lamp is a lamp, not a desk.\nThese are known as noun-noun compounds.\nIn the following rules, note that we do not need to say that more than one adjective is allowed; this is handled by the rules for `modifiers`.\n\n```lisp\n(rule (adjunct pre noun ?info ?x ?gap ?gap ?sem) ==>\n  (adj ?x ?sem))\n\n(rule (adjunct pre noun ?info ?h ?gap ?gap :sem) ==>\n  (:sem (noun-noun ?h ?x))\n  (noun ?agr () ?x ?sem))\n```\n\nAfter the noun there is a wider variety of modifiers.\nSome nouns have complements, which are primarily prepositional phrases, as in \"mayor of Boston.\" These will be covered when we get to the lexical entries for nouns.\nPrepositional phrases can be adjuncts for nouns or verbs, as in \"man in the middle\" and \"slept for an hour.\" We can write one rule to cover both cases:\n\n```lisp\n(rule (adjunct post ?cat ?info ?x ?g1 ?g2 ?sem) ==>\n  (PP ?prep ?prep ?wh ?np ?x ?g1 ?g2 ?sem))\n```\n\nHere are the rules for prepositional phrases, which can be either a preposition followed by a noun phrase or can be gapped, as in \"to whom are you speaking &blank;?\"\nThe object of a preposition is always in the objective case: \"with him\" not \"*with he.\"\n\n```lisp\n(rule (PP ?prep ?role ?wh ?np ?x ?g1 ?g2 :sem) ==>\n  (prep ?prep t)\n  (:sem (?role ?x ?np))\n  (NP ?agr (common obj) ?wh ?np ?g1 ?g2 ?np-sem))\n\n(rule (PP ?prep ?role ?wh ?np ?x\n          (gap (PP ?prep ?role ?np ?x)) (gap nil) t) ==> )\n```\n\nNouns can be modified by present participles, past participles, and relative clauses.\nExamples are \"the man eating the snack,\" \"the snack eaten by the man,\" and \"the man that ate the snack,\" respectively.\nWe will see that each verb in the lexicon is marked with an inflection, and that the marker `-ing` is used for present participles while `-en` is used for past participles.\nThe details of the `clause` will be covered later.\n\n```lisp\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==>\n  (:ex (the man) \"visiting me\" (the man) \"visited by me\")\n  (:test (member ?infl (-ing passive)))\n  (clause ?infl ?x ? ?v (gap (NP ?agr ? ?x)) (gap nil) ?sem))\n\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==>\n  (rel-clause ?agr ?x ?sem))\n```\n\nIt is possible to have a relative clause where it is an object, not the subject, that the head refers to: \"the snack that the man ate.\" In this kind of relative clause the relative pronoun is optional: \"The snack the man ate was delicious.\" The following rules say that if the relative pronoun is omitted then the noun that is being modified must be an object, and the relative clause should include a subject internally.\nThe constant `int-subj` indicates this.\n\n```lisp\n(rule (rel-clause ?agr ?x :sem) ==>\n  (:ex (the man) \"that she liked\" \"that liked her\"\n       \"that I know Lee liked\")\n  (opt-rel-pronoun ?case ?x ?int-subj ?rel-sem)\n  (clause (finite ? ?) ? ?int-subj ?v\n          (gap (NP ?agr ?case ?x)) (gap nil) ?clause-sem))\n\n(rule (opt-rel-pronoun ?case ?x ?int-subj (?type ?x)) ==>\n  (:word ?rel-pro)\n  (:test (word ?rel-pro rel-pro ?case ?type)))\n\n(rule (opt-rel-pronoun (common obj) ?x int-subj t) ==> )\n```\n\nIt should be noted that it is rare but not impossible to have names and pronouns with modifiers: \"John the Baptist,\" \"lovely Rita, meter maid,\" \"Lucy in the sky with diamonds,\" \"Sylvia in accounting on the 42nd floor,\" \"she who must be obeyed.\" Here and throughout this chapter we will raise the possibility of such rare cases, leaving them as exercises for the reader.\n\n## 21.4 Determiners\n\nWe will cover three kinds of determiners.\nThe simplest is the article: \"a dog\" or \"the dogs.\" We also allow genitive pronouns, as in \"her dog,\" and numbers, as in \"three dogs.\" The semantic interpretation of a determiner-phrase is of the form (*quantifier variable restriction*).\nFor example, `(a ?x (dog ?x) )` or `((number 3) ?x (dog ?x))`.\n\n```lisp\n(rule (Det ?agr ?wh ?x ?restriction (?art ?x ?restriction)) ==>\n  (:ex \"the\" \"every\")\n  (art ?agr ?art)\n  (:test (if (= ?art wh) (= ?wh +wh) (= ?wh -wh))))\n\n(rule (Det ?agr ?wh ?x ?r (the ?x ?restriction)) ==>\n  (:ex \"his\" \"her\")\n  (pronoun ?agr gen ?wh ?y ?sem)\n  (:test (and* ((genitive ?y ?x) ?sem ?r) ?restriction)))\n\n(rule (Det ?agr -wh ?x ?r ((number ?n) ?x ?r)) ==>\n  (:ex \"three\")\n  (cardinal ?n ?agr))\n```\n\nThese are the most important determiner types, but there are others, and there are pre- and postdeterminers that combine in restricted combinations.\nPredeterminers include all, both, half, double, twice, and such.\nPostdeterminers include every, many, several, and few.\nThus, we can say \"all her many good ideas\" or \"all the King's men.\"\nBut we can not say \"\\*all much ideas\" or \"\\*the our children.\"\nThe details are complicated and are omitted from this grammar.\n\n## 21.5 Verb Phrases\n\nNow that we have defined `modifiers`, verb phrases are easy.\nIn fact, we only need two rules.\nThe first says a verb phrase consists of a verb optionally preceded and followed by modifiers, and that the meaning of the verb phrase includes the fact that the subject fills some role:\n\n```lisp\n(rule (VP ?infl ?x ?subject-slot ?v ?g1 ?g2 :sem) ==>\n  (:ex \"sleeps\" \"quickly give the dog a bone\")\n  (modifiers pre verb ? () ?v (gap nil) (gap nil) ?pre-sem)\n  (:sem (?role ?x ?v)) (:test (= ?subject-slot (?role 1 ?)))\n  (verb ?verb ?infl (?subject-slot . ?slots) ?v ?v-sem)\n  (modifiers post verb ? ?slots ?v ?g1 ?g2 ?mod-sem))\n```\n\nThe `VP` category takes seven arguments.\nThe first is an inflection, which represents the tense of the verb.\nTo describe the possibilities for this argument we need a quick review of some basic linguistics.\nA sentence must have a *finite* verb, meaning a verb in the present or past tense.\nThus, we say \"Kim likes Lee,\" not \"\\*Kim liking Lee.\" Subject-predicate agreement takes effect for finite verbs but not for any other tense.\nThe other tenses show up as complements to other verbs.\nFor example, the complement to \"want\" is an infinitive: \"Kim wants *to like* Lee\" and the complement to the modal auxiliary verb \"would\" is a nonfinite verb: \"Kim would *like* Lee.\" If this were in the present tense, it would be \"likes,\" not \"like.\" The inflection argument takes on one of the forms in the table here:\n\n| Expression              | Type               | Example   |\n|-------------------------|--------------------|-----------|\n| `(finite ?agr present)` | present tense      | eat, eats |\n| `(finite ?agr past)`    | past tense         | ate       |\n| `nonfinite`             | nonfinite          | eat       |\n| `infinitive`            | infinitive         | to eat    |\n| `-en`                   | past participle    | eaten     |\n| `-ing`                  | present participle | eating    |\n\nThe second argument is a metavariable that refers to the subject, and the third is the subject's complement slot.\nWe adopt the convention that the subject slot must always be the first among the verb's complements.\nThe other slots are handled by the postverb modifiers.\nThe fourth argument is a metavariable indicating the verb phrase itself.\nThe final three are the familiar gap and semantics arguments.\nAs an example, if the verb phrase is the single word \"slept,\" then the semantics of the verb phrase will be `(and (past ?v) (sleep ?v))`.\nOf course, adverbs, complements, and adjuncts will also be handled by this rule.\n\nThe second rule for verb phrases handles auxiliary verbs, such as \"have,\" \"is\" and \"would.\" Each auxiliary verb (or `aux`) produces a verb phrase with a particular inflection when followed by a verb phrase with the required inflection.\nTo repeat an example, \"would\" produces a finite phrase when followed by a nonfinite verb.\n\"Have\" produces a nonfinite when followed by a past participle.\nThus, \"would have liked\" is a finite verb phrase.\n\nWe also need to account for negation.\nThe word \"not\" can not modify a bare main verb but can follow an auxiliary verb.\nThat is, we can't say \"*Kim not like Lee,\" but we can add an auxiliary to get \"Kim does not like Lee.\"\n\n```lisp\n(rule (VP ?infl ?x ?subject-slot ?v ?g1 ?g2 :sem) ==>\n  (:ex \"is sleeping\" \"would have given a bone to the dog.\"\n       \"did not sleep\" \"was given a bone by this old man\")\n  ;; An aux verb, followed by a VP\n  (aux ?infl ?needs-infl ?v ?aux)\n  (modifiers post aux ? () ?v (gap nil) (gap nil) ?mod)\n  (VP ?needs-infl ?x ?subject-slot ?v ?g1 ?g2 ?vp))\n\n(rule (adjunct post aux ? ?v ?gap ?gap (not ?v)) ==>\n  (:word not))\n```\n\n## 21.6 Adverbs\n\nAdverbs can serve as adjuncts before or after a verb: \"to boldly go,\" \"to go boldly.\" There are some limitations on where they can occur, but it is difficult to come up with firm rules; here we allow any adverb anywhere.\nWe define the category `advp` for adverbial phrase, but currently restrict it to a single adverb.\n\n```lisp\n(rule (adjunct ?pre/post verb ?info ?v ?g1 ?g2 ?sem) ==>\n  (advp ?wh ?v ?g1 ?g2 ?sem))\n\n(rule (advp ?wh ?v ?gap ?gap ?sem) ==>\n  (adverb ?wh ?v ?sem))\n\n(rule (advp ?wh ?v (gap (advp ?v)) (gap nil) t) ==> )\n```\n\n## 21.7 Clauses\n\nA clause consists of a subject followed by a predicate.\nHowever, the subject need not be realized immediately before the predicate.\nFor example, in \"Alice promised Bob to lend him her car\" there is an infinitive clause that consists of the predicate \"to lend him her car\" and the subject \"Alice.\"\nThe sentence as a whole is another clause.\nIn our analysis, then, a clause is a subject followed by a verb phrase, with the possibility that the subject will be instantiated by something from the gap arguments:\n\n```lisp\n(rule (clause ?infl ?x ?int-subj ?v ?gap1 ?gap3 :sem) ==>\n  (subject ?agr ?x ?subj-slot ?int-subj ?gap1 ?gap2 ?subj-sem)\n  (VP ?infl ?x ?subj-slot ?v ?gap2 ?gap3 ?pred-sem)\n  (:test (subj-pred-agree ?agr ?infl)))\n```\n\nThere are now two possibilities for `subject`.\nIn the first case it has already been parsed, and we pick it up from the gap list.\nIf that is so, then we also need to find the agreement feature of the subject.\nIf the subject was a noun phrase, the agreement will be present in the gap list.\nIf it was not, then the agreement is third-person singular.\nAn example of this is \"*That the Red Sox won* surprises me,\" where the italicized phrase is a non-NP subject.\nThe fact that we need to use \"surprises\" and not \"surprise\" indicates that it is third-person singular.\nWe will see that the code `(- - + -)` is used for this.\n\n```lisp\n(rule (subject ?agree ?x ?subj-slot ext-subj\n               (gap ?subj) (gap nil) t) ==>\n  ;; Externally realized subject (the normal case for S)\n  (:test (slot-constituent ?subj-slot ?subj ?x ?)\n         (if (= ?subj (NP ?agr ?case ?x))\n             (= ?agree ?agr)\n             (= ?agree (- - + -))))) ;Non-NP subjects are 3sing\n```\n\nIn the second case we just parse a noun phrase as the subject.\nNote that the fourth argument to `subject` is either `ext-subj` or `int-subj` depending on if the subject is realized internally or externally.\nThis will be important when we cover sentences in the next section.\nIn case it was not already clear, the second argument to both `clause` and `subject` is the metavariable representing the subject.\n\n```lisp\n(rule (subject ?agr ?x (?role 1 (NP ?x)) int-subj ?gap ?gap ?sem)\n  ==>\n  (NP ?agr (common nom) ?wh ?x (gap nil) (gap nil) ?sem))\n```\n\nFinally, the rules for subject-predicate agreement say that only finite predicates need to agree with their subject:\n\n```lisp\n(<- (subj-pred-agree ?agr (finite ?agr ?)))\n(<- (subj-pred-agree ? ?infl) (atom ?infl))\n```\n\n## 21.8 Sentences\n\nIn the previous chapter we allowed only simple declarative sentences.\nThe current grammar supports commands and four kinds of questions in addition to declarative sentences.\nIt also supports *thematic fronting:* placing a nonsubject at the beginning of a sentence to emphasize its importance, as in \"*Smith* he says his name is\" or *\"Murder,* she wrote\" or *\"In God* we trust.\"\nIn the last example it is a prepositional phrase, not a noun phrase, that occurs first.\nIt is also possible to have a subject that is not a noun phrase: *\"That the dog didn't bark* puzzled Holmes.\" To support all these possibilities, we introduce a new category, `XP`, which stands for any kind of phrase.\nA declarative sentence is then just an XP followed by a clause, where the subject of the clause may or may not turn out to be the XP:\n\n```lisp\n(rule (S ?s :sem) ==>\n  (:ex \"Kim likes Lee\" \"Lee, I like _\" \"In god, we trust _\"\n       \"Who likes Lee?\" \"Kim likes who?\")\n  (XP ?kind ?constituent ?wh ?x (gap nil) (gap nil) ?topic-sem)\n  (clause (finite ? ?) ?x ? ?s (gap ?constituent) (gap nil) ?sem))\n```\n\nAs it turns out, this rule also serves for two types of questions.\nThe simplest kind of question has an interrogative noun phrase as its subject: \"Who likes Lee?\" or \"What man likes Lee?\" Another kind is the so-called *echo question*, which can be used only as a reply to another statement: if I tell you Kim likes Jerry Lewis, you could reasonably reply \"Kim likes *who*?\" Both these question types have the same structure as declarative sentences, and thus are handled by the same rule.\n\nThe following table lists some sentences that can be parsed by this rule, showing the XP and subject of each.\n\n| Sentence                  | XP                 | Subject            |\n|---------------------------|--------------------|--------------------|\n| Kim likes Lee             | Kim                | Kim                |\n| Lee, Kim likes            | Lee                | Kim                |\n| In god, we trust          | In god             | we                 |\n| That Kim likes Lee amazes | That Kim likes Lee | That Kim likes Lee |\n| Who likes Lee?            | Who                | Who                |\n\nThe most common type of command has no subject at all: \"Be quiet\" or \"Go to your room.\" When the subject is missing, the meaning is that the command refers to *you*, the addressee of the command.\nThe subject can also be mentioned explicitly, and it can be \"you,\" as in \"You be quiet,\" but it need not be: \"Somebody shut the door\" or \"Everybody sing along.\" We provide a rule only for commands with subject omitted, since it can be difficult to distinguish a command with a subject from a declarative sentence.\nNote that commands are always nonfinite.\n\n```lisp\n(rule (S ?s :sem) ==>\n  ;; Commands have implied second-person subject\n  (:ex \"Give the dog a bone.\")\n  (:sem (command ?s))\n  (:sem (listener ?x))\n  (clause nonfinite ?x ext-subj ?s\n          (gap (NP ? ? ?x)) (gap nil) ?sem))\n```\n\nAnother form of command starts with \"let,\" as in \"Let me see what I can do\" and \"Let us all pray.\" The second word is better considered as the object of \"let\" rather than the subject of the sentence, since the subject would have to be \"I\" or \"we.\" This kind of command can be handled with a lexical entry for \"let\" rather than with an additional rule.\n\nWe now consider questions.\nQuestions that can be answered by yes or no have the subject and auxiliary verb inverted: \"Did you see him?\" or \"Should I have been doing this?\" The latter example shows that it is only the first auxiliary verb that comes before the subject.\nThe category `aux-inv-S` is used to handle this case:\n\n```lisp\n(rule (S ?s (yes-no ?s ?sem)) ==>\n  (:ex \"Does Kim like Lee?\" \"Is he a doctor?\")\n  (aux-inv-S nil ?s ?sem))\n```\n\nQuestions that begin with a wh-phrase also have the auxiliary verb before the subject, as in \"Who did you see?\" or \"Why should I have been doing this?\" The first constituent can also be a prepositional phrase: \"For whom am I doing this?\" The following rule parses an XP that must have the  `+wh` feature and then parses an `aux-inv-S` to arrive at a question:\n\n```lisp\n(rule (S ?s :sem) ==>\n  (:ex \"Who does Kim like _?\" \"To whom did he give it _?\"\n       \"What dog does Kim like _?\")\n  (XP ?slot ?constituent +wh ?x (gap nil) (gap nil) ?subj-sem)\n  (aux-inv-S ?constituent ?s ?sem))\n```\n\nA question can also be signaled by rising intonation in what would otherwise be a declarative statement: \"You want some?\" Since we don't have intonation information, we won't include this kind of question.\n\nThe implementation for `aux-inv-S` is straightforward: parse an auxiliary and then a clause, pausing to look for modifiers in between.\n(So far, a \"not\" is the only modifier allowed in that position.)\n\n```lisp\n(rule (aux-inv-S ?constituent ?v :sem) ==>\n  (:ex \"Does Kim like Lee?\" (who) \"would Kim have liked\")\n  (aux (finite ?agr ?tense) ?needs-infl ?v ?aux-sem)\n  (modifiers post aux ? () ?v (gap nil) (gap nil) ?mod)\n  (clause ?needs-infl ?x int-subj ?v (gap ?constituent) (gap nil)\n          ?clause-sem))\n```\n\nThere is one more case to consider.\nThe verb \"to be\" is the most idiosyncratic in English.\nIt is the only verb that has agreement differences for anything besides third-person singular.\nAnd it is also the only verb that can be used in an `aux-inv-S` without a main verb.\nAn example of this is \"Is he a doctor?,\" where \"is\" clearly is not an auxiliary, because there is no main verb that it could be auxiliary to.\nOther verbs can not be used in this way: \"\\*Seems he happy?\" and \"\\*Did they it?\" are ungrammatical.\nThe only possibility is \"have,\" as in \"Have you any wool?,\" but this use is rare.\n\nThe following rule parses a verb, checks to see that it is a version of \"be,\" and then parses the subject and the modifiers for the verb.\n\n```lisp\n(rule (aux-inv-S ?ext ?v :sem) ==>\n  (:ex \"Is he a doctor?\")\n  (verb ?be (finite ?agr ?) ((?role ?n ?xp) . ?slots) ?v ?sem)\n  (:test (word ?be be))\n  (subject ?agr ?x (?role ?n ?xp) int-subj\n           (gap nil) (gap nil) ?subj-sem)\n  (:sem (?role ?v ?x))\n  (modifiers post verb ? ?slots ?v (gap ?ext) (gap nil) ?mod-sem))\n```\n\n## 21.9 XPs\n\nAll that remains in our grammar is the XP category.\nXPs are used in two ways: First, a phrase can be extraposed, as in \"*In god* we trust,\" where \"in god\" will be parsed as an XP and then placed on the gap list until it can be taken off as an adjunct to \"trust.\" Second, a phrase can be a complement, as in \"He wants *to be a fireman,\"* where the infinitive phrase is a complement of \"wants.\"\n\nAs it turns out, the amount of information that needs to appear in a gap list is slightly different from the information that appears in a complement slot.\nFor example, one sense of the verb \"want\" has the following complement list:\n\n```lisp\n((agt 1 (NP ?x)) (con 3 (VP infinitive ?x)))\n```\n\nThis says that the first complement (the subject) is a noun phrase that serves as the agent of the wanting, and the second is an infinitive verb phrase that is the concept of the wanting.\nThe subject of this verb phrase is the same as the subject of the wanting, so in \"She wants to go home,\" it is she who both wants and goes.\n(Contrast this to \"He persuaded her to go home,\" where it is he that persuades, but she that goes.)\n\nBut when we put a noun phrase on a gap list, we need to include its number and case as well as the fact that it is an NP and its metavariable, but we don't need to include the fact that it is an agent.\nThis difference means we have two choices: either we can merge the notions of slots and gap lists so that they use a common notation containing all the information that either can use, or we need some way of mapping between them.\nI made the second choice, on the grounds that each notation was complicated enough without bringing in additional information.\n\nThe relation `slot-constituent` maps between the slot notation used for complements and the constituent notation used in gap lists.\nThere are eight types of complements, five of which can appear in gap lists: noun phrases, clauses, prepositional phrases, the word \"it\" (as in \"it is raining\"), and adverbial phrases.\nThe three phrases that are allowed only as complements are verb phrases, particles (such as \"up\" in \"look up the number\"), and adjectives.\nHere is the mapping between the two notations.\nThe `***` indicates no mapping:\n\n```lisp\n(<- (slot-constituent (?role ?n (NP ?x))\n                      (NP ?agr ?case ?x) ?x ?h))\n(<- (slot-constituent (?role ?n (clause ?word ?infl))\n                      (clause ?word ?infl ?v) ?v ?h))\n(<- (slot-constituent (?role ?n (PP ?prep ?np))\n                      (PP ?prep ?role ?np ?h) ?np ?h))\n(<- (slot-constituent (?role ?n it)            (it ? ? ?x) ?x ?))\n(<- (slot-constituent (manner 3 (advp ?x))     (advp ?v) ? ?v))\n(<- (slot-constituent (?role ?n (VP ?infl ?x)) *** ? ?))\n(<- (slot-constituent (?role ?n (Adj ?x))      *** ?x ?))\n(<- (slot-constituent (?role ?n (P ?particle)) *** ? ?))\n```\n\nWe are now ready to define `complement`.\nIt takes a slot description, maps it into a constituent, and then calls `XP` to parse that constituent:\n\n```lisp\n(rule (complement ?cat ?info (?role ?n ?xp) ?h ?gap1 ?gap2 :sem)\n  ==>\n  ;; A complement is anything expected by a slot\n  (:sem (?role ?h ?x))\n  (:test (slot-constituent (?role ?n ?xp) ?constituent ?x ?h))\n  (XP ?xp ?constituent ?wh ?x ?gap1 ?gap2 ?sem))\n```\n\nThe category `XP` takes seven arguments.\nThe first two are the slot we are trying to fill and the constituent we need to fill it.\nThe third is used for any additional information, and the fourth is the metavariable for the phrase.\nThe last three supply gap and semantic information.\n\nHere are the first five XP categories:\n\n```lisp\n(rule (XP (PP ?prep ?np) (PP ?prep ?role ?np ?h) ?wh ?np\n          ?gap1 ?gap2 ?sem) ==>\n  (PP ?prep ?role ?wh ?np ?h ?gap1 ?gap2 ?sem))\n\n(rule (XP (NP ?x) (NP ?agr ?case ?x) ?wh ?x ?gap1 ?gap2 ?sem) ==>\n  (NP ?agr ?case ?wh ?x ?gap1 ?gap2 ?sem))\n\n(rule (XP it (it ? ? ?x) -wh ?x ?gap ?gap t) ==>\n  (:word it))\n\n(rule (XP (clause ?word ?infl) (clause ?word ?infl ?v) -wh ?v\n          ?gap1 ?gap2 ?sem) ==>\n  (:ex (he thinks) \"that she is tall\")\n  (opt-word ?word)\n  (clause ?infl ?x int-subj ?v ?gap1 ?gap2 ?sem))\n\n(rule (XP (?role ?n (advp ?v)) (advp ?v) ?wh ?v ?gap1 ?gap2 ?sem)\n  ==>\n  (advp ?wh ?v ?gap1 ?gap2 ?sem))\n```\n\nThe category `opt-word` parses a word, which may be optional.\nFor example, one sense of \"know\" subcategorizes for a clause with an optional \"that\": we can say either \"I know that he's here\" or \"I know he's here.\" The complement list for \"know\" thus contains the slot `(con 2 (clause (that) (finite ? ?)))`.\nIf the \"that\" had been obligatory, it would not have parentheses around it.\n\n```lisp\n(rule (opt-word ?word) ==> (:word ?word))\n(rule (opt-word (?word)) ==> (:word ?word))\n(rule (opt-word (?word)) ==>)\n```\n\nFinally, here are the three XPs that can not be extraposed:\n\n```lisp\n(rule (XP (VP ?infl ?x) *** -wh ?v ?gap1 ?gap2 ?sem) ==>\n  (:ex (he promised her) \"to sleep\")\n  (VP ?infl ?x ?subj-slot ?v ?gap1 ?gap2 ?sem))\n\n(rule (XP (Adj ?x) *** -wh ?x ?gap ?gap ?sem) ==>\n  (Adj ?x ?sem))\n\n(rule (XP (P ?particle) *** -wh ?x ?gap ?gap t) ==>\n  (prep ?particle t))\n```\n\n## 21.10 Word Categories\n\nEach word category has a rule that looks words up in the lexicon and assigns the right features.\nThe relation `word` is used for all lexicon access.\nWe will describe the most complicated word class, `verb`, and just list the others.\n\nVerbs are complex because they often are *polysemous-*they have many meanings.\nIn addition, each meaning can have several different complement lists.\nThus, an entry for a verb in the lexicon will consist of the verb form, its inflection, and a list of senses, where each sense is a semantics followed by a list of possible complement lists.\nHere is the entry for the verb \"sees,\" indicating that it is a present-tense verb with three senses.\nThe understand sense has two complement lists, which correspond to \"He sees\" and \"He sees that you are right.\" The `look` sense has one complement list corresponding to \"He sees the picture,\" and the `dating` sense, corresponding to \"He sees her (only on Friday nights),\" has the same complement list.\n\n```lisp\n(?- (word sees verb ?infl ?senses))\n?INFL = (FINITE (--+-) PRESENT)\n?SENSES = ((UNDERSTAND ((AGT 1 (NP ?3)))\n                ((EXP 1 (NP ?4))\n                  (CON 2 (CLAUSE (THAT) (FINITE ?5 ?6)))))\n          (LOOK ((AGT 1 (NP ?7)) (OBJ 2 (NP ?8))))\n          (DATING ((AGT 1 (NP ?9)) (OBJ 2 (NP ?10)))))\n```\n\nThe category `verb` takes five arguments: the verb itself, its inflection, its complement list, its metavariable, and its semantics.\nThe `member` relations are used to pick a sense from the list of senses and a complement list from the list of lists, and the semantics is built from semantic predicate for the chosen sense and the metavariable for the verb:\n\n```lisp\n(rule (verb ?verb ?infl ?slots ?v :sem) ==>\n  (:word ?verb)\n  (:test (word ?verb verb ?infl ?senses)\n         (member (?sem . ?subcats) ?senses)\n         (member ?slots ?subcats)\n         (tense-sem ?infl ?v ?tense-sem))\n  (:sem ?tense-sem)\n  (:sem (?sem ?v)))\n```\n\nIt is difficulty to know how to translate tense information into a semantic interpretation.\nDifferent applications will have different models of time and thus will want different interpretations.\nThe relation `tense-sem` gives semantics for each tense.\nHere is a very simple definition of `tense-sem`:\n\n```lisp\n(<- (tense-sem (finite ? ?tense) ?v (?tense ?v)))\n(<- (tense-sem -ing ?v (progressive ?v)))\n(<- (tense-sem -en  ?v (past-participle ?v)))\n(<- (tense-sem infinitive ?v t))\n(<- (tense-sem nonfinite ?v t))\n(<- (tense-sem passive ?v (passive ?v)))\n```\n\nAuxiliary verbs and modal verbs are listed separately:\n\n```lisp\n(rule (aux ?infl ?needs-infl ?v ?tense-sem) ==>\n  (:word ?aux)\n  (:test (word ?aux aux ?infl ?needs-infl)\n         (tense-sem ?infl ?v ?tense-sem)))\n\n(rule (aux (finite ?agr ?tense) nonfinite ?v (?sem ?v)) ==>\n  (:word ?modal)\n  (:test (word ?modal modal ?sem ?tense)))\n```\n\nNouns, pronouns, and names are also listed separately, although they have much in common.\nFor pronouns we use quantifier `wh` or `pro`, depending on if it is a wh-pronoun or not.\n\n```lisp\n(rule (noun ?agr ?slots ?x (?sem ?x)) ==>\n  (:word ?noun)\n  (:test (word ?noun noun ?agr ?slots ?sem)))\n\n(rule (pronoun ?agr ?case ?wh ?x (?quant ?x (?sem ?x))) ==>\n  (:word ?pro)\n  (:test (word ?pro pronoun ?agr ?case ?wh ?sem)\n         (if (= ?wh +wh) (= ?quant wh) (= ?quant pro))))\n\n(rule (name ?agr ?name) ==>\n  (:word ?name)\n  (:test (word ?name name ?agr)))\n```\n\nHere are the rules for the remaining word classes:\n\n```lisp\n(rule (adj ?x (?sem ?x)) ==>\n  (:word ?adj)\n  (:test (word ?adj adj ?sem)))\n\n(rule (adj ?x ((nth ?n) ?x)) ==> (ordinal ?n))\n\n(rule (art ?agr ?quant) ==>\n  (:word ?art)\n  (:test (word ?art art ?agr ?quant)))\n\n(rule (prep ?prep t) ==>\n  (:word ?prep)\n  (:test (word ?prep prep)))\n\n(rule (adverb ?wh ?x ?sem) ==>\n  (:word ?adv)\n  (:test (word ?adv adv ?wh ?pred)\n         (if (= ?wh +wh)\n             (= ?sem (wh ?y (?pred ?x ?y)))\n             (= ?sem (?pred ?x)))))\n\n(rule (cardinal ?n ?agr) ==>\n  (:ex \"five\")\n  (:word ?num)\n  (:test (word ?num cardinal ?n ?agr)))\n\n(rule (cardinal ?n ?agr) ==>\n  (:ex \"5\")\n  (:word ?n)\n  (:test (numberp ?n)\n         (if (= ?n 1)\n             (= ?agr (- - + -))    ;3sing\n             (= ?agr (- - - +))))) ;3plur\n\n(rule (ordinal ?n) ==>\n  (:ex \"fifth\")\n  (:word ?num)\n  (:test (word ?num ordinal ?n)))\n```\n\n## 21.11 The Lexicon\n\nThe lexicon itself consists of a large number of entries in the `word` relation, and it would certainly be possible to ask the lexicon writer to make a long list of `word` facts.\nBut to make the lexicon easier to read and write, we adopt three useful tools.\nFirst, we introduce a system of abbreviations.\nCommon expressions can be abbreviated with a symbol that will be expanded by `word`.\nSecond, we provide the macros `verb` and `noun` to cover the two most complex word classes.\nThird, we provide a macro `word` that makes entries into a hash table.\nThis is more efficient than compiling a `word` relation consisting of hundreds of Prolog clauses.\n\nThe implementation of these tools is left for the next section; here we show the actual lexicon, starting with the list of abbreviations.\n\nThe first set of abbreviations defines the agreement features.\nThe obvious way to handle agreement is with two features, one for person and one for number.\nSo first-person singular might be represented `(1 sing)`.\nA problem arises when we want to describe verbs.\nEvery verb except \"be\" makes the distinction only between third-person singular and all the others.\nWe don't want to make five separate entries in the lexicon to represent all the others.\nOne alternative is to have the agreement feature be a set of possible values, so all the others would be a single set of five values rather than five separate values.\nThis makes a big difference in cutting down on backtracking.\nThe problem with this approach is keeping track of when to intersect sets.\nAnother approach is to make the agreement feature be a list of four binary features, one each for first-person singular, first-person plural, third-person singular, and third-person plural.\nThen \"all the others\" can be represented by the list that is negative in the third feature and unknown in all the others.\nThere is no way to distinguish second-person singular from plural in this scheme, but English does not make that distinction.\nHere are the necessary abbreviations:\n\n```lisp\n(abbrev 1sing       (+ - - -))\n(abbrev 1plur       (- + - -))\n(abbrev 3sing       (- - + -))\n(abbrev 3plur       (- - - +))\n(abbrev 2pers       (- - - -))\n(abbrev ~3sing      (? ? - ?))\n```\n\nThe next step is to provide abbreviations for some of the common verb complement lists:\n\n```lisp\n(abbrev v/intrans   ((agt 1 (NP ?))))\n(abbrev v/trans     ((agt 1 (NP ?)) (obj 2 (NP ?))))\n(abbrev v/ditrans   ((agt 1 (NP ?)) (goal 2 (NP ?)) (obj 3 (NP ?))))\n(abbrev v/trans2    ((agt 1 (NP ?)) (obj 2 (NP ?)) (goal 2 (PP to ?))))\n(abbrev v/trans4    ((agt 1 (NP ?)) (obj 2 (NP ?)) (ben 2 (PP for ?))))\n(abbrev v/it-null   ((nil 1 it)))\n(abbrev v/opt-that  ((exp 1 (NP ?)) (con 2 (clause (that) (finite ? ?)))))\n(abbrev v/subj-that ((con 1 (clause that (finite ? ?))) (exp 2 (NP ?))))\n(abbrev v/it-that   ((nil 1 it) (exp 2 (NP ?))\n                     (con 3 (clause that (finite ? ?)))))\n(abbrev v/inf       ((agt 1 (NP ?x)) (con 3 (VP infinitive ?x))))\n(abbrev v/promise   ((agt 1 (NP ?x)) (goal (2) (NP ?y))\n                     (con 3 (VP infinitive ?x))))\n(abbrev v/persuade  ((agt 1 (NP ?x)) (goal 2 (NP ?y))\n                     (con 3 (VP infinitive ?y))))\n(abbrev v/want      ((agt 1 (NP ?x)) (con 3 (VP infinitive ?x))))\n(abbrev v/p-up      ((agt 1 (NP ?)) (pat 2 (NP ?)) (nil 3 (P up))))\n(abbrev v/pp-for    ((agt 1 (NP ?)) (pat 2 (PP for ?))))\n(abbrev v/pp-after  ((agt 1 (NP ?)) (pat 2 (PP after ?))))\n```\n\n### Verbs\n\nThe macro `verb` allows us to list verbs in the form below, where the spellings of each tense can be omitted if the verb is regular:\n\n(`verb` (*base past-tense past-participle present-participle present-plural* ) (*semantics complement-list*...) ...)\n\nFor example, in the following list \"ask\" is regular, so only its base-form spelling is necessary.\n\"Do,\" on the other hand, is irregular, so each form is spelled out.\nThe haphazard list includes verbs that are either useful for examples or illustrate some unusual complement list.\n\n```lisp\n(verb (ask) (query v/ditrans))\n(verb (delete) (delete v/trans))\n(verb (do did done doing does) (perform v/trans))\n(verb (eat ate eaten) (eat v/trans))\n(verb (give gave given giving) (give-1 v/trans2 v/ditrans)\n      (donate v/trans v/intrans))\n(verb (go went gone going goes))\n(verb (have had had having has) (possess v/trans))\n(verb (know knew known) (know-that v/opt-that) (know-of v/trans))\n(verb (like) (like-1 v/trans))\n(verb (look) (look-up v/p-up) (search v/pp-for)\n      (take-care v/pp-after) (look v/intrans))\n(verb (move moved moved moving moves)\n      (self-propel v/intrans) (transfer v/trans2))\n(verb (persuade) (persuade v/persuade))\n(verb (promise) (promise v/promise))\n(verb (put put put putting))\n(verb (rain) (rain v/it-null))\n(verb (saw) (cut-with-saw v/trans v/intrans))\n(verb (see saw seen seeing) (understand v/intrans v/opt-that)\n      (look v/trans) (dating v/trans))\n(verb (sleep slept) (sleep v/intrans))\n(verb (surprise) (surprise v/subj-that v/it-that))\n(verb (tell told) (tell v/persuade))\n(verb (trust) (trust v/trans ((agt 1 (NP ?)) (obj 2 (PP in ?)))))\n(verb (try tried tried trying tries) (attempt v/inf))\n(verb (visit) (visit v/trans))\n(verb (want) (desire v/want v/persuade))\n```\n\n### Auxiliary Verbs\n\nAuxiliary verbs are simple enough to be described directly with the word macro.\nEach entry lists the auxiliary itself, the tense it is used to construct, and the tense it must be followed by.\nThe auxiliaries \"have\" and \"do\" are listed, along with \"to,\" which is used to construct infinitive clauses and thus can be treated as if it were an auxiliary.\n\n```lisp\n(word have    aux nonfinite -en)\n(word have    aux (finite ~3sing present) -en)\n(word has     aux (finite 3sing present) -en)\n(word had     aux (finite ? past) -en)\n(word having  aux -ing -en)\n\n(word do      aux (finite ~3sing present) nonfinite)\n(word does    aux (finite  3sing present) nonfinite)\n(word did     aux (finite  ?     past)    nonfinite)\n\n(word to      aux infinitive nonfinite)\n```\n\nThe auxiliary \"be\" is special: in addition to its use as both an auxiliary and main verb, it also is used in passives and as the main verb in aux-inverted sentences.\nThe function `copula` is used to keep track of all these uses.\nIt will be defined in the next section, but you can see it takes two arguments, a list of senses for the main verb, and a list of entries for the auxiliary verb.\nThe three senses correspond to the examples \"He is a fool,\" \"He is a Republican,\" and \"He is in Indiana,\" respectively.\n\n```lisp\n(copula\n  '((nil      ((nil 1 (NP ?x)) (nil 2 (Adj ?x))))\n    (is-a     ((exp 1 (NP ?x)) (arg2 2 (NP ?y))))\n    (is-loc   ((exp 1 (NP ?x)) (?prep 2 (PP ?prep ?)))))\n  '((be       nonfinite -ing)\n    (been     -en -ing)\n    (being    -ing -en)\n    (am       (finite 1sing present) -ing)\n    (is       (finite 3sing present) -ing)\n    (are      (finite 2pers present) -ing)\n    (were     (finite (- - ? ?) past) -ing)   ; 2nd sing or pl\n    (was      (finite (? - ? -) past) -ing))) ; 1st or 3rd sing\n```\n\nFollowing are the modal auxiliary verbs.\nAgain, it is difficult to specify semantics for them.\nThe word \"not\" is also listed here; it is not an auxiliary, but it does modify them.\n\n```lisp\n(word can    modal able      past)\n(word could  modal able      present)\n(word may    modal possible  past)\n(word might  modal possible  present)\n(word shall  modal mandatory past)\n(word should modal mandatory present)\n(word will   modal expected  past)\n(word would  modal expected  present)\n(word must   modal necessary present)\n\n(word not not)\n```\n\n### Nouns\n\nNo attempt has been made to treat nouns seriously.\nWe list enough nouns here to make some of the examples work.\nThe first noun shows a complement list that is sufficient to parse \"the destruction of the city by the enemy.\"\n\n```lisp\n(noun destruction * destruction\n      (pat (2) (PP of ?)) (agt (2) (PP by ?)))\n(noun beach)\n(noun bone)\n(noun box boxes)\n(noun city cities)\n(noun color)\n(noun cube)\n(noun doctor)\n(noun dog dogs)\n(noun enemy enemies)\n(noun file)\n(noun friend friends friend (friend-of (2) (PP of ?)))\n(noun furniture *)\n(noun hat)\n(noun man men)\n(noun saw)\n(noun woman women)\n```\n\n### Pronouns\n\nHere we list the nominative, objective, and genitive pronouns, followed by interrogative and relative pronouns.\nThe only thing missing are reflexive pronouns, such as \"myself.\"\n\n```lisp\n(word I     pronoun 1sing (common nom) -wh speaker)\n(word we    pronoun 1plur (common nom) -wh speaker+other)\n(word you   pronoun 2pers (common   ?) -wh listener)\n(word he    pronoun 3sing (common nom) -wh male)\n(word she   pronoun 3sing (common nom) -wh female)\n(word it    pronoun 3sing (common   ?) -wh anything)\n(word they  pronoun 3plur (common nom) -wh anything)\n\n(word me    pronoun 1sing (common obj) -wh speaker)\n(word us    pronoun 1plur (common obj) -wh speaker+other)\n(word him   pronoun 3sing (common obj) -wh male)\n(word her   pronoun 3sing (common obj) -wh female)\n(word them  pronoun 3plur (common obj) -wh anything)\n\n(word my    pronoun 1sing gen -wh speaker)\n(word our   pronoun 1plur gen -wh speaker+other)\n(word your  pronoun 2pers gen -wh listener)\n(word his   pronoun 3sing gen -wh male)\n(word her   pronoun 3sing gen -wh female)\n(word its   pronoun 3sing gen -wh anything)\n(word their pronoun 3plur gen -wh anything)\n(word whose pronoun 3sing gen +wh anything)\n\n(word who   pronoun ? (common ?) +wh person)\n(word whom  pronoun ? (common obj) +wh person)\n(word what  pronoun ? (common ?) +wh thing)\n(word which pronoun ? (common ?) +wh thing)\n\n(word who   rel-pro ? person)\n(word which rel-pro ? thing)\n(word that  rel-pro ? thing)\n(word whom  rel-pro (common obj) person)\n```\n\n### Names\n\nThe following names were convenient for one example or another:\n\n```lisp\n(word God   name 3sing)  (word Lynn  name 3sing)\n(word Jan   name 3sing)  (word Mary  name 3sing)\n(word John  name 3sing)  (word NY    name 3sing)\n(word Kim   name 3sing)  (word LA    name 3sing)\n(word Lee   name 3sing)  (word SF    name 3sing)\n```\n\n### Adjectives\n\nHere are a few adjectives:\n\n```lisp\n(word big   adj big)    (word bad   adj bad)\n(word old   adj old)    (word smart adj smart)\n(word green adj green)  (word red   adj red)\n(word tall  adj tall)   (word fun   adj fun)\n```\n\n### Adverbs\n\nThe adverbs covered here include interrogatives:\n\n```lisp\n(word quickly adv -wh quickly)\n(word slowly  adv -wh slowly)\n\n(word where   adv +wh loc)\n(word when    adv +wh time)\n(word why     adv +wh reason)\n(word how     adv +wh manner)\n```\n\n### Articles\n\nThe common articles are listed here:\n\n```lisp\n(word the   art 3sing the)\n(word the   art 3plur group)\n(word a     art 3sing a)\n(word an    art 3sing a)\n(word every art 3sing every)\n(word each  art 3sing each)\n(word all   art 3sing all)\n(word some  art ?     some)\n\n(word this  art 3sing this)\n(word that  art 3sing that)\n(word these art 3plur this)\n(word those art 3plur that)\n\n(word what  art ?     wh)\n(word which art ?     wh)\n```\n\n### Cardinal and Ordinal Numbers\n\nWe can take advantage of `format`'s capabilities to fill up the lexicon.\nTo go beyond 20, we would need a subgrammar of numbers.\n\n```lisp\n;; This puts in numbers up to twenty, as if by\n;; (word five cardinal 5 3plur)\n;; (word fifth ordinal 5)\n\n(dotimes (i 21)\n  (add-word (read-from-string (format nil \"~r\" i))\n            'cardinal i (if (= i 1) '3sing '3plur))\n  (add-word (read-from-string (format nil \"~:r\" i)) 'ordinal i))\n```\n\n### Prepositions\n\nHere is a fairly complete list of prepositions:\n\n```lisp\n(word above prep)  (word about prep)  (word around prep)\n(word across prep) (word after prep)  (word against prep)\n(word along prep)  (word at prep)     (word away prep)\n(word before prep) (word behind prep) (word below prep)\n(word beyond prep) (word by prep)     (word down prep)\n(word for prep)    (word from prep)   (word in prep)\n(word of prep)     (word off prep)    (word on prep)\n(word out prep)    (word over prep)   (word past prep)\n(word since prep)  (word through prep)(word throughout prep)\n(word till prep)   (word to prep)     (word under prep)\n(word until prep)  (word up prep)     (word with prep)\n(word without prep)\n```\n\n## 21.12 Supporting the Lexicon\n\nThis section describes the implementation of the macros `word`, `verb`, `noun`, and `abbrev`.\nAbbreviations are stored in a hash table.\nThe macro `abbrev` and the functions `get-abbrev` and `clear-abbrevs` define the interface.\nWe will see how to expand abbreviations later.\n\n```lisp\n(defvar *abbrevs* (make-hash-table))\n\n(defmacro abbrev (symbol definition)\n  \"Make symbol be an abbreviation for definition.\"\n  `(setf (gethash ',symbol *abbrevs*) ',definition))\n\n(defun clear-abbrevs () (clrhash *abbrevs*))\n(defun get-abbrev (symbol) (gethash symbol *abbrevs*))\n```\n\nWords are also stored in a hash table.\nCurrently, words are symbols, but it might be a better idea to use strings for words, since then we could maintain capitalization information.\nThe macro `word` or the function `add-word` adds a word to the lexicon.\nWhen used as an index into the hash table, each word returns a list of entries, where the first element of each entry is the word's category, and the other elements depend on the category.\n\n```lisp\n(defvar *words* (make-hash-table :size 500))\n\n(defmacro word (word cat &rest info)\n  \"Put word, with category and subcat info, into lexicon.\"\n  `(add-word ',word ',cat .,(mapcar #'kwote info)))\n\n(defun add-word (word cat &rest info)\n  \"Put word, with category and other info, into lexicon.\"\n  (push (cons cat (mapcar #'expand-abbrevs-and-variables info))\n        (gethash word *words*))\n  word)\n\n(defun kwote (x) (list 'quote x))\n```\n\nThe function `expand-abbrevs-and-variables` expands abbreviations and substitutes variable structures for symbols beginning with `?`.\nThis makes it easier to make a copy of the structure, which will be needed later.\n\n```lisp\n(defun expand-abbrevs-and-variables (exp)\n  \"Replace all variables in exp with vars, and expand abbrevs.\"\n  (let ((bindings nil))\n    (labels\n      ((expand (exp)\n         (cond\n           ((lookup exp bindings))\n           ((eq exp '?) (?))\n           ((variable-p exp)\n            (let ((var (?)))\n              (push (cons exp var) bindings)\n              var))\n           ((consp exp)\n            (reuse-cons (expand (first exp))\n                        (expand (rest exp))\n                        exp))\n           (t (multiple-value-bind (expansion found?)\n                  (get-abbrev exp)\n                (if found?\n                    (expand-abbrevs-and-variables expansion)\n                    exp))))))\n      (expand exp))))\n```\n\nNow we can store words in the lexicon, but we need some way of getting them out.\nThe function `word/n` takes a word (which must be instantiated to a symbol) and a category and optional additional information and finds the entries in the lexicon for that word that unify with the category and additional information.\nFor each match, it calls the supplied continuation.\nThis means that `word/n` is a replacement for a long list of word facts.\nThere are three differences: `word/n` hashes, so it will be faster; it is incremental (you can add a word at a time without needing to recompile); and it can not be used when the word is unbound.\n(It is not difficult to change it to handle an unbound word using `maphash`, but there are better ways of addressing that problem.)\n\n```lisp\n(defun word/n (word cat cont &rest info)\n  \"Retrieve a word from the lexicon.\"\n  (unless (unbound-var-p (deref word))\n    (let ((old-trail (fill-pointer *trail*)))\n      (dolist (old-entry (gethash word *words*))\n        (let ((entry (deref-copy old-entry)))\n          (when (and (consp entry)\n                     (unify! cat (first entry))\n                     (unify! info (rest entry)))\n            (funcall cont)))\n        (undo-bindings! old-trail)))))\n```\n\nNote that `word/n` does not follow our convention of putting the continuation last.\nTherefore, we will need the following additional functions:\n\n```lisp\n(defun word/2 (w cat cont) (word/n w cat cont))\n(defun word/3 (w cat a cont) (word/n w cat cont a))\n(defun word/4 (w cat a b cont) (word/n w cat cont a b))\n(defun word/5 (w cat a b c cont) (word/n w cat cont a b c))\n(defun word/6 (w cat a b c d cont) (word/n w cat cont a b c d))\n```\n\nWe could create the whole lexicon with the macro `word`, but it is convenient to create specific macros for some classes.\nThe macro `noun` is used to generate two entries, one for the singular and one for the plural.\nThe arguments are the base noun, optionally followed by the plural (which defaults to the base plus \"s\"), the semantics (which defaults to the base), and a list of complements.\nMass nouns, like \"furniture,\" have only one entry, and are marked by an asterisk where the plural would otherwise be.\n\n```lisp\n(defmacro noun (base &rest args)\n  \"Add a noun and its plural to the lexicon.\"\n  `(add-noun-form ',base ,@(mapcar #'kwote args)))\n\n(defun add-noun-form (base &optional (plural (symbol base 's))\n                      (sem base) &rest slots)\n  (if (eq plural '*)\n      (add-word base 'noun '? slots sem)\n      (progn\n        (add-word base 'noun '3sing slots sem)\n        (add-word plural 'noun '3plur slots sem))))\n```\n\nVerbs are more complex.\nEach verb has seven entries: the base or nonfinite, the present tense singular and plural, the past tense, the past-participle, the present-participle, and the passive.\nThe macro `verb` automatically generates all seven entries.\nVerbs that do not have all of them can be handled by individual calls to `word`.\nWe automatically handle the spelling for the simple cases of adding \"s,\" \"ing,\" and \"ed,\" and perhaps stripping a trailing vowel.\nMore irregular spellings have to be specified explicitly.\nHere are three examples of the use of `verb`:\n\n```lisp\n(verb (do did done doing does) (perform v/trans))\n(verb (eat ate eaten) (eat v/trans))\n(verb (trust) (trust v/trans ((agt 1 (NP ?)) (obj 2 (PP in ?)))))\n```\n\nAnd here is the macro definition:\n\n```lisp\n(defmacro verb ((base &rest forms) &body senses)\n  \"Enter a verb into the lexicon.\"\n  `(add-verb ',senses ',base ,@(mapcar #'kwote (mklist forms))))\n\n(defun add-verb (senses base &optional\n                 (past (symbol (strip-vowel base) 'ed))\n                 (past-part past)\n                 (pres-part (symbol (strip-vowel base) 'ing))\n                 (plural (symbol base 's)))\n  \"Enter a verb into the lexicon.\"\n  (add-word base 'verb 'nonfinite senses)\n  (add-word base 'verb '(finite ~3sing present) senses)\n  (add-word past 'verb '(finite ? past) senses)\n  (add-word past-part 'verb '-en senses)\n  (add-word pres-part 'verb '-ing senses)\n  (add-word plural 'verb '(finite 3sing present) senses)\n  (add-word past-part 'verb 'passive\n            (mapcar #'passivize-sense\n                    (expand-abbrevs-and-variables senses))))\n```\n\nThis uses a few auxiliary functions.\nFirst, `strip-vowel` removes a vowel if it is the last character of the given argument.\nThe idea is that for a verb like \"fire,\" stripping the vowel yields \"fir,\" from which we can get \"fired\" and \"firing\" automatically.\n\n```lisp\n(defun strip-vowel (word)\n  \"Strip off a trailing vowel from a string.\"\n  (let* ((str (string word))\n         (end (- (length str) 1)))\n    (if (vowel-p (char str end))\n        (subseq str 0 end)\n        str)))\n\n(defun vowel-p (char) (find char \"aeiou\" :test #'char-equal))\n```\n\nWe also provide a function to generate automatically the passive sense with the proper complement list(s).\nThe idea is that the subject slot of the active verb becomes an optional slot marked by the preposition \"by,\" and any slot that is marked with number 2 can be promoted to become the subject:\n\n```lisp\n(defun passivize-sense (sense)\n  ;; The first element of sense is the semantics; rest are slots\n  (cons (first sense) (mapcan #'passivize-subcat (rest sense))))\n\n(defun passivize-subcat (slots)\n  \"Return a list of passivizations of this subcat frame.\"\n  ;; Whenever the 1 slot is of the form (?any 1 (NP ?)),\n  ;; demote the 1 to a (3), and promote any 2 to a 1.\n  (when (and (eql (slot-number (first slots)) 1)\n             (starts-with (third (first slots)) 'NP))\n    (let ((old-1 `(,(first (first slots)) (3) (PP by ?))))\n      (loop for slot in slots\n            when (eql (slot-number slot) 2)\n            collect `((,(first slot) 1 ,(third slot))\n                      ,@(remove slot (rest slots))\n                      ,old-1)))))\n\n(defun slot-number (slot) (first-or-self (second slot)))\n```\n\nFinally, we provide a special function just to define the copula, \"be.\"\n\n```lisp\n(defun copula (senses entries)\n  \"Copula entries are both aux and main verb.\"\n  ;; They also are used in passive verb phrases and aux-inv-S\n  (dolist (entry entries)\n    (add-word (first entry) 'aux (second entry) (third entry))\n    (add-word (first entry) 'verb (second entry) senses)\n    (add-word (first entry) 'aux (second entry) 'passive)\n    (add-word (first entry) 'be)))\n```\n\nThe remaining functions are used for testing, debugging, and extending the grammar.\nFirst, we need functions to clear everything so that we can start over.\nThese functions can be placed at the top of the lexicon and grammar files, respectively:\n\n```lisp\n(defun clear-lexicon ()\n  (clrhash *words*)\n  (clear-abbrevs))\n\n(defun clear-grammar ()\n  (clear-examples)\n  (clear-db))\n```\n\nTesting could be done with `run-examples`, but it is convenient to provide another interface, the macro `try` (and its corresponding function, `try-dcg`).\nBoth macro and function can be invoked three ways.\nWith no argument, all the examples stored by `:ex` are run.\nWhen the name of a category is given, all the examples for that category alone are run.\nFinally, the user can supply both the name of a category and a list of words to test whether those words can be parsed as that category.\nThis option is only available for categories that are listed in the definition:\n\n```lisp\n(defmacro try (&optional cat &rest words)\n  \"Tries to parse WORDS as a constituent of category CAT.\n  With no words, runs all the :ex examples for category.\n  With no cat, runs all the examples.\"\n  `(try-dcg ',cat ',words))\n\n(defun try-dcg (&optional cat words)\n  \"Tries to parse WORDS as a constituent of category CAT.\n  With no words, runs all the :ex examples for category.\n  With no cat, runs all the examples.\"\n  (if (null words)\n      (run-examples cat)\n      (let ((args `((gap nil) (gap nil) ?sem ,words ())))\n        (mapc #'test-unknown-word words)\n        (top-level-prove\n          (ecase cat\n            (np `((np ? ? ?wh ?x ,@args)))\n            (vp `((vp ?infl ?x ?sl ?v ,@args)))\n            (pp `((pp ?prep ?role ?wh ?x ,@args)))\n            (xp `((xp ?slot ?constituent ?wh ?x ,@args)))\n            (s  `((s ? ?sem ,words ())))\n            (rel-clause `((rel-clause ? ?x ?sem ,words ())))\n            (clause `((clause ?infl ?x ?int-subj ?v ?g1 ?g2\n                              ?sem ,words ()))))))))\n\n(defun test-unknown-word (word)\n  \"Print a warning message if this is an unknown word.\"\n  (unless (or (gethash word *words*) (numberp word))\n    (warn \"~&Unknown word: ~a\" word)))\n```\n\n## 21.13 Other Primitives\n\nTo support the `:test` predicates made in various grammar rules we need definitions of the Prolog predicates `if, member, =, numberp`, and `atom`.\nThey are repeated here:\n\n```lisp\n(<- (if ?test ?then) (if ?then ?else (fail)))\n(<- (if ?test ?then ?else) (call ?test) ! (call ?then))\n(<- (if ?test ?then ?else) (call ?else))\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ?rest)) (member ?item ?rest))\n(<- (= ?x ?x))\n(defun numberp/1 (x cont)\n    (when (numberp (deref x))\n      (funcall cont)))\n(defun atom/1 (x cont)\n    (when (atom (deref x))\n      (funcall cont)))\n(defun call/1 (goal cont)\n    \"Try to prove goal by calling it.\"\n    (deref goal)\n    (apply (make-predicate (first goal)\n                    (length (args goal)))\n            (append (args goal) (list cont))))\n```\n\n## 21.14 Examples\n\nHere are some examples of what the parser can handle.\nI have edited the output by changing variable names like `?168` to more readable names like `?J`.\nThe first two examples show that nested clauses are supported and that we can extract a constituent from a nested clause:\n\n```lisp\n> (try S John promised Kim to persuade Lee to sleep)\n?SEM = (AND (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n            (PAST ?P) (PROMISE ?P)\n            (GOAL ?P ?K) (THE ?K (NAME KIM ?K))\n            (CON ?P ?PER) (PERSUADE ?PER) (GOAL ?PER ?L)\n            (THE ?L (NAME LEE ?L)) (CON ?PER ?S) (SLEEP ?S));\n> (try S Who did John promise Kim to persuade to sleep)\n?SEM = (AND (WH ?W (PERSON ?W)) (PAST ?P)\n            (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n            (PROMISE ?P) (GOAL ?P ?K)\n            (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n            (PERSUADE ?PER) (GOAL ?PER ?W)\n            (CON ?PER ?S) (SLEEP ?S));\n```\n\nIn the next example, the \"when\" can be interpreted as asking about the time of any of the three events: the promising, the persuading, or the sleeping.\nThe grammar finds all three.\n\n```lisp\n>(try S When did John promise Kim to persuade Lee to sleep)\n?SEM = (AND (WH ?W (TIME ?S ?W)) (PAST ?P)\n            (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n            (PROMISE ?P) (GOAL ?P ?K)\n            (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n            (PERSUADE ?PER) (GOAL ?PER ?L)\n            (THE ?L (NAME LEE ?L)) (CON ?PER ?S)\n            (SLEEP ?S));\n?SEM = (AND (WH ?W (TIME ?PER ?W)) (PAST ?P)\n            (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n            (PROMISE ?P) (GOAL ?P ?K)\n            (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n            (PERSUADE ?PER) (GOAL ?PER ?L)\n            (THE ?L (NAME LEE ?L)) (CON ?PER ?S)\n            (SLEEP ?S));\n?SEM = (AND (WH ?W (TIME ?P ?W)) (PAST ?P)\n            (THE ?J (NAME JOHN ?J)) (AGT ?P ?J)\n            (PROMISE ?P) (GOAL ?P ?K)\n            (THE ?K (NAME KIM ?K)) (CON ?P ?PER)\n            (PERSUADE ?PER) (GOAL ?PER ?L)\n            (THE ?L (NAME LEE ?L)) (CON ?PER ?S)\n            (SLEEP ?S)).\n```\n\nThe next example shows auxiliary verbs and negation.\nIt is ambiguous between an interpretation where Kim is searching for Lee and one where Kim is looking at something unspecified, on Lee's behalf.\n\n```lisp\n>(try S Kim would not have been looking for Lee)\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?S ?K)\n            (EXPECTED ?S) (NOT ?S) (PAST-PARTICIPLE ?S)\n            (PROGRESSIVE ?S) (SEARCH ?S) (PAT ?S ?L)\n            (PAT ?S ?L) (THE ?L (NAME LEE ?L)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?2 ?K)\n            (EXPECTED ?2) (NOT ?2) (PAST-PARTICIPLE ?LOOK)\n            (PROGRESSIVE ?LOOK) (LOOK ?LOOK) (FOR ?LOOK ?L)\n            (THE ?L (NAME LEE ?L)));\n```\n\nThe next two examples are unambiguous:\n\n```lisp\n> (try s It should not surprise you that Kim does not like Lee)\n?SEM = (AND (MANDATORY ?2) (NOT ?2) (SURPRISE ?2) (EXP ?2 ?Y0U)\n            (PRO ?YOU (LISTENER ?YOU)) (CON ?2 ?LIKE)\n            (THE ?K (NAME KIM ?K)) (AGT ?LIKE ?K)\n            (PRESENT ?LIKE) (NOT ?LIKE) (LIKE-1 ?LIKE)\n            (OBJ ?LIKE ?L) (THE ?L (NAME LEE ?L)));\n>(try s Kim did not want Lee to know that the man knew her)\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?W ?K) (PAST ?W)\n            (NOT ?W) (DESIRE ?W) (GOAL ?W ?L)\n            (THE ?L (NAME LEE ?L)) (CON ?W ?KN)\n            (KNOW-THAT ?KN) (CON ?KN ?KN2)\n            (THE ?M (MAN ?M)) (AGT ?KN2 ?M) (PAST ?KN2)\n            (KNOW-OF ?KN2) (OBJ ?KN2 ?HER)\n            (PRO ?HER (FEMALE ?HER))).\n```\n\nThe final example appears to be unambiguous, but the parser finds four separate parses.\nThe first is the obvious interpretation where the looking up is done quickly, and the second has quickly modifying the surprise.\nThe last two interpretations are the same as the first two; they are artifacts of the search process.\nA disambiguation procedure should be equipped to weed out such duplicates.\n\n```lisp\n>(try s That Kim looked her up quickly surprised me)\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU1 ?K) (PAST ?LU1)\n            (LOOK-UP ?LU1) (PAT ?LU1 ?H) (PRO ?H (FEMALE ?H))\n            (QUICKLY ?LU1) (CON ?S ?LU1) (PAST ?S) (SURPRISE ?S)\n            (EXP ?S ?ME1) (PRO ?ME1 (SPEAKER ?ME1)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU2 ?K) (PAST ?LU2)\n            (LOOK-UP ?LU2) (PAT ?LU2 ?H) (PRO ?H (FEMALE ?H))\n            (CON ?S ?LU2) (QUICKLY ?S) (PAST ?S) (SURPRISE ?S)\n            (EXP ?S ?ME2) (PRO ?ME2 (SPEAKER ?ME2)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU3 ?K) (PAST ?LU3)\n            (LOOK-UP ?LU3) (PAT ?LU3 ?H) (PRO ?H (FEMALE ?H))\n            (QUICKLY ?LU3) (CON ?S ?LU3) (PAST ?S) (SURPRISE ?S)\n            (EXP ?S ?ME3) (PRO ?ME3 (SPEAKER ?ME3)));\n?SEM = (AND (THE ?K (NAME KIM ?K)) (AGT ?LU4 ?K) (PAST ?LU4)\n            (LOOK-UP ?LU4) (PAT ?LU4 ?H) (PRO ?H (FEMALE ?H))\n            (CON ?S ?LU4) (QUICKLY ?S) (PAST ?S) (SURPRISE ?S)\n            (EXP ?S ?ME4) (PRO ?ME4 (SPEAKER ?ME4)));\n```\n\n## 21.15 History and References\n\n[Chapter 20](chapter20.md) provides some basic references on natural language.\nHere we will concentrate on references that provide:\n\n1.  A comprehensive grammar of English.\n\n2.  A complete implementation.\n\nThere are a few good textbooks that partially address both issues.\nBoth [Winograd (1983)](bibliography.md#bb1395) and [Allen (1987)](bibliography.md#bb0030) do a good job of presenting the major grammatical features of English and discuss implementation techniques, but they do not provide actual code.\n\nThere are also a few textbooks that concentrate on the second issue.\n[Ramsey and Barrett (1987)](bibliography.md#bb0975) and [Walker et al.\n(1990)](bibliography.md#bb1295) provide chapter-length implementations at about the same level of detail as this chapter.\nBoth are recommended.\n[Pereira and Shieber 1987](bibliography.md#bb0945) and [Gazdar and Mellish 1989](bibliography.md#bb0445) are book-length treatments, but because they cover a variety of parsing techniques rather than concentrating on one in depth, they are actually less comprehensive.\n\nSeveral linguists have made serious attempts at addressing the first issue.\nThe largest is the aptly named A *Comprehensive Grammar of Contemporary English* by Quirk, Greenbaum, Leech and Svartik (1985).\nMore manageable (although hardly concise) is their abridged edition, *A Concise Grammar of Contemporary English.* Both editions contain a gold mine of examples and facts about the English langauge, but the authors do not attempt to write rigorous rules.\n[Harris (1982)](bibliography.md#bb0510) and [Huddleston (1984)](bibliography.md#bb0555) offer less complete grammars with greater linguistic rigor.\n\nNaomi [Sager (1981)](bibliography.md#bb1035) presents the most complete computerized grammar ever published.\nThe grammar is separated into a simple, neat, context-free component and a rather baroque augmentation that manipulates features.\n\n## 21.16 Exercises\n\n**Exercise  21.1 [m]** Change the grammar to account better for *mass nouns.* The current grammar treats mass nouns by making them vague between singular and plural, which is incorrect.\nThey should be treated separately, since there are determiners such as \"much\" that work only with mass nouns, and other determiners such as \"these\" that work only with plural count nouns.\n\n**Exercise  21.2 [m]** Change the grammar to make a distinction between *attributive* and *predicative* adjectives.\nMost adjectives fall into both classes, but some can be used only attributively, as in \"an *utter* fool\" but not \"\\*the fool is *utter.\"*\nOther adjectives can only be used predicatively, as in \"the woman was *loath* to admit it\" but not \"\\*a *loath* (to admit it) woman.\"\n\n**Exercise  21.3 [h]** Implement complement lists for adjectives, so that \"loath\" would take an obligatory infinitive complement, and \"proud\" would take an optional `(PP of)` complement.\nIn connection to the previous exercise, note that it is rare if not impossible for attributive adjectives to take complements: \"he is proud,\" \"he is proud of his country\" and \"a proud citizen\" are all acceptable, but \"\\*a proud of his country citizen\" is not.\n\n**Exercise  21.4 [m]** Add rules to `advp` to allow for adverbs to modify other adverbs, as in \"extremely likely\" or \"very strongly.\"\n\n**Exercise  21.5 [h]** Allow adverbs to modify adjectives, as in \"very good\" or \"really delicious.\" The syntax will be easy, but it is harder to get a reasonable semantics.\nWhile you're at it, make sure that you can handle adjectives with so-called *non-intersective* semantics.\nSome adjectives can be handled by intersective semantics: a red circle is something that is red and is a circle.\nBut for other adjectives, this model does not work: a former senator is not something that is former and is a senator-a former senator is not a senator at all.\nSimilarly, a toy elephant is not an elephant.\n\nThe semantics should be represented by something doser to `((toy elephant) ?x)` rather than `(and (toy ?x) (elephant ?x))`.\n\n**Exercise  21.6 [m]** Write a function that notices punctuation instead of ignoring it.\nIt should work something like this:\n\n```lisp\n(string->words \"Who asked Lee, Kim and John?\")\n(WHO ASKED LEE |,| KIM AND JOHN |?|)\n```\n\n**Exercise  21.7 [m]** Change the grammar to allow optional punctuation marks at the end of sentences and before relative clauses.\n\n**Exercise  21.8 [m]** Change the grammar to allow conjunction with more than two elements, using commas.\nCan these rules be generated automatically by `conj-rule?`\n\n**Exercise  21.9 [h]** Make a distinction between *restrictive* and *nonrestrictive* relative clauses.\nIn \"The truck *that has 4-wheel drive* costs $5000,\" the italicized relative clause is restrictive.\nIt serves to identify the truck and thus would be part of the quantifier's restriction.\nThe complete sentence might be interpreted as:\n\n```lisp\n(and (the ?x (and (truck ?x) (4-wheel-drive ?x)))\n        (costs ?x $5000))\n```\n\nContrast this to \"The truck, which has 4-wheel drive, costs $5000.\" Here the relative clause is nonrestrictive and thus belongs outside the quantifier's restriction:\n\n```lisp\n(and (the ?x (truck ?x))\n      (4-wheel-drive ?x) (costs ?x $5000))\n```\n"
  },
  {
    "path": "docs/chapter22.md",
    "content": "# Chapter 22\n## Scheme: An Uncommon Lisp\n\n> The best laid schemes o' mice an' men\n\n> -Robert Burns (1759-1796)\n\nThis chapter presents the Scheme dialect of Lisp and an interpreter for it.\nWhile it is not likely that you would use this interpreter for any serious programming, understanding how the interpreter works can give you a better appreciation of how Lisp works, and thus make you a better programmer.\nA Scheme interpreter is used instead of a Common Lisp one because Scheme is simpler, and also because Scheme is an important language that is worth knowing about.\n\nScheme is the only dialect of Lisp besides Common Lisp that is currently flourishing.\nWhere Common Lisp tries to standardize all the important features that are in current use by Lisp programmers, Scheme tries to give a minimal set of very powerful features that can be used to implement the others.\nIt is interesting that among all the programming languages in the world, Scheme is one of the smallest, while Common Lisp is one of the largest.\nThe Scheme manual is only 45 pages (only 38 if you omit the example, bibliography, and index), while *Common Lisp the Language*, 2d edition, is 1029 pages.\nHere is a partial list of the ways Scheme is simpler than Common Lisp:\n\n1.  Scheme has fewer built-in functions and special forms.\n\n2.  Scheme has no special variables, only lexical variables.\n\n3.  Scheme uses the same name space for functions and variables (and everything else).\n\n4.  Scheme evaluates the function part of a function call in exactly the same way as the arguments.\n\n5.  Scheme functions can not have optional and keyword parameters.\nHowever, they can have the equivalent of a `&rest` parameter.\n\n6.  Scheme has no `block`, `return`, `go`, or `throw`; a single function `(call/cc)` replaces all of these (and does much more).\n\n7.  Scheme has no packages.\nLexical variables can be used to implement package-like structures.\n\n8.  Scheme, as a standard, has no macros, although most implementations provide macros as an extension.\n\n9.  Scheme has no special forms for looping; instead it asks the user to use recursion and promises to implement the recursion efficiently.\n\nThe five main special forms in Scheme are `quote` and `if`, which are just as in Common Lisp; `begin` and `set!`, which are just different spellings for `progn` and `setq`; and `lambda`, which is as in Common Lisp, except that it doesn't require a `#'` before it.\nIn addition, Scheme allows variables, constants (numbers, strings, and characters), and function calls.\nThe function call is different because the function itself is evaluated in the same way as the arguments.\nIn Common Lisp, (`f x`) means to look up the function binding of `f` and apply that to the value of `x`.\nIn Scheme, `(f x)` means to evaluate `f` (in this case by looking up the value of the variable `f` ), evaluate `x` (by looking up the value of the variable in exactly the same way) and then apply the function to the argument.\nAny expression can be in the function position, and it is evaluated just like the arguments.\nAnother difference is that Scheme uses `#t` and `#f` for true and false, instead of `t` and `nil`.\nThe empty list is denoted by `()`, and it is distinct from the false value, `#f`.\nThere are also minor lexical differences in the conventions for complex numbers and numbers in different bases, but these can be ignored for all the programs in this book.\nAlso, in Scheme a single macro, `define`, serves to define both variables and functions.\n\n| Scheme                           | Common Lisp                              |\n|----------------------------------|------------------------------------------|\n| *var*                            | *var*                                    |\n| *constant*                       | *constant*                               |\n| (`quote` *x*) or '*x*            | (`quote` *x*) or '*x*                    |\n| (`begin` *x*...)                 | (`progn` *x*...)                         |\n| (`set!` *var x*)                 | (`setq` *var x*)                         |\n| (`if` *p a b*)                   | (`if` *p a b*)                           |\n| (`lambda` *parms x*...)          | `#'` (`lambda` *parms x*...)             |\n| (*fn arg*...)                    | (*fn arg*...) or (`funcall` *fn arg*...) |\n| `#t`                             | `t`                                      |\n| `#f`                             | `nil`                                    |\n| `( )`                            | `nil`                                    |\n| (`define` *var exp*)             | (`defparameter` *var exp*)               |\n| (`define` (*fn parm*...) *body*) | (`defun` *fn* (*parm*...) *body*)        |\n\n**Exercise  22**.**1** [**s**] What does the following expression evaluate to in Scheme?\nHow many errors does it have as a Common Lisp expression?\n\n```lisp\n((if (= (+  2 2) 4)\n      (lambda (x y) (+ (* x y) 12))\n      cons)\n  5\n  6)\n```\n\nA great many functions, such as `car`, `cdr`, `cons`, `append`, +, `*`, and `list` are the same (or nearly the same) in both dialects.\nHowever, Scheme has some spelling conventions that are different from Common Lisp.\nMost Scheme mutators, like `set!`, end in '`!`'\nCommon Lisp has no consistent convention for this; some mutators start with `n` (`nreverse`, `nsubst`, `nintersection`) while others have idiosyncratic names (`delete` versus `remove`).\nScheme would use consistent names - `reverse!` and `remove!` - if these functions were defined at all (they are not defined in the standard).\nMost Scheme predicates end in '`?`', not '`p`'.\nThis makes predicates more obvious and eliminates the complicated conventions for adding a hyphen before the `p`.<a id=\"tfn22-1\"></a><sup>[1](#fn22-1)</sup>\nThe only problem with this convention is in spoken language: is `equal?` pronounced \"equal-question-mark\" or \"equal-q\" or perhaps equal, with rising intonation?\nThis would make Scheme a tone language, like Chinese.\n\nIn Scheme, it is an error to apply `car` or `cdr` to the empty list.\nDespite the fact that Scheme has `cons`, it calls the result a `pair` rather than a cons cell, so the predicate is `pair?`, not `consp`.\n\nScheme recognizes not all lambda expressions will be \"functions\" according to the mathematical definition of function, and so it uses the term \"procedure\" instead.\nHere is a partial list of correspondences between the two dialects:\n\n| Scheme Procedure | Common Lisp Function |\n|------------------|----------------------|\n| `char-ready?`    | `listen`             |\n| `char?`          | `characterp`         |\n| `eq?`            | `eq`                 |\n| `equal?`         | `equal`              |\n| `eqv?`           | `eql`                |\n| `even?`          | `evenp`              |\n| `for-each`       | `mapc`               |\n| `integer?`       | `integerp`           |\n| `list->string`   | `coerce`             |\n| `list->vector`   | `coerce`             |\n| `list-ref`       | `nth`                |\n| `list-tail`      | `nthcdr`             |\n| `map`            | `mapcar`             |\n| `negative?`      | `minusp`             |\n| `pair?`          | `consp`              |\n| `procedure?`     | `functionp`          |\n| `set!`           | `setq`               |\n| `set-car!`       | `replaca`            |\n| `vector-set!`    | `setf`               |\n| `string-set!`    | `setf`               |\n\n## 22.1 A Scheme Interpreter\n\nAs we have seen, an interpreter takes a program (or expression) as input and returns the value computed by that program.\nThe Lisp function `eval` is thus an interpreter, and that is essentially the function we are trying to write in this section.\nWe have to be careful, however, in that it is possible to confuse the notions of interpreter and compiler.\nA compiler takes a program as input and produces as output a translation of that program into some other language-usually a language that can be directly (or more easily) executed on some machine.\nSo it is also possible to write `eval` by compiling the argument and then interpreting the resulting machine-level program.\nMost modern Lisp systems support both possibilities, although some only interpret code directly, and others compile all code before executing it.\nTo make the distinction clear, we will not write a function called `eval`.\nInstead, we will write versions of two functions: `interp`, a Scheme interpreter, and, in the next chapter, `comp`, a Scheme compiler.\n\nAn interpreter that handles the Scheme primitives is easy to write.\nIn the interpreter `interp`, the main conditional has eight cases, corresponding to the five special forms, symbols, other atoms, and procedure applications (otherwise known as function calls).\nFor the moment we will stick with `t` and `nil` instead of `#t` and `#f`.\nAfter developing a simple interpreter, we will add support for macros, then develop a tail-recursive interpreter, and finally a continuation-passing interpreter.\n(These terms will be defined when the time comes.).\nThe glossary for `interp` is in [figure 22.1](#f0010).\n\n| | **Top-Level Functions** |\n|---|---|\n| `scheme` | A Scheme read-interp-print loop |\n| `interp` | Interpret (evaluate) an expression in an environment. |\n| `def-scheme-macro` | Define a Scheme macro. |\n| | **Special Variables** |\n| `*scheme-procs*` | Some procedures to store in the global environment. |\n| | **Auxiliary Functions** |\n| `set-var!` | Set a variable to a value |\n| `get-var` | Get the value of a variable in an environment. |\n| `set-global-var!` | Set a global variable to a value. |\n| `get-global-var` | Get the value of a variable from the global environment. |\n| `extend-env` | Add some variables and values to an environment. |\n| `init-scheme-iterp` | Initialize some global variables. |\n| `init-scheme-proc` | Define a primitive Scheme procedure. |\n| `scheme-macro` | Retrieve the Scheme macro for a symbol. |\n| `scheme-macro-expand` | Macro-expand a Scheme expression. |\n| `maybe-add` | Add an element to the front of a non-singleton list. |\n| `print-proc` | Print a procedure. |\n| | **Data Type (tail-recursive version only)** |\n| `proc` | A Scheme procedure. |\n| | **Functions (continuation version only)** |\n| `interp-begin` | Interpret a `begin` expression. |\n| `interp-call` | Interpret a function application. |\n| `map-interp` | Map `interp` over a list. |\n| `call/cc` | call with current continuation. |\n| | **Previously Defined Functions** |\n| `lastl` | Select the last element of a list. |\n| `length=1` | Is this a list of length 1? |\n| Table 22.1: Glossary for the Scheme Interpreter |\n\nThe simple interpreter has eight cases to worry about: (1) If the expression is a symbol, look up its value in the environment.\n(2) If it is an atom that is not a symbol (such as a number), just return it.\nOtherwise, the expression must be a list.\n(3) If it starts with `quote`, return the quoted expression.\n(4) If it starts with `begin`, interpret each subexpression, and return the last one.\n(5) If it starts with `set!`, interpret the value and then set the variable to that value.\n(6) If it starts with `if`, then interpret the conditional, and depending on if it is true or not, interpret the then-part or the else-part.\n(7) If it starts with `lambda`, build a new procedure-a closure over the current environment.\n(8) Otherwise, it must be a procedure application.\nInterpret the procedure and all the arguments, and apply the procedure value to the argument values.\n\n```lisp\n(defun interp (x &optional env)\n  \"Interpret (evaluate) the expression x in the environment env.\"\n  (cond\n    ((symbolp x) (get-var x env))\n    ((atom x) x)\n    ((case (first x)\n       (QUOTE  (second x))\n       (BEGIN  (last1 (mapcar #'(lambda (y) (interp y env))\n                              (rest x))))\n       (SET!   (set-var! (second x) (interp (third x) env) env))\n       (IF     (if (interp (second x) env)\n                   (interp (third x) env)\n                   (interp (fourth x) env)))\n       (LAMBDA (let ((parms (second x))\n                     (code (maybe-add 'begin (rest2 x))))\n                 #'(lambda (&rest args)\n                     (interp code (extend-env parms args env)))))\n       (t      ;; a procedure application\n               (apply (interp (first x) env)\n                      (mapcar #'(lambda (v) (interp v env))\n                              (rest x))))))))\n```\n\nAn environment is represented as an association list of variable/value pairs, except for the global environment, which is represented by values on the `global-val` property of symbols.\nIt would be simpler to represent the global environment in the same way as local environments, but it is more efficient to use property lists than one big global a-list.\nFurthermore, the global environment is distinct in that every symbol is implicitly defined in the global environment, while local environments only contain variables that are explicitly mentioned (in a `lambda` expression).\n\nAs an example, suppose we interpret the function call `(f 1 2 3)`, and that the functions `f` has been defined by the Scheme expression:\n\n```lisp\n(set! f (lambda (a b c) (+ a (g b c))))\n```\n\nThen we will interpret `( f 1 2 3 )` by interpreting the body of `f` with the environment:\n\n```lisp\n((a 1) (b 2) (c 3))\n```\n\nScheme procedures are implemented as Common Lisp functions, and in fact all the Scheme data types are implemented by the corresponding Common Lisp types.\nI include the function `init-scheme-interp` to initialize a few global values and repeat the definitions of `last1` and `length=1`:\n\n```lisp\n(defun set-var! (var val env)\n  \"Set a variable to a value, in the given or global environment.\"\n  (if (assoc var env)\n      (setf (second (assoc var env)) val)\n      (set-global-var! var val))\n  val)\n\n(defun get-var (var env)\n  \"Get the value of a variable, from the given or global environment.\"\n    (if (assoc var env)\n        (second (assoc var env))\n        (get-global-var var)))\n\n(defun set-global-var! (var val)\n  (setf (get var 'global-val) val))\n\n(defun get-global-var (var)\n  (let* ((default \"unbound\")\n         (val (get var 'global-val default)))\n    (if (eq val default)\n        (error \"Unbound scheme variable: ~a\" var)\n        val)))\n\n(defun extend-env (vars vals env)\n  \"Add some variables and values to an environment.\"\n  (nconc (mapcar #'list vars vals) env))\n\n(defparameter *scheme-procs*\n  '(+ - * / = < > <= >= cons car cdr not append list read member\n    (null? null) (eq? eq) (equal? equal) (eqv? eql)\n    (write prin1) (display princ) (newline terpri)))\n\n(defun init-scheme-interp ()\n  \"Initialize the scheme interpreter with some global variables.\"\n  ;; Define Scheme procedures as CL functions:\n  (mapc #'init-scheme-proc *scheme-procs*)\n  ;; Define the boolean `constants'. Unfortunately, this won't\n  ;; stop someone from saying: (set! t nil)\n  (set-global-var! t t)\n  (set-global-var! nil nil))\n\n(defun init-scheme-proc (f)\n  \"Define a Scheme procedure as a corresponding CL function.\"\n  (if (listp f)\n      (set-global-var! (first f) (symbol-function (second f)))\n      (set-global-var! f (symbol-function f))))\n```\n\n```lisp\n(defun maybe-add (op exps &optional if-nil)\n  \"For example, (maybe-add 'and exps t) returns\n  t if exps is nil, exps if there is only one,\n  and (and exp1 exp2...) if there are several exps.\"\n  (cond ((null exps) if-nil)\n              ((length=1 exps) (first exps))\n              (t (cons op exps))))\n(defun length=1 (x)\n  \"Is x a list of length 1?\"\n  (and (consp x) (null (cdr x))))\n(defun lastl (list)\n  \"Return the last element (not last cons cell) of list\"\n  (first (last list)))\n```\n\nTo test the interpreter, we add a simple read-eval-print loop:\n\n```lisp\n(defun scheme ()\n  \"A Scheme read-eval-print loop (using interp)\"\n  (init-scheme-interp)\n  (loop (format t \"~&==> \")\n        (print (interp (read) nil))))\n```\n\nAnd now we're ready to try out the interpreter.\nNote the Common Lisp prompt is `>`, while the Scheme prompt is `==>`.\n\n```lisp\n> (scheme)\n==> (+ 2 2)\n4\n==> ((if (= 1 2) * +) 3 4)\n7\n==> ((if (= 1 1) * +) 3 4)\n12\n==> (set! fact (lambda (n)\n        (if (= n 0) 1\n          (* n (fact (- n 1))))))\n#<DTP-LEXICAL-CLOSURE 36722615 >\n==> (fact 5)\n120\n==> (set! table (lambda (f start end)\n          (if (<= start end)\n            (begin\n             (write (list start (f start)))\n             (newline)\n             (table f (+ start 1) end)))))\n#<DTP-LEXICAL-CLOSURE 41072172 >\n==> (table fact 1 10)\n(1 1)\n(2 2)\n(3 6)\n(4 24)\n(5 120)\n(6 720)\n(7 5040)\n(8 40320)\n(9 362880)\n(10 3628800)\nNIL\n==> (table (lambda (x) (* x x x)) 5 10)\n(5 125)\n(6 216)\n(7 343)\n(8 512)\n(9 729)\n(10 1000)\nNIL\n==> [ABORT]\n```\n\n## 22.2 Syntactic Extension with Macros\n\nScheme has a number of other special forms that were not listed above.\nActually, Scheme uses the term \"syntax\" where we have been using \"special form.\" The remaining syntax can be defined as \"derived expressions\" in terms of the five primitives.\nThe Scheme standard does not recognize a concept of macros, but it is clear that a \"derived expression\" is like a macro, and we will implement them using macros.\nThe following forms are used (nearly) identically in Scheme and Common Lisp:\n\n```lisp\nlet let* and or do cond case\n```\n\nOne difference is that Scheme is less lenient as to what counts as a binding in `let`, `let*` and `do`.\nEvery binding must be `(`*var init*`)`; just `(`*var*`)` or *var* is not allowed.\nIn do, a binding can be either (*var init step*) or (*var init*).\nNotice there is no `do*`.\nThe other difference is in `case` and `cond`.\nWhere Common Lisp uses the symbol `t` or `otherwise` to mark the final case, Scheme uses `else`.\nThe final three syntactic extensions are unique to Scheme:\n\n```lisp\n(define *var val*)      *or*          (define (*proc*-*name arg*...) *body*...)\n(delay *expression*)\n(letrec ((*var init*)...) *body*...)\n```\n\n`define` is a combination of `defun` and `defparameter`.\nIn its first form, it assigns a value to a variable.\nSince there are no special variables in Scheme, this is no different than using `set!`.\n(There is a difference when the `define` is nested inside another definition, but that is not yet considered.) In the second form, it defines a function.\n`delay` is used to delay evaluation, as described in [section 9.3](chapter9.md#s0020), page 281.\n`letrec` is similar to `let`.\nThe difference is that all the *init* forms are evaluated in an environment that includes all the *vars*.\nThus, `letrec` can be used to define local recursive functions, just as `labels` does in Common Lisp.\n\nThe first step in implementing these syntactic extensions is to change `interp` to allow macros.\nOnly one clause has to be added, but we'll repeat the whole definition:\n\n```lisp\n(defun interp (x &optional env)\n  \"Interpret (evaluate) the expression x in the environment env.\"\n  (cond\n    ((symbolp x) (get-var x env))\n    ((atom x) x)\n    ((scheme-macro (first x))              ;***\n     (interp (scheme-macro-expand x) env)) ;***\n    ((case (first x)\n       (QUOTE  (second x))\n       (BEGIN  (last1 (mapcar #'(lambda (y) (interp y env))\n                              (rest x))))\n       (SET!   (set-var! (second x) (interp (third x) env) env))\n       (IF     (if (interp (second x) env)\n                   (interp (third x) env)\n                   (interp (fourth x) env)))\n       (LAMBDA (let ((parms (second x))\n                     (code (maybe-add 'begin (rest2 x))))\n                 #'(lambda (&rest args)\n                     (interp code (extend-env parms args env)))))\n       (t      ;; a procedure application\n               (apply (interp (first x) env)\n                      (mapcar #'(lambda (v) (interp v env))\n                              (rest x))))))))\n```\n\nNow we provide a mechanism for defining macros.\nThe macro definitions can be in any convenient language; the easiest choices are Scheme itself or Common Lisp.\nI have chosen the latter.\nThis makes it clear that macros are not part of Scheme itself but rather are used to implement Scheme.\nIf we wanted to offer the macro facility to the Scheme programmer, we would make the other choice.\n(But then we would be sure to add the backquote notation, which is so useful in writing macros.) `def-scheme-macro` (which happens to be a macro itself) provides a way of adding new Scheme macros.\nIt does that by storing a Common Lisp function on the `scheme-macro` property of a symbol.\nThis function, when given a list of arguments, returns the code that the macro call should expand into.\nThe function `scheme-macro` tests if a symbol has a macro attached to it, and `scheme-macro-expand` does the actual macro-expansion:\n\n```lisp\n(defun scheme-macro (symbol)\n  (and (symbolp symbol) (get symbol 'scheme-macro)))\n(defmacro def-scheme-macro (name parmiist &body body)\n  \"Define a Scheme macro.\"\n  '(setf (get ',name 'scheme-macro)\n        #'(lambda .parmlist ..body)))\n(defun scheme-macro-expand (x)\n  \"Macro-expand this Scheme expression.\"\n  (if (and (listp x) (scheme-macro (first x)))\n              (scheme-macro-expand\n                (apply (scheme-macro (first x)) (rest x)))\n              x))\n```\n\nHere are the definitions of nine important macros in Scheme:\n\n```lisp\n(def-scheme-macro let (bindings &rest body)\n  '((lambda .(mapcar #'first bindings) . ,body)\n    .,(mapcar #'second bindings)))\n(def-scheme-macro let* (bindings &rest body)\n  (if (null bindings)\n              '(begin .,body)\n              '(let (,(first bindings))\n          (let* ,(rest bindings) . ,body))))\n(def-scheme-macro and (&rest args)\n  (cond ((null args) 'T)\n          ((length=1 args) (first args))\n          (t '(if ,(first args)\n                    (and . ,(rest args))))))\n(def-scheme-macro or (&rest args)\n  (cond ((null args) 'nil)\n        ((length=1 args) (first args))\n        (t (let ((var (gensym)))\n                '(let ((,var ,(first args)))\n                  (if ,var ,var (or . ,(rest args))))))))\n(def-scheme-macro cond (&rest clauses)\n  (cond ((null clauses) nil)\n          ((length=1 (first clauses))\n            '(or ,(first clauses) (cond .,(rest clauses))))\n          ((starts-with (first clauses) 'else)\n            '(begin .,(rest (first clauses))))\n          (t '(if ,(first (first clauses))\n                    (begin .,(rest (first clauses)))\n                    (cond .,(rest clauses))))))\n(def-scheme-macro case (key &rest clauses)\n  (let ((key-val (gensym \"KEY\")))\n    '(let ((,key-val ,key))\n      (cond ,@(mapcar\n                #'(lambda (clause)\n                    (if (starts-with clause 'else)\n                        clause\n                        '((member ,key-val ',(first clause))\n                                .,(rest clause))))\n                clauses)))))\n(def-scheme-macro define (name &rest body)\n (if (atom name)\n       '(begin (set! ,name . ,body) ',name)\n       '(define ,(first name)\n     (lambda ,(rest name) . ,body))))\n(def-scheme-macro delay (computation)\n  '(lambda () ,computation))\n(def-scheme-macro letrec (bindings &rest body)\n '(let ,(mapcar #'(lambda (v) (list (first v) nil)) bindings)\n    ,@(mapcar #'(lambda (v) '(set! . ,v)) bindings)\n   .,body))\n```\n\nWe can test out the macro facility:\n\n```lisp\n> (scheme-macro-expand '(and p q)) => (IF P (AND Q))\n> (scheme-macro-expand '(and q)) Q\n```\n\n`> (scheme-macro-expand '(let ((x 1) (y 2)) (+ x y)))`=>\n\n```lisp\n((LAMBDA (X Y) (+ X Y)) 1 2)\n> (scheme-macro-expand\n  '(letrec\n    ((even? (lambda (x) (or (= x 0) (odd? (- x 1)))))\n     (odd? (lambda (x) (even? (- x 1)))))\n```\n\n`    (even?\nz)))`=>\n\n```lisp\n(LET ((EVEN? NIL)\n       (ODD? NIL))\n (SET! EVEN? (LAMBDA (X) (OR (= X 0) (ODD? (- X 1)))))\n (SET! ODD? (LAMBDA (X) (EVEN? (- X 1))))\n (EVEN? Z))\n> (scheme)\n==> (define (reverse 1)\n   (if (null? 1) nil\n      (append (reverse (cdr 1)) (list (car 1)))))\nREVERSE\n==> (reverse '(a b c d))\n(D C B A)\n==> (let* ((x 5) (y (+ x x)))\n      (if (or (= x 0) (and (<  0 y) (< y 20)))\n            (list x y)\n            (+ y x)))\n(5 10)\n```\n\nThe macro `define` is just like `set!`, except that it returns the symbol rather than the value assigned to the symbol.\nIn addition, `define` provides an optional syntax for defining functions-it serves the purposes of both `defun` and `defvar`.\nThe syntax (`define` (*fn* . *args*) . *body*) is an abbreviation for (`define` *fn* (`lambda` *args* . *body*)).\n\nIn addition, Scheme provides a notation where `define` can be used inside a function definition in a way that makes it work like `let` rather than `set!.`\n\nThe advantage of the macro-based approach to special forms is that we don't have to change the interpreter to add new special forms.\nThe interpreter remains simple, even while the language grows.\nThis also holds for the compiler, as we see in the next section.\n\n## 22.3 A Properly Tail-Recursive Interpreter\n\nUnfortunately, the interpreter presented above can not lay claim to the name Scheme, because a true Scheme must be properly tail-recursive.\nOur interpreter is tail-recursive only when run in a Common Lisp that is tail-recursive.\nTo see the problem, consider the following Scheme procedure:\n\n```lisp\n(define (traverse lyst)\n  (if lyst (traverse (cdr lyst))))\n```\n\nTrace the function `interp` and execute `(interp '(traverse '(a b c d)))`.\nThe nested calls to `interp` go 16 levels deep.\nIn general, the level of nesting is 4 plus 3 times the length of the list.\nEach call to `interp` requires Common Lisp to allocate some storage on the stack, so for very long lists, we will eventually run out of storage.\nTo earn the name Scheme, a language must guarantee that such a program does not run out of storage.\n\nThe problem, in this example, lies in two places.\nEverytime we interpret an `if` form or a procedure call, we descend another recursive level into `interp`.\nBut that extra level is not necessary.\nConsider the `if` form.\nIt is certainly necessary to call `interp` recursively to decide if the test is true or not.\nFor the sake of argument, let's say the test is true.\nThen we call `interp` again on the *then* part.\nThis recursive call will return a value, which will then be immediately returned as the value of the original call as well.\n\nThe alternative is to replace the recursive call to `interp` with a renaming of variables, followed by a `goto` statement.\nThat is, instead of calling `interp` and thereby binding a new instance of the variable `x` to the *then* part, we just assign the *then* part to `x`, and branch to the top of the `interp` routine.\nThis works because we know we have no more use for the old value of `x`.\nA similar technique is used to eliminate the recursive call for the last expression in a `begin` form.\n(Many programmers have been taught the \"structured programming\" party line that `goto` statements are harmful.\nIn this case, the `goto` is necessary to implement a low-level feature efficiently.)\n\nThe final thing we need to do is explicitly manage Scheme procedures.\nInstead of implementing Scheme procedures as Common Lisp closures, we will define a structure, `proc`, to contain the code, environment, parameter list, and optionally the name of the procedure.\nThen when we are evaluating a procedure call, we can assign the body of the procedure to `x` rather than recursively calling `interp`.\n\n```lisp\n(defstruct (proc (:print-function print-proc))\n  \"Represent a Scheme procedure\"\n  code (env nil)(name nil) (parms nil))\n```\n\nThe following is a properly tail-recursive interpreter.\nThe macro `prog` sets up a `tagbody` within which we can use `go` statements to branch to labels, and it also sets up a `block` from which we can return a value.\nIt can also bind variables like `let`, although in this usage, the variable list is empty.\nAny symbol within the body of a `prog` is considered a label.\nIn this case, the label `:INTERP` is the target of the branch statements `(GO :INTERP)`.\nI use uppercase to indicate that go-to statements are being used, but this convention has not been widely adopted.\n\n```lisp\n(defun interp (x &optional env)\n \"Evaluate the expression x in the environment env.\n This version is properly tail-recursive.\"\n (prog ()\n  :INTERP\n  (return\n   (cond\n    ((symbolp x) (get-var x env))\n    ((atom x) x)\n    ((scheme-macro (first x))\n     (setf x (scheme-macro-expand x)) (go :INTERP))\n    ((case (first x)\n      (QUOTE (second x))\n      (BEGIN (pop x) ; pop off the BEGIN to get at the args\n           ;; Now interpret all but the last expression\n           (loop while (rest x) do (interp (pop x) env))\n           ;; Finally, rename the last expression as x\n           (setf x (first x))\n           (GO :INTERP))\n      (SET!  (set-var! (second x) (interp (third x) env) env))\n      (IF       (setf x (if (interp (second x) env)\n                (third x)\n                (fourth x)))\n           ;; That is, rename the right expression as x\n           (GO :INTERP))\n      (LAMBDA (make-proc :env env :parms (second x)\n                :code (maybe-add 'begin (rest2 x))))\n      (t   ;; a procedure application\n          (let ((proc (interp (first x) env))\n             (args (mapcar #'(lambda (v) (interp v env))\n                           (rest x))))\n           (if (proc-p proc)\n              ;; Execute procedure with rename+goto\n              (progn\n               (setf x (proc-code proc))\n               (setf env (extend-env (proc-parms proc) args\n                                     (proc-env proc)))\n               (GO :INTERP))\n              ;; else apply primitive procedure\n              (apply proc args))))))))))\n(defun print-proc (proc &optional (stream *standard-output*) depth)\n  (declare (ignore depth))\n  (format stream \"{~a}\" (or (proc-name proc) '??)))\n```\n\nBy tracing the tail-recursive version of `interp`, you can see that calls to `traverse` descend only three recursive levels of `interp`, regardless of the length of the list traversed.\n\nNote that we are not claiming that this interpreter allocates no storage when it makes tail-recursive calls.\nIndeed, it wastes quite a bit of storage in evaluating arguments and building environments.\nThe claim is that since the storage is allocated on the heap rather than on the stack, it can be reclaimed by the garbage collector.\nSo even if `traverse` is applied to an infinitely long list (i.e., a circular list), the interpreter will never run out of space-it will always be able to garbage-collect and continue.\n\nThere are many improvements that could be made to this interpreter, but effort is better spent in improving a compiler rather than an interpreter.\nThe next chapter does just that.\n\n## 22.4 Throw, Catch, and Call/cc\n\nTail-recursion is crucial to Scheme.\nThe idea is that when the language is guaranteed to optimize tail-recursive calls, then there is no need for special forms to do iteration.\nAll loops can be written using recursion, without any worry of overflowing the runtime stack.\nThis helps keep the language simple and rules out the `goto` statement, the scourge of the structured programming movement.\nHowever, there are cases where some kind of nonlocal exit is the best alternative.\nSuppose that some unexpected event happens deep inside your program.\nThe best action is to print an error message and pop back up to the top level of your program.\nThis could be done trivially with a goto-like statement.\nWithout it, every function along the calling path would have to be altered to accept either a valid result or an indication of the exceptional condition, which just gets passed up to the next level.\n\nIn Common Lisp, the functions `throw` and `catch` are provided for this kind of nonlocal exit.\nScott Zimmerman, the perennial world Frisbee champion, is also a programmer for a Southern California firm.\nHe once told me, \"I'm starting to learn Lisp, and it must be a good language because it's got `throw` and `catch` in it.\"\nUnfortunately for Scott, `throw` and `catch` don't refer to Frisbees but to transfer of control.\nThey are both special forms, with the following syntax:\n\n```lisp\n(catch tag body...)\n(throw tag value)\n```\n\nThe first argument to `catch` is a tag, or label.\nThe remaining arguments are evaluated one at a time, and the last one is returned.\nThus, `catch` is much like `progn`.\nThe difference is that if any code in the dynamic extent of the body of the `catch` evaluates the special form `throw`, then control is immediately passed to the enclosing `catch` with the same tag.\n\nFor example, the form\n\n```lisp\n(catch 'tag\n  (print 1) (throw 'tag 2) (print 3))\n```\n\nprints `1` and returns `2`, without going on to print `3`.\nA more representative example is:\n\n```lisp\n(defun print-table (l)\n  (catch 'not-a-number (mapcar #'print-sqrt-abs l)))\n(defun print-sqrt-abs (x)\n  (print (sqrt (abs (must-be-number x)))))\n(defun must-be-number (x)\n  (if (numberp x) x\n      (throw 'not-a-number \"huh?\")))\n> (print-table '(1 4 -9 x 10 20))\n1\n2\n3\n\"huh?\"\n```\n\nHere `print-table` calls `print-sqrt-abs`, which calls `must-be-number`.\nThe first three times all is fine and the values 1, 2, 3 get printed.\nThe next time `x` is not a number, so the value `\"huh?\"` gets thrown to the tag `not-a-number` established by `catch` in `f`.\nThe throw bypasses the pending calls to `abs`, `sqrt`, and `print`, as well as the rest of the call to `mapcar`.\n\nThis kind of control is provided in Scheme with a very general and powerful procedure, `call-with-current-continuation`, which is often abbreviated `call/cc`.\n`call/cc` is a normal procedure (not a special form like `throw` and `catch`) that takes a single argument.\nLet's call the argument `computation`.\n`computation` must be a procedure of one argument.\nWhen `call/cc` is invoked, it calls `computation`, and whatever `computation` returns is the value of the call to `call/cc`.\nThe trick is that the procedure `computation` also takes an argument (which we'll call `cc`) that is another procedure representing the current continuation point.\nIf `cc` is applied to some value, that value is returned as the value of the call to `call/cc`.\nHere are some examples:\n\n```lisp\n> (scheme)\n=> (+ 1 (call/cc (lambda (cc) (+ 20 300))))\n321\n```\n\nThis example ignores `cc` and just computes `(+ 1 (+ 20 300))`.\nMore precisely, it is equivalent to:\n\n```lisp\n((lambda (val) (+ 1 val))\n  (+ 20 300))\n```\n\nThe next example does make use of `cc`:\n\n```lisp\n=> (+ 1 (call/cc (lambda (cc) (+ 20 (cc 300)))))\n301\n```\n\nThis passes `300` to `cc`, thus bypassing the addition of `20`.\nIt effectively throws `300` out of the computation to the catch point established by `call/cc`.\nIt is equivalent to:\n\n```lisp\n((lambda (val) (+ 1 val))\n  300)\n```\n\nor to:\n\n```lisp\n((lambda (val) (+ 1 val))\n  (catch 'cc\n    ((lambda (v) (+ 20 v))\n      (throw 'cc 300))))\n```\n\nHere's how the `throw/catch` mechanism would look in Scheme:\n\n```lisp\n(define (print-table l )\n (call/cc\n  (lambda (escape)\n   (set! not-a-number escape)\n   (map print-sqrt-abs l))))\n\n(define (print-sqrt-abs x)\n  (write (sqrt (abs (must-be-number x)))))\n\n(define (must-be-number x)\n  (if (numberp x) x\n      (not-a-number \"huh?\")))\n\n(define (map fn l)\n (if (null? l)\n   '()\n   (cons (fn (first l))\n       (map fn (rest 1)))))\n```\n\nThe ability to return to a pending point in the computation is useful for this kind of error and interrupt handling.\nHowever, the truly amazing, wonderful thing about `call/cc` is the ability to return to a continuation point more than once.\nConsider a slight variation:\n\n```lisp\n=> (+ 1 (call/cc (lambda (cc)\n           (set! old-cc cc)\n           (+ 20 (cc 300)))))\n301\n\n=> (old-cc 500)\n501\n```\n\nHere, we first computed 301, just as before, but along the way saved `cc` in the global variable `old-cc`.\nAfterward, calling `(old-cc 500)` returns (for the second time) to the point in the computation where 1 is added, this time returning `501`.\nThe equivalent Common Lisp code leads to an error:\n\n```lisp\n> (+ 1 (catch 'tag (+ 20 (throw 'tag 300))))\n301\n\n> (throw 'tag 500)\n*Error*: *there was no pending CATCH for the tag TAG*\n```\n\nIn other words, `call/cc`'s continuations have indefinite extent, while throw/catch tags only have dynamic extent.\n\nWe can use `call/cc` to implement automatic backtracking (among other things).\nSuppose we had a special form, `amb`, the \"ambiguous\" operator, which returns one of its arguments, chosen at random.\nWe could write:\n\n```lisp\n(define (integer) (amb 1 (+ 1 (integer))))\n```\n\nand a call to `integer` would return some random positive integer.\nIn addition, suppose we had a function, `fail`, which doesn't return at all but instead causes execution to continue at a prior `amb` point, with the other choice taken.\nThen we could write succinct<a id=\"tfn22-2\"></a><sup>[2](#fn22-2)</sup> backtracking code like the following:\n\n```lisp\n(define (prime)\n (let ((n (integer)))\n (if (prime? n) n (fail))))\n```\n\nIf `prime?` is a predicate that returns true only when its argument is a prime number, then `prime` will always return some prime number, decided by generating random integers.\nWhile this looks like a major change to the language-adding backtracking and nondeterminism-it turns out that `amb` and `fail` can be implemented quite easily with `call/cc`.\nFirst, we need to make `amb` be a macro:\n\n```lisp\n(def-scheme-macro amb (x y)\n  '(random-choice (lambda () ,x) (lambda () ,y))))\n```\n\nThe rest is pure Scheme.\nWe maintain a list of `backtrack-points`, which are implemented as functions of no arguments.\nTo backtrack, we just call one of these functions.\nThat is what `fail` does.\nThe function `choose-first` takes two functions and pushes the second, along with the proper continuation, on `backtrack-points`, and then calls the first, returning that value.\nThe function `random-choice` is what `amb` expands into: it decides which choice is first, and which is second.\n(Note that the convention in Scheme is to write global variables like `backtrack-points` without asterisks.)\n\n```lisp\n(define backtrack-points nil)\n(define (fail)\n (let ((last-choice (car backtrack-points)))\n  (set! backtrack-points (cdr backtrack-points))\n  (last-choice)))\n(define (random-choice f g)\n  (if (=  1 (random 2))\n      (choose-first f g)\n      (choose-first g f)))\n(define (choose-first f g)\n (call/cc\n  (lambda (k)\n   (set! backtrack-points\n      (cons (lambda () (k (g))) backtrack-points))\n   (f))))\n```\n\nThis implements chronological backtracking, as in Prolog.\nHowever, we actually have the freedom to do other kinds of backtracking as well.\nInstead of having `fail` take the first element of `backtrack-points`, we could choose a random element instead.\nOr, we could do some more complex analysis to choose a good backtrack point.\n\n`call/cc` can be used to implement a variety of control structures.\nAs another example, many Lisp implementations provide a `reset` function that aborts the current computation and returns control to the top-level read-eval-print loop.\n`reset` can be defined quite easily using `call/cc`.\nThe trick is to capture a continuation that is at the top level and save it away for future use.\nThe following expression, evaluated at the top level, saves the appropriate continuation in the value of `reset`:\n\n```lisp\n(call/cc (lambda (cc) (set! reset (lambda ()\n                (cc \"Back to top level\")))))\n```\n\n**Exercise 22.2 [m]** Can you implement `call/cc` in Common Lisp?\n\n**Exercise 22.3 [s]** Can you implement `amb` and `fail` in Common Lisp?\n\n**Exercise 22.4 [m]** `fail` could be written `(define (fail) ((pop backtrack-points)))` if we had the pop macro in Scheme.\nWrite `pop.`\n\n## 22.5 An Interpreter Supporting Call/cc\n\nIt is interesting that the more a host language has to offer, the easier it is to write an interpreter.\nPerhaps the hardest part of writing a Lisp interpreter (or compiler) is garbage collection.\nBy writing our interpreter in Lisp, we bypassed the problem all together-the host language automatically collects garbage.\nSimilarly, if we are using a Common Lisp that is properly tail-recursive, then our interpreter will be too, without taking any special steps.\nIf not, the interpreter must be rewritten to take care of tail-recursion, as we have seen above.\n\nIt is the same with `call/cc`.\nIf our host language provides continuations with indefinite extent, then it is trivial to implement `call/cc`.\nIf not, we have to rewrite the whole interpreter, so that it explicitly handles continuations.\nThe best way to do this is to make `interp` a function of three arguments: an expression, an environment, and a continuation.\nThat means the top level will have to change too.\nRather than having `interp` return a value that gets printed, we just pass it the function `print` as a continuation:\n\n```lisp\n(defun scheme ()\n    \"A Scheme read-eval-print loop (using interp).\n    Handles call/cc by explicitly passing continuations.\"\n    (init-scheme-interp)\n    (loop (format t \"~&==> \")\n              (interp (read) nil #'print)))\n```\n\nNow we are ready to tackle `interp`.\nFor clarity, we will base it on the non-tail-recursive version.\nThe cases for symbols, atoms, macros, and `quote` are almost the same as before.\nThe difference is that the result of each computation gets passed to the continuation, `cc`, rather than just being returned.\n\nThe other cases are all more complex, because they all require explicit representation of continuations.\nThat means that calls to `interp` cannot be nested.\nInstead, we call `interp` with a continuation that includes another call to `interp`.\nFor example, to interpret (`if p x y`), we first call `interp` on the second element of the form, the predicate `p`.\nThe continuation for this call is a function that tests the value of `p` and interprets either `x` or `y` accordingly, using the original continuation for the recursive call to `interp`.\nThe other cases are similar.\nOne important change is that Scheme procedures are implemented as Lisp functions where the first argument is the continuation:\n\n```lisp\n(defun interp (x env cc)\n \"Evaluate the expression x in the environment env,\n and pass the result to the continuation cc.\"\n (cond\n  ((symbolp x) (funcall cc (get-var x env)))\n  ((atom x) (funcall cc x))\n  ((scheme-macro (first x))\n   (interp (scheme-macro-expand x) env cc))\n  ((case (first x)\n     (QUOTE (funcall cc (second x)))\n     (BEGIN (interp-begin (rest x) env cc))\n(SET!  (interp (third x) env\n          #'(lambda (val)\n             (funcall cc (set-var! (second x)\n                                    val env)))))\n(IF   (interp (second x) env\n          #'(lambda (pred)\n             (interp (if pred (third x) (fourth x))\n                env cc))))\n(LAMBDA (let ((parms (second x))\n         (code (maybe-add 'begin (rest2 x))))\n       (funcall\n        cc\n        #'(lambda (cont &rest args)\n          (interp code\n               (extend-env parms args env)\n               cont)))))\n(t   (interp-call x env cc))))))\n```\n\nA few auxiliary functions are defined, in the same continuation-passing style:\n\n```lisp\n(defun interp-begin (body env cc)\n  \"Interpret each element of BODY, passing the last to CC.\"\n  (interp (first body) env\n          #'(lambda (val)\n              (if (null (rest body))\n                      (funcall cc val)\n                      (interp-begin (rest body) env cc)))))\n(defun interp-call (call env cc)\n  \"Interpret the call (f x...) and pass the result to CC.\"\n  (map-interp call env\n                  #'(lambda (fn-and-args)\n                      (apply (first fn-and-args)\n                                cc\n                                (rest fn-and-args)))))\n(defun map-interp (list env cc)\n  \"Interpret each element of LIST, and pass the list to CC.\"\n  (if (null list)\n        (funcall cc nil)\n        (interp (first list) env\n                  #'(lambda (x)\n                      (map-interp (rest list) env\n                                #'(lambda (y)\n                                (funcall cc (cons x y))))))))\n```\n\nBecause Scheme procedures expect a continuation as the first argument, we need to redefine `init-scheme-proc` to install procedures that accept and apply the continuation:\n\n```lisp\n(defun init-scheme-proc (f)\n  \"Define a Scheme procedure as a corresponding CL function.\"\n  (if (listp f)\n      (set-global-var! (first f) (symbol-function (second f)))\n      (set-global-var! f (symbol-function f))))\n```\n\nWe also need to define `call/cc`.\nThink for a moment about what `call/cc` must do.\nLike all Scheme procedures, it takes the current continuation as its first argument.\nThe second argument is a procedure-a computation to be performed.\n`call/cc` performs the computation by calling the procedure.\nThis is just a normal call, so it uses the current continuation.\nThe tricky part is what `call/cc` passes the computation as its argument.\nIt passes an escape procedure, which can be invoked to return to the same point that the original call to `call/cc` would have returned to.\nOnce the working of `call/cc` is understood, the implementation is obvious:\n\n```lisp\n(defun call/cc (cc computation)\n  \"Make the continuation accessible to a Scheme procedure.\"\n  (funcall computation cc\n           ;; Package up CC into a Scheme function:\n           #'(lambda (cont val)\n               (declare (ignore cont))\n               (funcall cc val))))\n\n;; Now install call/cc in the global environment\n(set-global-var! 'call/cc #'call/cc)\n(set-global-var! 'call-with-current-continuation #'call/cc)\n```\n\n## 22.6 History and References\n\nLisp interpreters and AI have a long history together.\nMIT AI Lab Memo No. 1 ([McCarthy 1958](bibliography.md#bb0790)) was the first paper on Lisp.\nMcCarthy's students were working on a Lisp compiler, had written certain routines-`read`, `print`, etc. - in assembly language, and were trying to develop a full Lisp interpreter in assembler.\nSometime around the end of 1958, McCarthy wrote a theoretical paper showing that Lisp was powerful enough to write the universal function, `eval`.\nA programmer on the project, Steve Russell, saw the paper, and, according to McCarthy:\n\n> Steve Russell said, look, why don't I program this `eval` and-you remember the interpreter-and I said to him, ho, ho, you're confusing theory with practice, this `eval` is intended for reading not for computing.\nBut he went ahead and did it.\nThat is, he compiled the `eval` in my paper into 704 machine code fixing bugs and then advertised this as a Lisp interpreter, which it certainly was.<a id=\"tfn22-3\"></a><sup>[3](#fn22-3)</sup>\n\n\nSo the first Lisp interpreter was the result of a programmer ignoring his boss's advice.\nThe first compiler was for the Lisp 1.5 system ([McCarthy et al.\n1962](bibliography.md#bb0815)).\nThe compiler was written in Lisp; it was probably the first compiler written in its own language.\n\nAllen's *Anatomy of Lisp* (1978) was one of the first overviews of Lisp implementation techniques, and it remains one of the best.\nHowever, it concentrates on the dynamic-scoping Lisp dialects that were in use at the time.\nThe more modern view of a lexically scoped Lisp was documented in an influential pair of papers by Guy Steele ([1976a](bibliography.md#bb1130),[b](bibliography.md#bb1135)).\nHis papers \"Lambda: the ultimate goto\" and \"Compiler optimization based on viewing lambda as rename plus goto\" describe properly tail-recursive interpreters and compilers.\n\nThe Scheme dialect was invented by Gerald Sussman and Guy Steele around 1975 (see their MIT AI Memo 349).\nThe *Revised*<sup>4</sup> *Report on the Algorithmic Language Scheme* ([Clinger et al.\n1991](bibliography.md#bb0205)) is the definitive reference manual for the current version of Scheme.\n\n[Abelson and Sussman (1985)](bibliography.md#bb0010) is probably the best introduction to computer science ever written.\nIt may or may not be a coincidence that it uses Scheme as the programming language.\nIt includes a Scheme interpreter.\nWinston and Horn's *Lisp* (1989) also develops a Lisp interpreter.\n\nThe `amb` operator for nondeterministic choice was proposed by [John McCarthy (1963)](bibliography.md#bb0800) and used in SCHEMER ([Zabih et al.\n1987](bibliography.md#bb1440)), a nondeterministic Lisp.\n[Ruf and Weise (1990)](bibliography.md#bb1015) present another implementation of backtracking in Scheme that incorporates all of logic programming.\n\n## 22.7 Exercises\n\n**Exercise  22.5 [m]** While Scheme does not provide full-blown support for optional and keyword arguments, it does support rest parameters.\nModify the interpreter to support the Scheme syntax for rest parameters:\n\n| Scheme                      | Common Lisp                       |\n|-----------------------------|-----------------------------------|\n| (`lambda x` *body*)         | (`lambda` (`&rest x`) *body*)     |\n| (`lambda (x y . z)` *body*) | (`lambda` (`x y &rest z`) *body*) |\n\n**Exercise  22.6 [h]** The representation of environments is somewhat wasteful.\nCurrently it takes 3*n* cons cells to represent an environment with *n* variables.\nChange the representation to take less space.\n\n**Exercise  22.7 [m]** As we've implemented macros, they need to be expanded each time they are encountered.\nThis is not so bad for the compiler-you expand the source code and compile it, and then never refer to the source code again.\nBut for the interpreter, this treatment of macros is most unsatisfactory: the work of macroexpansion must be done again and again.\nHow can you eliminate this duplicated effort?\n\n**Exercise  22.8 [m]** It turns out Scheme allows some additional syntax in `let` and `cond`.\nFirst, there is the \"named-let\" expression, which binds initial values for variables but also defines a local function that can be called within the body of the `let`.\nSecond, `cond` recognizes the symbol `=>` when it is the second element of a cond clause, and treats it as a directive to pass the value of the test (when it is not false) to the third element of the clause, which must be a function of one argument.\nHere are two examples:\n\n```lisp\n(define (fact n)\n  ;; Iterative factorial; does not grow the stack\n  (let loop ((result 1) (i n))\n    (if (= i 0) result (loop (* result i) (- i 1)))))\n(define (lookup key alist)\n  ;; Find key's value in alist\n  (cond ((assoc key alist) => cdr)\n          (else #f)))\n```\n\nThese are equivalent to:\n\n```lisp\n(define (fact n)\n  (letrec\n    ((loop (lambda (result i)\n                (if (= i 0)\n                    result\n                    (loop (* result i) (- i 1))))))\n    (loop 1 n)))\n(define (lookup key alist)\n  (let ((g0030 (assoc key alist)))\n    (if g0030\n        (cdr g0030)\n        #f)))\n```\n\nWrite macro definitions for `let` and `cond` allowing these variations.\n\n**Exercise  22.9 [h]** Some Scheme implementations permit `define` statements inside the body of a `lambda` (and thus of a `define`, `let`, `let*`, or `letrec` as well).\nHere is an example:\n\n```lisp\n(define (length l)\n (define (len l n)\n  (if (null? l) n (len (cdr l) (+ n 1))))\n (len l 0))\n```\n\nThe internal definition of len is interpreted not as defining a global name but rather as defining a local name as if with `letrec`.\nThe above definition is equivalent to:\n\n```lisp\n(define (length l)\n (letrec ((len (lambda (l n)\n           (if (null? l) n (len (cdr l) (+ n 1))))))\n  (len l 0)))\n```\n\nMake changes to the interpreter to allow this kind of internal definition.\n\n**Exercise 22.10** Scheme programmers are often disdainful of the `function` or `#'` notation in Common Lisp.\nIs it possible (without changing the compiler) to make Common Lisp accept `(lambda ( ) ... )` instead of `#'(lambda () ... )` and `fn` instead of `#'fn`?\n\n**Exercise 22.11 [m]** The top level of the continuation-passing version of `scheme` includes the call: `(interp (read) nil #'print)`.\nWill this always result in some value being printed?\nOr is it possible that the expression read might call some escape function that ignores the value without printing anything?\n\n**Exercise  22.12 [h]** What would have to be added or changed to turn the Scheme interpreter into a Common Lisp interpreter?\n\n**Exercise  22.13 [h]** How would you change the interpreter to allow for multiple values?\nExplain how this would be done both for the first version of the interpreter and for the continuation-passing version.\n\n## 22.8 Answers\n\n**Answer 22.2** There is no way to implement a full `call/cc` to Common Lisp, but the following works for cases where the continuation is only used with dynamic extent:\n\n```lisp\n(defun call/cc (cc computation)\n  \"Make the continuation accessible to a Scheme procedure.\"\n  (funcall computation cc\n           ;; Package up CC into a Scheme function:\n           #'(lambda (cont val)\n               (declare (ignore cont))\n               (funcall cc val))))\n```\n\n**Answer 22.3** No.\n`fail` requires continuations with dynamic extent.\n\n**Answer 22.5** We need only modify `extend-env` to know about an atomic `vars` list.\nWhile we're at it, we might as well add some error checking:\n\n```lisp\n(defun extend-env (vars vals env)\n  \"Add some variables and values to an environment.\"\n  (cond ((null vars)\n          (assert (null vals) ( ) \"Too many arguments supplied\")\n          env)\n          ((atom vars)\n            (cons (list vars vals) env))\n          (t (assert (rest vals) ( ) \"Too few arguments supplied\")\n              (cons (list (first vars) (first vals))\n                      (extend-env (rest vars) (rest vals) env)))))\n```\n\n**Answer 22.6** Storing the environment as an association list, `((*var val*)...)`, makes it easy to look up variables with `assoc`.\nWe could save one cons cell per variable just by changing to ((*var* . *val*)...).\nBut even better is to switch to a different representation, one presented by Steele and Sussman in *The Art of the Interpreter* (1978).\nIn this representation we switch from a single list of var/val pairs to a list of frames, where each frame is a var-list/val-list pair.\nIt looks like this:\n\n```lisp\n(((*var*...) . (*val*...))\n  ((*var*...) . (*val*...))\n...)\n```\n\nNow `extend-env` is trivial:\n\n```lisp\n(defun extend-env (vars vals env)\n  \"Add some variables and values to an environment.\"\n  (nconc (mapcar #'list vars vals) env))\n```\n\nThe advantage of this approach is that in most cases we already have a list of variables (the procedure's parameter list) and values (from the `mapcar` of `interp` over the arguments).\nSo it is cheaper to just cons these two lists together, rather than arranging them into pairs.\nOf course, `get-var` and `set-var!` become more complex.\n\n**Answer 22.7** One answer is to destructively alter the source code as it is macro-expanded, so that the next time the source code is interpreted, it will already be expanded.\nThe following code takes care of that:\n\n```lisp\n(defun scheme-macro-expand (x)\n  (displace x (apply (scheme-macro (first x)) (rest x))))\n(defun displace (old new)\n  \"Destructively change old cons-cell to new value.\"\n  (if (consp new)\n        (progn (setf (car old) (car new))\n                      (setf (cdr old) (cdr new))\n                      old)\n        (displace old '(begin ,new))))\n```\n\nOne drawback to this approach is that the user's source code is actually changed, which may make debugging confusing.\nAn alternative is to expand into something that keeps both the original and macro-expanded code around:\n\n```lisp\n(defun displace (old new)\n  \"Destructively change old to a DISPLACED structure.\"\n  (setf (car old) 'DISPLACED)\n  (setf (cdr old) (list new old))\n  old)\n```\n\nThis means that `DISPLACED` is a new special form, and we need a clause for it in the interpreter.\nIt would look something like this:\n\n```lisp\n(case (first x)\n  ...\n  (DISPLACED (interp (second x) env))\n  ...\n```\n\nWe'd also need to modify the printing routines to print just `old` whenever they see `(displaced old new)`.\n\n**Answer 22.8**\n\n```lisp\n(def-scheme-macro let (vars &rest body)\n (if (symbolp vars)\n    ;; named let\n    (let ((f vars) (vars (first body)) (body (rest body)))\n     '(letrec ((,f (lambda ,(mapcar #'first vars) .,body)))\n        (,f .,(mapcar #'second vars))))\n    ;; \"regular\" let\n    '((lambda ,(mapcar #'first vars) . ,body)\n     . ,(mapcar #'second vars)))))\n(def-scheme-macro cond (&rest clauses)\n (cond ((null clauses) nil)\n     ((length=1 (first clauses))\n      '(or ,(first clauses) (cond .,(rest clauses))))\n     ((starts-with (first clauses) 'else)\n      '(begin .,(rest (first clauses))))\n     ((eq (second (first clauses)) '=>)\n      (assert (= (length (first clauses)) 3))\n      (let ((var (gensym)))\n      '(let ((,var ,(first (first clauses))))\n        (if ,var (,(third (first clauses)) ,var)\n             (cond .,(rest clauses))))))\n     (t '(if ,(first (first clauses))\n          (begin .,(rest (first clauses)))\n          (cond .,(rest clauses)))))))\n```\n\n**Answer 22.10** It is easy to define `lambda` as a macro, eliminating the need for `#'(lambda ...)`:\n\n```lisp\n(defmacro lambda (args &rest body)\n  '(function (lambda .args .@body)))\n```\n\nIf this were part of the Common Lisp standard, I would gladly use it.\nBut because it is not, I have avoided it, on the grounds that it can be confusing.\n\nIt is also possible to write a new function-defining macro that would do the following type of expansion:\n\n```lisp\n(defn double (x) (* 2 x)) =>\n(defparameter double (defun double (x) (* 2 x)))\n```\n\nThis makes `double` a special variable, so we can write `double` instead of `#'double`.\nBut this approach is not recommended-it is dangerous to define special variables that violate the asterisk convention, and the Common Lisp compiler may not be able to optimize special variable references the way it can `function` special forms.\nAlso, this approach would not interact properly with `flet` and `labels`.\n\n----------------------\n\n<a id=\"fn22-1\"></a><sup>[1](#tfn22-1)</sup>\nOne writes `numberp` because there is no hyphen in `number` but `random-state-p` because there is a hyphen in `random-state`.\nHowever, `defstruct` concatenates `-p` in all its predicates, regardless of the presence of a hyphen in the structure's name.\n\n<a id=\"fn22-2\"></a><sup>[2](#tfn22-2)</sup>\nalthough inefficient\n\n<a id=\"fn22-3\"></a><sup>[3](#tfn22-3)</sup>\nMcCarthy's words from a talk on the history of Lisp, 1974, recorded by [Stoyan (1984)](bibliography.md#bb1205).\n"
  },
  {
    "path": "docs/chapter23.md",
    "content": "# Chapter 23\n## Compiling Lisp\n\nMany textbooks show simple interpreters for Lisp, because they are simple to write, and because it is useful to know how an interpreter works.\nUnfortunately, not as many textbooks show how to write a compiler, even though the same two reasons hold.\nThe simplest compiler need not be much more complex than an interpreter.\n\nOne thing that makes a compiler more complex is that we have to describe the output of the compiler: the instruction set of the machine we are compiling for.\nFor the moment let's assume a stack-based machine.\nThe calling sequence on this machine for a function call with *n* arguments is to push the *n* arguments onto the stack and then push the function to be called.\nA \"`CALL` *n*\" instruction saves the return point on the stack and goes to the first instruction of the called function.\nBy convention, the first instruction of a function will always be \"`ARGS` *n*\", which pops *n* arguments off the stack, putting them in the new function's environment, where they can be accessed by `LVAR` and `LSET` instructions.\nThe function should return with a `RETURN` instruction, which resets the program counter and the environment to the point of the original `CALL` instruction.\n\nIn addition, our machine has three `JUMP` instructions; one that branches unconditionally, and two that branch depending on if the top of the stack is nil or non-nil.\nThere is also an instruction for popping unneeded values off the stack, and for accessing and altering global variables.\nThe instruction set is shown in figure 23.1.\nA glossary for the compiler program is given in figure 23.2.\nA summary of a more complex version of the compiler appears in [figure 23.3](#figure-23-3).\n\n\n| opcode | args  | description                                             |\n|--------|-------|---------------------------------------------------------|\n| CONST  | x     | Push a constant on the stack.                           |\n| LVAR   | i,j   | Push a local variable's value.                          |\n| GVAR   | sym   | Push a global variable's value.                         |\n| LSET   | i,j   | Store top-of-stack in a local variable.                 |\n| GSET   | sym   | Store top-of-stack in a global variable.                |\n| POP    |       | Pop the stack.                                          |\n| TJUMP  | label | Go to label if top-of-stack is non-nil; pop stack.      |\n| FJUMP  | label | Go to label if top-of-stack is nil; pop stack.          |\n| JUMP   | label | Go to label (don't pop stack).                          |\n| RETURN |       | Go to last return point.                                |\n| ARGS   | n     | Move *n* arguments from stack to environment.           |\n| CALL   | n     | Go to start of function, saving return point,           |\n|        |       | [where] *n* is the number of arguments passed.          |\n| FN     | fn    | Create  a closure from argument and current environment |\n|        |       | and push it on the stack.                               |\n\nFigure 23.1: Instruction Set for Hypothetical Stack Machine\n\n\n| Function          | Description                                        |\n|-------------------|----------------------------------------------------|\n|                   | **Top-Level Functions**                            |\n| `comp-show`       | Compile an expression and show the resulting code. |\n| `compiler`        | Compile an expression as a parameterless function. |\n|                   | **Special Variables**                              |\n| `*label-num*`     | Number for the next assembly language label.       |\n| `*primitive-fns*` | List of built-in Scheme functions.                 |\n|                   | **Data Types**                                     |\n| `fn`              | A Scheme function.                                 |\n|                   | **Major Functions**                                |\n| `comp`            | Compile an expression into a list of instructions. |\n| `comp-begin`      | Compile a sequence of expressions.                 |\n| `comp-if`         | Compile a conditional (`if`) expression.           |\n| `comp-lambda`     | Compile a lambda expression.                       |\n|                   | **Auxiliary Functions**                            |\n| `gen`             | Generate a single instruction.                     |\n| `seq`             | Generate a sequence of instructions.               |\n| `gen-label`       | Generate an assembly language label.               |\n| `gen-var`         | Generate an instruction to reference a variable.   |\n| `gen-set`         | Generate an instruction to set a variable.         |\n| `name!`           | Set the name of a function to a given value.       |\n| `print-fn`        | Print a Scheme function (just the name).           |\n| `show-fn`         | Print the instructions in a Scheme function.       |\n| `label-p`         | Is the argument a label?                           |\n| `in-env-p`        | Is the symbol in the environment?  If so, where?   |\n\nFigure 23.2: Glossary for the Scheme Compiler\n\n\nAs an example, the procedure\n\n```lisp\n(lambda () (if (= x y) (f (g x)) (h x y (h 1 2))))\n```\n\nshould compile into the following instructions:\n\n```\n      ARGS    0\n      GVAR    X\n      GVAR    Y\n      GVAR    =\n      CALL    2\n      FJUMP   L1\n      GVAR    X\n      GVAR    G\n      CALL    1\n      GVAR    F\n      CALL    1\n      JUMP    L2\nL1:   GVAR    X\n      GVAR    Y\n      CONST   1\n      CONST   2\n      GVAR    H\n      CALL    2\n      GVAR    H\n      CALL    3\nL2:   RETURN\n```\n\nThe first version of the Scheme compiler is quite simple.\nIt mimics the structure of the Scheme evaluator.\nThe difference is that each case generates code rather than evaluating a subexpression:\n\n```lisp\n(defun comp (x env)\n  \"Compile the expression x into a list of instructions\"\n  (cond\n    ((symbolp x) (gen-var x env))\n    ((atom x) (gen 'CONST x))\n    ((scheme-macro (first x)) (comp (scheme-macro-expand x) env))\n    ((case (first x)\n       (QUOTE  (gen 'CONST (second x)))\n       (BEGIN  (comp-begin (rest x) env))\n       (SET!   (seq (comp (third x) env) (gen-set (second x) env)))\n       (IF     (comp-if (second x) (third x) (fourth x) env))\n       (LAMBDA (gen 'FN (comp-lambda (second x) (rest (rest x)) env)))\n       ;; Procedure application:\n       ;; Compile args, then fn, then the call\n       (t      (seq (mappend #'(lambda (y) (comp y env)) (rest x))\n                    (comp (first x) env)\n                              (gen 'call (length (rest x)))))))))\n\n```\n\nThe compiler `comp` has the same nine cases-in fact the exact same structure-as the interpreter `interp` from [chapter 22](chapter22.md).\nEach case is slightly more complex, so the three main cases have been made into separate functions: `comp-begin`, `comp-if`, and `comp-lambda.` A `begin` expression is compiled by compiling each argument in turn but making sure to pop each value but the last off the stack after it is computed.\nThe last element in the `begin` stays on the stack as the value of the whole expression.\nNote that the function `gen` generates a single instruction (actually a list of one instruction), and `seq` makes a sequence of instructions out of two or more subsequences.\n\n```lisp\n(defun comp-begin (exps env)\n  \"Compile a sequence of expressions, popping all but the last.\"\n  (cond ((null exps) (gen 'CONST nil))\n        ((length=1 exps) (comp (first exps) env))\n        (t (seq (comp (first exps) env)\n                (gen 'POP)\n                (comp-begin (rest exps) env)))))\n```\n\nAn `if` expression is compiled by compiling the predicate, then part, and else part, and by inserting appropriate branch instructions.\n\n```lisp\n(defun comp-if (pred then else env)\n  \"Compile a conditional expression.\"\n  (let ((L1 (gen-label))\n        (L2 (gen-label)))\n    (seq (comp pred env) (gen 'FJUMP L1)\n         (comp then env) (gen 'JUMP L2)\n         (list L1) (comp else env)\n         (list L2))))\n```\n\nFinally, a `lambda` expression is compiled by compiling the body, surrounding it with one instruction to set up the arguments and another to return from the function, and then storing away the resulting compiled code, along with the environment.\nThe data type `fn` is implemented as a structure with slots for the body of the code, the argument list, and the name of the function (for printing purposes only).\n\n```lisp\n(defstruct (fn (:print-function print-fn))\n  code (env nil) (name nil) (args nil))\n\n(defun comp-lambda (args body env)\n  \"Compile a lambda form into a closure with compiled code.\"\n  (assert (and (listp args) (every #'symbolp args)) ()\n          \"Lambda arglist must be a list of symbols, not ~a\" args)\n  ;; For now, no &rest parameters.\n  ;; The next version will support Scheme's version of &rest\n  (make-fn\n    :env env :args args\n    :code (seq (gen 'ARGS (length args))\n               (comp-begin body (cons args env))\n               (gen 'RETURN))))\n```\n\nThe advantage of compiling over interpreting is that much can be decided at compile time.\nFor example, the compiler can determine if a variable reference is to a global or lexical variable, and if it is to a lexical variable, exactly where that lexical variable is stored.\nThis computation is done only once by the compiler, but it has to be done each time the expression is encountered by the interpreter.\nSimilarly, the compiler can count up the number of arguments once and for all, while the interpreter must go through a loop, counting up the number of arguments, and testing for the end of the arguments after each one is interpreted.\nSo it is clear that the compiler can be more efficient than the interpreter.\n\nAnother advantage is that the compiler can be more robust.\nFor example, in `comp-lambda,` we check that the parameter list of a lambda expression is a list containing only symbols.\nIt would be too expensive to make such checks in an interpreter, but in a compiler it is a worthwhile trade-off to check once at compile time for error conditions rather than checking repeatedly at run time.\n\nBefore we show the rest of the compiler, here's a useful top-level interface to `comp`:\n\n```lisp\n(defvar *label-num* 0)\n\n(defun compiler (x)\n  \"Compile an expression as if it were in a parameterless lambda.\"\n  (setf *label-num* 0)\n  (comp-lambda '() (list x) nil))\n\n(defun comp-show (x)\n  \"Compile an expression and show the resulting code\"\n   (show-fn (compiler x))\n  (values))\n```\n\nNow here's the code to generate individual instructions and sequences of instructions.\nA sequence of instructions is just a list, but we provide the function `seq` rather than using `append` directly for purposes of data abstraction.\nA label is just an atom.\n\n```lisp\n(defun gen (opcode &rest args)\n  \"Return a one-element list of the specified instruction.\"\n  (list (cons opcode args)))\n\n(defun seq (&rest code)\n  \"Return a sequence of instructions\"\n  (apply #'append code))\n\n(defun gen-label (&optional (label 'L))\n  \"Generate a label (a symbol of the form Lnnn)\"\n  (intern (format nil \"~a~d\" label (incf *label-num*))))\n```\n\nEnvironments are now represented as lists of frames, where each frame is a sequence of variables.\nLocal variables are referred to not by their name but by two integers: the index into the list of frames and the index into the individual frame.\nAs usual, the indexes are zero-based.\nFor example, given the code:\n\n```lisp\n(let ((a 2.0)\n          (b 2.1))\n  (let ((c 1.0)\n            (d 1.1))\n    (let ((e 0.0)\n          (f 0.1))\n      (+ a b c d e f))))\n```\n\nthe innermost environment is `((e f) (c d) (a b))`.\nThe function `in-env-p` tests if a variable appears in an environment.\nIf this environment were called `env`, then `(in-env-p 'f env)` would return `(0 1)` and `(in-env-p 'x env)` would return `nil`.\n\n```lisp\n(defun gen-var (var env)\n  \"Generate an instruction to reference a variable's value.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LVAR (first p) (second p) \";\" var)\n        (gen 'GVAR var))))\n\n(defun gen-set (var env)\n  \"Generate an instruction to set a variable to top-of-stack.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LSET (first p) (second p) \";\" var)\n        (gen 'GSET var))))(def-scheme-macro define (name &rest body)\n  (if (atom name)\n      `(name! (set! ,name . ,body) ',name)\n      (scheme-macro-expand\n         `(define ,(first name)\n            (lambda ,(rest name) . ,body)))))\n```\n\nFinally, we have some auxiliary functions to print out the results, to distinguish between labels and instructions, and to determine the index of a variable in an environment.\nScheme functions now are implemented as structures, which must have a field for the code, and one for the environment.\nIn addition, we provide a field for the name of the function and for the argument list; these are used only for debugging purposes.\nWe'll adopt the convention that the `define` macro sets the function's name field, by calling `name!` (which is not part of standard Scheme).\n\n```lisp\n(defun name! (fn name)\n  \"Set the name field of fn, if it is an un-named fn.\"\n  (when (and (fn-p fn) (null (fn-name fn)))\n    (setf (fn-name fn) name))\n  name)\n\n;; This should also go in init-scheme-interp:\n(set-global-var! 'name! #'name!)\n\n(defun print-fn (fn &optional (stream *standard-output*) depth)\n  (declare (ignore depth))\n  (format stream \"{~a}\" (or (fn-name fn) '??)))\n\n(defun show-fn (fn &optional (stream *standard-output*) (depth 0))\n  \"Print all the instructions in a function.\n  If the argument is not a function, just princ it,\n  but in a column at least 8 spaces wide.\"\n  (if (not (fn-p fn))\n      (format stream \"~8a\" fn)\n      (progn\n        (fresh-line)\n        (incf depth 8)\n        (dolist (instr (fn-code fn))\n          (if (label-p instr)\n              (format stream \"~a:\" instr)\n              (progn\n                (format stream \"~VT\" depth)\n                (dolist (arg instr)\n                  (show-fn arg stream depth))\n                (fresh-line)))))))\n\n(defun label-p (x) \"Is x a label?\" (atom x))\n\n(defun in-env-p (symbol env)\n  \"If symbol is in the environment, return its index numbers.\"\n  (let ((frame (find symbol env :test #'find)))\n    (if frame (list (position frame env) (position symbol frame)))))\n```\n\nNow we are ready to show the compiler at work:\n\n```\n> (comp-show '(if (= x y) (f (g x)) (h x y (h 1 2))))\n```\n\n| []()  |          |      |\n|-------|----------|------|\n|       | `ARGS`   | `0`  |\n|       | `GVAR`   | `X`  |\n|       | `GVAR`   | `Y`  |\n|       | `GVAR`   | `=`  |\n|       | `CALL`   | `2`  |\n|       | `FJUMP`  | `L1` |\n|       | `GVAR`   | `X`  |\n|       | `GVAR`   | `G`  |\n|       | `CALL`   | `1`  |\n|       | `GVAR`   | `F`  |\n|       | `CALL`   | `1`  |\n|       | `JUMP`   | `L2` |\n| `L1:` | `GVAR`   | `X`  |\n|       | `GVAR`   | `Y`  |\n|       | `CONST`  | `1`  |\n|       | `CONST`  | `2`  |\n|       | `GVAR`   | `H`  |\n|       | `CALL`   | `2`  |\n|       | `GVAR`   | `H`  |\n|       | `CALL`   | `3`  |\n| `L2:` | `RETURN` |      |\n\nThis example should give the reader a feeling for the code generated by the compiler.\n\nAnother reason a compiler has an advantage over an interpreter is that the compiler can afford to spend some time trying to find a more efficient encoding of an expression, while for the interpreter, the overhead of searching for a more efficient interpretation usually offsets any advantage gained.\nHere are some places where a compiler could do better than an interpreter (although our compiler currently does not):\n\n```\n> (comp-show '(begin \"doc\" (write x) y))\n```\n\n| []() |          |         |\n|------|----------|---------|\n|      | `ARGS`   | `0`     |\n|      | `CONST`  | `doc`   |\n|      | `POP`    |         |\n|      | `GVAR`   | `X`     |\n|      | `GVAR`   | `WRITE` |\n|      | `CALL`   | `1`     |\n|      | `POP`    |         |\n|      | `GVAR`   | `Y`     |\n|      | `RETURN` |         |\n\nIn this example, code is generated to push the constant \"`doc`\" on the stack and then immediately pop it off.\nIf we have the compiler keep track of what expressions are compiled \"for value\"-as y is the value of the expression above-and which are only compiled \"for effect,\" then we can avoid generating any code at all for a reference to a constant or variable for effect.\nHere's another example:\n\n```\n> (comp-show '(begin (+ (* a x) (f x)) x))\n```\n\n| []()     |     |\n|----------|-----|\n| `ARGS`   | `0` |\n| `GVAR`   | `A` |\n| `GVAR`   | `X` |\n| `GVAR`   | `*` |\n| `CALL`   | `2` |\n| `GVAR`   | `X` |\n| `GVAR`   | `F` |\n| `CALL`   | `1` |\n| `GVAR`   | `+` |\n| `CALL`   | `2` |\n| `POP`    |     |\n| `GVAR`   | `X` |\n| `RETURN` |     |\n\nIn this expression, if we can be assured that `+` and `*` refer to the normal arithmetic functions, then we can compile this as if it were `(begin (f x) x)`.\nFurthermore, it is reasonable to assume that `+` and `*` will be instructions in our machine that can be invoked inline, rather than having to call out to a function.\nMany compilers spend a significant portion of their time optimizing arithmetic operations, by taking into account associativity, commutativity, distributivity, and other properties.\n\nBesides arithmetic, compilers often have expertise in conditional expressions.\nConsider the following:\n\n```\n> (comp-show '(if (and p q) x y))\n```\n\n| []()  |          |       |\n|-------|----------|-------|\n|       | `ARGS`   | `0`   |\n|       | `GVAR`   | `P`   |\n|       | `FJUMP`  | `L3`  |\n|       | `GVAR`   | `Q`   |\n|       | `JUMP`   | `L4`  |\n| `L3:` | `GVAR`   | `NIL` |\n| `L4:` | `FJUMP`  | `L1`  |\n|       | `GVAR`   | `X`   |\n|       | `JUMP`   | `L2`  |\n| `L1:` | `GVAR`   | `Y`   |\n| `L2:` | `RETURN` |       |\n\nNote that `(and p q)` macro-expands to `(if p q nil)`.\nThe resulting compiled code is correct, but inefficient.\nFirst, there is an unconditional jump to `L4`, which labels a conditional jump to `L1`.\nThis could be replaced with a conditional jump to `L1`.\nSecond, at `L3` we load `NIL` and then jump on nil to `L1`.\nThese two instructions could be replaced by an unconditional jump to `L1`.\nThird, the `FJUMP` to `L3` could be replaced by an `FJUMP` to `L1`, since we now know that the code at `L3` unconditionally goes to `L1`.\n\nFinally, some compilers, particularly Lisp compilers, have expertise in function calling.\nConsider the following:\n\n```\n> (comp-show '(f (g x y)))\n```\n\n| []() |          |     |\n| ---  |----------|-----|\n|      | `ARGS`   | `0` |\n|      | `GVAR`   | `X` |\n|      | `GVAR`   | `Y` |\n|      | `GVAR`   | `G` |\n|      | `CALL`   | `2` |\n|      | `GVAR`   | `F` |\n|      | `CALL`   | `1` |\n|      | `RETURN` |     |\n\nHere we call `g` and when `g` returns we call `f`, and when `f` returns we return from this function.\nBut this last return is wasteful; we push a return address on the stack, and then pop it off, and return to the next return address.\nAn alternative function-calling protocol involves pushing the return address before calling `g,` but then not pushing a return address before calling `f;` when `f` returns, it returns directly to the calling function, whatever that is.\n\nSuch an optimization looks like a small gain; we basically eliminate a single instruction.\nIn fact, the implications of this new protocol are enormous: we can now invoke a recursive function to an arbitrary depth without growing the stack at all-as long as the recursive call is the last statement in the function (or in a branch of the function when there are conditionals).\nA function that obeys this constraint on its recursive calls is known as a *properly tail-recursive* function.\nThis subject was discussed in [section 22.3.](chapter22.md#s0020)\n\nAll the examples so far have only dealt with global variables.\nHere's an example using local variables:\n\n```\n> (comp-show '((lambda (x) ((lambda (y z) (f x y z)) 3 x)) 4))\n```\n\n| []()     |          |          |     |     |     |     |\n|----------|----------|----------|-----|-----|-----|-----|\n| `ARGS`   | `0`      |          |     |     |     |     |\n| `CONST`  | `4`      |          |     |     |     |     |\n| `FN`     |          |          |     |     |     |     |\n|          | `ARGS`   | `1`      |     |     |     |     |\n|          | `CONST`  | `3`      |     |     |     |     |\n|          | `LVAR`   | `0`      | `0` | ;   | `X` |     |\n|          | `FN`     |          |     |     |     |     |\n|          |          | `ARGS`   | `2` |     |     |     |\n|          |          | `LVAR`   | `1` | `0` | ;   | `X` |\n|          |          | `LVAR`   | `0` | `0` | ;   | `Y` |\n|          |          | `LVAR`   | `0` | `1` | `;` | `Z` |\n|          |          | `GVAR`   | `F` |     |     |     |\n|          |          | `CALL`   | `3` |     |     |     |\n|          |          | `RETURN` |     |     |     |     |\n|          | `CALL`   | `2`      |     |     |     |     |\n|          | `RETURN` |          |     |     |     |     |\n| `CALL`   | `1`      |          |     |     |     |     |\n| `RETURN` |          |          |     |     |     |     |\n\nThe code is indented to show nested functions.\nThe top-level function loads the constant 4 and an anonymous function, and calls the function.\nThis function loads the constant 3 and the local variable `x`, which is the first (0th) element in the top (0th) frame.\nIt then calls the double-nested function on these two arguments.\nThis function loads `x`, `y`, and `z`: `x` is now the 0th element in the next-to-top (1st) frame, and `y` and `z` are the 0th and 1st elements of the top frame.\nWith all the arguments in place, the function `f` is finally called.\nNote that no continuations are stored-`f` can return directly to the caller of this function.\n\nHowever, all this explicit manipulation of environments is inefficient; in this case we could have compiled the whole thing by simply pushing 4, 3, and 4 on the stack and calling `f`.\n\n## 23.1 A Properly Tail-Recursive Lisp Compiler\n\nIn this section we describe a new version of the compiler, first by showing examples of its output, and then by examining the compiler itself, which is summarized in figure 23.3.\nThe new version of the compiler also makes use of a different function calling sequence, using two new instructions, `CALLJ` and `SAVE`.\nAs the name implies, `SAVE` saves a return address on the stack.\nThe `CALLJ` instruction no longer saves anything; it can be seen as an unconditional jump-hence the `J` in its name.\n\n| Function           | Description <a id=\"figure-23-3\"></a>                       |\n|--------------------|------------------------------------------------------------|\n|                    | **Top-Level Functions**                                    |\n| `scheme`           | A read-compile-execute-print loop.                         |\n| `comp-go`          | Compile and execute an expression.                         |\n| `machine`          | Run the abstract machine.                                  |\n|                    | **Data Types**                                             |\n| `prim`             | A Scheme primitive function.                               |\n| `ret-addr`         | A return address (function, program counter, environment). |\n|                    | **Auxiliary Functions**                                    |\n| `arg-count`        | Report an error for wrong number of arguments.             |\n| `comp-list`        | Compile a list of expressions onto the stack.              |\n| `comp-const`       | Compile a constant expression.                             |\n| `comp-var`         | Compile a variable reference.                              |\n| `comp-funcall`     | Compile a function application.                            |\n| `primitive-p`      | Is this function a primitive?                              |\n| `init-scheme-comp` | Initialize primitives used by compiler.                    |\n| `gen-args`         | Generate code to load arguments to a function.             |\n| `make-true-list`   | Convert a dotted list to a nondotted one.                  |\n| `new-fn`           | Build a new function.                                      |\n| `is`               | Predicate is true if instructions opcode matches.          |\n| `optimize`         | A peephole optimizer.                                      |\n| `gen1`             | Generate a single instruction.                             |\n| `target`           | The place a branch instruction branches to.                |\n| `next-instr`       | The next instruction in a sequence.                        |\n| `quasi-q`          | Expand a quasiquote form into `append`, `cons`, etc.       |\n|                    | **Functions for the Abstract Machine**                     |\n| `assemble`         | Turn a list of instructions into a vector.                 |\n| `asm-first-pass`   | Find labels and length of code.                            |\n| `asm-second-pass`  | Put code into the code vector.                             |\n| `opcode`           | The opcode of an instruction.                              |\n| `args`             | The arguments of an instruction.                           |\n| `argi`             | For *i* = 1,2,3 -- select ith argument of instruction.     |\n\nFigure 23.3: Glossary of the Scheme Compiler, Second Version\n\nFirst, we see how nested function calls work:\n\n```\n> (comp-show '(f (g x)))\n```\n\n| []()  |         |      |\n|-------|---------|------|\n|       | `ARGS`  | `0`  |\n|       | `SAVE`  | `K1` |\n|       | `GVAR`  | `X`  |\n|       | `GVAR`  | `G`  |\n|       | `CALLJ` | `1`  |\n| `K1:` | `GVAR`  | `F`  |\n|       | `CALLJ` | `1`  |\n\nThe continuation point `K1` is saved so that g can return to it, but then no continuation is saved for f, so f returns to whatever continuation is on the stack.\nThus, there is no need for an explicit `RETURN` instruction.\nThe final `CALL` is like an unconditional branch.\n\nThe following example shows that all functions but the last `(f)` need a continuation point:\n\n```\n> (comp-show '(f (g (h x) (h y))))\n```\n\n| []()  |         |      |\n|-------|---------|------|\n|       | `ARGS`  | `0`  |\n|       | `SAVE`  | `K1` |\n|       | `SAVE`  | `K2` |\n|       | `GVAR`  | `X`  |\n|       | `GVAR`  | `H`  |\n|       | `CALLJ` | `1`  |\n| `K2:` | `SAVE`  | `K3` |\n|       | `GVAR`  | `Y`  |\n|       | `GVAR`  | `H`  |\n|       | `CALLJ` | `1`  |\n| `K3:` | `GVAR`  | `G`  |\n|       | `CALLJ` | `2`  |\n| `K1:` | `GVAR`  | `F`  |\n|       | `CALLJ` | `1`  |\n\nThis code first computes `(h x)` and returns to `K2`.\nThen it computes `(h y)` and returns to `K3`.\nNext it calls `g` on these two values, and returns to `K1` before transferring to `f`.\nSince whatever `f` returns will also be the final value of the function we are compiling, there is no need to save a continuation point for `f` to return to.\n\nIn the next example we see that unneeded constants and variables in `begin` expressions are ignored:\n\n```\n> (comp-show '(begin \"doc\" x (f x) y))\n```\n\n| []()  |          |      |\n|-------|----------|------|\n|       | `ARGS`   | `0`  |\n|       | `SAVE`   | `K1` |\n|       | `GVAR`   | `X`  |\n|       | `GVAR`   | `F`  |\n|       | `CALLJ`  | `1`  |\n| `K1:` | `POP`    |      |\n|       | `GVAR`   | `Y`  |\n|       | `RETURN` |      |\n\nOne major flaw with the first version of the compiler is that it could pass data around, but it couldn't actually *do* anything to the data objects.\nWe fix that problem by augmenting the machine with instructions to do arithmetic and other primitive operations.\nUnneeded primitive operations, like variables constants, and arithmetic operations are ignored when they are in the nonfinal position within `begins`.\nContrast the following two expressions:\n\n```\n> (comp-show '(begin (+ (* a x) (f x)) x))\n```\n\n| []()  |          |      |\n|-------|----------|------|\n|       | `ARGS`   | `0`  |\n|       | `SAVE`   | `K1` |\n|       | `GVAR`   | `X`  |\n|       | `GVAR`   | `F`  |\n|       | `CALLJ`  | `1`  |\n| `K1:` | `POP`    |      |\n|       | `GVAR`   | `X`  |\n|       | `RETURN` |      |\n\n| `> (comp-show '(begin (+ (* a x) (f x))))` |\n\n| []()  |          |      |\n|-------|----------|------|\n|       | `ARGS`   | `0`  |\n|       | `GVAR`   | `A`  |\n|       | `GVAR`   | `X`  |\n|       | `*`      |      |\n|       | `SAVE`   | `K1` |\n|       | `GVAR`   | `X`  |\n|       | `GVAR`   | `F`  |\n|       | `CALLJ`  | `1`  |\n| `K1:` | `+`      |      |\n|       | `RETURN` |      |\n\nThe first version of the compiler was context-free, in that it compiled all equivalent expressions equivalently, regardless of where they appeared.\nA properly tail-recursive compiler needs to be context-sensitive: it must compile a call that is the final value of a function differently than a call that is used as an intermediate value, or one whose value is ignored.\nIn the first version of the compiler, `comp-lambda` was responsible for generating the `RETURN` instruction, and all code eventually reached that instruction.\nTo make sure the `RETURN` was reached, the code for the two branches of `if` expressions had to rejoin at the end.\n\nIn the tail-recursive compiler, each piece of code is responsible for inserting its own `RETURN` instruction or implicitly returning by calling another function without saving a continuation point.\n\nWe keep track of these possibilities with two flags.\nThe parameter `val?` is true when the expression we are compiling returns a value that is used elsewhere.\nThe parameter `more?` is false when the expression represents the final value, and it is true when there is more to compute.\nIn summary, there are three possibilities:\n\n| `val?` | `more?` | example: the `X` in:            |\n|--------|---------|---------------------------------|\n| true   | true    | `(if X y z)` *or* `(f X y)`     |\n| true   | false   | `(if p X z)` *or* `(begin y X)` |\n| false  | true    | `(begin X y)`                   |\n| false  | false   | *impossible*                    |\n\nThe code for the compiler employing these conventions follows:\n\n```lisp\n(defun comp (x env)\n  \"Compile the expression x into a list of instructions\"\n  (cond\n    ((symbolp x) (gen-var x env))\n    ((atom x) (gen 'CONST x))\n    ((scheme-macro (first x)) (comp (scheme-macro-expand x) env))\n    ((case (first x)\n       (QUOTE  (gen 'CONST (second x)))\n       (BEGIN  (comp-begin (rest x) env))\n       (SET!   (seq (comp (third x) env) (gen-set (second x) env)))\n       (IF     (comp-if (second x) (third x) (fourth x) env))\n       (LAMBDA (gen 'FN (comp-lambda (second x) (rest (rest x)) env)))\n       ;; Procedure application:\n       ;; Compile args, then fn, then the call\n       (t      (seq (mappend #'(lambda (y) (comp y env)) (rest x))\n                    (comp (first x) env)\n                              (gen 'call (length (rest x)))))))))\n```\n\nHere we've added one more case: `t` and `nil` compile directly into primitive instructions, rather than relying on them being bound as global variables.\n(In real Scheme, the Boolean values are `#t` and `#f`, which need not be quoted, the empty list is `()`, which must be quoted, and `t` and `nil` are ordinary symbols with no special significance.)\n\nI've also added some error checking for the number of arguments supplied to quote, `set!` and `if`.\nNote that it is reasonable to do more error checking in a compiler than in an interpreter, since the checking need be done only once, not each time through.\nThe function to check arguments is as follows:\n\n```lisp\n(defun arg-count (form min &optional (max min))\n  \"Report an error if form has wrong number of args.\"\n  (let ((n-args (length (rest form))))\n    (assert (<= min n-args max) (form)\n      \"Wrong number of arguments for ~a in ~a:\n       ~d supplied, ~d~@[ to ~d~] expected\"\n      (first form) form n-args min (if (/= min max) max))))\n```\n\n**Exercise  23.1 [m]** Modify the compiler to check for additional compile-time errors suggested by the following erroneous expression:\n\n```lisp\n(cdr (+ (list x y) 'y (3 x) (car 3 x)))\n```\n\nThe tail-recursive compiler still has the familiar nine cases, but I have introduced `comp-var, comp-const, comp-if,` and `comp-funcall` to handle the increased complexity introduced by the `var?` and `more?` parameters.\n\nLet's go through the `comp-` functions one at a time.\nFirst, `comp-begin` and `comp-list` just handle and pass on the additional parameters.\n`comp-list` will be used in `comp-funcall`, a new function that will be introduced to compile a procedure application.\n\n```lisp\n(defun comp-begin (exps env val? more?)\n  \"Compile a sequence of expressions,\n  returning the last one as the value.\"\n  (cond ((null exps) (comp-const nil val? more?))\n        ((length=1 exps) (comp (first exps) env val? more?))\n        (t (seq (comp (first exps) env nil t)\n                (comp-begin (rest exps) env val? more?)))))\n\n(defun comp-list (exps env)\n  \"Compile a list, leaving them all on the stack.\"\n  (if (null exps) nil\n      (seq (comp (first exps) env t t)\n           (comp-list (rest exps) env))))\n```\n\nThen there are two trivial functions to compile variable access and constants.\nIf the value is not needed, these produce no instructions at all.\nIf there is no more to be done, then these functions have to generate the return instruction.\nThis is a change from the previous version of `comp`, where the caller generated the return instruction.\nNote I have extended the machine to include instructions for the most common constants: t, nil, and some small integers.\n\n```lisp\n(defun comp-const (x val? more?)\n  \"Compile a constant expression.\"\n  (if val? (seq (if (member x '(t nil -1 0 1 2))\n                    (gen x)\n                    (gen 'CONST x))\n                (unless more? (gen 'RETURN)))))\n\n(defun comp-var (x env val? more?)\n  \"Compile a variable reference.\"\n  (if val? (seq (gen-var x env) (unless more? (gen 'RETURN)))))\n```\n\nThe remaining two functions are more complex.\nFirst consider `comp-if`.\nRather than blindly generating code for the predicate and both branches, we will consider some special cases.\nFirst, it is clear that `(if t x y)` can reduce to `x` and `(if nil x y)` can reduce to `y`.\nIt is perhaps not as obvious that `(if p x x)` can reduce to `(begin p x)`, or that the comparison of equality between the two branches should be done on the object code, not the source code.\nOnce these trivial special cases have been considered, we're left with three more cases: `(if p x nil), (if p nil y),` and `(if p x y)`.\nThe pattern of labels and jumps is different for each.\n\n```lisp\n(defun comp-if (pred then else env val? more?)\n  \"Compile a conditional (IF) expression.\"\n  (cond\n    ((null pred)          ; (if nil x y) ==> y\n     (comp else env val? more?))\n    ((constantp pred)     ; (if t x y) ==> x\n     (comp then env val? more?))\n    ((and (listp pred)    ; (if (not p) x y) ==> (if p y x)\n          (length=1 (rest pred))\n          (primitive-p (first pred) env 1)\n          (eq (prim-opcode (primitive-p (first pred) env 1)) 'not))\n     (comp-if (second pred) else then env val? more?))\n    (t (let ((pcode (comp pred env t t))\n             (tcode (comp then env val? more?))\n             (ecode (comp else env val? more?)))\n         (cond\n           ((equal tcode ecode) ; (if p x x) ==> (begin p x)\n            (seq (comp pred env nil t) ecode))\n           ((null tcode)  ; (if p nil y) ==> p (TJUMP L2) y L2:\n            (let ((L2 (gen-label)))\n              (seq pcode (gen 'TJUMP L2) ecode (list L2)\n                   (unless more? (gen 'RETURN)))))\n           ((null ecode)  ; (if p x) ==> p (FJUMP L1) x L1:\n            (let ((L1 (gen-label)))\n              (seq pcode (gen 'FJUMP L1) tcode (list L1)\n                   (unless more? (gen 'RETURN)))))\n           (t             ; (if p x y) ==> p (FJUMP L1) x L1: y\n                          ; or p (FJUMP L1) x (JUMP L2) L1: y L2:\n            (let ((L1 (gen-label))\n                  (L2 (if more? (gen-label))))\n              (seq pcode (gen 'FJUMP L1) tcode\n                   (if more? (gen 'JUMP L2))\n                   (list L1) ecode (if more? (list L2))))))))))\n```\n\nHere are some examples of `if` expressions.\nFirst, a very simple example:\n\n```\n> (comp-show '(if p (+ x y) (* x y)))\n        ARGS    0\n        GVAR    P\n        FJUMP   L1\n        GVAR    X\n        GVAR    Y\n        +\n        RETURN\nL1 :    GVAR    X\n        GVAR    Y\n        *\n        RETURN\n```\n\nEach branch has its own `RETURN` instruction.\nBut note that the code generated is sensitive to its context.\nFor example, if we put the same expression inside a `begin` expression, we get something quite different:\n\n```\n> (comp-show '(begin (if p (+ x y) (* x y)) z))\n        ARGS   0\n        GVAR   Z\n        RETURN\n```\n\nWhat happens here is that `(+ x y)` and `(* x y)`, when compiled in a context where the value is ignored, both result in no generated code.\nThus, the `if` expression reduces to `(if p nil nil)`, which is compiled like `(begin p nil)`, which also generates no code when not evaluated for value, so the final code just references `z`.\nThe compiler can only do this optimization because it knows that `+` and `*` are side-effect-free operations.\nConsider what happens when we replace `+` with `f`:\n\n```\n> (comp-show '(begin (if p (f x) (* x x)) z))\n        ARGS    0\n        GVAR    P\n        FJUMP   L2\n        SAVE    K1\n        GVAR    X\n        GVAR    F\n        CALLJ   1\nK1:     POP\nL2:     GVAR    Z\n        RETURN\n```\n\nHere we have to call `(f x)` if `p` is true (and then throw away the value returned), but we don't have to compute `(* x x)` when `p` is false.\n\nThese examples have inadvertently revealed some of the structure of `comp-funcall`, which handles five cases.\nFirst, it knows some primitive functions that have corresponding instructions and compiles these instructions inline when their values are needed.\nIf the values are not needed, then the function can be ignored, and just the arguments can be compiled.\nThis assumes true functions with no side effects.\nIf there are primitive operations with side effects, they too can be compiled inline, but the operation can never be ignored.\nThe next case is when the function is a lambda expression of no arguments.\nWe can just compile the body of the lambda expression as if it were a `begin` expression.\nNonprimitive functions require a function call.\nThere are two cases: when there is more to compile we have to save a continuation point, and when we are compiling the final value of a function, we can just branch to the called function.\nThe whole thing looks like this:\n\n```lisp\n(defun comp-funcall (f args env val? more?)\n  \"Compile an application of a function to arguments.\"\n  (let ((prim (primitive-p f env (length args))))\n    (cond\n      (prim  ; function compilable to a primitive instruction\n       (if (and (not val?) (not (prim-side-effects prim)))\n           ;; Side-effect free primitive when value unused\n           (comp-begin args env nil more?)\n           ;; Primitive with value or call needed\n           (seq (comp-list args env)\n                (gen (prim-opcode prim))\n                (unless val? (gen 'POP))\n                (unless more? (gen 'RETURN)))))\n      ((and (starts-with f 'lambda) (null (second f)))\n       ;; ((lambda () body)) => (begin body)\n       (assert (null args) () \"Too many arguments supplied\")\n       (comp-begin (rest2 f) env val? more?))\n      (more? ; Need to save the continuation point\n       (let ((k (gen-label 'k)))\n         (seq (gen 'SAVE k)\n              (comp-list args env)\n              (comp f env t t)\n              (gen 'CALLJ (length args))\n              (list k)\n              (if (not val?) (gen 'POP)))))\n      (t     ; function call as rename plus goto\n       (seq (comp-list args env)\n            (comp f env t t)\n            (gen 'CALLJ (length args)))))))\n```\n\nThe support for primitives is straightforward.\nThe `prim` data type has five slots.\nThe first holds the name of a symbol that is globally bound to a primitive operation.\nThe second, `n-args`, is the number of arguments that the primitive requires.\nWe have to take into account the number of arguments to each function because we want `(+ x y)` to compile into a primitive addition instruction, while `(+ x y z)` should not.\nIt will compile into a call to the `+` function instead.\nThe `opcode` slot gives the opcode that is used to implement the primitive.\nThe `always` field is true if the primitive always returns non-nil, `false` if it always returns nil, and nil otherwise.\nIt is used in exercise 23.6.\nFinally, the `side-effects` field says if the function has any side effects, like doing I/O or changing the value of an object.\n\n```lisp\n(defstruct (prim (:type list))\n  symbol n-args opcode always side-effects)\n\n(defparameter *primitive-fns*\n  '((+ 2 + true nil) (- 2 - true nil) (* 2 * true nil) (/ 2 / true nil)\n    (< 2 < nil nil) (> 2 > nil nil) (<= 2 <= nil nil) (>= 2 >= nil nil)\n    (/= 2 /= nil nil) (= 2 = nil nil)\n    (eq? 2 eq nil nil) (equal? 2 equal nil nil) (eqv? 2 eql nil nil)\n    (not 1 not nil nil) (null? 1 not nil nil) (cons 2 cons true nil)\n    (car 1 car nil nil) (cdr 1 cdr nil nil)  (cadr 1 cadr nil nil)\n    (list 1 list1 true nil) (list 2 list2 true nil) (list 3 list3 true nil)\n    (read 0 read nil t) (write 1 write nil t) (display 1 display nil t)\n    (newline 0 newline nil t) (compiler 1 compiler t nil)\n    (name! 2 name! true t) (random 1 random true nil)))\n\n(defun primitive-p (f env n-args)\n  \"F is a primitive if it is in the table, and is not shadowed\n  by something in the environment, and has the right number of args.\"\n  (and (not (in-env-p f env))\n       (find f *primitive-fns*\n             :test #'(lambda (f prim)\n                       (and (eq f (prim-symbol prim))\n                            (= n-args (prim-n-args prim)))))))\n\n(defun list1 (x) (list x))\n(defun list2 (x y) (list x y))\n(defun list3 (x y z) (list x y z))\n(defun display (x) (princ x))\n(defun newline () (terpri))\n```\n\nThese optimizations only work if the symbols are permanently bound to the global values given here.\nWe can enforce that by altering `gen-set` to preserve them as constants:\n\n```lisp\n(defun gen-set (var env)\n  \"Generate an instruction to set a variable to top-of-stack.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LSET (first p) (second p) \";\" var)\n        (if (assoc var *primitive-fns*)\n            (error \"Can't alter the constant ~a\" var)\n            (gen 'GSET var)))))\n```\n\nNow an expression like `(+ x 1)` will be properly compiled using the `+` instruction rather than a subroutine call, and an expression like `(set ! + *)` will be flagged as an error when `+` is a global variable, but allowed when it has been locally bound.\nHowever, we still need to be able to handle expressions like `(set ! add +)` and then `(add x y)`.\nThus, we need some function object that `+` will be globally bound to, even if the compiler normally optimizes away references to that function.\nThe function `init-scheme-comp` takes care of this requirement:\n\n```lisp\n(defun init-scheme-comp ()\n  \"Initialize the primitive functions.\"\n  (dolist (prim *primitive-fns*)\n     (setf (get (prim-symbol prim) 'global-val)\n           (new-fn :env nil :name (prim-symbol prim)\n                   :code (seq (gen 'PRIM (prim-symbol prim))\n                              (gen 'RETURN))))))\n```\n\nThere is one more change to make-rewriting `comp-lambda`.\nWe still need to get the arguments off the stack, but we no longer generate a `RETURN` instruction, since that is done by `comp-begin`, if necessary.\nAt this point we'll provide a hook for a peephole optimizer, which will be introduced in [section 23.4](#s0025), and for an assembler to convert the assembly language to machine code, `new-fn` provides this interface, but for now, `new-fn` acts just like `make-fn`.\n\nWe also need to account for the possibility of rest arguments in a lambda list.\nA new function, `gen-rgs`, generates the single instruction to load the arguments of the stack.\nIt introduces a new instruction, `ARGS`., into the abstract machine.\nThis instruction works just like `ARGS`, except it also conses any remaining arguments on the stack into a list and stores that list as the value of the rest argument.\nWith this innovation, the new version of `comp-lambda` looks like this:\n\n```lisp\n(defun comp-lambda (args body env)\n  \"Compile a lambda form into a closure with compiled code.\"\n  (new-fn :env env :args args\n          :code (seq (gen-args args 0)\n                     (comp-begin body\n                                 (cons (make-true-list args) env)\n                                 t nil))))\n\n(defun gen-args (args n-so-far)\n  \"Generate an instruction to load the arguments.\"\n  (cond ((null args) (gen 'ARGS n-so-far))\n        ((symbolp args) (gen 'ARGS. n-so-far))\n        ((and (consp args) (symbolp (first args)))\n         (gen-args (rest args) (+ n-so-far 1)))\n        (t (error \"Illegal argument list\"))))\n\n(defun make-true-list (dotted-list)\n  \"Convert a possibly dotted list into a true, non-dotted list.\"\n  (cond ((null dotted-list) nil)\n        ((atom dotted-list) (list dotted-list))\n        (t (cons (first dotted-list)\n                 (make-true-list (rest dotted-list))))))\n\n(defun new-fn (&key code env name args)\n  \"Build a new function.\"\n  (assemble (make-fn :env env :name name :args args\n                     :code (optimize code))))\n```\n\n`new-fn` includes calls to an assembler and an optimizer to generate actual machine code.\nFor the moment, both will be identity functions:\n\n```lisp\n(defun optimize (code) code)\n(defun assemble (fn) fn)\n```\n\nHere are some more examples of the compiler at work:\n\n```\n> (comp-show '(if (null? (car l)) (f (+ (* a x) b)) (g (/ x 2))))\n        ARGS    0\n        GVAR    L\n        CAR\n        FJUMP   L1\n        GVAR    X\n        2\n        /\n        GVAR    G\n        CALLJ   1\nL1:     GVAR    A\n        GVAR    X\n        *\n        GVAR    B\n        +\n        GVAR    F\n        CALLJ   1\n```\n\nThere is no need to save any continuation points in this code, because the only calls to nonprimitive functions occur as the final values of the two branches of the function.\n\n```lisp\n> (comp-show '(define (lastl l)\n                (if (null? (cdr l)) (car l)\n                    (last1 (cdr l)))))\n\n        ARGS    0\n        FN\n                ARGS    1\n                LVAR    0       0       ;       L\n                CDR\n                FJUMP   L1\n                LVAR    0       0       ;       L\n                CDR\n                GVAR    LAST1\n                CALLJ   1\nL1:             LVAR    0       0       ;       L\n                CAR\n                RETURN\n        GSET    LAST1\n        CONST   LAST1\n        NAME!\n        RETURN\n```\n\nThe top-level function just assigns the nested function to the global variable `last1`.\nSince `last1` is tail-recursive, it has only one return point, for the termination case, and just calls itself without saving continuations until that case is executed.\n\nContrast that to the non-tail-recursive definition of `length` below.\nIt is not tail-recursive because before it calls `length` recursively, it must save a continuation point, `K1`, so that it will know where to return to to add 1.\n\n```lisp\n> (comp-show '(define (length l)\n                (if (null? l) 0 (+ 1 (length (cdr l))))))\n        ARGS    0\n        FN\n                ARGS    1\n                LVAR    0       0       ;       L\n                FJUMP   L2\n                1\n                SAVE    K1\n                LVAR    0       0       ;       L\n                CDR\n                GVAR    LENGTH\n                CALLJ   1\nK1:             +\n                RETURN\nL2:             0\n                RETURN\n        GSET    LENGTH\n        CONST   LENGTH\n        NAME!\n        RETURN\n```\n\nOf course, it is possible to write `length` in tail-recursive fashion:\n\n```lisp\n> (comp-show '(define (length l)\n              (letrec ((len (lambda (l n)\n                              (if (null? l) n\n                                  (len (rest l) (+ n l))))))\n                (len l 0))))\n        ARGS   0\n        FN\n               ARGS   1\n               NIL\n               FN\n                      ARGS      1\n                      FN\n                                ARGS    2\n                                LVAR    0       0       ;       L\n                                FJUMP   L2\n                                SAVE    K1\n                                LVAR    0       0       ;       L\n                                GVAR    REST\n                                CALLJ   1\nK1:                             LVAR    0       1       ;       N\n                                1\n                                +\n                                LVAR    1       0       ;       LEN\n                                CALLJ   2\nL2:                             LVAR    0       1       ;       N\n                                RETURN\n                      LSET      0       0       ;       LEN\n                      POP\n                      LVAR      1       0       ;       L\n                      0\n                      LVAR      0       0       ;       LEN\n                      CALLJ     2\n               CALLJ  1\n        GSET   LENGTH\n        CONST  LENGTH\n        NAME!\n        RETURN\n```\n\nLet's look once again at an example with nested conditionals:\n\n```\n> (comp-show '(if (not (and p q (not r))) x y))\n        ARGS    0\n        GVAR    P\n        FJUMP   L3\n        GVAR    Q\n        FJUMP   L1\n        GVAR    R\n        NOT\n        JUMP    L2\nL1:     NIL\nL2:     JUMP    L4\nL3:     NIL\nL4:     FJUMP   L5\n        GVAR    Y\n        RETURN\nL5:     GVAR    X\n        RETURN\n```\n\nHere the problem is with multiple `JUMP`s and with not recognizing negation.\nIf `p` is false, then the and expression is false, and the whole predicate is true, so we should return `x`.\nThe code does in fact return `x`, but it first jumps to `L3`, loads `NIL`, and then does an `FJUMP` that will always jump to `L5`.\nOther branches have similar inefficiencies.\nA sufficiently clever compiler should be able to generate the following code:\n\n```\n        ARGS    0\n        GVAR    P\n        FJUMP   L1\n        GVAR    Q\n        FJUMP   L1\n        GVAR    R\n        TJUMP   L1\n        GVAR    Y\n        RETURN\nL1:     GVAR X\n        RETURN\n```\n\n## 23.2 Introducing Call/cc\n\nNow that the basic compiler works, we can think about how to implement `call/cc` in our compiler.\nFirst, remember that `call/cc` is a normal function, not a special form.\nSo we could define it as a primitive, in the manner of `car` and `cons`.\nHowever, primitives as they have been defined only get to see their arguments, and `call/cc` will need to see the run-time stack, in order to save away the current continuation.\nOne choice is to install `call/cc` as a normal Scheme nonprimitive function but to write its body in assembly code ourselves.\nWe need to introduce one new instruction, `CC`, which places on the stack a function (to which we also have to write the assembly code by hand) that saves the current continuation (the stack) in its environment, and, when called, fetches that continuation and installs it, by setting the stack back to that value.\nThis requires one more instruction, `SET-CC`.\nThe details of this, and of all the other instructions, are revealed in the next section.\n\n## 23.3 The Abstract Machine\n\nSo far we have defined the instruction set of a mythical abstract machine and generated assembly code for that instruction set.\nIt's now time to actually execute the assembly code and hence have a useful compiler.\nThere are several paths we could pursue: we could implement the machine in hardware, software, or microcode, or we could translate the assembly code for our abstract machine into the assembly code of some existing machine.\nEach of these approaches has been taken in the past.\n\n**Hardware.** If the abstract machine is simple enough, it can be implemented directly in hardware.\nThe Scheme-79 and Scheme-81 Chips ([Steele and Sussman 1980](bibliography.md#bb1180); [Batali et al.\n1982](bibliography.md#bb0070)) were VLSI implementations of a machine designed specifically to run Scheme.\n\n**Macro-Assembler.** In the translation or macro-assembler approach, each instruction in the abstract machine language is translated into one or more instructions in the host computer's instruction set.\nThis can be done either directly or by generating assembly code and passing it to the host computer's assembler.\nIn general this will lead to code expansion, because the host computer probably will not provide direct support for Scheme's data types.\nThus, whereas in our abstract machine we could write a single instruction for addition, with native code we might have to execute a series of instructions to check the type of the arguments, do an integer add if they are both integers, a floating-point add if they are both floating-point numbers, and so on.\nWe might also have to check the result for overflow, and perhaps convert to bignum representation.\nCompilers that generate native code often include more sophisticated data-flow analysis to know when such checks are required and when they can be omitted.\n\n**Microcode.** The MIT Lisp Machine project, unlike the Scheme Chip, actually resulted in working machines.\nOne important decision was to go with microcode instead of a single chip.\nThis made it easy to change the system as experienced was gained, and as the host language was changed from ZetaLisp to Common Lisp.\nThe most important architectural feature of the Lisp Machine was the inclusion of tag bits on each word to specify data types.\nAlso important was microcode to implement certain frequently used generic operations.\nFor example, in the Symbolics 3600 Lisp Machine, the microcode for addition simultaneously did an integer add, a floating-point add, and a check of the tag bits.\nIf both arguments turned out to be either integers or floating-point numbers, then the appropriate result was taken.\nOtherwise, a trap was signaled, and a conversion routine was entered.\nThis approach makes the compiler relatively simple, but the trend in architecture is away from highly microcoded processors toward simpler (RISC) processors.\n\n**Software.** We can remove many of these problems with a technique known as *byte-code assembly.* Here we translate the instructions into a vector of bytes and then interpret the bytes with a byte-code interpreter.\nThis gives us (almost) the machine we want; it solves the code expansion problem, but it may be slower than native code compilation, because the byte-code interpreter is written in software, not hardware or microcode.\n\nEach opcode is a single byte (we have less than 256 opcodes, so this will work).\nThe instructions with arguments take their arguments in the following bytes of the instruction stream.\nSo, for example, a `CALL` instruction occupies two bytes; one for the opcode and one for the argument count.\nThis means we have imposed a limit of 256 arguments to a function call.\nAn `LVAR` instruction would take three bytes; one for the opcode, one for the frame offset, and one for the offset within the frame.\nAgain, we have imposed 256 as the limit on nesting level and variables per frame.\nThese limits seem high enough for any code written by a human, but remember, not only humans write code.\nIt is possible that some complex macro may expand into something with more than 256 variables, so a full implementation would have some way of accounting for this.\nThe `GVAR` and `CONST` instructions have to refer to an arbitrary object; either we can allocate enough bytes to fit a pointer to this object, or we can add a `constants` field to the `fn` structure, and follow the instructions with a single-byte index into this vector of constants.\nThis latter approach is more common.\n\nWe can now handle branches by changing the program counter to an index into the code vector.\n(It seems severe to limit functions to 256 bytes of code; a two-byte label allows for 65536 bytes of code per function.) In summary, the code is more compact, branching is efficient, and dispatching can be fast because the opcode is a small integer, and we can use a branch table to go to the right piece of code for each instruction.\n\nAnother source of inefficiency is implementing the stack as a list, and consing up new cells every time something is added to the stack.\nThe alternative is to implement the stack as a vector with a fill-pointer.\nThat way a push requires no consing, only a change to the pointer (and a check for overflow).\nThe check is worthwhile, however, because it allows us to detect infinite loops in the user's code.\n\nHere follows an assembler that generates a sequence of instructions (as a vector).\nThis is a compromise between byte codes and the assembly language format.\nFirst, we need some accessor functions to get at parts of an instruction:\n\n```lisp\n(defun opcode (instr) (if (label-p instr) :label (first instr)))\n(defun args (instr) (if (listp instr) (rest instr)))\n(defun arg1 (instr) (if (listp instr) (second instr)))\n(defun arg2 (instr) (if (listp instr) (third instr)))\n(defun arg3 (instr) (if (listp instr) (fourth instr)))\n\n(defsetf arg1 (instr) (val) `(setf (second ,instr) ,val))\n```\n\nNow we write the assembler, which already is integrated into the compiler with a hook in `new-fn`.\n\n```lisp\n(defun assemble (fn)\n  \"Turn a list of instructions into a vector.\"\n  (multiple-value-bind (length labels)\n      (asm-first-pass (fn-code fn))\n    (setf (fn-code fn)\n          (asm-second-pass (fn-code fn)\n                           length labels))\n    fn))\n\n(defun asm-first-pass (code)\n  \"Return the labels and the total code length.\"\n  (let ((length 0)\n        (labels nil))\n    (dolist (instr code)\n      (if (label-p instr)\n          (push (cons instr length) labels)\n          (incf length)))\n    (values length labels)))\n\n(defun asm-second-pass (code length labels)\n  \"Put code into code-vector, adjusting for labels.\"\n  (let ((addr 0)\n        (code-vector (make-array length)))\n    (dolist (instr code)\n      (unless (label-p instr)\n        (if (is instr '(JUMP TJUMP FJUMP SAVE))\n            (setf (arg1 instr)\n                  (cdr (assoc (arg1 instr) labels))))\n        (setf (aref code-vector addr) instr)\n        (incf addr)))\n    code-vector))\n```\n\nIf we want to be able to look at assembled code, we need a new printing function:\n\n```lisp\n(defun show-fn (fn &optional (stream *standard-output*) (indent 2))\n  \"Print all the instructions in a function.\n  If the argument is not a function, just princ it,\n  but in a column at least 8 spaces wide.\"\n  ;; This version handles code that has been assembled into a vector\n  (if (not (fn-p fn))\n      (format stream \"~8a\" fn)\n      (progn\n        (fresh-line)\n        (dotimes (i (length (fn-code fn)))\n          (let ((instr (elt (fn-code fn) i)))\n            (if (label-p instr)\n                (format stream \"~a:\" instr)\n                (progn\n                  (format stream \"~VT~2d: \" indent i)\n                  (dolist (arg instr)\n                    (show-fn arg stream (+ indent 8)))\n                  (fresh-line))))))))\n\n(defstruct ret-addr fn pc env)\n\n(defun is (instr op)\n  \"True if instr's opcode is OP, or one of OP when OP is a list.\"\n  (if (listp op)\n      (member (opcode instr) op)\n      (eq (opcode instr) op)))\n\n(defun top (stack) (first stack))\n\n(defun machine (f)\n  \"Run the abstract machine on the code for f.\"\n  (let* ((code (fn-code f))\n         (pc 0)\n         (env nil)\n         (stack nil)\n         (n-args 0)\n         (instr nil))\n    (loop\n       (setf instr (elt code pc))\n       (incf pc)\n       (case (opcode instr)\n\n         ;; Variable/stack manipulation instructions:\n         (LVAR   (push (elt (elt env (arg1 instr)) (arg2 instr))\n                       stack))\n         (LSET   (setf (elt (elt env (arg1 instr)) (arg2 instr))\n                       (top stack)))\n         (GVAR   (push (get (arg1 instr) 'global-val) stack))\n         (GSET   (setf (get (arg1 instr) 'global-val) (top stack)))\n         (POP    (pop stack))\n         (CONST  (push (arg1 instr) stack))\n\n         ;; Branching instructions:\n         (JUMP   (setf pc (arg1 instr)))\n         (FJUMP  (if (null (pop stack)) (setf pc (arg1 instr))))\n         (TJUMP  (if (pop stack) (setf pc (arg1 instr))))\n\n         ;; Function call/return instructions:\n         (SAVE   (push (make-ret-addr :pc (arg1 instr)\n                                      :fn f :env env)\n                       stack))\n         (RETURN ;; return value is top of stack; ret-addr is second\n          (setf f (ret-addr-fn (second stack))\n                code (fn-code f)\n                env (ret-addr-env (second stack))\n                pc (ret-addr-pc (second stack)))\n          ;; Get rid of the ret-addr, but keep the value\n          (setf stack (cons (first stack) (rest2 stack))))\n         (CALLJ  (pop env)                 ; discard the top frame\n                 (setf f  (pop stack)\n                       code (fn-code f)\n                       env (fn-env f)\n                       pc 0\n                       n-args (arg1 instr)))\n         (ARGS   (assert (= n-args (arg1 instr)) ()\n                         \"Wrong number of arguments:~\n                         ~d expected, ~d supplied\"\n                         (arg1 instr) n-args)\n                 (push (make-array (arg1 instr)) env)\n                 (loop for i from (- n-args 1) downto 0 do\n                       (setf (elt (first env) i) (pop stack))))\n         (ARGS.  (assert (>= n-args (arg1 instr)) ()\n                         \"Wrong number of arguments:~\n                         ~d or more expected, ~d supplied\"\n                         (arg1 instr) n-args)\n                 (push (make-array (+ 1 (arg1 instr))) env)\n                 (loop repeat (- n-args (arg1 instr)) do\n                       (push (pop stack) (elt (first env) (arg1 instr))))\n                 (loop for i from (- (arg1 instr) 1) downto 0 do\n                       (setf (elt (first env) i) (pop stack))))\n         (FN     (push (make-fn :code (fn-code (arg1 instr))\n                                :env env) stack))\n         (PRIM   (push (apply (arg1 instr)\n                              (loop with args = nil repeat n-args\n                                    do (push (pop stack) args)\n                                    finally (return args)))\n                       stack))\n\n         ;; Continuation instructions:\n         (SET-CC (setf stack (top stack)))\n         (CC     (push (make-fn\n                         :env (list (vector stack))\n                         :code '((ARGS 1) (LVAR 1 0 \";\" stack) (SET-CC)\n                                 (LVAR 0 0) (RETURN)))\n                       stack))\n\n         ;; Nullary operations:\n         ((SCHEME-READ NEWLINE) ; *** fix, gat, 11/9/92\n          (push (funcall (opcode instr)) stack))\n\n         ;; Unary operations:\n         ((CAR CDR CADR NOT LIST1 COMPILER DISPLAY WRITE RANDOM)\n          (push (funcall (opcode instr) (pop stack)) stack))\n\n         ;; Binary operations:\n         ((+ - * / < > <= >= /= = CONS LIST2 NAME! EQ EQUAL EQL)\n          (setf stack (cons (funcall (opcode instr) (second stack)\n                                     (first stack))\n                            (rest2 stack))))\n\n         ;; Ternary operations:\n         (LIST3\n          (setf stack (cons (funcall (opcode instr) (third stack)\n                                     (second stack) (first stack))\n                            (rest3 stack))))\n\n         ;; Constants:\n         ((T NIL -1 0 1 2)\n          (push (opcode instr) stack))\n\n         ;; Other:\n         ((HALT) (RETURN (top stack)))\n         (otherwise (error \"Unknown opcode: ~a\" instr))))))\n\n(defun init-scheme-comp ()\n  \"Initialize values (including call/cc) for the Scheme compiler.\"\n  (set-global-var! 'exit\n    (new-fn :name 'exit :args '(val) :code '((HALT))))\n  (set-global-var! 'call/cc\n    (new-fn :name 'call/cc :args '(f)\n            :code '((ARGS 1) (CC) (LVAR 0 0 \";\" f)\n            (CALLJ 1)))) ; *** Bug fix, gat, 11/9/92\n  (dolist (prim *primitive-fns*)\n     (setf (get (prim-symbol prim) 'global-val)\n           (new-fn :env nil :name (prim-symbol prim)\n                   :code (seq (gen 'PRIM (prim-symbol prim))\n                              (gen 'RETURN))))))\n```\n\nHere's the Scheme top level.\nNote that it is written in Scheme itself; we compile the definition of the read-eval-print loop,<a id=\"tfn23-1\"></a><sup>[1](#fn23-1)</sup> load it into the machine, and then start executing it.\nThere's also an interface to compile and execute a single expression, `comp-go`.\n\n```lisp\n(defconstant scheme-top-level\n  '(begin (define (scheme)\n            (newline)\n            (display \"=> \")\n            (write ((compiler (read))))\n            (scheme))\n          (scheme)))\n\n(defun scheme ()\n  \"A compiled Scheme read-eval-print loop\"\n  (init-scheme-comp)\n  (machine (compiler scheme-top-level)))\n\n(defun comp-go (exp)\n  \"Compile and execute the expression.\"\n  (machine (compiler `(exit ,exp))))\n```\n\n**Exercise  23.2 [m]** This implementation of the machine is wasteful in its representation of environments.\nFor example, consider what happens in a tail-recursive function.\nEach `ARG` instruction builds a new frame and pushes it on the environment.\nThen each `CALL` pops the latest frame off the environment.\nSo, while the stack does not grow with tail-recursive calls, the heap certainly does.\nEventually, we will have to garbage-collect all those unused frames (and the cons cells used to make lists out of them).\nHow could we avoid or limit this garbage collection?\n\n## 23.4 A Peephole Optimizer\n\nIn this section we investigate a simple technique that will generate slightly better code in cases where the compiler gives inefficient sequences of instructions.\nThe idea is to look at short sequences of instructions for prespecified patterns and replace them with equivalent but more efficient instructions.\n\nIn the following example, `comp-if` has already done some source-level optimization, such as eliminating the `(f x)` call.\n\n```\n> (comp-show '(begin (if (if t 1 (f x)) (set! x 2)) x))\n   0: ARGS    0\n   1: 1\n   2: FJUMP   6\n   3: 2\n   4: GSET    X\n   5: POP\n   6: GVAR    X\n   7: RETURN\n```\n\nBut the generated code could be made much better.\nThis could be done with more source-level optimizations to transform the expression into `(set!\nx 2)`.\nAlternatively, it could also be done by looking at the preceding instruction sequence and transforming local inefficiencies.\nThe optimizer presented in this section is capable of generating the following code:\n\n```\n> (comp-show '(begin (if (if t 1 (f x)) (set! x 2)) x))\n   0: ARGS    0\n   1: 2\n   2: GSET    X\n   3: RETURN\n```\n\nThe function `optimize` is implemented as a data-driven function that looks at the opcode of each instruction and makes optimizations based on the following instructions.\nTo be more specific, `optimize` takes a list of assembly language instructions and looks at each instruction in order, trying to apply an optimization.\nIf any changes at all are made, then `optimize` will be called again on the whole instruction list, because further changes might be triggered by the first round of changes.\n\n```lisp\n(defun optimize (code)\n  \"Perform peephole optimization on assembly code.\"\n  (let ((any-change nil))\n    ;; Optimize each tail\n    (loop for code-tail on code do\n          (setf any-change (or (optimize-1 code-tail code)\n                               any-change)))\n    ;; If any changes were made, call optimize again\n    (if any-change\n        (optimize code)\n        code)))\n```\n\nThe function `optimize-1` is responsible for each individual attempt to optimize.\nIt is passed two arguments: a list of instructions starting at the current one and going to the end of the list, and a list of all the instructions.\nThe second argument is rarely used.\nThe whole idea of a peephole optimizer is that it should look at only a few instructions following the current one.\n`optimize-1` is data-driven, based on the opcode of the first instruction.\nNote that the optimizer functions do their work by destructively modifying the instruction sequence, *not* by consing up and returning a new sequence.\n\n```lisp\n(defun optimize-1 (code all-code)\n  \"Perform peephole optimization on a tail of the assembly code.\n  If a change is made, return true.\"\n  ;; Data-driven by the opcode of the first instruction\n  (let* ((instr (first code))\n         (optimizer (get-optimizer (opcode instr))))\n    (when optimizer\n      (funcall optimizer instr code all-code))))\n```\n\nWe need a table to associate the individual optimizer functions with the opcodes.\nSince opcodes include numbers as well as symbols, an `eql` hash table is an appropriate choice:\n\n```lisp\n(let ((optimizers (make-hash-table :test #'eql)))\n\n  (defun get-optimizer (opcode)\n    \"Get the assembly language optimizer for this opcode.\"\n    (gethash opcode optimizers))\n\n  (defun put-optimizer (opcode fn)\n    \"Store an assembly language optimizer for this opcode.\"\n    (setf (gethash opcode optimizers) fn)))\n```\n\nWe could now build a table with `put-optimizer`, but it is worth defining a macro to make this a little neater:\n\n```lisp\n(defmacro def-optimizer (opcodes args &body body)\n  \"Define assembly language optimizers for these opcodes.\"\n  (assert (and (listp opcodes) (listp args) (= (length args) 3)))\n  `(dolist (op ',opcodes)\n     (put-optimizer op #'(lambda ,args .,body))))\n```\n\nBefore showing example optimizer functions, we will introduce three auxiliary functions.\n`gen1` generates a single instruction, `target` finds the code sequence that a jump instruction branches to, and `next-instr` finds the next actual instruction in a sequence, skipping labels.\n\n```lisp\n(defun gen1 (&rest args) \"Generate a single instruction\" args)\n(defun target (instr code) (second (member (arg1 instr) code)))\n(defun next-instr (code) (find-if (complement #'label-p) code))\n```\n\nHere are six optimizer functions that implement a few important peephole optimizations.\n\n```lisp\n(def-optimizer (:LABEL) (instr code all-code)\n  ;; ... L ... => ... ... ;if no reference to L\n  (when (not (find instr all-code :key #'arg1))\n    (setf (first code) (second code)\n          (rest code) (rest2 code))\n    t))\n\n(def-optimizer (GSET LSET) (instr code all-code)\n  ;; ex: (begin (set! x y) (if x z))\n  ;; (SET X) (POP) (VAR X) ==> (SET X)\n  (when (and (is (second code) 'POP)\n             (is (third code) '(GVAR LVAR))\n             (eq (arg1 instr) (arg1 (third code))))\n    (setf (rest code) (nthcdr 3 code))\n    t))\n\n(def-optimizer (JUMP CALL CALLJ RETURN) (instr code all-code)\n  ;; (JUMP L1) ...dead code... L2 ==> (JUMP L1) L2\n  (setf (rest code) (member-if #'label-p (rest code)))\n  ;; (JUMP L1) ... L1 (JUMP L2) ==> (JUMP L2)  ... L1 (JUMP L2)\n  (when (and (is instr 'JUMP)\n             (is (target instr code) '(JUMP RETURN))\n    (setf (first code) (copy-list (target instr code)))\n    t)))\n\n(def-optimizer (TJUMP FJUMP) (instr code all-code)\n  ;; (FJUMP L1) ... L1 (JUMP L2) ==> (FJUMP L2) ... L1 (JUMP L2)\n  (when (is (target instr code) 'JUMP)\n    (setf (second instr) (arg1 (target instr code)))\n    t))\n\n(def-optimizer (T -1 0 1 2) (instr code all-code)\n  (case (opcode (second code))\n    (NOT ;; (T) (NOT) ==> NIL\n     (setf (first code) (gen1 'NIL)\n           (rest code) (rest2 code))\n     t)\n    (FJUMP ;; (T) (FJUMP L) ... => ...\n     (setf (first code) (third code)\n           (rest code) (rest3 code))\n     t)\n    (TJUMP ;; (T) (TJUMP L) ... => (JUMP L) ...\n     (setf (first code) (gen1 'JUMP (arg1 (next-instr code))))\n     t)))\n\n(def-optimizer (NIL) (instr code all-code)\n  (case (opcode (second code))\n    (NOT ;; (NIL) (NOT) ==> T\n     (setf (first code) (gen1 'T)\n           (rest code) (rest2 code))\n     t)\n    (TJUMP ;; (NIL) (TJUMP L) ... => ...\n     (setf (first code) (third code)\n             (rest code) (rest3 code))\n     t)\n    (FJUMP ;; (NIL) (FJUMP L) ==> (JUMP L)\n     (setf (first code) (gen1 'JUMP (arg1 (next-instr code))))\n     t)))\n```\n\n## 23.5 Languages with Different Lexical Conventions\n\nThis chapter has shown how to evaluate a language with Lisp-like syntax, by writing a read-eval-print loop where only the `eval` needs to be replaced.\nIn this section we see how to make the `read` part slightly more general.\nWe still read Lisp-like syntax, but the lexical conventions can be slightly different.\n\nThe Lisp function `read` is driven by an object called the *readtable,* which is stored in the special variable `*readtable*`.\nThis table associates some action to take with each of the possible characters that can be read.\nThe entry in the readtable for the character `#\\(`, for example, would be directions to read a list.\nThe entry for `#\\;` would be directions to ignore every character up to the end of the line.\n\nBecause the readtable is stored in a special variable, it is possible to alter completely the way `read` works just by dynamically rebinding this variable.\n\nThe new function `scheme-read` temporarily changes the readtable to a new one, the Scheme readtable.\nIt also accepts an optional argument, the stream to read from, and it returns a special marker on end of file.\nThis can be tested for with the predicate `eof-object?`.\nNote that once `scheme-read` is installed as the value of the Scheme `symbol-read` we need do no more-`scheme-read` will always be called when appropriate (by the top level of Scheme, and by any user Scheme program).\n\n```lisp\n(defconstant eof \"EoF\")\n(defun eof-object? (x) (eq x eof))\n(defvar *scheme-readtable* (copy-readtable))\n\n(defun scheme-read (&optional (stream *standard-input*))\n  (let ((*readtable* *scheme-readtable*))\n    (read stream nil eof)))\n```\n\nThe point of having a special `eof` constant is that it is unforgeable.\nThe user cannot type in a sequence of characters that will be read as something `eq` to `eof`.\nIn Common Lisp, but not Scheme, there is an escape mechanism that makes `eof` forgable.\nThe user can type `#.eof` to get the effect of an end of file.\nThis is similar to the `^D` convention in UNIX systems, and it can be quite handy.\n\nSo far the Scheme readtable is just a copy of the standard readtable.\nThe next step in implementing `scheme-read` is to alter `*scheme-readtable*`, adding read macros for whatever characters are necessary.\nHere we define macros for `#t` and `#f` (the true and false values), for `#d` (decimal numbers) and for the backquote read macro (called quasiquote in Scheme).\nNote that the backquote and comma characters are defined as read macros, but the `@` in `,@` is processed by reading the next character, not by a read macro on `@`.\n\n```lisp\n(set-dispatch-macro-character #\\# #\\t\n  #'(lambda (&rest ignore) t)\n  *scheme-readtable*)\n\n(set-dispatch-macro-character #\\# #\\f\n  #'(lambda (&rest ignore) nil)\n  *scheme-readtable*)\n\n(set-dispatch-macro-character #\\# #\\d\n  ;; In both Common Lisp and Scheme,\n  ;; #x, #o and #b are hexadecimal, octal, and binary,\n  ;; e.g. #xff = #o377 = #b11111111 = 255\n  ;; In Scheme only, #d255 is decimal 255.\n  #'(lambda (stream &rest ignore)\n      (let ((*read-base* 10)) (scheme-read stream)))\n  *scheme-readtable*)\n\n(set-macro-character #\\`\n  #'(lambda (s ignore) (list 'quasiquote (scheme-read s)))\n  nil *scheme-readtable*)\n\n(set-macro-character #\\,\n   #'(lambda (stream ignore)\n       (let ((ch (read-char stream)))\n         (if (char= ch #\\@)\n             (list 'unquote-splicing (read stream))\n             (progn (unread-char ch stream)\n                    (list 'unquote (read stream))))))\n   nil *scheme-readtable*)\n```\n\nFinally, we install `scheme-read` and `eof-object?` as primitives:\n\n```lisp\n(defparameter *primitive-fns*\n  '((+ 2 + true) (- 2 - true) (* 2 * true) (/ 2 / true)\n    (< 2 <) (> 2 >) (<= 2 <=) (>= 2 >=) (/= 2 /=) (= 2 =)\n    (eq? 2 eq) (equal? 2 equal) (eqv? 2 eql)\n    (not 1 not) (null? 1 not)\n    (car 1 car) (cdr 1 cdr)  (cadr 1 cadr) (cons 2 cons true)\n    (list 1 list1 true) (list 2 list2 true) (list 3 list3 true)\n    (read 0 scheme-read nil t) (eof-object? 1 eof-object?) ;***\n    (write 1 write nil t) (display 1 display nil t)\n    (newline 0 newline nil t) (compiler 1 compiler t)\n    (name! 2 name! true t) (random 1 random true nil)))\n```\n\nHere we test `scheme-read`.\nThe characters in italics were typed as a response to the `scheme-read`.\n\n```lisp\n> (scheme-read) #*t*\nT\n> (scheme-read) #f\nNIL\n> (scheme-read) *'(a,b,@cd)*\n(QUASIQUOTE (A (UNQUOTE B) (UNQUOTE-SPLICING C) D))\n```\n\nThe final step is to make `quasiquote` a macro that expands into the proper sequence of calls to `cons`, `list`, and `append`.\nThe careful reader will keep track of the difference between the form returned by `scheme-read` (something starting with `quasiquote`), the expansion of this form with the Scheme macro `quasiquote` (which is implemented with the Common Lisp function `quasi-q`), and the eventual evaluation of the expansion.\nIn an environment where `b` is bound to the number 2 and `c` is bound to the list `(c1 c2)`, we might have:\n\n| []()       |                                                       |\n|------------|-------------------------------------------------------|\n| Typed:     | `'(a ,b ,@c d)`                                       |\n| Read:      | `(quasiquote (a (unquote b) (unquote-splicing c) d))` |\n| Expanded:  | `(cons 'a (cons b (append c '(d))))`                  |\n| Evaluated: | `(a 2 c1 c2 d)`                                       |\n\nThe implementation of the `quasiquote` macro is modeled closely on the one given in Charniak et al.'s *Artificial Intelligence Programming.* I added support for vectors.\nIn `combine-quasiquote` I add the trick of reusing the old cons cell `x` rather than consing together `left` and `right` when that is possible.\nHowever, the implementation still wastes cons cells-a more efficient version would pass back multiple values rather than consing `quote` onto a list, only to strip it off again.\n\n```lisp\n(setf (scheme-macro 'quasiquote) 'quasi-q)\n\n(defun quasi-q (x)\n  \"Expand a quasiquote form into append, list, and cons calls.\"\n  (cond\n    ((vectorp x)\n     (list 'apply 'vector (quasi-q (coerce x 'list))))\n    ((atom x)\n     (if (constantp x) x (list 'quote x)))\n    ((starts-with x 'unquote)\n     (assert (and (rest x) (null (rest2 x))))\n     (second x))\n    ((starts-with x 'quasiquote)\n     (assert (and (rest x) (null (rest2 x))))\n     (quasi-q (quasi-q (second x))))\n    ((starts-with (first x) 'unquote-splicing)\n     (if (null (rest x))\n         (second (first x))\n         (list 'append (second (first x)) (quasi-q (rest x)))))\n    (t (combine-quasiquote (quasi-q (car x))\n                           (quasi-q (cdr x))\n                           x))))\n\n(defun combine-quasiquote (left right x)\n  \"Combine left and right (car and cdr), possibly re-using x.\"\n  (cond ((and (constantp left) (constantp right))\n         (if (and (eql (eval left) (first x))\n                  (eql (eval right) (rest x)))\n             (list 'quote x)\n             (list 'quote (cons (eval left) (eval right)))))\n        ((null right) (list 'list left))\n        ((starts-with right 'list)\n         (list* 'list left (rest right)))\n        (t (list 'cons left right))))\n```\n\nActually, there is a major problem with the `quasiquote` macro, or more accurately, in the entire approach to macro-expansion based on textual substitution.\nSuppose we wanted a function that acted like this:\n\n```lisp\n(extrema '(3 1 10 5 20 2))\n((max 20) (min 1))\n```\n\nWe could write the Scheme function:\n\n```lisp\n(define (extrema list)\n   ;; Given a list of numbers, return an a-list\n   ;; with max and min values\n   '((max ,(apply max list)) (min ,(apply min list))))\n```\n\nAfter expansion of the quasiquote, the definition of `extrema` will be:\n\n```lisp\n(define extrema\n   (lambda (list)\n     (list (list 'max (apply max list))\n           (list 'min (apply min list)))))\n```\n\nThe problem is that `list` is an argument to the function `extrema`, and the argument shadows the global definition of `list` as a function.\nThus, the function will fail.\nOne way around this dilemma is to have the macro-expansion use the global value of `list` rather than the symbol `list` itself.\nIn other words, replace the `'list` in `quasi-q` with (`get-global-var 'list`).\nThen the expansion can be used even in an environment where `list` is locally bound.\nOne has to be careful, though: if this tack is taken, then `comp-funcall` should be changed to recognize function constants, and to do the right thing with respect to primitives.\n\nIt is problems like these that made the designers of Scheme admit that they don't know the best way to specify macros, so there is no standard macro definition mechanism in Scheme.\nSuch problems rarely come up in Common Lisp because functions and variables have different name spaces, and because local function definitions (with `flet` or `labels`) are not widely used.\nThose who do define local functions tend not to use already established names like `list` and `append.`\n\n## 23.6 History and References\n\nGuy Steele's 1978 MIT master's thesis on the language Scheme, rewritten as Steele 1983, describes an innovative and influential compiler for Scheme, called RABBIT.<a id=\"tfn23-2\"></a><sup>[2](#fn23-2)</sup>\nA good article on an \"industrial-strength\" Scheme compiler based on this approach is described in [Kranz et al.'s 1986](bibliography.md#bb0675) paper on ORBIT, the compiler for the T dialect of Scheme.\n\nAbelson and Sussman's *Structure and Interpretation of Computer Programs* (1985) contains an excellent chapter on compilation, using slightly different techniques and compiling into a somewhat more confusing machine language.\nAnother good text is [John Allen's *Anatomy of Lisp* (1978)](bibliography.md#bb0040).\nIt presents a very clear, simple compiler, although it is for an older, dynamically scoped dialect of Lisp and it does not address tail-recursion or `call/cc`.\n\nThe peephole optimizer described here is based on the one in [Masinter and Deutsch 1980](bibliography.md#bb0780).\n\n## 23.7 Exercises\n\n**Exercise  23.3 [h]** Scheme's syntax for numbers is slightly different from Common Lisp's.\nIn particular, complex numbers are written like `3+4i` rather than `#c(3 4)`.\nHow could you make `scheme-read` account for this?\n\n**Exercise  23.4 [m]** Is it possible to make the core Scheme language even smaller, by eliminating any of the five special forms `(quote, begin, set!, if, lambda)` and replacing them with macros?\n\n**Exercise  23.5 [m]** Add the ability to recognize internal defines (see [page 779](chapter22.md#p779)).\n\n**Exercise  23.6 [h]** In `comp-if` we included a special case for `(if t x y)` and `(if nil x y)`.\nBut there are other cases where we know the value of the predicate.\nFor example, `(if (* a b) x y)` can also reduce to `x`.\nArrange for these optimizations to be made.\nNote the `prim-always` field of the `prim` structure has been provided for this purpose.\n\n**Exercise  23.7 [m]** Consider the following version of the quicksort algorithm for sorting a vector:\n\n```lisp\n(define (sort-vector vector test)\n      (define (sort lo hi)\n              (if (>= lo hi)\n                        vector\n                        (let ((pivot (partition vector lo hi test)))\n                                (sort lo pivot)\n                        (sort (+ pivot 1) hi))))\n      (sort 0 (- (vector-length vector 1))))\n```\n\nHere the function `partition` takes a vector, two indices into the vector, and a comparison function, `test`.\nIt modifies the vector and returns an index, `pivot`, such that all elements of the vector below `pivot` are less than all elements at `pivot` or above.\n\nIt is well known that quicksort takes time proportional to *n* log *n* to sort a vector of *n* elements, if the pivots are chosen well.\nWith poor pivot choices, it can take time proportional to *n*<sup>2</sup>.\n\nThe question is, what is the space required by quicksort?\nBesides the vector itself, how much additional storage must be temporarily allocated to sort a vector?\n\nNow consider the following modified version of quicksort.\nWhat time and space complexity does it have?\n\n```lisp\n(define (sort-vector vector test)\n   (define (sort lo hi)\n     (if (>= lo hi)\n         vector\n         (let ((pivot (partition vector lo hi)))\n            (if (> (- hi pivot) (- pivot lo))\n                 (begin (sort lo pivot)\n                           (sort (+ pivot 1) hi))\n                 (begin (sort (+ pivot 1) hi)\n                           (sort lo pivot))))))\n   (sort 0 (- (vector-length vector 1))))\n```\n\nThe next three exercises describe extensions that are not part of the Scheme standard.\n\n**Exercise  23.8 [h]** The `set!` special form is defined only when its first argument is a symbol.\nExtend `set!` to work like `setf` when the first argument is a list.\nThat is, `(set! (car x) y)` should expand into something like `((setter car) y x)`, where `(setter car)` evaluates to the primitive procedure `set-car!`.\nYou will need to add some new primitive functions, and you should also provide a way for the user to define new `set!` procedures.\nOne way to do that would be with a `setter` function for `set!`, for example:\n\n```lisp\n(set! (setter third)\n      (lambda (val list) (set-car! (cdr (cdr list)) val)))\n```\n\n**Exercise  23.9 [m]** It is a curious asymmetry of Scheme that there is a special notation for lambda expressions within `define` expressions, but not within `let`.\nThus, we see the following:\n\n```lisp\n(define square (lambda (x) (* x x)))      ; is the same as\n(define (square x) (* x x))\n(let ((square (lambda (x) (* x x)))) ...) ; is not the same as\n(let (((square x) (* x x))) ...)          ; <= illegal!\n```\n\nDo you think this last expression should be legal?\nIf so, modify the macros for `let, let*`, and `letrec` to allow the new syntax.\nIf not, explain why it should not be included in the language.\n\n**Exercise  23.10 [m]** Scheme does not define `funcall`, because the normal function-call syntax does the work of funcall.\nThis suggests two problems.\n(1) Is it possible to define `funcall` in Scheme?\nShow a definition or explain why there can't be one.\nWould you ever have reason to use `funcall` in a Scheme program?\n(2) Scheme does define `apply`, as there is no syntax for an application.\nOne might want to extend the syntax to make `(+ . numbers)` equivalent to `(apply + numbers)`.\nWould this be a good idea?\n\n**Exercise  23.11 [d]** Write a compiler that translates Scheme to Common Lisp.\nThis will involve changing the names of some procedures and special forms, figuring out a way to map Scheme's single name space into Common Lisp's distinct function and variable name spaces, and dealing with Scheme's continuations.\nOne possibility is to translate a `call/cc` into a `catch` and `throw`, and disallow dynamic continuations.\n\n## 23.8 Answers\n\n**Answer 23.2** We can save frames by making a resource for frames, as was done on page 337.\nUnfortunately, we can't just use the `defresource` macro as is, because we need a separate resource for each size frame.\nThus, a two-dimensional array or a vector of vectors is necessary.\nFurthermore, one must be careful in determining when a frame is no longer needed, and when it has been saved and may be used again.\nSome compilers will generate a special calling sequence for a tail-recursive call where the environment can be used as is, without discarding and then creating a new frame for the arguments.\nSome compilers have varied and advanced representations for environments.\nAn environment may never be represented explicitly as a list of frames; instead it may be represented implicitly as a series of values in registers.\n\n**Answer 23.3** We could read in Scheme expressions as before, and then convert any symbols that looked like complex numbers into numbers.\nThe following routines do this without consing.\n\n```lisp\n(defun scheme-read (&optional (stream *standard-input*))\n  (let ((*readtable* *scheme-readtable*))\n    (convert-numbers (read stream nil eof))))\n\n(defun convert-numbers (x)\n  \"Replace symbols that look like Scheme numbers with their values.\"\n  ;; Don't copy structure, make changes in place.\n  (typecase x\n    (cons   (setf (car x) (convert-numbers (car x)))\n            (setf (cdr x) (convert-numbers (cdr x)))\n        x) ; *** Bug fix, gat, 11/9/92\n    (symbol (or (convert-number x) x))\n    (vector (dotimes (i (length x))\n              (setf (aref x i) (convert-numbers (aref x i))))\n        x) ; *** Bug fix, gat, 11/9/92\n    (t x)))\n\n(defun convert-number (symbol)\n  \"If str looks like a complex number, return the number.\"\n  (let* ((str (symbol-name symbol))\n         (pos (position-if #'sign-p str))\n         (end (- (length str) 1)))\n    (when (and pos (char-equal (char str end) #\\i))\n      (let ((re (read-from-string str nil nil :start 0 :end pos))\n            (im (read-from-string str nil nil :start pos :end end)))\n        (when (and (numberp re) (numberp im))\n          (complex re im))))))\n\n(defun sign-p (char) (find char \"+-\"))\n```\n\nActually, that's not quite good enough, because a Scheme complex number can have multiple signs in it, as in `3.4e-5+6.7e+8i`, and it need not have two numbers, as in `3i` or `4+i` or just `+i`.\nThe other problem is that complex numbers can only have a lowercase `i`, but `read` does not distinguish between the symbols `3+4i` and `3+4I`.\n\n**Answer 23.4** Yes, it is possible to implement `begin` as a macro:\n\n```lisp\n(setf (scheme-macro 'begin)\n                #'(lambda (&rest exps) '((lambda () .,exps))))\n```\n\nWith some work we could also eliminate quote.\nInstead of `'x`, we could use `(string->symbol \"X\" )`, and instead of `'(1 2)`, we could use something like `(list 1 2)`.\nThe problem is in knowing when to reuse the same list.\nConsider:\n\n```lisp\n=> (define (one-two) '(1 2))\nONE-TWO\n=> (eq? (one-two) (one-two))\nT\n=> (eq? '(1 2) '(1 2))\nNIL\n```\n\nA clever memoized macro for quote could handle this, but it would be less efficient than having `quote` as a special form.\nIn short, what's the point?\n\nIt is also (nearly) possible to replace `if` with alternate code.\nThe idea is to replace:\n\n`(if` *test then-part else-part*)\n\nwith\n\n(*test* `(delay` *then-part*) `(delay` *else-part*))\n\nNow if we are assured that any *test* returns either `#t` or `#f`, then we can make the following definitions:\n\n```lisp\n(define #t (lambda (then-part else-part) (force then-part)))\n(define #f (lambda (then-part else-part) (force else-part)))\n```\n\nThe only problem with this is that any value, not just `#t`, counts as true.\n\nThis seems to be a common phenomenon in Scheme compilers: translating everything into a few very general constructs, and then recognizing special cases of these constructs and compiling them specially.\nThis has the disadvantage (compared to explicit use of many special forms) that compilation may be slower, because all macros have to be expanded first, and then special cases have to be recognized.\nIt has the advantage that the optimizations will be applied even when the user did not have a special construct in mind.\nCommon Lisp attempts to get the advantages of both by allowing implementations to play loose with what they implement as macros and as special forms.\n\n**Answer 23.6** We define the predicate `always` and install it in two places in `comp-if`:\n\n```lisp\n(defun always (pred env)\n  \"Does predicate always evaluate to true or false?\"\n  (cond ((eq pred t) 'true)\n        ((eq pred nil) 'false)\n        ((symbolp pred) nil)\n        ((atom pred) 'true)\n        ((scheme-macro (first pred))\n         (always (scheme-macro-expand pred) env))\n        ((case (first pred)\n          (QUOTE (if (null (second pred)) 'false 'true))\n          (BEGIN (if (null (rest pred)) 'false\n                     (always (last1 pred) env)))\n          (SET! (always (third pred) env))`\n          (IF (let ((test (always (second pred)) env)\n                    (then (always (third pred)) env)\n                    (else (always (fourth pred)) env))\n                (cond ((eq test 'true) then)\n                      ((eq test 'false) else)\n                      ((eq then else) then))))\n          (LAMBDA 'true)\n          (t (let ((prim (primitive-p (first pred) env\n                         (length (rest pred)))))\n               (if prim (prim-always prim))))))))\n\n(defun comp-if (pred then else env val? more?)\n  (case (always pred env)\n    (true ; (if nil x y) = => y  ; ***\n     (comp then env val? more?)) ; ***\n    (false ; (if t x y) = => x   ; ***\n     (comp else env val? more?)) ; ***`\n    (otherwise\n     (let ((pcode (comp pred env t t))\n           (tcode (comp then env val? more?))\n           (ecode (comp else env val? more?)))\n       (cond\n         ((and (listp pred) ; (if (not p) x y) ==> (if p y x)\n               (length=1 (rest pred))\n               (primitive-p (first pred) env 1)\n               (eq (prim-opcode (primitive-p (first pred) env 1))\n                   'not))\n          (comp-if (second pred) else then env val? more?))\n         ((equal tcode ecode) ; (if p x x) ==> (begin p x)\n          (seq (comp pred env nil t) ecode))\n         ((null tcode) ; (if p nil y) ==> p (TJUMP L2) y L2:\n          (let ((L2 (gen-label)))\n                   (seq pcode (gen 'TJUMP L2) ecode (list L2)\n                   (unless more? (gen 'RETURN)))))\n           ((null ecode) ; (if p x) ==> p (FJUMP L1) x L1:\n            (let ((L1 (gen-label)))\n              (seq pcode (gen TJUMP L1) tcode (list L1)\n                   (unless more? (gen 'RETURN)))))\n            (t                  ; (if p x y) ==> p (FJUMP L1) x L1: y\n                                ; or p (FJUMP L1) x (JUMP L2) L1: y L2:\n             (let ((L1 (gen-label))\n                   (L2 (if more? (gen-label))))\n               (seq pcode (gen 'FJUMP L1) tcode\n                    (if more? (gen 'JUMP L2))\n                    (list L1) ecode (if more? (list L2))))))))))\n```\n\nDevelopment note: originally, I had coded `always` as a predicate that took a Boolean value as input and returned true if the expression always had that value.\nThus, you had to ask first if the predicate was always true, and then if it was always false.\nThen I realized this was duplicating much effort, and that the duplication was exponential, not just linear: for a triply-nested conditional I would have to do eight times the work, not twice the work.\nThus I switched to the above formulation, where `always` is a three-valued function, returning `true`, `false`, or `nil` for none-of-the-above.\nBut to demonstrate that the right solution doesn't always appear the first time, I give my original definition as well:\n\n```lisp\n(defun always (boolean pred env)\n   \"Does predicate always evaluate to boolean in env?\"\n   (if (atom pred)\n     (and (constantp pred) (equiv boolean pred))\n     (case (first pred)\n        (QUOTE (equiv boolean pred))\n        (BEGIN (if (null (rest pred)) (equiv boolean nil)\n                          (always boolean (last1 pred) env)))\n        (SET! (always boolean (third pred) env))\n        (IF (or (and (always t (second pred) env)\n                           (always boolean (third pred) env))\n                     (and (always nil (second pred) env)\n                           (always boolean (fourth pred) env))\n                     (and (always boolean (third pred) env)\n                           (always boolean (fourth pred) env))))\n        (LAMBDA (equiv boolean t))\n        (t (let ((prim (primitive-p (first pred) env\n                                             (length (rest pred)))))\n            (and prim\n                    (eq (prim-always prim)\n                          (if boolean 'true 'false))))))))\n(defun equiv (x y) \"Boolean equivalence\" (eq (not x) (not y)))\n```\n\n**Answer 23.7** The original version requires *O*(*n*) stack space for poorly chosen pivots.\nAssuming a properly tail-recursive compiler, the modified version will never require more than *O*(log *n*) space, because at each step at least half of the vector is being sorted tail-recursively.\n\n\n**Answer 23.10** (1) `(defun (funcall fn . args) (apply fn args))`\n(2) Suppose you changed the piece of code `(+ . numbers)` to `(+ . (map sqrt numbers))`.\nThe latter is the same expression as `(+ map sqrt numbers)`, which is not the intended result at all.\nSo there would be an arbitrary restriction: the last argument in an apply form would have to be an atom.\nThis kind of restriction goes against the grain of Scheme.\n\n----------------------\n\n<a id=\"fn23-1\"></a><sup>[1](#tfn23-1)</sup>\nStrictly speaking, this is a read-compile-funcall-write loop.\n\n<a id=\"fn23-2\"></a><sup>[2](#tfn23-2)</sup>\nAt the time, the MacLisp compiler dealt with something called \"lisp assembly code\" or LAP.\nThe function to input LAP was called `lapin`.\nThose who know French will get the pun.\n"
  },
  {
    "path": "docs/chapter24.md",
    "content": "# Chapter 24\n## ANSI Common Lisp\n\nThis chapter briefly covers some advanced features of Common Lisp that were not used in the rest of the book.\nThe first topic, packages, is crucial in building large systems but was not covered in this book, since the programs are concise.\nThe next four topics-error handling, pretty printing, series, and the loop macro-are covered in *Common Lisp the Language,* 2d edition, but not in the first edition of the book.\nThus, they may not be applicable to your Lisp compiler.\nThe final topic, sequence functions, shows how to write efficient functions that work for either lists or vectors.\n\n## 24.1 Packages\n\nA *package* is a symbol table that maps from strings to symbols named by those strings.\nWhen read is confronted with a sequence of characters like `list`, it uses the symbol table to determine that this refers to the symbol `list`.\nThe important point is that every use of the symbol name `list` refers to the same symbol.\nThat makes it easy to refer to predefined symbols, but it also makes it easy to introduce unintended name conflicts.\nFor example, if I wanted to hook up the `emycin` expert system from [chapter 16](chapter16.md) with the parser from [chapter 19](chapter19.md), there would be a conflict because both programs use the symbol `defrule` to mean different things.\n\nCommon Lisp uses the package system to help resolve such conflicts.\nInstead of a single symbol table, Common Lisp allows any number of packages.\nThe function `read` always uses the current package, which is defined to be the value of the special variable `*package*`.\nBy default, Lisp starts out in the `common-lisp-user` package.<a id=\"tfn24-1\"></a><sup>[1](#fn24-1)</sup>\nThat means that if we type a new symbol, like `zxv@!?+qw`, it will be entered into that package.\nConverting a string to a symbol and placing it in a package is called *interning.* It is done automatically by `read`, and can be done by the function `intern` if necessary.\nName conflicts arise when there is contention for names within the `common-lisp-user` package.\n\nTo avoid name conflicts, simply create your new symbols in another package, one that is specific to your program.\nThe easiest way to implement this is to split each system into at least two files-one to define the package that the system resides in, and the others for the system itself.\nFor example, the `emycin` system should start with a file that defines the `emycin` package.\nThe following form defines the `emycin` package to use the `lisp` package.\nThat means that when the current package is `emycin`, you can still refer to all the built-in Lisp symbols.\n\n```lisp\n(make-package \"EMYCIN\" :use '(\"LISP\"))\n```\n\nThe file containing the package definition should always be loaded before the rest of the system.\nThose files should start with the following call, which insures that all new symbols will be interned in the `emycin` package:\n\n```lisp\n(in-package \"EMYCIN\")\n```\n\nPackages are used for information-hiding purposes as well as for avoiding name clashes.\nA distinction is made between *internal* and *external* symbols.\nExternal symbols are those that a user of a system would want to refer to, while internal symbols are those that help implement the system but are not needed by a user of the system.\nThe symbol `rule` would probably be internal to both the `emycin` and `parser` package, but `defrule` would be external, because a user of the `emycin` system uses `defrule` to define new rules.\nThe designer of a system is responsible for advertising which symbols are external.\nThe proper call is:\n\n```lisp\n(export '(emycin defrule defcontext defparm yes/no yes no is))\n```\n\nNow the user who wants to refer to symbols in the `emycin` package has four choices.\nFirst, he or she can use the *package prefix* notation.\nTo refer to the symbol `defrule` in the emycin package, type `emycin:defrule`.\nSecond, the user can make `emycin` be the current package with `(in-package \"EMYCIN\").` Then, of course, we need only type `defrule`.\nThird, if we only need part of the functionality of a system, we can import specific symbols into the current package.\nFor example, we could call `(import 'emycin:defrule)`.\nFrom then on, typing `defrule` (in the current package) will refer to `emycin:defrule`.\nFourth, if we want the full functionality of the system, we call `(use-package \"EMYCIN\")`.\nThis makes all the external symbols of the `emycin` package accessible in the current package.\n\nWhile packages help eliminate name conflicts, `import` and `use-package` allow them to reappear.\nThe advantage is that there will only be conflicts between external symbols.\nSince a carefully designed package should have far fewer external than internal symbols, the problem has at least been reduced.\nBut if two packages both have an external `defrule` symbol, then we cannot `use-package` both these packages, nor `import` both symbols without producing a genuine name conflict.\nSuch conflicts can be resolved by *shadowing* one symbol or the other; see *Common Lisp the Language* for details.\n\nThe careful reader may be confused by the distinction between `\"EMYCIN\"` and `emycin`.\nIn *Common Lisp the Language*, it was not made clear what the argument to package functions must be.\nThus, some implementations signal an error when given a symbol whose print name is a package.\nIn ANSI Common Lisp, all package functions are specified to take either a package, a package name (a string), or a symbol whose print name is a package name.\nIn addition, ANSI Common Lisp adds the convenient `defpackage` macro.\nIt can be used as a replacement for separate calls to `make-package, use-package, import`, and `export`.\nAlso note that ANSI renames the `lisp package` as `common-lisp`.\n\n```lisp\n(defpackage emycin\n (:use common-lisp)\n (:export emycin defrule defcontext defparm yes/no yes no is))\n```\n\nFor more on packages and building systems, see [section 25.16](chapter25.md#s0110) or *Common Lisp the Language.*\n\n### The Seven Name Spaces\n\nOne important fact to remember about packages is that they deal with symbols, and only indirectly deal with the uses those symbols might have.\nFor example, you may think of `(export 'parse)` as exporting the function `parse`, but really it is exporting the symbol `parse`, which may happen to have a function definition associated with it.\nHowever, if the symbol is put to another use-perhaps as a variable or a data type-then those uses are made accessible by the `export` statement as well.\n\nCommon Lisp has at least seven name spaces.\nThe two we think of most often are (1) for functions and macros and (2) for variables.\nWe have seen that Scheme conflates these two name spaces, but Common Lisp keeps them separate, so that in a function application like `(f)` the function/macro name space is consulted for the value of `f`, but in `(+ f)`, f is treated as a variable name.\nThose who understand the scope and extent rules of Common Lisp know that (3) special variables form a distinct name space from lexical variables.\nSo the `f` in `(+ f)` is treated as either a special or lexical variable, depending on if there is an applicable `special` declaration.\nThere is also a name space (4) for data types.\nEven if `f` is defined as a function and/or a variable, it can also be defined as a data type with `defstruct`, `deftype`, or `defclass`.\nIt can also be defined as (5) a label for `go` statements within a `tagbody` or (6) a block name for `return-from` statements within a `block`.\nFinally, symbols inside a quoted expression are treated as constants, and thus form name space (7).\nThese symbols are often used as keys in user-defined tables, and in a sense each such table defines a new name space.\nOne example is the *tag* name space, used by catch and `throw`.\nAnother is the package name space.\n\nIt is a good idea to limit each symbol to only one name space.\nCommon Lisp will not be confused if a symbol is used in multiple ways, but the poor human reader probably will be.\n\nIn the following example `f`, can you identify which of the twelve uses of `f` refer to which name spaces?\n\n```lisp\n(defun f (f)\n (block f\n  (tagbody\n   f (catch 'f\n    (if (typep f 'f)\n     (throw 'f (go f)))\n    (funcall #'f (get (symbol-value 'f) 'f))))))\n```\n\n## 24.2 Conditions and Error Handling\n\nAn extraordinary feature of ANSI Common Lisp is the facility for handling errors.\nIn most languages it is very difficult for the programmer to arrange to recover from an error.\nAlthough Ada and some implementations of C provide functions for error recovery, they are not generally part of the repertoire of most programmers.\nThus, we find C programs that exit with the ungraceful message `Segmentation violation: core dumped`.\n\nCommon Lisp provides one of the most comprehensive and easy-to-use error-handling mechanism of any programming language, which leads to more robust programs.\nThe process of error handling is divided into two parts: signaling an error, and handling it.\n\n### Signaling Errors\n\nAn *error* is a condition that the program does not know how to handle.\nSince the program does not know what to do, its only recourse is to announce the occurrence of the error, with the hope that some other program or user will know what to do.\nThis announcement is called *signaling* an error.\nAn error can be signaled by a Common Lisp built-in function, as when `( / 3 0 )` signals a divide-by-zero error.\nErrors can also be signaled explicitly by the programmer, as in a call to `(error \"Illegal value.\")`.\n\nActually, it is a bit of a simplification to talk only of *signaling errors.* The precise term is *signaling a condition.* Some conditions, like end-of-file, are not considered errors, but nevertheless they are unusual conditions that must be dealt with.\nThe condition system in Common Lisp allows for the definition of all kinds of conditions, but we will continue to talk about errors in this brief discussion, since most conditions are in fact error conditions.\n\n### Handling Errors\n\nBy default, signaling an error invokes the debugger.\nIn the following example, the >> prompt means that the user is in the debugger rather than at the top level.\n\n```lisp\n> (/ 3 0)\nError: An attempt was made to divide by zero.\n>>\n```\n\nANSI Common Lisp provides ways of changing this default behavior.\nConceptually, this is done by setting up an *error handler* which handles the error in some way.\nError handlers are bound dynamically and are used to process signaled errors.\nAn error handler is much like a `catch`, and signaling an error is like a `throw`.\nIn fact, in many systems `catch` and `throw` are implemented with the error-condition system.\n\nThe simplest way of handling an error is with the macro `ignore-errors`.\nIf no error occurs, `ignore-errors` is just like `progn`.\nBut if an error does occur, `ignore-errors` will return `nil` as its first value and `t` as its second, to indicate that an error has occurred but without doing anything else:\n\n```lisp\n> (ignore-errors (/ 3 1)) => 3 NIL\n> (ignore-errors (/ 3 0)) => NIL T\n```\n\n`ignore-errors` is a very coarse-grain tool.\nIn an interactive interpreter, `ignore-errors` can be used to recover from any and all errors in the response to one input and get back to the read-process-print loop for the next input.\nIf the errors that are ignored are not serious ones, this can be a very effective way of transforming a buggy program into a useful one.\n\nBut some errors are too important to ignore.\nIf the error is running out of memory, then ignoring it will not help.\nInstead, we need to find some way of freeing up memory and continuing.\n\nThe condition-handling system can be used to handle only certain errors.\nThe macro `handler-case`, is a convenient way to do this.\nLike `case`, its first argument is evaluated and used to determine what to do next.\nIf no error is signaled, then the value of the expression is returned.\nBut if an error does occur, the following clauses are searched for one that matches the type of the error.\nIn the following example, `handler-case` is used to handle division by zero and other arithmetic errors (perhaps floating-point underflow), but it allows all other errors to pass unhandled.\n\n```lisp\n(defun div (x y)\n (handler-case (/ x y)\n  (division-by-zero () most-positive-fixnum)\n  (arithmetic-error () 0)))\n> (div 8 2) => 4\n> (div 3 0) => 16777215\n> (div 'xyzzy 1)\nError: The value of NUMBER, XYZZY, should be a number\n```\n\nThrough judicious use of `handler-case`, the programmer can create robust code that reacts well to unexpected situations.\nFor more details, see chapter 29 of *Common Lisp the Language,* 2d edition.\n\n## 24.3 Pretty Printing\n\nANSI Common Lisp adds a facility for user-controlled pretty printing.\nIn general, *pretty printing* refers to the process of printing complex expressions in a format that uses indentation to improve readability.\nThe function `pprint` was always available, but before ANSI Common Lisp it was left unspecified, and it could not be extended by the user.\nChapter 27 of *Common Lisp the Language,* 2d edition presents a pretty-printing facility that gives the user fine-grained control over the printing of all types of objects.\nIn addition, the facility is integrated with the `format` function.\n\n## 24.4 Series\n\nThe functional style of programming with higher-order functions is one of the attractions of Lisp.\nThe following expression to sum the square roots of the positive numbers in the list `nums` is clear and concise:\n\n```lisp\n(reduce #'+ (mapcar #'sqrt (find-all-if #'plusp nums)))\n```\n\nUnfortunately, it is inefficient: both `find-all-if` and `mapcar` cons up intermediate lists that are not needed in the final sum.\nThe following two versions using `loop` and `dolist` are efficient but not as pretty:\n\n```lisp\n;; Using Loop\n(loop for num in nums\n      when (plusp num)\n      sum (sqrt num))\n\n;; Using dolist\n(let ((sum 0))\n  (dolist (num nums sum)\n     (when (plusp num)\n       (incf sum num))))\n```\n\nA compromise between the two approaches is provided by the *series* facility, defined in appendix A of *Common Lisp the Language*, 2d edition.\nThe example using series would look like:\n\n```lisp\n(collect-sum (#Msqrt (choose-if #'plusp nums)))\n```\n\nThis looks very much like the functional version: only the names have been changed.\nHowever, it compiles into efficient iterative code very much like the `dolist` version.\n\nLike pipes (see [section 9.3](chapter9.md#s0015)), elements of a series are only evaluated when they are needed.\nSo we can write `(scan-range :from 0)` to indicate the infinite series of integers starting from 0, but if we only use, say, the first five elements of this series, then only the first five elements will be generated.\n\nThe series facility offers a convenient and efficient alternative to iterative loops and sequence functions.\nAlthough the series proposal has not yet been adopted as an official part of ANSI Common Lisp, its inclusion in the reference manual has made it increasingly popular.\n\n## 24.5 The Loop Macro\n\nThe original specification of Common Lisp included a simple `loop` macro.\nThe body of the loop was executed repeatedly, until a `return` was encountered.\nANSI Common Lisp officially introduces a far more complex `loop` macro, one that had been used in ZetaLisp and its predecessors for some time.\nThis book has occasionally used the complex `loop` in place of alternatives such as `do, dotimes, dolist`, and the mapping functions.\n\nIf your Lisp does not include the complex `loop` macro, this chapter gives a definition that will run all the examples in this book, although it does not support all the features of `loop`.\nThis chapter also serves as an example of a complex macro.\nAs with any macro, the first thing to do is to look at some macro calls and what they might expand into.\nHere are two examples:\n\n```lisp\n(loop for i from 1 to n do (print (sqrt i))) =\n(LET* ((I 1)\n    (TEMP N))\n (TAGBODY\n   LOOP\n    (IF (> I TEMP)\n       (GO END))\n    (PRINT (SQRT I))\n    (SETF I (+ I 1))\n    (GO LOOP)\n   END))\n(loop for v in list do (print v)) =\n(LET* ((IN LIST)\n    (V (CAR IN)))\n   (TAGBODY\n   LOOP\n    (IF (NULL IN)\n       (GO END))\n    (PRINT V)\n    (SETF IN (CDR IN))\n    (SETF V (CAR IN))\n    (GO LOOP)\n   END))\n```\n\nEach loop initializes some variables, then enters a loop with some exit tests and a body.\nSo the template is something like:\n\n```lisp\n(let* (*variables...*)\n (tagbody\n  loop\n   (if *exit-tests*\n    (go end))\n   *Body*\n   (go loop)\n  end))\n```\n\nActually, there's more we might need in the general case.\nThere may be a prologue that appears before the loop but after the variable initialization, and similarly there may be an epilogue after the loop.\nThis epilogue may involve returning a value, and since we want to be able to return from the loop in any case, we need to wrap a `block` around it.\nSo the complete template is:\n\n```lisp\n(let* (*variables...*)\n (block *name*\n  *Prologue*\n  (tagbody\n   Loop\n    *body*\n    (go loop)\n   end\n    *epilogue*\n    (return *result*))))\n```\n\nTo generate this template from the body of a `loop` form, we will employ a structure with fields for each of the parts of the template:\n\n```lisp\n(defstruct loop\n  \"A structure to hold parts of a loop as it is built.\"\n  (vars nil) (prologue nil) (body nil) (steps nil)\n  (epilogue nil) (result nil) (name nil))\n```\n\nNow the `loop` macro needs to do four things: (1) decide if this is a use of the simple, non-keyword `loop` or the complex ANSI `loop`.\nIf it is the latter, then (2) make an instance of the `loop` structure, (3) process the body of the loop, filling in apprpriate fields of the structure, and (4) place the filled fields into the template.\nHere is the `loop` macro:\n\n```lisp\n(defmacro loop (&rest exps)\n  \"Supports both ANSI and simple LOOP.\n  Warning: Not every loop keyword is supported.\"\n  (if (every #'listp exps)\n    ;; No keywords implies simple loop:\n    '(block nil (tagbody loop ,@exps (go loop)))\n    ;; otherwise process loop keywords:\n    (let ((l (make-loop)))\n      (parse-loop-body l exps)\n      (fill-loop-template l))))\n(defun fill-loop-template (l)\n  \"Use a loop-structure instance to fill the template.\"\n  '(let* .(nreverse (loop-vars l))\n    (block ,(loop-name l)\n     ,@(nreverse (loop-prologue l)\n     (tagbody\n      loop\n        ,@(nreverse (loop-body l))\n        ,@(nreverse (loop-steps l))\n        (go loop)\n      end\n        ,@(nreverse (loop-epilogue l))\n        (return ,(loop-result l))))))\n```\n\nMost of the work is in writing `parse-loop-body`, which takes a list of expressions and parses them into the proper fields of a loop structure.\nIt will use the following auxiliary functions:\n\n```lisp\n(defun add-body (l exp) (push exp (loop-body l)))\n(defun add-test (l test)\n  \"Put in a test for loop termination.\"\n  (push '(if .test (go end)) (loop-body l)))\n(defun add-var (l var init &optional (update nil update?))\n  \"Add a variable, maybe including an update step.\"\n  (unless (assoc var (loop-vars l))\n    (push (list var init) (loop-vars l)))\n  (when update?\n    (push '(setq ,var ,update) (loop-steps l))))\n```\n\nThere are a number of alternative ways of implementing this kind of processing.\nOne would be to use special variables: `*prologue*, *body*, *epilogue*`, and so on.\nThis would mean we wouldn't have to pass around the loop structure `l`, but there would be significant clutter in having seven new special variables.\nAnother possibility is to use local variables and close the definitions of `loop`, along with the `add-` functions in that local environment:\n\n```lisp\n(let (body prologue epilogue steps vars name result)\n  (defmacro loop ...)\n  (defun add-body ...)\n  (defun add-test ...)\n  (defun add-var ...))\n```\n\nThis is somewhat cleaner style, but some early Common Lisp compilers do not support embedded `defuns`, so I chose to write in a style that I knew would work in all implementations.\nAnother design choice would be to return multiple values for each of the components and have `parse-loop-body` put them all together.\nThis is in fact done in one of the Lisp Machine implementations of `loop`, but I think it is a poor decision: seven components are too many to keep track of by positional notation.\n\n### Anatomy of a Loop\n\nAll this has just been to set up for the real work: parsing the expressions that make up the loop with the function `parse-loop-body`.\nEvery loop consists of a sequence of clauses, where the syntax of each clause is determined by the first expression of the clause, which should be a known symbol.\nThese symbols are called *loop keywords,* although they are not in the keyword package.\n\nThe loop keywords will be defined in a data-driven fashion.\nEvery keyword has a function on its property list under the `loop-fn` indicator.\nThe function takes three arguments: the `loop` structure being built, the very next expression in the loop body, and a list of the remaining expressions after that.\nThe function is responsible for updating the `loop` structure (usually by making appropriate calls to the `add-` functions) and then returning the unparsed expressions.\nThe three-argument calling convention is used because many of the keywords only look at one more expression.\nSo those functions see that expression as their first argument, and they can conveniently return their second argument as the unparsed remainder.\nOther functions will want to look more carefully at the second argument, parsing some of it and returning the rest.\n\nThe macro `defloop` is provided to add new loop keywords.\nThis macro enforces the three-argument calling convention.\nIf the user supplies only two arguments, then a third argument is automatically added and returned as the remainder.\nAlso, if the user specifies another symbol rather than a list of arguments, this is taken as an alias, and a function is constructed that calls the function for that keyword:\n\n```lisp\n(defun parse-loop-body (l exps)\n  \"Parse the exps based on the first exp being a keyword.\n  Continue until all the exps are parsed.\"\n  (unless (null exps)\n    (parse-loop-body\n      l (call-loop-fn l (first exps) (rest exps)))))\n(defun call-loop-fn (l key exps)\n  \"Return the loop parsing function for this keyword.\"\n  (if (and (symbolp key) (get key 'loop-fn))\n    (funcall (get key 'loop-fn) l (first exps) (rest exps))\n    (error \"Unknown loop key: \"a\" key)))\n(defmacro defloop (key args &rest body)\n  \"Define a new LOOP keyword.\"\n  ;; If the args do not have a third arg, one is supplied.\n  ;; Also, we can define an alias with (defloop key other-key)\n  '(setf (get ',key 'loop-fn)\n    ,(cond ((and (symbolp args) (null body))\n      '#'(lambda (1 x y)\n          (call-loop-fn l '.args (cons x y))))\n       ((and (listp args) (= (length args) 2))\n        '#'(lambda (.@args -exps-) ,@body -exps-))\n       (t '#'(lambda .args ,@body)))))\n```\n\nNow we are ready to define some `loop` keywords.\nEach of the following sections refers to (and implements the loop keywords in) a section of chapter 26 of *Common Lisp the Language*, 2d edition.\n\n### Iteration Control (26.6)\n\nHere we define keywords for iterating over elements of a sequence and for stopping the iteration.\nThe following cases are covered, where uppercase words represent loop keywords:\n\n```lisp\n(LOOP REPEAT n ...)\n(LOOP FOR i FROM s TO e BY inc ...)\n(LOOP FOR v IN l ...)\n(LOOP FOR v ON l ...)\n(LOOP FOR v = expr [THEN step] ...)\n```\n\nThe implementation is straightforward, although somewhat tedious for complex keywords like `for`.\nTake the simpler keyword, `repeat`.\nTo handle it, we generate a new variable that will count down the number of times to repeat.\nWe call `add-var` to add that variable, with its initial value, to the loop structure.\nWe also give this variable an update expression, which decrements the variable by one each time through the loop.\nThen all we need to do is call `add-test` to insert code that will exit the loop when the variable reaches zero:\n\n```lisp\n(defloop repeat (l times)\n  \"(LOOP REPEAT n ...) does loop body n times.\"\n  (let ((i (gensym \"REPEAT\")))\n    (add-var l i times '(- ,i 1))\n    (add-test l '(<= ,i 0))))\n```\n\nThe loop keyword `for` is more complicated, but each case can be analyzed in the same way as `repeat`:\n\n```lisp\n(defloop as for) ;; AS is the same as FOR\n(defloop for (l var exps)\n  \"4 of the 7 cases for FOR are covered here:\n  (LOOP FOR i FROM s TO e BY inc ...) does arithmetic iteration\n  (LOOP FOR v IN l ...) iterates for each element of l\n  (LOOP FOR v ON l ...) iterates for each tail of l\n  (LOOP FOR v = expr [THEN step]) initializes and iterates v\"\n  (let ((key (first exps))\n      (source (second exps))\n      (rest (rest2 exps)))\n    (ecase key\n      ((from downfrom upfrom to downto upto by)\n     (loop-for-arithmetic l var exps))\n      (in (let ((v (gensym \"IN\")))\n           (add-var l v source '(cdr ,v))\n           (add-var l var '(car ,v) '(car ,v))\n           (add-test l '(null ,v))\n           rest))\n      (on (add-var l var source '(cdr ,var))\n          (add-test l '(null .var))\n          rest)\n      (= (if (eq (first rest) 'then)\n              (progn\n                (pop rest)\n                (add-var l var source (pop rest)))\n              (progn\n                (add-var l var nil)\n                (add-body l '(setq ,var .source))))\n          rest)\n      ;; ACROSS. BEING clauses omitted\n      )))\n(defun loop-for-arithmetic (l var exps)\n  \"Parse loop expressions of the form:\n  (LOOP FOR var [FROM | DOWNFROM | UPFROM exp1] [TO | DOWNTO | UPTO exp2]\n       [BY exp3]\"\n  ;; The prepositions BELOW and ABOVE are omitted\n  (let ((exp1 0)\n       (exp2 nil)\n       (exp3 1)\n       (down? nil))\n    ;; Parse the keywords:\n    (when (member (first exps) '(from downfrom upfrom))\n     (setf exp1 (second exps)\n         down? (eq (first exps) 'downfrom)\n         exps (rest2 exps)))\n    (when (member (first exps) '(to downto upto))\n     (setf exp2 (second exps)\n         down? (or down? (eq (first exps) 'downto))\n         exps (rest2 exps)))\n    (when (eq (first exps) 'by)\n     (setf exp3 (second exps)\n         exps (rest2 exps)))\n    ;; Add variables and tests:\n    (add-var l var exp1\n         '(,(if down? '- '+) ,var ,(maybe-temp l exp3)))\n    (when exp2\n      (add-test l '(,(if down? '< '>) ,var ,(maybe-temp l exp2))))\n    ;; and return the remaining expressions:\n         exps))\n(defun maybe-temp (l exp)\n  \"Generate a temporary variable, if needed.\"\n  (if (constantp exp)\n    exp\n    (let ((temp (gensym \"TEMP\")))\n      (add-var l temp exp)\n      temp)))\n```\n\n### End-Test Control (26.7)\n\nIn this section we cover the following clauses:\n\n```lisp\n(LOOP UNTIL test ...)\n(LOOP WHILE test ...)\n(LOOP ALWAYS condition ...)\n(LOOP NEVER condition ...)\n(LOOP THEREIS condition ...)\n(LOOP ... (LOOP-FINISH) ...)\n```\n\nEach keyword is quite simple:\n\n```lisp\n(defloop until (l test) (add-test l test))\n(defloop while (l test) (add-test l '(not .test)))\n(defloop always (l test)\n  (setf (loop-result l) t)\n  (add-body l '(if (not ,test) (return nil))))\n(defloop never (l test)\n  (setf (loop-result l) t)\n  (add-body l '(if ,test (return nil))))\n(defloop thereis (l test) (add-body l '(return-if ,test)))\n(defmacro return-if (test)\n  \"Return TEST if it is non-nil.\"\n  (once-only (test)\n    '(if ,test (return ,test))))\n(defmacro loop-finish () '(go end))\n```\n\n### Value Accumulation (26.8)\n\nThe `collect` keyword poses another challenge.\nHow do you collect a list of expressions presented one at a time?\nThe answer is to view the expressions as a queue, one where we add items to the rear but never remove them from the front of the queue.\nThen we can use the queue functions defined in [section 10.5](chapter10.md#s0025).\n\nUnlike the other clauses, value accumulation clauses can communicate with each other.\nThere can be, say, two `collect` and an append clause in the same loop, and they all build onto the same list.\nBecause of this, I use the same variable name for the accumulator, rather than gensyming a new variable for each use.\nThe name chosen is stored in the global variable `*acc*`.\nIn the official `loop` standard it is possible for the user to specify the variable with an `into` modifier, but I have not implemented that option.\nThe clauses covered are:\n\n```lisp\n(LOOP COLLECT item ...)\n(LOOP NCONC item ...)\n(LOOP APPEND item ...)\n(LOOP COUNT item ...)\n(LOOP SUM item ...)\n(LOOP MAXIMIZE item ...)\n(LOOP MINIMIZE item ...)\n```\n\nThe implementation is:\n\n```lisp\n(defconstant *acc* (gensym \"ACC\")\n  \"Variable used for value accumulation in LOOP.\")\n;;; INTO preposition is omitted\n(defloop collect (l exp)\n  (add-var l *acc* '(make-queue))\n  (add-body l '(enqueue ,exp .*acc*))\n  (setf (loop-result l) '(queue-contents ,*acc*)))\n(defloop nconc (l exp)\n  (add-var l *acc* '(make-queue))\n  (add-body l '(queue-nconc ,*acc* .exp))\n  (setf (loop-result l) '(queue-contents .*acc*)))\n(defloop append (l exp exps)\n  (call-loop-fn l 'nconc '((copy-list .exp) .,exps)))\n(defloop count (l exp)\n  (add-var l *acc* 0)\n  (add-body l '(when .exp (incf .*acc*)))\n  (setf (loop-result l) *acc*))\n(defloop sum (l exp)\n  (add-var l *acc* 0)\n  (add-body l '(incf ,*acc* .exp))\n  (setf (loop-result l) *acc*))\n(defloop maximize (l exp)\n  (add-var l *acc* nil)\n  (add-body l '(setf ,*acc*\n        (if ,*acc*\n            (max ,*acc* ,exp)\n            ,exp)))\n  (setf (loop-result l) *acc*))\n(defloop minimize (l exp)\n  (add-var 1 *acc* nil)\n  (add-body l '(setf ,*acc*\n        (if ,*acc*\n            (min ,*acc* ,exp)\n            ,exp)))\n  (setf (loop-result l) *acc*))\n(defloop collecting collect)\n(defloop nconcing nconc)\n(defloop appending append)\n(defloop counting count)\n(defloop summing sum)\n(defloop maximizing maximize)\n(defloop minimizing minimize)\n```\n\n**Exercise  24.1** `loop` lets us build aggregates (lists, maximums, sums, etc.) over the body of the loop.\nSometimes it is inconvenient to be restricted to a single-loop body.\nFor example, we might want a list of all the nonzero elements of a two-dimensional array.\nOne way to implement this is with a macro, `with-collection`, that sets up and returns a queue structure that is built by calls to the function `collect`.\nFor example:\n\n```lisp\n> (let ((A '#2a((l 0 0) (0 2 4) (0 0 3))))\n  (with-collection\n    (loop for i from 0 to 2 do\n      (loop for j from 0 to 2 do\n        (if (> (aref a i j) 0)\n          (collect (aref A i j)))))))\n(1 2 4 3)\n```\n\nImplement `with-collection` and `collect`.\n\n### Variable Initialization (26.9)\n\nThe `with` clause allows local variables-I have included it, but recommend using a `let` instead.\nI have not included the `and` preposition, which allows the variables to nest at different levels.\n\n```lisp\n;;;; 26.9. Variable Initializations (\"and\" omitted)\n(defloop with (l var exps)\n  (let ((init nil))\n    (when (eq (first exps) '=)\n      (setf init (second exps)\n        exps (rest2 exps)))\n    (add-var l var init)\n    exps))\n```\n\n### Conditional Execution (26.10)\n\n`loop` also provides forms for conditional execution.\nThese should be avoided whenever possible, as Lisp already has a set of perfectly good conditional macros.\nHowever, sometimes you want to make, say, a `collect` conditional on some test.\nIn that case, loop conditionals are acceptable.\nThe clauses covered here are:\n\n```lisp\n(LOOP WHEN test ... [ELSE ...])   ; IF is a synonym for WHEN\n(LOOP UNLESS test ... [ELSE ...])\n```\n\nHere is an example of `when`:\n\n```lisp\n> (loop for x from 1 to 10\n     when (oddp x)\n         collect x\n     else collect (- x))\n(1 -2 3 -4 5 -6 7 -8 9 -10)\n```\n\nOf course, we could have said `collect (if (oddp x ) x (- x ))` and done without the conditional.\nThere is one extra feature in loop's conditionals: the value of the test is stored in the variable `it` for subsequent use in the THEN or ELSE parts.\n(This is just the kind of feature that makes some people love `loop` and others throw up their hands in despair.) Here is an example:\n\n```lisp\n> (loop for x from 1 to 10\n    when (second (assoc x '((l one) (3 three) (5 five))))\n    collect it)\n(ONE THREE FIVE)\n```\n\nThe conditional clauses are a little tricky to implement, since they involve parsing other clauses.\nThe idea is that `call-loop-fn` parses the THEN and ELSE parts, adding whatever is necessary to the body and to other parts of the loop structure.\nThen `add-body` is used to add labels and go statements that branch to the labels as needed.\nThis is the same technique that is used to compile conditionals in [chapter 23](chapter23.md); see the function `comp-if` on [page 787](chapter23.md#p787).\nHere is the code:\n\n```lisp\n(defloop when (l test exps)\n  (loop-unless l '(not ,(maybe-set-it test exps)) exps))\n(defloop unless (l test exps)\n  (loop-unless l (maybe-set-it test exps) exps))\n(defun maybe-set-it (test exps)\n  \"Return value, but if the variable IT appears in exps,\n  then return code that sets IT to value.\"\n  (if (find-anywhere 'it exps)\n    '(setq it .test)\n    test))\n(defloop if when)\n(defun loop-unless (l test exps)\n  (let ((label (gensym \"L\")))\n    (add-var l 'it nil )\n    ;; Emit code for the test and the THEN part\n    (add-body l '(if .test (go ,label)))\n    (setf exps (call-loop-fn l (first exps) (rest exps)))\n    ;; Optionally emit code for the ELSE part\n    (if (eq (first exps) 'else)\n      (progn\n        (let ((label2 (gensym \"L\")))\n          (add-body l '(go ,label2))\n          (add-body l label)\n          (setf exps (call-loop-fn l (second exps) (rest2 exps)))\n          (add-body l label2)))\n        (add-body l label)))\n  exps)\n```\n\n### Unconditional Execution (26.11)\n\nThe unconditional execution keywords are `do` and `return`:\n\n```lisp\n(defloop do (l exp exps)\n  (add-body l exp)\n  (loop (if (symbolp (first exps)) (RETURN exps))\n    (add-body l (pop exps))))\n(defloop return (l exp) (add-body l '(return ,exp)))\n```\n\n### Miscellaneous Features (26.12)\n\nFinally, the miscellaneous features include the keywords `initially` and `finally`, which define the loop prologue and epilogue, and the keyword named, which gives a name to the loop for use by a `return-from` form.\nI have omitted the data-type declarations and destructuring capabilities.\n\n```lisp\n(defloop initially (l exp exps)\n  (push exp (loop-prologue l))\n  (loop (if (symbolp (first exps)) (RETURN exps))\n    (push (pop exps) (loop-prologue l))))\n(defloop finally (l exp exps)\n  (push exp (loop-epilogue l))\n  (loop (if (symbolp (first exps)) (RETURN exps))\n    (push (pop exps) (loop-epilogue l))))\n(defloop named (l exp) (setf (loop-name l) exp))\n```\n\n## 24.6 Sequence Functions\n\nCommon Lisp provides sequence functions to make the programmer's life easier: the same function can be used for lists, vectors, and strings.\nHowever, this ease of use comes at a cost.\nSequence functions must be written very carefully to make sure they are efficient.\nThere are three main sources of indeterminacy that can lead to inefficiency: (1) the sequences can be of different types; (2) some functions have keyword arguments; (3) some functions have a `&rest` argument.\nCareful coding can limit or eliminate these sources of inefficiency, by making as many choices as possible at compile time and making the remaining choices outside of the main loop.\n\nIn this section we see how to implement the new ANSI sequence function `map-into` and the updated function reduce efficiently.\nThis is essential for those without an ANSI compiler.\nEven those who do have access to an ANSI compiler will benefit from seeing the efficiency techniques used here.\n\nBefore defining the sequence functions, the macro `once-only` is introduced.\n\n### Once-only: A Lesson in Macrology\n\nThe macro `once-only` has been around for a long time on various systems, although it didn't make it into the Common Lisp standard.\nI include it here for two reasons: first, it is used in the following `funcall-if` macro, and second, if you can understand how to write and when to use `once-only`, then you truly understand macro.\n\nFirst, you have to understand the problem that `once-only` addresses.\nSuppose we wanted to have a macro that multiplies its input by itself:<a id=\"tfn24-2\"></a><sup>[2](#fn24-2)</sup>\n\n```lisp\n(defmacro square (x) '(* ,x ,x))\n```\n\nThis definition works fine in the following case:\n\n```lisp\n> (macroexpand '(square z)) => (* Z Z)\n```\n\nBut it doesn't work as well here:\n\n```lisp\n> (macroexpand '(square (print (incf i))))\n(* (PRINT (INCF I)) (PRINT (INCF I)))\n```\n\nThe problem is that `i` will get incremented twice, not once, and two different values will get printed, not one.\nWe need to bind `(print (incf i))` to a local variable before doing the multiplication.\nOn the other hand, it would be superfluous to bind `z` to a local variable in the previous example.\nThis is where `once-only` comes in.\nIt allows us to write macro definitions like this:\n\n```lisp\n(defmacro square (x) (once-only (x) '(* ,x ,x)))\n```\n\nand have the generated code be just what we want:\n\n```lisp\n> (macroexpand '(square z))\n(* Z Z)\n> (macroexpand '(square (print (incf i))))\n(LET ((G3811 (PRINT (INCF I))))\n  (* G3811 G3811))\n```\n\nYou have now learned lesson number one of `once-only`: you know how macros differ from functions when it comes to arguments with side effects, and you now know how to handle this.\nLesson number two comes when you try to write (or even understand) a definition of `once-only` – only when you truly understand the nature of macros will you be able to write a correct version.\nAs always, the first thing to determine is what a call to `once-only` should expand into.\nThe generated code should test the variable to see if it is free of side effects, and if so, generate the body as is; otherwise it should generate code to bind a new variable, and use that variable in the body of the code.\nHere's roughly what we want:\n\n```lisp\n> (macroexpand '(once-only (x) '(* ,x ,x)))\n(if (side-effect-free-p x)\n  '(* ,x ,x)\n  '(let ((g00l ,x))\n    , (let ((x 'g00l))\n      '(* x ,x))))\n```\n\nwhere `g001` is a new symbol, to avoid conflicts with the `x` or with symbols in the body.\nNormally, we generate macro bodies using backquotes, but if the macro body itself has a backquote, then what?\nIt is possible to nest backquotes (and appendix C of *Common Lisp the Language*, 2d edition has a nice discussion of doubly and triply nested backquotes), but it certainly is not trivial to understand.\nI recommend replacing the inner backquote with its equivalent using `list` and `quote`:\n\n```lisp\n(if (side-effect-free-p x)\n  '(* ,x ,x)\n  (list 'let (list (list 'g00l x))\n    (let ((x 'g00l))\n      '(* ,x ,x))))\n```\n\nNow we can write `once-only`.\nNote that we have to account for the case where there is more than one variable and where there is more than one expression in the body.\n\n```lisp\n(defmacro once-only (variables &rest body)\n  \"Returns the code built by BODY. If any of VARIABLES\n  might have side effects, they are evaluated once and stored\n  in temporary variables that are then passed to BODY.\"\n  (assert (every #'symbolp variables))\n  (let ((temps (loop repeat (length variables) collect (gensym))))\n    '(if (every #'side-effect-free-p (list .,variables))\n      (progn .,body)\n      (list 'let\n        ,'(list .@(mapcar #'(lambda (tmp var)\n          '(list '.tmp .var))\n        temps variables))\n         (let .(mapcar #'(lambda (var tmp) '(.var ',tmp))\n      variables temps)\n     .,body)))))\n(defun side-effect-free-p (exp)\n  \"Is exp a constant, variable, or function,\n  or of the form (THE type x) where x is side-effect-free?\"\n  (or (constantp exp) (atom exp) (starts-with exp 'function)\n    (and (starts-with exp 'the)\n      (side-effect-free-p (third exp)))))\n```\n\nHere we see the expansion of the call to `once-only` and a repeat of the expansions of two calls to `square`:\n\n```lisp\n> (macroexpand '(once-only (x) '(* ,x ,x)))\n(IF (EVERY #'SIDE-EFFECT-FREE-P (LIST X))\n    (PROGN\n      '(* ,X ,X))\n    (LIST 'LET (LIST (LIST 'G3763 X))\n          (LET ((X 'G3763))\n            '(* ,X ,X))))\n> (macroexpand '(square z))\n(* Z Z)\n> (macroexpand '(square (print (incf i))))\n(LET ((G3811 (PRINT (INCF I))))\n  (* G3811 G3811))\n```\n\nThis output was produced with `*print-gensym*` set to `nil`.\nWhen this variable is non-nil, uninterned symbols are printed with a prefix `#:`, as in `#:G3811`.\nThis insures that the symbol will not be interned by a subsequent read.\n\nIt is worth noting that Common Lisp automatically handles problems related to multiple evaluation of subforms in setf methods.\nSee [page 884](chapter25.md#p884) for an example.\n\n### Avoid Overusing Macros\n\nA word to the wise: don't get carried away with macros.\nUse macros freely to represent your *problem*, but shy away from new macros in the implementation of your *solution,* unless absolutely necessary.\nSo, it is good style to introduce a macro, say, `defrule`, which defines rules for your application, but adding macros to the code itself may just make things harder for others to use.\n\nHere is a story.\nBefore `if` was a standard part of Lisp, I defined my own version of `if`.\nUnlike the simple `if`, my version took any number of test/result pairs, followed by an optional else result.\nIn general, the expansion was:\n\n`(if` *a b c d ... x*) => (`cond` *(a b) (c d)* ... (`T` *x*))\n\nMy `if` also had one more feature: the symbol `'that'` could be used to refer to the value of the most recent test.\nFor example, I could write:\n\n```lisp\n(if (assoc item a-list)\n  (process (cdr that)))\n```\n\nwhich would expand into:\n\n```lisp\n(LET (THAT)\n  (COND\n    ((SETQ THAT (ASSOC ITEM A-LIST)) (PROCESS (CDR THAT)))))\n```\n### remove extra line\n\nThis was a convenient feature (compare it to the `=>` feature of Scheme's `cond`, as discussed on [page 778](chapter22.md#p778)), but it backfired often enough that I eventually gave up on my version of `if`.\nHere's why.\nI would write code like this:\n\n```lisp\n(if (total-score x)\n  (print (/ that number-of-trials))\n  (error \"No scores\"))\n```\n\nand then make a small change:\n\n```lisp\n(if (total-score x)\n  (if *print-scores* (print (/ that number-of-trials)))\n  (error \"No scores\"))\n```\n\nThe problem is that the variable `that` now refers to `*print-scores*`, not `(total-score x),` as it did before.\nMy macro violates referential transparency.\nIn general, that's the whole point of macros, and it is why macros are sometimes convenient.\nBut in this case, violating referential transparency can lead to confusion.\n\n### MAP-INTO\n\nThe function `map-into` is used on [page 632](chapter18.md#p632).\nThis function, added for the ANSI version of Common Lisp, is like `map`, except that instead of building a new sequence, the first argument is changed to hold the results.\nThis section describes how to write a fairly efficient version of `map-into`, using techniques that are applicable to any sequence function.\nWe'll start with a simple version:\n\n```lisp\n(defun map-into (result-sequence function &rest sequences)\n  \"Destructively set elements of RESULT-SEQUENCE to the results\n  of applying FUNCTION to respective elements of SEQUENCES.\"\n  (replace result-sequence (apply #'map 'list function sequences)))\n```\n\nThis does the job, but it defeats the purpose of `map-into`, which is to avoid generating garbage.\nHere's a version that generates less garbage:\n\n```lisp\n(defun map-into (result-sequence function &rest sequences)\n  \"Destructively set elements of RESULT-SEQUENCE to the results\n  of applying FUNCTION to respective elements of SEQUENCES.\"\n  (let ((n (loop for seq in (cons result-sequence sequences)\n              minimize (length seq))))\n    (dotimes (i n)\n      (setf (elt result-sequence i)\n        (apply function\n          (mapcar #'(lambda (seq) (elt seq i))\n            sequences))))))\n```\n\nThere are three problems with this definition.\nFirst, it wastes space: `mapcar` creates a new argument list each time, only to have the list be discarded.\nSecond, it wastes time: doing a `setf` of the *i*th element of a list makes the algorithm *O*(*n<sup>2</sup>*) instead of *O*(*n*), where *n* is the length of the list.\nThird, it is subtly wrong: if `result-sequence` is a vector with a fill pointer, then `map-into` is supposed to ignore `result-sequence`'s current length and extend the fill pointer as needed.\nThe following version fixes those problems:\n\n```lisp\n(defun map-into (result-sequence function &rest sequences)\n  \"Destructively set elements of RESULT-SEQUENCE to the results\n  of applying FUNCTION to respective elements of SEQUENCES.\"\n  (let ((arglist (make-list (length sequences)))\n    (n (if (listp result-sequence)\n      most-positive-fixnum\n      (array-dimension result-sequence 0))))\n   ;; arglist is made into a list of args for each call\n   ;; n is the length of the longest vector\n   (when sequences\n     (setf n (min n (loop for seq in sequences\n       minimize (length seq)))))\n   ;; Define some shared functions:\n   (flet\n    ((do-one-call (i)\n      (loop for seq on sequences\n        for arg on arglist\n        do (if (listp (first seq))\n          (setf (first arg)\n            (pop (first seq)))\n          (setf (first arg)\n            (aref (first seq) i))))\n      (apply function arglist))\n    (do-result (i)\n      (if (and (vectorp result-sequence)\n        (array-has-fill-pointer-p result-sequence))\n      (setf (fill-pointer result-sequence)\n  (max i (fill-pointer result-sequence))))))\n   (declare (inline do-one-call))\n   ;; Decide if the result is a list or vector,\n   ;; and loop through each element\n   (if (listp result-sequence)\n    (loop for i from 0 to (- n 1)\n     for r on result-sequence\n     do (setf (first r)\n        (do-one-call i)))\n    (loop for i from 0 to (- n 1)\n     do (setf (aref result-sequence i)\n        (do-one-call i))\n     finally (do-result n))))\n   result-sequence))\n```\n\nThere are several things worth noticing here.\nFirst, I split the main loop into two versions, one where the result is a list, and the other where it is a vector.\nRather than duplicate code, the local functions `do-one-call` and `do-result` are defined.\nThe former is declared inline because it it called often, while the latter is not.\nThe arguments are computed by looking at each sequence in turn, taking the *i*th element if it is a vector, and popping the sequence if it is a list.\nThe arguments are stored into the list `arglist`, which has been preallocated to the correct size.\nAll in all, we compute the answer fairly efficiently, without generating unnecessary garbage.\n\nThe application could be done more efficiently, however.\nThink what `apply` must do: scan down the argument list, and put each argument into the location expected by the function-calling conventions, and then branch to the function.\nSome implementations provide a better way of doing this.\nFor example, the TI Lisp Machine provides two low-level primitive functions, `%push` and `%call`, that compile into single instructions to put the arguments into the right locations and branch to the function.\nWith these primitives, the body of `do-one-call` would be:\n\n```lisp\n(loop for seq on sequences\n  do (if (listp (first seq))\n    (%push (pop (first seq)))\n    (%push (aref (first seq) i))))\n(%call function length-sequences)\n```\n\nThere is a remaining inefficiency, though.\nEach sequence is type-checked each time through the loop, even though the type remains constant once it is determined the first time.\nTheoretically, we could code separate loops for each combination of types, just as we coded two loops depending on the type of the result sequence.\nBut that would mean 2*<sup>n</sup>* loops for *n* sequences, and there is no limit on how large *n* can be.\n\nIt might be worth it to provide specialized functions for small values of *n*, and dispatch to the appropriate function.\nHere's a start at that approach:\n\n```lisp\n(defun map-into (result function &rest sequences)\n  (apply\n   (case (length sequences)\n    (0 (if (listp result) #'map-into-list-0 #'map-into-vect-0))\n    (1 (if (listp result)\n     (if (listp (first sequences))\n       #'map-into-list-l-list #'map-into-list-1-vect)\n     (if (listp (first sequences))\n       #'map-into-vect-l-list #'map-into-vect-l-vect)) )\n    (2 (if (listp result)\n     (if (listp (first sequences))\n      (if (listp (second sequences))\n       #'map-into-list-2-list-list\n       #'map-into-list-2-list-vect)\n      ...)))\n    (t (if (listp result) #'map-into-list-n #'map-into-vect-n)))\n   result function sequences))\n```\n\nThe individual functions are not shown.\nThis approach is efficient in execution time, but it takes up a lot of space, considering that `map-into` is a relatively obscure function.\nIf `map-into` is declared `inline` and the compiler is reasonably good, then it will produce code that just calls the appropriate function.\n\n### REDUCE with :key\n\nAnother change in the ANSI proposal is to add a `:key` keyword to `reduce`.\nThis is a useful addition-in fact, for years I had been using a `reduce-by` function that provided just this functionality.\nIn this section we see how to add the `:key` keyword.\n\nAt the top level, I define reduce as an interface to the keywordless function `reduce*`.\nThey are both proclaimed inline, so there will be no overhead for the keywords in normal uses of reduce.\n\n```lisp\n(proclaim '(inline reduce reduce*))\n (defun reduce* (fn seq from-end start end key init init-p)\n     (funcall (if (listp seq) #'reduce-list #'reduce-vect)\n          fn seq from-end (or start 0) end key init init-p))\n(defun reduce (function sequence &key from-end start end key\n               (initial-value nil initial-value-p))\n    (reduce* function sequence from-end start end\n                  key initial-value initial-value-p))\n```\n\nThe easier case is when the sequence is a vector:\n\n```lisp\n(defun reduce-vect (fn seq from-end start end key init init-p)\n    (when (null end) (setf end (length seq)))\n    (assert (<= 0 start end (length seq)) (start end)\n              \"Illegal subsequence of ~ a --- :start ~ d :end ~ d\"\n                 seq start end)\n   (case (- end start)\n         (0 (if init-p init (funcall fn)))\n         (1 (if init-p\n             (funcall fn init (funcall-if key (aref seq start)))\n             (funcall-if key (aref seq start))))\n         (t (if (not from-end)\n             (let ((result\n                 (if init-p\n                  (funcall fn init\n                   (funcall-if key (aref seq start)))\n                 (funcall\n                      fn\n                          (funcall-if key (aref seq start))\n                          (funcall-if key (aref seq (+ start 1)))))))\n             (loop for i from (+ start (if init-p 1 2))\n                     to (- end 1)\n                     do (setf result\n                       (funcall\n                        fn result\n                        (funcall-if key (aref seq i)))))\n                 result)\n             (let ((result\n                 (if init-p\n               (funcall\n       fn\n       (funcall-if key (aref seq (- end 1)))\n               init)\n          (funcall\n              fn\n               (funcall-if key (aref seq (- end 2)))\n               (funcall-if key (aref seq (- end 1)))))))\n (loop for i from (- end (if init-p 2 3)) downto start\n         do (setf result\n                (funcall\n                                fn\n                                (funcall-if key (aref seq i))\n                                result)))\nresult)))))\n```\n\nWhen the sequence is a list, we go to some trouble to avoid computing the length, since that is an *O(n)* operation on lists.\nThe hardest decision is what to do when the list is to be traversed from the end.\nThere are four choices:\n\n*   **recurse.** We could recursively walk the list until we hit the end, and then compute the results on the way back up from the recursions.\nHowever, some implementations may have fairly small bounds on the depths of recursive calls, and a system function like reduce should never run afoul of such limitations.\nIn any event, the amount of stack space consumed by this approach would normally be more than the amount of heap space consumed in the next approach.\n\n*   **reverse.** We could reverse the list and then consider `from-end` true.\nThe only drawback is the time and space needed to construct the reversed list.\n\n*   **nreverse.** We could destructively reverse the list in place, do the reduce computation, and then destructively reverse the list back to its original state (perhaps with an unwind-protect added).\nUnfortunately, this is just incorrect.\nThe list may be bound to some variable that is accessible to the function used in the reduction.\nIf that is so, the function will see the reversed list, not the original list.\n\n*   **coerce.** We could convert the list to a vector, and then use `reduce-vect`.\nThis has an advantage over the reverse approach in that vectors generally take only half as much storage as lists.\nTherefore, this is the approach I adopt.\n\n```lisp\n(defmacro funcall-if (fn arg)\n   (once-only (fn)\n       '(if .fn (funcall .fn .arg) .arg)))\n(defun reduce-list (fn seq from-end start end key init init-p)\n    (when (null end) (setf end most-positive-fixnum))\n    (cond ((> start 0)\n             (reduce-list fn (nthcdr start seq) from-end 0\n                   (- end start) key init init-p))\n             ((or (null seq) (eql start end))\n             (if init-p init (funcall fn)))\n             ((= (- end start) 1)\n             (if init-p\n                (funcall fn init (funcall-if key (first seq)))\n                (funcall-if key (first seq))))\n          (from-end\n             (reduce-vect fn (coerce seq 'vector) t start end\n                   key init init-p))\n                ((null (rest seq))\n             (if init-p\n                (funcall fn init (funcall-if key (first seq)))\n                (funcall-if key (first seq))))\n          (t (let ((result\n          (if init-p\n                 (funcall\n                        fn init\n                        (funcall-if key (pop seq)))\n                 (funcall\n                        fn\n                        (funcall-if key (pop seq))\n                        (funcall-if key (pop seq))))))\n          (if end\n                (loop repeat (- end (if init-p 1 2)) while seq\n                 do (setf result\n                        (funcall\n                        fn result\n                     (funcall-if key (pop seq)))))\n             (loop while seq\n                 do (setf result\n               (funcall\n                  fn result\n                  (funcall-if key (pop seq)))))\n             result)))))\n```\n\n## 24.7 Exercises\n\n**Exercise  24.2 [m]** The function `reduce` is a very useful one, especially with the `key` keyword.\nWrite nonrecursive definitions for `append` and `length` using `reduce`.\nWhat other common functions can be written with `reduce`?\n\n**Exercise  24.3** The so-called loop keywords are not symbols in the keyword package.\nThe preceding code assumes they are all in the current package, but this is not quite right.\nChange the definition of `loop` so that any symbol with the same name as a loop keyword acts as a keyword, regardless of the symbol's package.\n\n**Exercise  24.4** Can there be a value for *exp* for which the following expressions are not equivalent?\nEither demonstrate such an *exp* or argue why none can exist.\n\n```lisp\n(loop for x in list collect *exp*)\n(mapcar #'(lambda (x) *exp)* list))\n```\n\n**Exercise  24.5** The object-oriented language Eiffel provides two interesting `loop` keywords: `invariant` and `variant`.\nThe former takes a Boolean-valued expression that must remain true on every iteration of the loop, and the latter takes a integer-valued expression that must decrease on every iteration, but never becomes negative.\nErrors are signaled if these conditions are violated.\nUse `defloop` to implement these two keywords.\nMake them generate code conditionally, based on a global flag.\n\n## 24.8 Answers\n\n**Answer 24.1**\n\n```lisp\n(defvar *queue*)\n(defun collect (item) (enqueue item *queue*))\n(defmacro with-collection (&body body)\n     '(let ((*queue* (make-queue)))\n                 ,@body\n           (queue-contents *queue*)))\n```\n\nHere's another version that allows the collection variable to be named.\nThat way, more than one collection can be going on at the same time.\n\n```lisp\n(defun collect (item &optional (queue *queue*))\n      (enqueue item queue))\n(defmacro with-collection ((&optional (queue '*queue*))\n                               &body body)\n      '(let ((,queue (make-queue)))\n       ,@body\n      (queue-contents .queue)))\n```\n\n**Answer 24.2**\n\n```lisp\n(defun append-r (x y)\n      (reduce #'cons x :initial-value y :from-end t))\n(defun length-r (list)\n      (reduce #'+ list :key #'(lambda (x) 1)))\n```\n\n**Answer 24.4** The difference between `loop` and `mapcar` is that the former uses only one variable `x`, while the latter uses a different `x` each time.\nIf `x`'s extent is no bigger than its scope (as it is in most expressions) then this makes no difference.\nBut if any `x` is captured, giving it a longer extent, then a difference shows up.\nConsider *exp =* `#'(lambda () x).`\n\n```lisp\n> (mapcar #'funcall (loop for x in '(1 2 3) collect\n                     #'(lambda O x)))\n(3 3 3)\n>(mapcar #'funcall (mapcar #'(lambda (x) #'(lambda () x))\n                          '(1 2 3)))\n(1 2 3)\n```\n\n**Answer 24.5**\n\n```lisp\n(defvar *check-invariants* t\n      \"Should VARIANT and INVARIANT clauses in LOOP be checked?\")\n(defloop invariant (l exp)\n      (when *check-invariants*\n                (add-body l '(assert .exp () \"Invariant violated.\"))))\n(defloop variant (l exp)\n (when *check-invariants*\n           (let ((var (gensym \"INV\")))\n                (add-var l var nil)\n                (add-body l '(setf ,var (update-variant .var .exp))))))\n     (defun update-variant (old new)\n      (assert (or (null old) (< new old)) ()\n                \"Variant is not monotonically decreasing\")\n      (assert (> new 0) () \"Variant is no longer positive\")\n     new)\n```\n\nHere's an example:\n\n```lisp\n(defun gcd2 (a b)\n      \"Greatest common divisor. For two positive integer arguments.\"\n      (check-type a (integer 1))\n      (check-type b (integer 1))\n      (loop with x = a with y = b\n                invariant (and (> x 0) (> y 0)) ;; (= (gcd x y) (gcd a b))\n                variant (max x y)\n                until (= x y)\n                do (if (> x y) (decf x y) (decf y x))\n                finally (return x)))\n```\n\nHere the invariant is written semi-informally.\nWe could include the calls to `gcd`, but that seems to be defeating the purpose of `gcd2`, so that part is left as a comment.\nThe idea is that the comment should help the reader prove the correctness of the code, and the executable part serves to notify the lazy reader when something is demonstrably wrong at run time.\n\n----------------------\n\n\n<a id=\"fn24-1\"></a><sup>[1](#tfn24-1)</sup>\nOr in the user package in non-ANSI systems.\n\n<a id=\"fn24-2\"></a><sup>[2](#tfn24-2)</sup>\nAs was noted before, the proper way to do this is to proclaim `square` as an inline function, not a macro, but please bear with the example.\n"
  },
  {
    "path": "docs/chapter25.md",
    "content": "# Chapter 25\n## Troubleshooting\n\n> Perhaps if we wrote programs from childhood on, as adults we'd be able to read them.\n\n> -Alan Perlis\n\nWhen you buy a new appliance such as a television, it comes with an instruction booklet that lists troubleshooting hints in the following form:\n\n**PROBLEM**: Nothing works.\n\n**Diagnosis**: Power is off.\n\n**Remedy:** Plug in outlet and turn on power switch.\n\nIf your Lisp compiler came without such a handy instruction booklet, this chapter may be of some help.\nIt lists some of the most common difficulties that Lisp programmers encounter.\n\n## 25.1 Nothing Happens\n\n**PROBLEM:** You type an expression to Lisp's read-eval-print loop and get no response-no result, no prompt.\n\n**Diagnosis:** There are two likely reasons why output wasn't printed: either Lisp is still doing read or it is still doing `eval`.\nThese possibilities can be broken down further into four cases:\n\n**Diagnosis:** If the expression you type is incomplete, Lisp will wait for more input to complete it.\nAn expression can be incomplete because you have left off a right parenthesis (or inserted an extra left parenthesis).\nOr you may have started a string, atom, or comment without finishing it.\nThis is particularly hard to spot when the error spans multiple lines.\nA string begins and ends with double-quotes: `\"string\"`; an atom containing unusual characters can be delimited by vertical bars: `| AN ATOM |`; and a comment can be of the form `# | a comment | #`.\nHere are four incomplete expressions:\n\n```lisp\n(+ (* 3 (sqrt 5) 1)\n(format t \"~&X=~a, Y=~a. x y)\n(get '|strange-atom 'prop)\n(if (= x 0) #1 test if x is zero\n    y\n    x)\n```\n\n**Remedy:** Add a `)`, `\"`, `|`, and `|#`, respectively.\nOr hit the interrupt key and type the input again.\n\n**Diagnosis:** Your program may be waiting for input.\n\n**Remedy:** Never do a `(read)` without first printing a prompt of some kind.\nIf the prompt does not end with a newline, a call to `finish-output` is also in order.\nIn fact, it is a good idea to call a function that is at a higher level than `read`.\nSeveral systems define the function `prompt-and-read`.\nHere is one version:\n\n```lisp\n(defun prompt-and-read (ctl-string &rest args)\n  \"Print a prompt and read a reply.\"\n  (apply #'format t ctl-string args)\n  (finish-output)\n  (read))\n```\n\n**Diagnosis:** The program may be caught in an infinite loop, either in an explicit `loop` or in a recursive function.\n\n**Remedy:** Interrupt the computation, get a back trace, and see what functions are active.\nCheck the base case and loop variant on active functions and loops.\n\n**Diagnosis:** Even a simple expression like (`mapc #'sqrt list`) or (`length list`) will cause an infinite loop if `list` is an infinite list-that is, a list that has some tail that points back to itself.\n\n**Remedy:** Be very careful any time you modify a structure with `nconc`, `delete`, `setf`, and so forth.\n\n**PROBLEM:** You get a new prompt from the read-eval-print loop, but no output was printed.\n\n**Diagnosis:** The expression you evaluated must have returned no values at all, that is, the result `(values)`.\n\n## 25.2 Change to Variable Has No Effect\n\n**PROBLEM:** You redefined a variable, but the new value was ignored.\n\n**Diagnosis:** Altering a variable by editing and re-evaluating a `defvar` form will not change the variable's value.\n`defvar` only assigns an initial value when the variable is unbound.\n\n**Remedy:** Use setf to update the variable, or change the `defvar` to a `defparameter`.\n\n**Diagnosis:** Updating a locally bound variable will not affect a like-named variable outside that binding.\nFor example, consider:\n\n```lisp\n(defun check-ops (*ops*)\n  (if (null *ops*)\n          (setf *ops* *default-ops*))\n  (mapcar #'check-op *ops*))\n```\n\nIf `check-ops` is called with a null argument, the `*ops*` that is a parameter of `check-ops` will be updated, but the global `*ops*` will not be, even if it is declared special.\n\n**Remedy:** Don't shadow variables you want to update.\nUse a different name for the local variable.\nIt is important to distinguish special and local variables.\nStick to the naming convention for special variables: they should begin and end with asterisks.\nDon't forget to introduce a binding for all local variables.\nThe following excerpt from a recent textbook is an example of this error:\n\n```lisp\n(defun test ()\n  (setq x 'test-data)       ; Warning!\n  (solve-problem x))        ; Don't do this.\n```\n\nThis function should have been written:\n\n```lisp\n(defun test ()\n  (let ((x 'test-data))     ; Do this instead.\n      (solve-problem x)))\n```\n\n## 25.3 Change to Function Has No Effect\n\n**PROBLEM:** You redefined a function, but the change was ignored.\n\n**Diagnosis:** When you change a macro, or a function that has been declared inline, the change will not necessarily be seen by users of the changed function.\n(It depends on the implementation.)\n\n**Remedy:** Recompile after changing a macro.\nDon't use inline functions until everything is debugged.\n(`Use (declare (notinline f)`) to cancel an inline declaration).\n\n**Diagnosis:** If you change a normal (non-inline) function, that change *will* be seen by code that refers to the function by *name*, but not by code that refers to the old value of the function itself.\nConsider:\n\n```lisp\n(defparameter *scorer* #'score-fn)\n(defparameter *printer* 'print-fn)\n(defun show (values)\n  (funcall *printer*\n      (funcall *scorer* values)\n      (reduce #'better values)))\n```\n\nNow suppose that the definitions of `score-fn`, `print-fn`, and `better` are all changed.\nDoes any of the prior code have to be recompiled?\nThe variable `*printer*` can stay as is.\nWhen it is funcalled, the symbol `print-fn` will be consulted for the current functional value.\nWithin `show`, the expression `#'better` is compiled into code that will get the current version of `better`, so it too is safe.\nHowever, the variable `*scorer*` must be changed.\nIts value is the old definition of `score-fn`.\n\n**Remedy:** Re-evaluate the definition of `*scorer*`.\nIt is unfortunate, but this problem encourages many programmers to use symbols where they really mean functions.\nSymbols will be coerced to the global function they name when passed to `funcall` or `apply`, but this can be the source of another error.\nIn the following example, the symbol `local-fn` will not refer to the locally bound function.\nOne needs to use `#'local-fn` to refer to it.\n\n```lisp\n(flet ((local-fn (x) ...))\n  (mapcar 'local-fn list))\n```\n\n**Diagnosis:** If you changed the name of a function, did you change the name everywhere?\nFor example, if you decide to change the name of `print-fn` to `print-function` but forget to change the value of `*printer*`, then the old function will be called.\n\n**Remedy:** Use your editor's global replace command.\nTo be even safer, redefine obsolete functions to call `error`.\nThe following function is handy for this purpose:\n\n```lisp\n(defun make-obsolete (fn-name)\n  \"Print an error if an obsolete function is called.\"\n  (setf (symbol-function fn-name)\n        #'(lambda (&rest args)\n              (declare (ignore args))\n              (error \"Obsolete function.\"))))\n```\n\n**Diagnosis:** Are you using `labels` and `flet` properly?\nConsider again the function `replace-?-vars`, which was defined in [section 11.3](chapter11.md#s0025) to replace an anonymous logic variable with a unique new variable.\n\n```lisp\n(defun replace-?-vars (exp)\n  \"Replace any ? within exp with a var of the form ?123.\"\n  (cond ((eq exp '?) (gensym \"?\"))\n      ((atom exp) exp)\n      (t (cons (replace-?-vars (first exp))\n          (replace-?-vars (rest exp))))))\n```\n\nIt might occur to the reader that gensyming a different variable each time is wasteful.\nThe variables must be unique in each clause, but they can be shared across clauses.\nSo we could generate variables in the sequence `?1, ?2, ...`, intern them, and thus reuse these variables in the next clause (provided we warn the user never to use such variable names).\nOne way to do that is to introduce a local variable to hold the variable number, and then a local function to do the computation:\n\n```lisp\n(defun replace-?-vars (exp)\n \"Replace any ? within exp with a var of the form ?123.\"\n ;;*** Buggy Version ***\n (let ((n 0))\n   (flet\n    ((replace-?-vars (exp)\n     (cond ((eq exp '?) (symbol '? (incf n)))\n     ((atom exp) exp)\n     (t (cons (replace-?-vars (first exp))\n         (replace-?-vars (rest exp)))))))\n   (replace-?-vars exp))))\n```\n\nThis version doesn't work.\nThe problem is that `flet`, like `let`, defines a new function within the body of the `flet` but not within the new function's definition.\nSo two lessons are learned here: use `labels` instead of `flet` to define recursive functions, and don't shadow a function definition with a local definition of the same name (this second lesson holds for variables as well).\nLet's fix the problem by changing `labels` to `flet` and naming the local function `recurse`:\n\n```lisp\n(defun replace-?-vars (exp)\n \"Replace any ? within exp with a var of the form ?123.\"\n ;;*** Buggy Version ***\n (let ((n 0))\n   (labels\n    ((recurse (exp)\n     (cond ((eq exp '?) (symbol '? (incf n)))\n     ((atom exp) exp)\n     (t (cons (replace-?-vars (first exp))\n      (replace-?-vars (rest exp)))))))\n    (recurse exp))))\n```\n\nAnnoyingly, this version still doesn't work!\nThis time, the problem is carelessness; we changed the `replace-?-vars` to `recurse` in two places, but not in the two calls in the body of `recurse`.\n\n**Remedy:** In general, the lesson is to make sure you call the right function.\nIf there are two functions with similar effects and you call the wrong one, it can be hard to see.\nThis is especially true if they have similar names.\n\n**PROBLEM:** Your closures don't seem to be working.\n\n**Diagnosis:** You may be erroneously creating a lambda expression by consing up code.\nHere's an example from a recent textbook:\n\n```lisp\n(defun make-specialization (c)\n  (let (pred newc)\n    ...\n  (setf (get newc 'predicate)\n    '(lambda (obj)    :Warning\n      (and ,(cons pred '(obj))    :Don't do this.\n      (apply '.(get c 'predicate) (list obj)))))\n    ...))\n```\n\nStrictly speaking, this is legal according to *Common Lisp the Language*, although in ANSI Common Lisp it will *not* be legal to use a list beginning with `lambda` as a function.\nBut in either version, it is a bad idea to do so.\nA list beginning with `lambda` is just that: a list, not a closure.\nTherefore, it cannot capture lexical variables the way a closure does.\n\n**Remedy:** The correct way to create a closure is to evaluate a call to the special form `function`, or its abbreviation, `#'`.\nHere is a replacement for the code beginning with '(`lambda ...`. Note that it is a closure, closed over `pred` and `c`.\nAlso note that it gets the `predicate` each time it is called; thus, it is safe to use even when predicates are being changed dynamically.\nThe previous version would not work when a predicate is changed.\n\n```lisp\n#'(lambda (obj)            ; Do this instead.\n      (and (funcall pred obj)\n          (funcall (get c 'predicate) obj)))\n```\n\nIt is important to remember that `function` (and thus `#'`) is a special form, and thus only returns the right value when it is evaluated.\nA common error is to use `#'` notation in positions that are not evaluated:\n\n```lisp\n(defvar *obscure-fns* '(#'cis #'cosh #'ash #'bit-orc2)) ; wrong\n```\n\nThis does not create a list of four functions.\nRather, it creates a list of four sublists; the first sublist is (`function cis`).\nIt is an error to funcall or apply such an object.\nThe two correct ways to create a list of functions are shown below.\nThe first assures that each function special form is evaluated, and the second uses function names instead of functions, thus relying on `funcall` or `apply` to coerce the names to the actual functions.\n\n```lisp\n(defvar *obscure-fns* (list #'cis #'cosh #'ash #'bit-orc2))\n(defvar *obscure-fns* '(cis cosh ash bit-orc2))\n```\n\nAnother common `error` is to expect `#'if` or `#'or` to return a function.\nThis is an error because special forms are just syntactic markers.\nThere is no function named `if` or `or`; they should be thought of as directives that tell the compiler what to do with a piece of code.\n\nBy the way, the function `make-specialization` above is bad not only for its lack of `function` but also for its use of backquote.\nThe following is a better use of backquote:\n\n```lisp\n'(lambda (obj)\n    (and (,pred obj)\n        (,(get c 'predicate) obj)))\n```\n\n## 25.4 Values Change \"by Themselves\"\n\n**PROBLEM:** You deleted/removed something, but it didn't take effect.\nFor example:\n\n```lisp\n> (setf numbers '(1 2 3 4 5)) => (1 2 3 4 5)\n> (remove 4 numbers) => (1 2 3 5)\n> numbers => (1 2 3 4 5)\n> (delete 1 numbers) => (2 3 4 5)\n> numbers => (1 2 3 4 5)\n```\n\n**Remedy:** Use (`setf numbers` (`delete 1 numbers`)).\nNote that `remove` is a non-destructive function, so it will never alter its arguments, `delete` is destructive, but when asked to delete the first element of a list, it returns the rest of the list, and thus does not alter the list itself.\nThat is why `setf` is necessary.\nSimilar remarks hold for `nconc`, `sort`, and other destructive operations.\n\n**PROBLEM:** You created a hundred different structures and changed a field in one of them.\nSuddenly, all the other ones magically changed!\n\n**Diagnosis:** Different structures may share identical subfields.\nFor example, suppose you had:\n\n```lisp\n(defstruct block\n  (possible-colors '(red green blue))\n  ...)\n  (setf bl (make-block))\n  (setf b2 (make-block))\n  ...\n  (delete 'green (block-possible-colors bl))\n```\n\nBoth `b1` and `b2` share the initial list of possible colors.\nThe `delete` function modifies this shared list, so `green` is deleted from `b2`'s possible colors list just as surely as it is deleted from `b1`'s.\n\n**Remedy:** Don't share pieces of data that you want to alter individually.\nIn this case, either use `remove` instead of `delete`, or allocate a different copy of the list to each instance:\n\n```lisp\n(defstruct block\n  (possible-colors (list 'red 'green 'blue))\n  ...)\n```\n\nRemember that the initial value field of a defstruct is an expression that is evaluated anew each time `make-block` is called.\nIt is incorrect to think that the initial form is evaluated once when the `defstruct` is defined.\n\n## 25.5 Built-In Functions Don't Find Elements\n\n**PROBLEM:** You tried (`find item list`), and you know it is there, but it wasn't found.\n\n**Diagnosis:** By default, many built-in functions use `eql` as an equality test, `find` is one of them.\nIf `item` is, say, a list that is `equal` but not `eql` to one of the elements of `list`, it will not be found.\n\n**Remedy:** Use (`find item list :test #'equal`)\n\n**Diagnosis:** If the `item` is nil, then nil will be returned whether it is found or not.\n\n**Remedy:** Use `member` or `position` instead of `find` whenever the item can be nil.\n\n## 25.6 Multiple Values Are Lost\n\n**PROBLEM:** You only get one of the multiple values you were expecting.\n\n**Diagnosis:** In certain contexts where a value must be tested by Lisp, multiple values are discarded.\nFor example, consider:\n\n```lisp\n(or (mv-1 x) (mv-2 x))\n(and (mv-1 x) (mv-2 x))\n(cond ((mv-1 x))\n  (t (mv-2 x)))\n```\n\nIn each case, if `mv-2` returns multiple values, they will all be passed on.\nBut if `mv-1` returns multiple values, only the first value will be passed on.\nThis is true even in the last clause of a cond.\nSo, while the final clause (`t (mv-2 x)`) passes on multiple values, the final clause (`(mv-2 x )`) would not.\n\n**Diagnosis:** Multiple values can be inadvertently lost in debugging as well.\nSuppose I had:\n\n```lisp\n(multiple-value-bind (a b c)\n  (mv-1 x)\n    ...)\n```\n\nNow, if I become curious as to what `mv-1` returns, I might change this code to:\n\n```lisp\n(multiple-value-bind (a b c)\n  (print (mv-1 x)) ;*** debugging output\n  ...)\n```\n\nUnfortunately, `print` will see only the first value returned by `mv-1`, and will return only that one value to be bound to the variable a.\nThe other values will be discarded, and `b` and `c` will be bound to `nil`.\n\n## 25.7 Declarations Are Ignored\n\n**PROBLEM:** Your program uses 1024 x 1024 arrays of floating-point numbers.\nBut you find that it takes 15 seconds just to initialize such an array to zeros!\nImagine how inefficient it is to actually do any computation!\nHere is your function that zeroes an array:\n\n```lisp\n(defun zero-array (arr)\n  \"Set the 1024x1024 array to all zeros.\"\n  (declare (type (array float) arr))\n  (dotimes (i 1024)\n    (dotimes (j 1024)\n      (setf (aref arr i j) 0.0))))\n```\n\n**Diagnosis:** The main problem here is an ineffective declaration.\nThe type (`array float`) does not help the compiler, because the array could be displaced to an array of another type, and because `float` encompasses both single- and double-precision floating-point numbers.\nThus, the compiler is forced to allocate storage for a new copy of the number 0.0 for each of the million elements of the array.\nThe function is slow mainly because it generates so much garbage.\n\n**Remedy:** The following version uses a much more effective type declaration: a simple array of single-precision numbers.\nIt also declares the size of the array and turns safety checks off.\nIt runs in under a second on a SPARCstation, which is slower than optimized C, but faster than unoptimized C.\n\n```lisp\n(defun zero-array (arr)\n  \"Set the array to all zeros.\"\n  (declare (type (simple-array single-float (1024 1024)) arr)\n          (optimize (speed 3) (safety 0)))\n  (dotimes (i 1024)\n    (dotimes (j 1024)\n      (setf (aref arr i j) 0.0))))\n```\n\nAnother common error is to use something like `(simple-vector fixnum)` as a type specifier.\nIt is a quirk of Common Lisp that the `simple-vector` type specifier only accepts a size, not a type, while the `array, vector` and `simple-array` specifiers all accept an optional type followed by an optional size or list of sizes.\nTo specify a simple vector of fixnums, use (`simple-array fixnum (*)`).\n\nTo be precise, `simple-vector` means (`simple-array t (*)`).\nThis means that `simple-vector` cannot be used in conjunction with any other type specifier.\nA common mistake is to think that the type (`and simple-vector (vector fixnum)`) is equivalent to (`simple-array fixnum (*)`), a simple, one-dimensional vector of fixnums.\nActually, it is equivalent to (`simple-array t (*)`), a simple one-dimensional array of any type elements.\nTo eliminate this problem, avoid `simple-vector` altogether.\n\n## 25.8 My Lisp Does the Wrong Thing\n\nWhen all else fails, it is tempting to shift the blame for an error away from your own code and onto the Common Lisp implementation.\nIt is certainly true that errors are found in existing implementations.\nBut it is also true that most of the time, Common Lisp is merely doing something the user did not expect rather than something that is in error.\n\nFor example, a common \"bug report\" is to complain about `read-from-string`.\nA user might write:\n\n```lisp\n(read-from-string \"a b c\" :start 2)\n```\n\nexpecting the expression to start reading at position `2` and thus return `b`.\nIn fact, this expression returns `a`.\nThe angry user thinks the implementation has erroneously ignored the `:start` argument and files a bug report,<a id=\"tfn25-1\"></a><sup>[1](#fn25-1)</sup> only to get back the following explanation:\n\nThe function `read-from-string` takes two optional arguments, `eof-errorp` and `eof-value`, in addition to the keyword arguments.\nThus, in the expression above, `:start` is taken as the value of `eof-errorp`, with `2` as the value of `eof-value`.\nThe correct answer is in fact to read from the start of the string and return the very first form, `a`.\n\nThe functions `read-from-string` and `parse-namestring` are the only built-in functions that have this problem, because they are the only ones that have both optional and keyword arguments, with an even number of optional arguments.\nThe functions `write-line` and `write-string` have keyword arguments and a single optional argument (the stream), so if the stream is accidently omitted, an error will be signaled.\n(If you type (`write-line str :start 4`), the system will complain either that `:start` is not a stream or that 4 is not a keyword.)\n\nThe moral is this: functions that have both optional and keyword arguments are confusing.\nTake care when using existing functions that have this problem, and abstain from using both in your own functions.\n\n## 25.9 How to Find the Function You Want\n\nVeteran Common Lisp programmers often experience a kind of software *d&eacute;j&agrave; vu:* they believe that the code they are writing could be done by a built-in Common Lisp function, but they can't remember the name of the function.\n\nHere's an example: while coding up a problem I realized I needed a function that, given the lists (`a b c d`) and (`c d`), would return (`a b`), that is, the part of the first list without the second list.\nI thought that this was the kind of function that might be in the standard, but I didn't know what it would be called.\nThe desired function is similar to `set-difference`, so I looked that up in the index of *Common Lisp the Language* and was directed to page 429.\nI browsed through the section on \"using lists as sets\" but found nothing appropriate.\nHowever, I was reminded of the function `butlast`, which is also similar to the desired function.\nThe index directed me to page 422 for `butlast`, and on the same page I found `ldiff`, which was exactly the desired function.\nIt might have been easier to find (and remember) if it were called `list-difference`, but the methodology of browsing near similar functions paid off.\n\nIf you think you know part of the name of the desired function, then you can use `apropos` to find it.\nFor example, suppose I thought there was a function to push a new element onto the front of an array.\nLooking under `array`, `push-array`, and `array-push` in the index yields nothing.\nBut I can turn to Lisp itself and ask:\n\n```lisp\n> (apropos \"push\")\nPUSH               Macro     (VALUE PLACE), plist\nPUSHNEW            Macro     (VALUE PLACE &KEY ...), plist\nVECTOR-PUSH        function  (NEW-ELEMENT VECTOR), plist\nVECTOR-PUSH-EXTEND function  (DATA VECTOR &OPTIONAL ...), plist\n```\n\nThis should be enough to remind me that `vector-push` is the answer.\nIf not, I can get more information from the manual or from the online functions `documentation` or `describe`:\n\n```lisp\n> (documentation 'vector-push 'function)\n\"Add NEW-ELEMENT as an element at the end of VECTOR.\nThe fill pointer (leader element 0) is the index of the next\nelement to be added. If the array is full, VECTOR-PUSH returns\nNIL and the array is unaffected; use VECTOR-PUSH-EXTEND instead\nif you want the array to grow automatically.\"\n```\n\nAnother possibility is to browse through existing code that performs a similar purpose.\nThat way, you may find the exact function you want, and you may get additional ideas on how to do things differently.\n\n## 25.10 Syntax of LOOP\n\n`loop` by itself is a powerful programming language, one with a syntax quite different from the rest of Lisp.\nIt is therefore important to exercise restraint in using `loop`, lest the reader of your program become lost.\nOne simple rule for limiting the complexity of `loops` is to avoid the `with` and `and` keywords.\nThis eliminates most problems dealing with binding and scope.\n\nWhen in doubt, macro-expand the loop to see what it actually does.\nBut if you need to macro-expand, then perhaps it would be clearer to rewrite the loop with more primitive constructs.\n\n## 25.11 Syntax of COND\n\nFor many programmers, the special form cond is responsible for more syntax errors than any other, with the possible exception of `loop`.\nBecause most cond-clause start with two left parentheses, beginners often come to the conclusion that every clause must.\nThis leads to errors like the following:\n\n```lisp\n(let ((entry (assoc item list)))\n  (cond ((entry (process entry)))\n          ...))\n```\n\nHere entry is a variable, but the urge to put in an extra parenthesis means that the cond-clause attempts to call entry as a function rather than testing its value as a variable.\n\nThe opposite problem, leaving out a parenthesis, is also a source of error:\n\n```lisp\n(cond (lookup item list)\n  (t nil))\n```\n\nIn this case, `lookup` is accessed as a variable, when the intent was to call it as a function.\nIn Common Lisp this will usually lead to an unbound variable error, but in Scheme this bug can be very difficult to pin down: the value of `lookup` is the function itself, and since this is not null, the test will succeed, and the expression will return `list` without complaining.\n\nThe moral is to be careful with cond, especially when using Scheme.\nNote that `if` is much less error prone and looks just as nice when there are no more than two branches.\n\n## 25.12 Syntax of CASE\n\nIn a `case` special form, each clause consists of a key or list of keys, followed by the value of that case.\nThe thing to watch out for is when the key is `t`, `otherwise`, or `nil`.\nFor example:\n\n```lisp\n(case letter\n  (s ...)\n  (t ...)\n  (u ...))\n```\n\nHere the `t` is taken as the default clause; it will always succeed, and all subsequent clauses will be ignored.\nSimilarly, using a `()` or `nil` as a key will not have the desired effect: it will be interpreted as an empty key list.\nIf you want to be completely safe, you can use a list of keys for every clause.<a id=\"tfn25-2\"></a><sup>[2](#fn25-2)</sup>\nThis is a particularly good idea when you write a macro that expands into a `case`.\nThe following code correctly tests for `t` and `nil` keys:\n\n```lisp\n(case letter\n  ((s) ...)\n  ((t) ...)\n  ((u) ...)\n  ((nil) ...))\n```\n\n## 25.13 Syntax of LET and LET*\n\nA common error is leaving off a layer of parentheses in `let`, just like in cond.\nAnother error is to refer to a variable that has not yet been bound in a `let`.\nTo avoid this problem, use `let*` whenever a variable's initial binding refers to a previous variable.\n\n## 25.14 Problems with Macros\n\nIn [section 3.2](chapter3.md#s0015) we described a four-part approach to the design of macros:\n\n*   Decide if the macro is really necessary.\n\n*   Write down the syntax of the macro.\n\n*   Figure out what the macro should expand into.\n\n*   Use `defmacro` to implement the syntax/expansion correspondence.\n\nThis section shows the problems that can arise in each part, starting with the first:\n\n*   Decide if the macro is really necessary.\n\nMacros extend the rules for evaluating an expression, while function calls obey the rules.\nTherefore, it can be a mistake to define too many macros, since they can make it more difficult to understand a program.\nA common mistake is to define macros that *do not* violate the usual evaluation rules.\nOne recent book on AI programming suggests the following:\n\n```lisp\n(defmacro binding-of (binding)      ; Warning!\n    '(cadr .binding))               ; Don't do this.\n```\n\nThe only possible reason for this macro is an unfounded desire for efficiency.\nAlways use an `inline` function instead of a macro for such cases.\nThat way you get the efficiency gain, you have not introduced a spurious macro, and you gain the ability to `apply` or `map` the function `#'binding-of`, something you could not do with a macro:\n\n```lisp\n(proclaim '(inline binding-of))\n(defun binding-of (binding)    ; Do this instead.\n  (second binding))\n```\n\n*   Write down the syntax of the macro.\n\nTry to make your macro follow conventions laid down by similar macros.\nFor example, if your macro defines something, it should obey the conventions of `defvar, defstruct, defmacro,` and the rest: start with the letters `def`, take the name of the thing to be defined as the first argument, then a lambda-list if appropriate, then a value or body.\nIt would be nice to allow for optional declarations and documentation strings.\n\nIf your macro binds some variables or variablelike objects, use the conventions laid down by `let, let*,` and `labels`: allow for a list of variable or ( *variable init-val)* pairs.\nIf you are iterating over some kind of sequence, follow `dotimes` and `dolist`.\nFor example, here is the syntax of a macro to iterate over the leaves of a tree of conses:\n\n```lisp\n(defmacro dotree ((var tree &optional result) &body body)\n \"Perform body with var bound to every leaf of tree,\n then return result. Return and Go can be used in body.\"\n ...)\n```\n\n*  Figure out what the macro should expand into.\n\n*  Use defmacro to implement the syntax/expansion correspondence.\n\nThere are a number of things to watch out for in figuring out how to expand a macro.\nFirst, make sure you don't shadow local variables.\nConsider the following definition for `pop-end`, a function to pop off and return the last element of a list, while updating the list to no longer contain the last element.\nThe definition uses `last1`, which was defined on page 305 to return the last element of a list, and the built-in function `nbutlast` returns all but the last element of a list, destructively altering the list.\n\n```lisp\n(defmacro pop-end (place)    ; Warning! Buggy!\n  \"Pop and return last element of the list in PLACE.\"\n  '(let ((result (last1 .place)))\n      (setf .place (nbutlast .place))\n      result))\n```\n\nThis will do the wrong thing for (`pop-end result`), or for other expressions that mention the variable `result`.\nThe solution is to use a brand new local variable that could not possibly be used elsewhere:\n\n```lisp\n(defmacro pop-end (place)    ; Less buggy\n  \"Pop and return last element of the list in PLACE.\"\n  (let ((result (gensym)))\n  '(let ((,result (lastl ,place)))\n    (setf ,place (nbutlast ,place))\n      ,result)))\n```\n\nThere is still the problem of shadowing local *functions.* For example, a user who writes:\n\n```lisp\n(flet ((last1 (x) (sqrt x)))\n  (pop-end list)\n  ...)\n```\n\nwill be in for a surprise, `pop-end` will expand into code that calls `last1`, but since `last1` has been locally defined to be something else, the code won't work.\nThus, the expansion of the macro violates referential transparency.\nTo be perfectly safe, we could try:\n\n```lisp\n(defmacro pop-end (place)    ; Less buggy\n  \"Pop and return last element of the list in PLACE.\"\n  (let ((result (gensym)))\n    '(let ((.result (funcall .#'last1 .place)))\n      (setf .place (funcall .#'nbutlast .place))\n        ,result)))\n```\n\nThis approach is sometimes used by Scheme programmers, but Common Lisp programmers usually do not bother, since it is rarer to define local functions in Common Lisp.\nIndeed, in *Common Lisp the Language*, 2d edition, it was explicitly stated (page 260) that a user function cannot redefine or even bind any built-in function, variable, or macro.\nEven if it is not prohibited in your implementation, redefining or binding a built-in function is confusing and should be avoided.\n\nCommon Lisp programmers expect that arguments will be evaluated in left-to-right order, and that no argument is evaluated more than once.\nOur definition of `pop-end` violates the second of these expectations.\nConsider:\n\n```lisp\n(pop-end (aref lists (incf i))) =\n(LET ((#:G3096 (LAST1 (AREF LISTS (INCF I)))))\n  (SETF (AREF LISTS (INCF I)) (NBUTLAST (AREF LISTS (INCF I))))\n  #:G3096)\n```\n\nThis increments `i` three times, when it should increment it only once.\nWe could fix this by introducing more local variables into the expansion:\n\n```lisp\n(let* ((templ (incf i))\n      (temp2 (AREF LISTS temp1))\n      (temp3 (LAST1 temp2)))\n  (setf (aref lists templ) (nbutlast temp2))\n  temp3)\n```\n\nThis kind of left-to-right argument processing via local variables is done automatically by the Common Lisp setf mechanism.\nFortunately, the mechanism is easy to use.\nWe can redefine `pop-end` to call `pop` directly:\n\n```lisp\n(defmacro pop-end (place)\n  \"Pop and return last element of the list in PLACE.\"\n  '(pop (last ,place)))\n```\n\nNow all we need to do is define the `setf` method for `last`.\nHere is a simple definition.\nIt makes use of the function `last2`, which returns the last two elements of a list.\nIn ANSI Common Lisp we could use (`last list 2`), but with a pre-ANSI compiler we need to define `last2`:\n\n```lisp\n(defsetf last (place) (value)\n  '(setf (cdr (last2 .place)) .value))\n(defun last2 (list)\n  \"Return the last two elements of a list.\"\n  (if (null (rest2 list))\n      list\n      (last2 (rest list))))\n```\n\nHere are some macro-expansions of calls to `pop-end` and to the `setf` method for `last`.\nDifferent compilers will produce different code, but they will always respect the left-to-right, one-evaluation-only semantics:\n\n```lisp\n> (pop-end (aref (foo lists) (incf i))) =\n(LET ((G0128 (AREF (FOO LISTS) (SETQ I (+ I 1)))))\n  (PROG1\n  (CAR (LAST G0128))\n  (SYS:SETCDR (LAST2 G0128) (CDR (LAST G0128)))))\n> (setf (last (append x y)) 'end) =\n(SYS:SETCDR (LAST2 (APPEND X Y)) 'END)\n```\n\nUnfortunately, there is an error in the `setf` method for `last`.\nIt assumes that the list will have at least two elements.\nIf the list is empty, it is probably an error, but if a list has exactly one element, then (`setf` (`last` *list) val)* should have the same effect as (`setf` *list val).*\nBut there is no way to do that with `defsetf`, because the `setf` method defined by `defsetf` never sees *list* itself.\nInstead, it sees a local variable that is automatically bound to the value of *list.* In other words, `defsetf` evaluates the *list* and *val* for you, so that you needn't worry about evaluating the arguments out of order, or more than once.\n\nTo solve the problem we need to go beyond the simple `defsetf` macro and delve into the complexities of `define-setf-method`, one of the trickiest macros in all of Common Lisp.\n`define-setf-method` defines a setf method not by writing code directly but by specifying five values that will be used by Common Lisp to write the code for a call to `setf`.\nThe five values give more control over the exact order in which expressions are evaluated, variables are bound, and results are returned.\nThe five values are: (1) a list of temporary, local variables used in the code; (2) a list of values these variables should be bound to; (3) a list of one variable to hold the value specified in the call to `setf`; (4) code that will store the value in the proper place; (5) code that will access the value of the place.\nThis is necessary for variations of `setf` like `inef` and `pop`, which need to both access and store.\n\nIn the following `setf` method for `last`, then, we are defining the meaning of `(setf (last place) value)`.\nWe keep track of all the variables and values needed to evaluate `place`, and add to that three more local variables: `last2-var` will hold the last two elements of the list, `last2-p` will be true only if there are two or more elements in the list, and `last-var` will hold the form to access the last element of the list.\nWe also make up a new variable, `result`, to hold the `value`.\nThe code to store the value either modifies the `cdr` of `last2-var`, if the list is long enough, or it stores directly into `place`.\nThe code to access the value just retrieves `last-var`.\n\n```lisp\n(define-setf-method last (place)\n  (multiple-value-bind (temps vals stores store-form access-form)\n        (get-setf-method place)\n    (let ((result (gensym))\n          (last2-var (gensym))\n          (last2-p (gensym))\n          (last-var (gensym)))\n        ;; Return 5 vals: temps vals stores store-form access-form\n        (values\n          '(.@temps .last2-var .last2-p .last-var)\n          '(.@vals (last2 .access-form)\n            (= (length .last2-var) 2)\n            (if .last2-p (rest .last2-var) .access-form))\n          (list result)\n          '(if .last2-p\n            (setf (cdr .last2-var) .result)\n            (let ((.(first stores) .result))\n              .store-form))\n          last-var))))\n```\n\nIt should be mentioned that `setf` methods are very useful and powerful things.\nIt is often better to provide a `setf` method for an arbitrary function, `f`, than to define a special setting function, say, `set-f`.\nThe advantage of the `setf` method is that it can be used in idioms like `incf` and `pop`, in addition to `setf` itself.\nAlso, in ANSI Common Lisp, it is permissible to name a function with `#'(setf f)`, so you can also use map or apply the `setf` method.\nMost `setf` methods are for functions that just access data, but it is permissible to define `setf` methods for functions that do any computation whatsoever.\nAs a rather fanciful example, here is a `setf` method for the square-root function.\nIt makes (`setf (sqrt x) 5`) be almost equivalent to (`setf x (* 5 5)`) ; the difference is that the first returns 5 while the second returns 25.\n\n```lisp\n(define-setf-method sqrt (num)\n (multiple-value-bind (temps vals stores store-form access-form)\n    (get-setf-method num)\n  (let ((store (gensym)))\n    (values temps\n          vals\n          (list store)\n          '(let ((,(first stores) (* .store .store)))\n            ,store-form\n            ,store)\n          '(sqrt .access-form)))))\n```\n\nTurning from `setf` methods back to macros, another hard part about writing portable macros is anticipating what compilers might warn about.\nLet's go back to the `dotree` macro.\nIts definition might look in part like this:\n\n```lisp\n(defmacro dotree ((var tree &optional result) &body body)\n \"Perform body with var bound to every leaf of tree.\n then return result. Return and Go can be used in body.\"\n '(let ((.var))\n   ...\n   ,@body))\n```\n\nNow suppose a user decides to count the leaves of a tree with:\n\n```lisp\n(let ((count 0))\n    (dotree (leaf tree count)\n        (incf count)))\n```\n\nThe problem is that the variable `leaf` is not used in the body of the macro, and a compiler may well issue a warning to that effect.\nTo make matters worse, a conscientious user might write:\n\n```lisp\n(let ((count 0))\n  (dotree (leaf tree count)\n    (declare (ignore leaf))\n      (incf count)))\n```\n\nThe designer of a new macro must decide if declarations are allowed and must make sure that compiler warnings will not be generated unless they are warranted.\n\nMacros have the full power of Lisp at their disposal, but the macro designer must remember the purpose of a macro is to translate macro code into primitive code, and not to do any computations.\nConsider the following macro, which assumes that `translate-rule-body` is defined elsewhere:\n\n```lisp\n(defmacro defrule (name &body body)  ; Warning! buggy!\n \"Define a new rule with the given name.\"\n (setf (get name 'rule)\n    '#'(lambda O ,(translate-rule-body body))))\n```\n\nThe idea is to store a function under the `rule` property of the rule's name.\nBut this definition is incorrect because the function is stored as a side effect of expanding the macro, rather than as an effect of executing the expanded macro code.\nThe correct definition is:\n\n```lisp\n(defmacro defrule (name &body body)\n  \"Define a new rule with the given name.\"\n  '(setf (get '.name 'rule)\n  #'(lambda () .(translate-rule-body body))))\n```\n\nBeginners sometimes fail to see the difference between these two approaches, because they both have the same result when interpreting a file that makes use of `defrule`.\nBut when the file is compiled and later loaded into a different Lisp image, the difference becomes clear: the first definition erroneously stores the function in the compiler's image, while the second produces code that correctly stores the function when the code is loaded.\n\nBeginning macro users have asked, \"How can I have a macro that expands into code that does more than one thing?\nCan I splice in the results of a macro?\"\n\nIf by this the beginner wants a macro that just *does* two things, the answer is simply to use a progn.\nThere will be no efficiency problem, even if the progn forms are nested.\nThat is, if macro-expansion results in code like:\n\n> `(progn (progn (progn` *a b) c*) `(progn` *d e*))\n\nthe compiler will treat it the same as `(progn` *a b c d e).*\n\nOn the other hand, if the beginner wants a macro that *returns* two values, the proper form is `values`, but it must be understood that the calling function needs to arrange specially to see both values.\nThere is no way around this limitation.\nThat is, there is no way to write a macro-or a function for that matter-that will \"splice in\" its results to an arbitrary call.\nFor example, the function `floor` returns two values (the quotient and remainder), as does `intern` (the symbol and whether or not the symbol already existed).\nBut we need a special form to capture these values.\nFor example, compare:\n\n```lisp\n> (list (floor 11 5) (intern 'x))=M2 X)\n> (multiple-value-call #'list\n  (floor 11 5) (intern 'x))=>(2 1 X :INTERNAL)\n```\n\n## 25.15 A Style Guide to Lisp\n\nIn a sense, this whole book is a style guide to writing quality Lisp programs.\nBut this section attempts to distill some of the lessons into a set of guidelines.\n\n### When to Define a Function\n\nLisp programs tend to consist of many short functions, in contrast to some languages that prefer a style using fewer, longer functions.\nNew functions should be introduced for any of the following reasons:\n\n1.  For a specific, easily stated purpose.\n\n2.  To break up a function that is too long.\n\n3.  When the name would be useful documentation.\n\n4.  When it is used in several places.\n\nIn (2), it is interesting to consider what \"too long\" means.\n[Charniak et al.\n(1987)](bibliography.md#bb0180) suggested that 20 lines is the limit.\nBut now that large bit-map displays have replaced 24-line terminals, function definitions have become longer.\nSo perhaps one screenful is a better limit than 20 lines.\nThe addition of `flet` and `labels` also contributes to longer function definitions.\n\n### When to Define a Special Variable\n\nIn general, it is a good idea to minimize the use of special variables.\nLexical variables are easier to understand, precisely because their scope is limited.\nTry to limit special variables to one of the following uses:\n\n1.  For parameters that are used in many functions spread throughout a program.\n\n2.  For global, persistant, mutable data, such as a data base of facts.\n\n3.  For infrequent but deeply nested use.\n\nAn example of (3) might be a variable like `*standard-output*`, which is used by low-level printing functions.\nIt would be confusing to have to pass this variable around among all your high-level functions just to make it available to `print`.\n\n### When to Bind a Lexical Variable\n\nIn contrast to special variables, lexical variables are encouraged.\nYou should feel free to introduce a lexical variable (with `a let, lambda` or `defun`) for any of the following reasons:\n\n1.  To avoid typing in the same expression twice.\n\n2.  To avoid computing the same expression twice.\n\n3.  When the name would be useful documentation.\n\n4.  To keep the indentation manageable.\n\n### How to Choose a Name\n\nYour choice of names for functions, variables, and other objects should be clear, meaningful, and consistent.\nSome of the conventions are listed here:\n\n1.  Use mostly letters and hyphens, and use full words: `delete-file`.\n\n2.  You can introduce an abbreviation if you are consistent: `get-dtree`, `dtree-fetch`.\nFor example, this book uses `fn` consistently as the abbreviation for \"function.\"\n\n3.  Predicates end in `-p` (or `?` in Scheme), unless the name is already a predicate: `variable-p`, `occurs-in`.\n\n4.  Destructive functions start with `n` (or end in `!` in Scheme): `nreverse`.\n\n5.  Generalized variable-setting macros end in `f`: `setf`, `incf`.\n(`Push` is an exception.)\n\n6.  Slot selectors created by `defstruct` are of the form *type-slot.* Use this for `non-defstruct` selectors as well: `char-bits`.\n\n7.  Many functions have the form *action-object:* `copy-list, delete-file`.\n\n8.  Other functions have the form *object-modifier:* `list-length, char-lessp`.\nBe consistent in your choice between these two forms.\nDon't have `print-edge` and `vertex-print` in the same system.\n\n9.  A function of the form *modulename-functionname* is an indication that packages are needed.\nUse parser: `print-tree` instead of `parser-print-tree`.\n\n10.  Special variables have asterisks: `*db*, *print-length*`.\n\n11.  Constants do not have asterisks: `pi, most-positive-fixnum`.\n\n12.  Parameters are named by type: (`defun length (sequence) ...)` or by purpose: (`defun subsetp(subset superset) ...`) or both: (`defun / (number &rest denominator-numbers) ...`)\n\n13.  Avoid ambiguity.\nA variable named `last-node` could have two meanings; use `previous-node` or `final-node` instead.\n\n14.  A name like `propagate-constraints-to-neighboring-vertexes` is too long, while `prp-con` is too short.\nIn deciding on length, consider how the name will be used: `propagate-constraints` is just right, because a typical call will be `(propagate-constraints vertex)`, so it will be obvious what the constraints are propagating to.\n\n### Deciding on the Order of Parameters\n\nOnce you have decided to define a function, you must decide what parameters it will take, and in what order.\nIn general,\n\n1.  Put important parameters first (and optional ones last).\n\n2.  Make it read like prose if possible: (`push element stack`).\n\n3.  Group similar parameters together.\n\nInterestingly, the choice of a parameter list for top-level functions (those that the user is expected to call) depends on the environment in which the user will function.\nIn many systems the user can type a keystroke to get back the previous input to the top level, and can then edit that input and re-execute it.\nIn these systems it is preferable to have the parameters that are likely to change be at the end of the parameter list, so that they can be easily edited.\nOn systems that do not offer this kind of editing, it is better to either use keyword parameters or make the highly variable parameters first in the list (with the others optional), so that the user will not have to type as much.\n\nMany users want to have *required* keyword parameters.\nIt turns out that all keyword parameters are optional, but the following trick is equivalent to a required keyword parameter.\nFirst we define the function `required` to signal an error, and then we use a call to `required` as the default value for any keyword that we want to make required:\n\n```lisp\n(defun required ()\n  (error \"A required keyword argument was not supplied.\"))\n(defun fn (x &key (y (required)))\n  ...)\n```\n\n## 25.16 Dealing with Files, Packages, and Systems\n\nWhile this book has covered topics that are more advanced than any other Lisp text available, it is still concerned only with programming in the small: a single project at a time, capable of being implemented by a single programmer.\nMore challenging is the problem of programming in the large: building multiproject, multiprogrammer systems that interact well.\n\nThis section briefly outlines an approach to organizing a larger project into manageable components, and how to place those components in files.\n\nEvery system should have a separate file that defines the other files that comprise the system.\nI recommend defining any packages in that file, although others put package definitions in separate files.\n\nThe following is a sample file for the mythical system Project-X.\nEach entry in the file is discussed in turn.\n\n1.  The first line is a comment known as the *mode line.*\nThe text editor emacs will parse the characters between `-*-` delimiters to discover that the file contains Lisp code, and thus the Lisp editing commands should be made available.\nThe dialect of Lisp and the package are also specified.\nThis notation is becoming widespread as other text editors emulate emacs's conventions.\n\n2.  Each file should have a description of its contents, along with information on the authors and what revisions have taken place.\n\n3.  Comments with four semicolons (`;;;;`) denote header lines.\nMany text editors supply a command to print all such lines, thus achieving an outline of the major parts of a file.\n\n4.  The first executable form in every file should be an `in-package`.\nHere we use the user package.\nWe will soon create the `project-x package`, and it will be used in all subsequent files.\n\n5.  We want to define the Project-X system as a collection of files.\nUnfortunately, Common Lisp provides no way to do that, so we have to load our own system-definition functions explicitly with a call to `load`.\n\n6.  The call to `define-system` specifies the files that make up Project-X.\nWe provide a name for the system, a directory for the source and object files, and a list of *modules* that make up the system.\nEach module is a list consisting of the module name (a symbol) followed by a one or more files (strings or pathnames).\nWe have used keywords as the module names to eliminate any possible name conflicts, but any symbol could be used.\n\n7.  The call to `defpackage` defines the package `project-x`.\nFor more on packages, see section 24.1.\n\n8.  The final form prints instructions on how to load and run the system.\n\n```lisp\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: User -*-\n;;; (Brief description of system here.)\n;;;; Define the Project-X system.\n(in-package \"USER\")\n(load \"/usr/norvig/defsys.lisp\") ; load define-system\n(define-system ;; Define the system Project-X\n  :name :project-x\n  :source-dir \"/usr/norvig/project-x/*.lisp\"\n  :object-dir \"/usr/norvig/project-x/*.bin\"\n  :modules '((:macros \"header\" \"macros\")\n    (:main \"parser\" \"transformer\" \"optimizer\"\n        \"commands\" \"database\" \"output\")\n    (:windows \"xwindows\" \"clx\" \"client\")))\n(defpackage :project-x ;; Define the package Project-X\n  (:export \"DEFINE-X\" \"DO-X\" \"RUN-X\")\n  (:nicknames \"PX\")\n  (:use common-lisp))\n(format *debug-io* To load the Project-X system, type\n  (make-system marne :project-x)\nTo run the system, type\n  (project-x:run-x)\")\n```\n\nEach of the files that make up the system will start like this:\n\n```lisp\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: Project-X -*-\n(in-package \"PROJECT-X\")\n```\n\nNow we need to provide the system-definition functions, `define-system` and `make-system`.\nThe idea is that `define-system` is used to define the files that make up a system, the modules that the system is comprised of, and the files that make up each module.\nIt is necessary to group files into modules because some files may depend on others.\nFor example, all macros, special variables, constants, and inline functions need to be both compiled and loaded before any other files that reference them are compiled.\nIn Project-X, all `defvar, defparameter, defconstant,` and `defstruct`<a id=\"tfn25-3\"></a><sup>[3](#fn25-3)</sup> forms are put in the file header, and all `defmacro` forms are put in the file `macros`.\nTogether these two files form the first module, named `:macros`, which will be loaded before the other two modules (`:main` and `:windows`) are compiled and loaded.\n\n`define-system` also provides a place to specify a directory where the source and object files will reside.\nFor larger systems spread across multiple directories, `define-system` will not be adequate.\n\nHere is the first part of the file `defsys.lisp`, showing the definition of `define-system` and the structure `sys`.\n\n```lisp\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: User -*-\n; ; ; ; A Facility for Defining Systems and their Components\n(in-package \"USER\")\n(defvar *systems* nil \"List of all systems defined.\")\n(defstruct sys\n  \"A system containing a number of source and object files.\"\n  name source-dir object-dir modules)\n(defun define-system (&key name source-dir object-dir modules)\n  \"Define a new system.\"\n  ;; Delete any old system of this name, and add the new one.\n  (setf *systems* (delete name *systems* :test #'string-equal\n      :key #'sys-name))\n  (push (make-sys\n      :name (string name)\n      :source-dir (pathname source-dir)\n      :object-dir (pathname object-dir)\n      :modules '((:all ..(mapcar #'first modules)) ..modules))\n    *systems*)\nname)\n```\n\nThe function `make-system` is used to compile and/or load a previously defined system.\nThe name supplied is used to look up the definition of a system, and one of three actions is taken on the system.\nThe keyword `:cload` means to compile and then load files.\n`:load` means to load files; if there is an object (compiled) file and it is newer than the source file, then it will be loaded, otherwise the source file will be loaded.\nFinally, `:update` means to compile just those source files that have been changed since their corresponding source files were last altered, and to load the new compiled version.\n\n```lisp\n(defun make-system (&key (module : al 1 ) (action :cload)\n         (name (sys-name (first *systems*))))\n  \"Compile and/or load a system or one of its modules.\"\n  (let ((system (find name *systems* :key #'sys-name\n      :test #'string-equal)))\n   (check-type system (not null))\n   (check-type action (member : cload : update :load))\n   (with-compilation-unit O (sys-action module system action))\n (defun sys-action (x system action)\n  \"Perform the specified action to x in this system.\n  X can be a module name (symbol). file name (string)\n  or a list.\"\n  (typecase x\n   (symbol (let ((files (rest (assoc x (sys-modules system)))))\n      (if (null files)\n       (warn \"No files for module ~ a\" x)\n       (sys-action files system action))))\n   (list (dolist (file x)\n     (sys-action file system action)))\n   ((string pathname)\n     (let ((source (merge-pathnames\n        x (sys-source-dir system)))\n      (object (merge-pathnames\n        x (sys-object-dir system))))\n     (case action\n (:cload (compile-file source) (load object))\n (:update (unless (newer-file-p object source)\n   (compile-file source))\n  (load object))\n (:load (if (newer-file-p object source)\n   (load object)\n   (load source))))))\n(t (warn \"Don't know how to ~ a \"~a in system ~ a\"\n  action x system))))\n```\n\nTo support this, we need to be able to compare the write dates on files.\nThis is not hard to do, since Common Lisp provides the function `file-write-date`.\n\n```lisp\n(defun newer-file-p (file1 file2)\n  \"Is file1 newer than (written later than) file2?\"\n  (>-num (if (probe-file filel) (file-write-date filel))\n  (if (probe-file file2) (file-write-date file2))))\n(defun >-num (x y)\n  \"True if x and y are numbers, and x > y.\"\n  (and (numberp x) (numberp y) (> x y)))\n```\n\n## 25.17 Portability Problems\n\nProgramming is difficult.\nAll programmers know the frustration of trying to get a program to work according to the specification.\nBut one thing that really defines the professional programmer is the ability to write portable programs that will work on a variety of systems.\nA portable program not only must work on the computer it was tested on but also must anticipate the difference between your computer and other ones.\nTo do this, you must understand the Common Lisp specification in the abstract, not just how it is implemented on your particular machine.\n\nThere are three ways in which Common Lisp systems can vary: in the treatment of \"is an error\" situations, in the treatment of unspecified results, and in extensions to the language.\n\n*Common Lisp the Language* specifies that it \"is an error\" to pass a non-number to an arithmetic function.\nFor example, it is an error to evaluate (`+ nil 1`).\nHowever, it is not specified what should be done in this situation.\nSome implementations may signal an error, but others may not.\nAn implementation would be within its right to return 1, or any other number or non-number as the result.\n\nAn unsuspecting programmer may code an expression that is an error but still computes reasonable results in his or her implementation.\nA common example is applying `get` to a non-symbol.\nThis is an error, but many implementations will just return nil, so the programmer may write (`get x ' prop`) when `(if ( symbol p x) (get x 'prop) nil`) is actually needed for portable code.\nAnother common problem is with `subseq` and the sequence functions that take `:end` keywords.\nIt is an error if the `:end` parameter is not an integer less than the length of the sequence, but many implementations will not complain if `:end` is nil or is an integer greater than the length of the sequence.\n\nThe Common Lisp specification often places constraints on the result that a function must compute, without fully specifying the result.\nFor example, both of the following are valid results:\n\n```lisp\n> (union '(a b c) '(b c d)) => (A B C D)\n> (union '(a b c) '(b c d)) => (D A B C)\n```\n\nA program that relies on one order or the other will not be portable.\nThe same warning applies to `intersection` and `set-difference`.\nMany functions do not specify how much the result shares with the input.\nThe following computation has only one possible printed result:\n\n```lisp\n> (remove 'x'(a b c d)) (A B C D)\n```\n\nHowever, it is not specified whether the output is `eq` or only `equal` to the second input.\n\nInput/output is particularly prone to variation, as different operating systems can have very different conceptions of how I/O and the file system works.\nThings to watch out for are whether `read-char` echoes its input or not, the need to include `finish-output`, and variationin where newlines are needed, particularly with respect to the top level.\n\nFinally, many implementations provide extensions to Common Lisp, either by adding entirely new functions or by modifying existing functions.\nThe programmer must be careful not to use such extensions in portable code.\n\n## 25.18 Exercises\n\n**Exercise 25.1 [h]** On your next programming project, keep a log of each bug you detect and its eventual cause and remedy.\nClassify each one according to the taxonomy given in this chapter.\nWhat kind of mistakes do you make most often?\nHow could you correct that?\n\n**Exercise  25.2 [s-d]** Take a Common Lisp program and get it to work with a different compiler on a different computer.\nMake sure you use conditional compilation read macros (`#+` and `#-`) so that the program will work on both systems.\nWhat did you have to change?\n\n**Exercise  25.3 [m]** Write a `setf` method for `if` that works like this:\n\n```lisp\n(setf (if test (first x) y) (+ 2 3))=\n(let ((temp (+ 2 3)))\n  (if test\n      (setf (first x) temp)\n      (setf y temp)))\n```\n\nYou will need to use `define-setf-method`, not `defsetf`.\n(Why?) Make sure you handle the case where there is no else part to the `if`.\n\n**Exercise  25.4 [h]** Write a `setf` method for `lookup`, a function to get the value for a key in an association list.\n\n```lisp\n(defun lookup (key alist)\n  \"Get the cdr of key's entry in the association list.\"\n  (cdr (assoc key alist)))\n```\n\n## 25.19 Answers\n\n**Answer 25.4** Here is the setf method for `lookup`.\nIt looks for the key in the a-list, and if the key is there, it modifies the cdr of the pair containing the key; otherwise it adds a new key/value pair to the front of the a-list.\n\n```lisp\n(define-setf-method lookup (key alist-place)\n  (multiple-value-bind (temps vals stores store-form access-form)\n      (get-setf-method alist-place)\n  (let ((key-var (gensym))\n          (pair-var (gensym))\n          (result (gensym)))\n      (values\n        '(.key-var .@temps .pair-var)\n        '(.key .@vals (assoc .key-var ,access-form))\n        '(.result)\n        '(if .pair-var\n            (setf (cdr .pair-var) .result)\n            (let ((.(first stores)\n                (acons ,key-var .result .access-form)))\n              .store-form\n              ,result))\n        '(cdr .pair-var)))))\n```\n\n----------------------\n\n<a id=\"fn25-1\"></a><sup>[1](#tfn25-1)</sup>\nThis misunderstanding has shown up even in published articles, such as [Baker 1991](bibliography.md#bb0060).\n\n<a id=\"fn25-2\"></a><sup>[2](#tfn25-2)</sup>\nScheme requires a list of keys in each clause.\nNow you know why.\n\n<a id=\"fn25-3\"></a><sup>[3](#tfn25-3)</sup>\ndef struct forms are put here because they may create inline functions.\n"
  },
  {
    "path": "docs/chapter3.md",
    "content": "# Chapter 3\n## Overview of Lisp\n\n> No doubt about it.\nCommon Lisp is a *big* language.\n\n> -Guy L. Steele, Jr.\n\n> Foreword to Koschman 1990\n\nThis chapter briefly covers the most important special forms and functions in Lisp.\nIt can be safely skipped or skimmed by the experienced Common Lisp programmer but is required reading for the novice Lisp programmer, or one who is new to the Common Lisp dialect.\n\nThis chapter can be used as a reference source, but the definitive reference is Steele's *Common Lisp the Language*, 2d edition, which should be consulted whenever there is any confusion.\nSince that book is 25 times longer than this chapter, it is clear that we can only touch on the important highlights here.\nMore detailed coverage is given later in this book as each feature is used in a real program.\n\n## 3.1 A Guide to Lisp Style\n\nThe beginning Common Lisp programmer is often overwhelmed by the number of options that the language provides.\nIn this chapter we show fourteen different ways to find the length of a list.\nHow is the programmer to choose between them?\nOne answer is by reading examples of good programs - as illustrated in this book - and copying that style.\nIn general, there are six maxims that every programmer should follow:\n\n* Be specific.\n* Use abstractions.\n* Be concise.\n* Use the provided tools.\n* Don't be obscure.\n* Be consistent.\n\nThese require some explanation.\n\nUsing the most specific form possible makes it easier for your reader to understand your intent.\nFor example, the conditional special form `when` is more specific than `if`.\nThe reader who sees a `when` knows to look for only one thing: the clause to consider when the test is true.\nThe reader who sees an `if` can rightfully expect two clauses: one for when the test is true, and one for when it is false.\nEven though it is possible to use `if` when there is only one clause, it is preferable to use `when,` because `when` is more specific.\n\nOne important way of being specific is using abstractions.\nLisp provides very general data structures, such as lists and arrays.\nThese can be used to implement specific data structures that your program will use, but you should not make the mistake of invoking primitive functions directly.\nIf you define a list of names:\n\n```lisp\n(defvar *names* '((Robert E. Lee) ...))\n```\n\nthen you should also define functions to get at the components of each name.\nTo get at `Lee`, use `(last-name (first *names*))`, not `(caddar *names*)`.\n\nOften the maxims are in concord.\nFor example, if your code is trying to find an element in a list, you should use `find` (or maybe `find-if`), not `loop` or `do`.\n`find` is more specific than the general constructs `loop` or `do,` it is an abstraction, it is more concise, it is a built-in tool, and it is simple to understand.\n\nSometimes, however, the maxims are in conflict, and experience will tell you which one to prefer.\n<a id=\"tfn03-1\"></a>\nConsider the following two ways of placing a new key/value pair on an association list:<sup>[1](#fn03-1)</sup>\n\n```lisp\n(push (cons key val) a-list)\n(setf a-list (acons key val a-list))\n```\n\nThe first is more concise.\nBut the second is more specific, as it uses the `acons` function, which is designed specifically for association lists.\nThe decision between them probably hinges on obscurity: those who find `acons` to be a familiar function would prefer the second, and those who find it obscure would prefer the first.\n\nA similar choice arises in the question of setting a variable to a value.\nSome prefer `(setq x val)` because it is most specific; others use `(setf x val)`, feeling that it is more consistent to use a single form, `setf`, for all updating.\nWhichever choice you make on such issues, remember the sixth maxim: be consistent.\n\n## 3.2 Special Forms\n\nAs noted in [chapter 1](chapter1.md), \"special form\" is the term used to refer both to Common Lisp's syntactic constructs and the reserved words that mark these constructs.\n\nThe most commonly used special forms are:\n\n| definitions    | conditional | variables | iteration | other      |\n|----------------|-------------|-----------|-----------|------------|\n| `defun`        | `and`       | `let`     | `do`      | `declare`  |\n| `defstruct`    | `case`      | `let*`    | `do*`     | `function` |\n| `defvar`       | `cond`      | `pop`     | `dolist`  | `progn`    |\n| `defparameter` | `if`        | `push`    | `dotimes` | `quote`    |\n| `defconstant`  | `or`        | `setf`    | `loop`    | `return`   |\n| `defmacro`     | `unless`    | `incf`    |           | `trace`    |\n| `labels`       | `when`      | `decf`    |           | `untrace`  |\n\nTo be precise, only `declare`, `function`, `if`, `labels`, `let`, `let*`, `progn` and `quote` are true special forms.\nThe others are actually defined as macros that expand into calls to more primitive special forms and functions.\nThere is no real difference to the programmer, and Common Lisp implementations are free to implement macros as special forms and vice versa, so for simplicity we will continue to use \"special form\" as a blanket term for both true special forms and built-in macros.\n\n### Special Forms for Definitions\n\nIn this section we survey the special forms that can be used to introduce new global functions, macros, variables, and structures.\nWe have already seen the `defun` form for defining functions; the `defmacro` form is similar and is covered on [page 66](#p66).\n\n> `(defun` *function-name (parameter...) \"optional documentation\" body...*)\n>\n> `(defmacro` *macro-name (parameter...) \"optional documentation\" body...*)\n\nThere are three forms for introducing special variables.\n`defvar` defines a special variable and can optionally be used to supply an initial value and a documentation string.\nThe initial value is evaluated and assigned only if the variable does not yet have any value, `defparameter` is similar, except that the value is required, and it will be used to change any existing value, `defconstant` is used to declare that a symbol will always stand for a particular value.\n\n> `(defvar` *variable-name initial-value \"optional documentation\"* )\n\n> `(defparameter` *variable-name value \"optional documentation\"*)\n\n> `(defconstant` *variable-name value \"optional documentation\"*)\n\nAll the `def-` forms define global objects.\nIt is also possible to define local variables with `let`, and to define local functions with `labels`, as we shall see.\n\nMost programming languages provide a way to group related data together into a structure.\nCommon Lisp is no exception.\nThe `defstruct` special form defines a structure type (known as a *record* type in Pascal) and automatically defines functions to get at components of the structure.\nThe general syntax is:\n\n> `(defstruct` *structure-name \"optional documentation\" slot...*)\n\nAs an example, we could define a structure for names:\n\n```lisp\n(defstruct name\n  first\n  (middle nil)\n  last)\n```\n\nThis automatically defines the constructor function `make-name,` the recognizer predicate `name-p,` and the accessor functions `name-first, name-middle` and `name-last`.\nThe `(middle nil)` means that each new name built by `make-name` will have a middle name of `nil` by default.\nHere we create, access, and modify a structure:\n\n```lisp\n> (setf b (make-name :first 'Barney :last 'Rubble)) =>\n#S(NAME :FIRST BARNEY :LAST RUBBLE)\n\n> (name-first b) => BARNEY\n\n> (name-middle b) => NIL\n\n> (name-last b) => RUBBLE\n\n> (name-p b) => T\n\n> (name-p 'Barney) => NIL ; only the results of make-name are names\n\n> (setf (name-middle b) 'Q) => Q\n\n> b => #S(NAME :FIRST BARNEY :MIDDLE Q :LAST RUBBLE)\n```\n\nThe printed representation of a structure starts with a `#S` and is followed by a list consisting of the type of the structure and alternating pairs of slot names and values.\nDo not let this representation fool you: it is a convenient way of printing the structure, but it is not an accurate picture of the way structures are represented internally.\nStructures are actually implemented much like vectors.\nFor the `name` structure, the type would be in the zero element of the vector, the first name in the first element, middle in the second, and last in the third.\nThis means structures are more efficient than lists: they take up less space, and any element can be accessed in a single step.\nIn a list, it takes *n* steps to access the *n*th element.\n\nThere are options that give more control over the structure itself and the individual slots.\nThey will be covered later as they come up.\n\n### Special Forms for Conditionals\n\nWe have seen the special form `if,` which has the form (`if` *test then-part else-part*), where either the *then-part* or the *else-part* is the value, depending on the success of the *test.*\nRemember that only `nil` counts as false; all other values are considered true for the purpose of conditionals.\nHowever, the constant `t` is the conventional value used to denote truth (unless there is a good reason for using some other value).\n\nThere are actually quite a few special forms for doing conditional evaluation.\nTechnically, `if` is defined as a special form, while the other conditionals are macros, so in some sense `if` is supposed to be the most basic.\nSome programmers prefer to use `if` for most of their conditionals; others prefer `cond` because it has been around the longest and is versatile (if not particularly pretty).\nFinally, some programmers opt for a style more like English prose, and freely use `when, unless, if,` and all the others.\n\nThe following table shows how each conditional can be expressed in terms of `if` and `cond`.\nActually, these translations are not quite right, because `or, case`, and `cond` take care not to evaluate any expression more than once, while the translations with `if` can lead to multiple evaluation of some expressions.\nThe table also has translations to `cond.` The syntax of `cond` is a series of *cond-clauses,* each consisting of a test expression followed by any number of *result* expressions:\n\n```\n(cond (test result...)\n      (test result...)\n      ...)\n```\n\n`cond` goes through the cond-clauses one at a time, evaluating each test expression.\nAs soon as a test expression evaluates non-nil, the result expressions for that clause are each evaluated, and the last expression in the clause is the value of the whole `cond.`\nIn particular, if a cond-clause consists of just a test and no result expressions, then the value of the `cond` is the test expression itself, if it is non-nil.\nIf all of the test expressions evaluate to nil, then nil is returned as the value of the `cond.` A common idiom is to make the last cond-clause be `(t` *result...*).\n\nThe forms `when` and `unless` operate like a single `cond` clause.\nBoth forms consist of a test followed by any number of consequents, which are evaluated if the test is satisfied - that is, if the test is true for `when` or false for `unless.`\n\nThe `and` form tests whether every one of a list of conditions is true, and `or` tests whether any one is true.\nBoth evaluate the arguments left to right, and stop as soon as the final result can be determined.\nHere is a table of equivalences:\n\n| conditional                    | `if` form                           | `cond` form                        |\n|--------------------------------|-------------------------------------|------------------------------------|\n| `(when` *test a b c*)          | `(if` *test* `(progn` *a  b c*))    | `(cond` (*test a b c*))            |\n| `(unless` *test x y*)          | `(if (not` *test*) `(progn` *x y*)) | `(cond ((not` *test*) *x y*))      |\n| `(and` *a b c*)                | `(if` *a* `(if` *b c*))             | `(cond` (*a* `(cond` (*b c*))))    |\n| `(or` *a b c*)                 | `(if` *a a* `(if` *b b c*))         | `(cond (a)` (*b*) (*c*))           |\n| `(case` *a* (*b c*) (`t` *x*)) | `(if (eql` *a 'b*) *c x*)           | `(cond ((eql` *a 'b*) *c*) (`t` *x*)) |\n\nIt is considered poor style to use `and` and `or` for anything other than testing a logical condition, `when`, `unless,` and `if` can all be used for taking conditional action.\nFor example:\n\n```lisp\n(and (> n 100)\n     (princ \"N is large.\"))   ; Bad style!\n(or (<= n 100)\n    (princ \"N is large.\"))    ; Even worse style!\n(cond ((> n 100)              ; OK, but not MY preference\n      (princ \"N is large.\"))\n(when (> n 100)\n  (princ \"N is large.\"))      ; Good style.\n```\n\nWhen the main purpose is to return a value rather than take action, `cond` and `if` (with explicit `nil` in the else case) are preferred over `when` and `unless`, which implicitly return `nil` in the else case, `when` and `unless` are preferred when there is only one possibility, `if` (or, for some people, `cond)` when there are two, and `cond` when there are more than two:\n\n```lisp\n(defun tax-bracket (income)\n  \"Determine what percent tax should be paid for this income.\"\n  (cond ((< income 10000.00) 0.00)\n        ((< income 30000.00) 0.20)\n        ((< income 50000.00) 0.25)\n        ((< income 70000.00) 0.30)\n        (t                   0.35)))\n```\n\nIf there are several tests comparing an expression to constants, then case is appropriate.\nA `case` form looks like:\n\n> `(case` *expression* \\\n      (*match result*...)...)\n\nThe *expression* is evaluated and compared to each successive *match*.\nAs soon as one is `eql`, the *result* expressions are evaluated and the last one is returned.\nNote that the *match* expressions are *not* evaluated.\nIf a *match* expression is a list, then case tests if the *expression* is `eql` to any member of the list.\nIf a *match* expression is the symbol `otherwise` (or the symbol `t`), then it matches anything.\n(It only makes sense for this `otherwise` clause to be the last one.)\n\nThere is also another special form, `typecase`, which compares the type of an expression against several possibilities and, like `case`, chooses the first clause that matches.\nIn addition, the special forms `ecase` and `etypecase` are just like `case` and `typecase` except that they signal an error if there is no match.\n\nYou can think of the `e` as standing for either \"exhaustive\" or \"error.\"\nThe forms `ccase` and `ctypecase` also signal errors, but they can be continuable errors (as opposed to fatal errors): the user is offered the chance to change the expression to something that satisfies one of the matches.\nHere are some examples of case forms and their `cond` equivalents:\n\n| []()                 |                                    |\n|----------------------|------------------------------------|\n| `(case x`            | `(cond`                            |\n| `(1 10)`             | `((eql x 1) 10)`                   |\n| `(2 20))`            | `((eql x 2) 20))`                  |\n|                      |                                    |\n| `(typecase x`        | `(cond`                            |\n| `(number (abs x))`   | `((typep x 'number) (abs x))`      |\n| `(list (length x)))` | `((typep x 'list) (length x)))`    |\n|                      |                                    |\n| `(ecase x`           | `(cond`                            |\n| `(1 10)`             | `((eql x 1) 10)`                   |\n| `(2 20))`            | `((eql x 2) 20)`                   |\n|                      | `(t (error \"no valid case\")))`     |\n|                      |                                    |\n| `(etypecase x`       | `(cond`                            |\n| `(number (abs x))`   | `((typep x 'number) (abs x))`      |\n| `(list (length x)))` | `((typep x 'list) (length x))`     |\n|                      | `(t (error \"no valid typecase\")))` |\n\n### Special Forms for Dealing with Variables and Places\n\nThe special form `setf` is used to assign a new value to a variable or *place,* much as an assignment statement with `=` or `:=` is used in other languages.\nA place, or *generalized variable* is a name for a location that can have a value stored in it.\nHere is a table of corresponding assignment forms in Lisp and Pascal:\n\n| []()                        |                      |\n|-----------------------------|----------------------|\n| `;; Lisp`                   | `/* Pascal */`       |\n| `(setf x 0)`                | `x := 0;`            |\n| `(setf (aref A i j) 0)`     | `A[i,j] := 0;`       |\n| `(setf (rest list) nil)`    | `list^.rest := nil;` |\n| `(setf (name-middle b) 'Q)` | `b\\middle := \"Q\";`   |\n\n`setf` can be used to set a component of a structure as well as to set a variable.\nIn languages like Pascal, the expressions that can appear on the left-hand side of an assignment statement are limited by the syntax of the language.\nIn Lisp, the user can extend the expressions that are allowed in a `setf` form using the special forms `defsetf` or `define-setf-method`.\nThese are introduced on [pages 514](chapter15.md#p514) and [884](chapter25.md#p884) respectively.\n\nThere are also some built-in functions that modify places.\nFor example, (`rplacd list nil`) has the same effect as (`setf` (`rest list`) `nil`), except that it returns `list` instead of `nil`.\nMost Common Lisp programmers prefer to use the `setf` forms rather than the specialized functions.\n\nIf you only want to set a variable, the special form `setq` can be used instead.\nIn this book I choose to use `setf` throughout, opting for consistency over specificity.\n\nThe discussion in this section makes it seem that variables (and slots of structures) are assigned new values all the time.\nActually, many Lisp programs do no assignments whatsoever.\nIt is very common to use Lisp in a functional style where new variables may be introduced, but once a new variable is established, it never changes.\nOne way to introduce a new variable is as a parameter of a function.\nIt is also possible to introduce local variables using the special form `let`.\nFollowing are the general `let` form, along with an example.\nEach variable is bound to the corresponding value, and then the body is evaluated:\n\n> `(let` ((*variable value*)...) \\\n> *body*...)\n\n```lisp\n(let ((x 40)\n       (y (+ 1 1)))\n  (+ x y)) => 42\n```\n\nDefining a local variable with a `let` form is really no different from defining parameters to an anonymous function.\nThe former is equivalent to:\n\n| []()                        |\n|-----------------------------|\n| ((`lambda` (*variable*... ) |\n| `  ` *body*... )            |\n| *value*...)                 |\n\n```lisp\n((lambda (x y)\n     (+ x y))\n40\n(+ 1 1))\n```\n\nFirst, all the values are evaluated.\nThen they are bound to the variables (the parameters of the lambda expression), and finally the body is evaluated, using those bindings.\n\nThe special form `let*` is appropriate when you want to use one of the newly introduced variables in a subsequent *value* computation.\nFor example:\n\n```lisp\n(let* ((x 6)\n       (y (* x x)))\n  (+ x y)) => 42\n```\n\nWe could not have used `let` here, because then the variable `x` would be unbound during the computation of `y`'s value.\n\n&#9635; **Exercise 3.1 [m]** Show a `lambda` expression that is equivalent to the above `let*` expression.\nYou may need more than one `lambda.`\n\nBecause lists are so important to Lisp, there are special forms for adding and deleting elements from the front of a list - in other words, for treating a list as a stack.\nIf `list` is the name of a location that holds a list, then (`push` *x* `list`) will change `list` to have *x* as its first element, and (`pop list`) will return the first element and, as a side-effect, change `list` to no longer contain the first element.\n`push` and `pop` are equivalent to the following expressions:\n\n```lisp\n(push x list) ≡ (setf list (cons x list))\n(pop list)    ≡ (let ((result (first list)))\n                 (setf list (rest list))\n                 result)\n```\n\nJust as a list can be used to accumulate elements, a running sum can be used to accumulate numbers.\nLisp provides two more special forms, `incf` and `decf`, that can be used to increment or decrement a sum.\nFor both forms the first argument must be a location (a variable or other `setf`-able form) and the second argument, which is optional, is the number to increment or decrement by.\nFor those who know C, (`incf x`) is equivalent to `++x`, and (`incf x 2`) is equivalent to `x+=2`.\nIn Lisp the equivalence is:\n\n```lisp\n(incf x) ≡ (incf x 1) ≡ (setf x (+ x 1))\n(decf x) ≡ (decf x 1) ≡ (setf x (- x 1))\n```\n\nWhen the location is a complex form rather than a variable, Lisp is careful to expand into code that does not evaluate any subform more than once.\nThis holds for `push`, `pop`, `incf,` and `decf`.\nIn the following example, we have a list of players and want to decide which player has the highest score, and thus has won the game.\nThe structure `player` has slots for the player's score and number of wins, and the function `determine-winner` increments the winning player's `wins` field.\nThe expansion of the `incf` form binds a temporary variable so that the sort is not done twice.\n\n```lisp\n(defstruct player (score 0) (wins 0))\n\n\n(defun determine-winner (players)\n  \"Increment the WINS for the player with highest score.\"\n  (incf (player-wins (first (sort players #'>\n                                  :key #'player-score)))))\n\n(defun determine-winner (players)\n   \"Increment the WINS for the player with highest score.\"\n   (let ((temp (first (sort players #'> :key #'player-score))))\n      (setf (player-wins temp) (+ (player-wins temp) 1))))\n```\n\n### Functions and Special Forms for Repetition\n\nMany languages have a small number of reserved words for forming iterative loops.\nFor example, Pascal has `while, repeat,` and `for` statements.\nIn contrast, Common Lisp has an almost bewildering range of possibilities, as summarized below:\n\n| []()                  |                                 |\n|-----------------------|---------------------------------|\n| `dolist`              | loop over elements of a list    |\n| `dotimes`             | loop over successive integers   |\n| `do, do*`             | general loop, sparse syntax     |\n| `loop`                | general loop, verbose syntax    |\n| `mapc, mapcar`        | loop over elements of lists(s)  |\n| `some, every`         | loop over list until condition  |\n| `find, reduce,`*etc.* | more specific looping functions |\n| *recursion*           | general repetition              |\n\nTo explain each possibility we will present versions of the function `length`, which returns the number of elements in a list.\nFirst, the special form `dolist` can be used to iterate over the elements of a list.\nThe syntax is:\n\n> `(dolist (`*variable list optional-result*) *body...*)\n\nThis means that the body is executed once for each element of the list, with *variable* bound to the first element, then the second element, and so on.\nAt the end, `dolist` evaluates and returns the *optional-result* expression, or nil if there is no result expression.\n\nBelow is a version of `length` using `dolist`.\nThe `let` form introduces a new variable, `len`, which is initially bound to zero.\nThe `dolist` form then executes the body once for each element of the list, with the body incrementing `len` by one each time.\nThis use is unusual in that the loop iteration variable, `element`, is not used in the body.\n\n```lisp\n(defun length1 (list)\n  (let ((len 0))            ; start with LEN=0\n    (dolist (element list)  ; and on each iteration\n      (incf len))           ;  increment LEN by 1\n    len))                   ; and return LEN\n```\n\nIt is also possible to use the optional result of `dolist`, as shown below.\nWhile many programmers use this style, I find that it is too easy to lose track of the result, and so I prefer to place the result last explicitly.\n\n```lisp\n(defun length1.1 (list)         ; alternate version:\n  (let ((len 0))                ; (not my preference)\n    (dolist (element list len)  ; uses len as result here\n      (incf len))))\n```\n\nThe function `mapc` performs much the same operation as the special form `dolist`.\nIn the simplest case, `mapc` takes two arguments, the first a function, the second a list.\nIt applies the function to each element of the list.\nHere is `length` using `mapc`:\n\n```lisp\n(defun length2 (list)\n  (let ((len 0))                    ; start with LEN=0\n    (mapc #'(lambda (element)       ; and on each iteration\n              (incf len))           ;  increment LEN by 1\n          list)\n    len))                           ; and return LEN\n```\n\nThere are seven different mapping functions, of which the most useful are `mapc` and `mapcar`.\n`mapcar` executes the same function calls as `mapc,` but then returns the results in a list.\n\nThere is also a `dotimes` form, which has the syntax:\n\n> (`dotimes` (*variable number optional-result*) *body...*)\n\nand executes the body with *variable* bound first to zero, then one, all the way up to *number*-1 (for a total of *number* times).\nOf course, `dotimes` is not appropriate for implementing `length`, since we don't know the number of iterations ahead of time.\n\nThere are two very general looping forms, `do` and `loop`.\nThe syntax of `do` is as follows:\n\n```lisp\n(do ((variable initial next)...)\n    (exit-test result)\n  body...)\n```\n\nEach *variable* is initially bound to the *initial* value.\nIf *exit-test* is true, then *result* is returned.\nOtherwise, the body is executed and each *variable* is set to the corresponding *next* value and *exit-test* is tried again.\nThe loop repeats until *exit-test* is true.\nIf a *next* value is omitted, then the corresponding variable is not updated each time through the loop.\nRather, it is treated as if it had been bound with a `let` form.\n\nHere is `length` implemented with `do`, using two variables, `len` to count the number of elements, and `l` to go down the list.\nThis is often referred to as *cdr-ing down a list,* because on each operation we apply the function `cdr` to the list.\n(Actually, here we have used the more mnemonic name `rest` instead of `cdr`.)\nNote that the `do` loop has no body!\nAll the computation is done in the variable initialization and stepping, and in the end test.\n\n```lisp\n(defun length3 (list)\n  (do ((len 0 (+ len 1))   ; start with LEN=0, increment\n       (l list (rest l)))  ; ... on each iteration\n      ((null l) len)))     ; (until the end of the list)\n```\n\nI find the `do` form a little confusing, because it does not clearly say that we are looping through a list.\nTo see that it is indeed iterating over the list requires looking at both the variable `l` and the end test.\nWorse, there is no variable that stands for the current element of the list; we would need to say (`first l`) to get at it.\nBoth `dolist` and `mapc` take care of stepping, end testing, and variable naming automatically.\nThey are examples of the \"be specific\" principle.\nBecause it is so unspecific, `do` will not be used much in this book.\nHowever, many good programmers use it, so it is important to know how to read `do` loops, even if you decide never to write one.\n\nThe syntax of `loop` is an entire language by itself, and a decidedly non-Lisp-like language it is.\nRather than list all the possibilities for `loop`, we will just give examples here, and refer the reader to *Common Lisp the Language*, 2d edition, or chapter 24.5 for more details.\nHere are three versions of `length` using `loop`:\n\n```lisp\n(defun length4 (list)\n  (loop for element in list      ; go through each element\n        count t))                ;   counting each one\n\n(defun length5 (list)\n  (loop for element in list      ; go through each element\n        summing 1))              ;   adding 1 each time\n\n(defun length6 (list)\n  (loop with len = 0             ; start with LEN=0\n        until (null list)        ; and (until end of list)\n        for element = (pop list) ; on each iteration\n        do (incf len)            ;  increment LEN by 1\n        finally (return len)))   ; and return LEN\n```\n\nEvery programmer learns that there are certain kinds of loops that are used again and again.\nThese are often called *programming idioms* or *cliches.* An example is going through the elements of a list or array and doing some operation to each element.\nIn most languages, these idioms do not have an explicit syntactic marker.\nInstead, they are implemented with a general loop construct, and it is up to the reader of the program to recognize what the programmer is doing.\n\nLisp is unusual in that it provides ways to explicitly encapsulate such idioms, and refer to them with explicit syntactic and functional forms.\n`dolist` and `dotimes` are two examples of this - they both follow the \"be specific\" principle.\nMost programmers prefer to use a `dolist` rather than an equivalent `do,` because it cries out \"this loop iterates over the elements of a list.\"\nOf course, the corresponding `do` form also says the same thing - but it takes more work for the reader to discover this.\n\nIn addition to special forms like `dolist` and `dotimes,` there are quite a few functions that are designed to handle common idioms.\nTwo examples are `count-if,` which counts the number of elements of a sequence that satisfy a predicate, and `position-if,` which returns the index of an element satisfying a predicate.\nBoth can be used to implement `length.`\nIn `length7` below, `count-if` gives the number of elements in `list` that satisfy the predicate `true.`\nSince `true` is defined to be always true, this gives the length of the list.\n\n```lisp\n(defun length7 (list)\n  (count-if #'true list))\n\n(defun true (x) t)\n```\n\nIn `length8,` the function `position-if` finds the position of an element that satisfies the predicate true, starting from the end of the list.\nThis will be the very last element of the list, and since indexing is zero-based, we add one to get the length.\nAdmittedly, this is not the most straightforward implementation of `length.`\n\n```lisp\n(defun length8 (list)\n  (if (null list)\n      0\n      (+ 1 (position-if #'true list :from-end t))))\n```\n\nA partial table of functions that implement looping idioms is given below.\nThese functions are designed to be flexible enough to handle almost all operations on sequences.\nThe flexibility comes in three forms.\nFirst, functions like `mapcar` can apply to an arbitrary number of lists, not just one:\n\n```lisp\n> (mapcar #'- '(1 2 3)) => (-1 -2 -3)\n> (mapcar #'+ '(1 2) '(10 20)) => (11 22)\n> (mapcar #'+ '(1 2) '(10 20) '(100 200)) => (111 222)\n```\n\nSecond, many of the functions accept keywords that allow the user to vary the test for comparing elements, or to only consider part of the sequence.\n\n```lisp\n> (remove 1 '(1 2 3 2 1 0 -1)) => (2 3 2 0 -1)\n\n> (remove 1 '(1 2 3 2 1 0 -1) :key #'abs) => (2 3 2 0)\n\n> (remove 1 '(1 2 3 2 1 0 -1) :test #'<) => (1 1 0 -1)\n\n> (remove 1 '(1 2 3 2 1 0 -1) :start 4) => (1 2 3 2 0 -1)\n```\n\nThird, some have corresponding functions ending in `-if` or `-if-not` that take a predicate rather than an element to match against:\n\n```lisp\n> (remove-if #'oddp '(1 2 3 2 1 0 -1)) => (2 2 0)\n\n> (remove-if-not #'oddp '(1 2 3 2 1 0 -1)) => (1 3 1 -1)\n\n> (find-if #'evenp '(1 2 3 2 1 0 -1)) => 2\n```\n\nThe following two tables assume these two values:\n\n```lisp\n(setf x '(a b c))\n(setf y '(1 2 3))\n```\n\nThe first table lists functions that work on any number of lists but do not accept keywords:\n\n| []()                |                  |                                                  |\n|---------------------|------------------|--------------------------------------------------|\n| `(every #'oddp y)` | => `nil`         | test if every element satisfies a predicate      |\n| `(some #'oddp y)`  | => `t`           | test if some element satisfies predicate         |\n| `(mapcar #'- y)`    | => `(-1 -2 -3)`  | apply function to each element and return result |\n| `(mapc #'print y)`  | *prints* `1 2 3` | perform operation on each element                |\n\nThe second table lists functions that have `-if` and `-if-not` versions and also accept keyword arguments:\n\n| []()                 |              |                                       |\n|----------------------|--------------|---------------------------------------|\n| `(member 2 y)`       | =>`(2 3)`    | see if element is in list             |\n| `(count 'b x)`       | => 1         | count the number of matching elements |\n| `(delete 1 y)`       | => `(2 3)`   | omit matching elements                |\n| `(find 2 y)`         | => `2`       | find first element that matches       |\n| `(position 'a x)`    | => 0         | find index of element in sequence     |\n| `(reduce #'+ y)`     | => `6`       | apply function to successive elements |\n| `(remove 2 y)`       | => `(1 3)`   | like `delete`, but makes a new copy   |\n| `(substitute 4 2 y)` | => `(1 4 3)` | replace elements with new ones        |\n\n### Repetition through Recursion\nLisp has gained a reputation as a \"recursive\" language, meaning that Lisp encourages programmers to write functions that call themselves.\nAs we have seen above, there is a dizzying number of functions and special forms for writing loops in Common Lisp, but it is also true that many programs handle repetition through recursion rather than with a syntactic loop.\n\nOne simple definition of `length` is \"the empty list has length 0, and any other list has a length which is one more than the length of the rest of the list (after the first element).\"\nThis translates directly into a recursive function:\n\n```lisp\n(defun length9 (list)\n  (if (null list)\n      0\n      (+ 1 (length9 (rest list)))))\n```\n\nThis version of `length` arises naturally from the recursive definition of a list: \"a list is either the empty list or an element `cons`ed onto another list.\"\nIn general, most recursive functions derive from the recursive nature of the data they are operating on.\nSome kinds of data, like binary trees, are hard to deal with in anything but a recursive fashion.\nOthers, like lists and integers, can be defined either recursively (leading to recursive functions) or as a sequence (leading to iterative functions).\nIn this book, I tend to use the \"list-as-sequence\" view rather than the \"list-as-first-and-rest\" view.\nThe reason is that defining a list as a first and a rest is an arbitrary and artificial distinction that is based on the implementation of lists that Lisp happens to use.\nBut there are many other ways to decompose a list.\nWe could break it into the last element and all-but-the-last elements, for example, or the first half and the second half.\nThe \"list-as-sequence\" view makes no such artificial distinction.\nIt treats all elements identically.\n\nOne objection to the use of recursive functions is that they are inefficient, because the compiler has to allocate memory for each recursive call.\nThis may be true for the function `length9`, but it is not necessarily true for all recursive calls.\nConsider the following definition:\n\n```lisp\n(defun length10 (list)\n  (length10-aux list 0))\n\n(defun length10-aux (sublist len-so-far)\n  (if (null sublist)\n      len-so-far\n      (length10-aux (rest sublist) (+ 1 len-so-far))))\n```\n\n`length10` uses `length10-aux` as an auxiliary function, passing it 0 as the length of the list so far.\n`length10-aux` then goes down the list to the end, adding 1 for each element.\nThe invariant relation is that the length of the sublist plus `len-so-far` always equals the length of the original list.\nThus, when the sublist is nil, then `len-so-far` is the length of the original list.\nVariables like `len-so-far` that keep track of partial results are called *accumulators.*\nOther examples of functions that use accumulators include `flatten-all` on page 329; `one-unknown` on page 237; the Prolog predicates discussed on page 686; and `anonymous-variables-in` on pages 400 and 433, which uses two accumulators.\n\nThe important difference between `length9` and `length10` is *when* the addition is done.\nIn `length9`, the function calls itself, then returns, and then adds 1.\nIn `length10-aux`, the function adds 1, then calls itself, then returns.\nThere are no pending operations to do after the recursive call returns, so the compiler is free to release any memory allocated for the original call before making the recursive call.\n`length10-aux` is called a *tail-recursive* function, because the recursive call appears as the last thing the function does (the tail).\nMany compilers will optimize tail-recursive calls, although not all do.\n([Chapter 22](chapter22.md) treats tail-recursion in more detail, and points out that Scheme compilers guarantee that tail-recursive calls will be optimized.)\n\nSome find it ugly to introduce `length10-aux`.\nFor them, there are two alternatives.\nFirst, we could combine `length10` and `length10-aux` into a single function with an optional parameter:\n\n```lisp\n(defun length11 (list &optional (len-so-far 0))\n  (if (null list)\n      len-so-far\n      (length11 (rest list) (+ 1 len-so-far))))\n```\n\nSecond, we could introduce a *local* function inside the definition of the main function.\nThis is done with the special form `labels`:\n\n```lisp\n(defun length12 (the-list)\n  (labels\n    ((length13 (list len-so-far)\n       (if (null list)\n           len-so-far\n           (length13 (rest list) (+ 1 len-so-far)))))\n    (length13 the-list 0)))\n```\n\nIn general, a `labels` form (or the similar `flet` form) can be used to introduce one or more local functions.\nIt has the following syntax:\n\n`(labels`\n&nbsp;&nbsp;&nbsp;&nbsp;((*function-name* (*parameter...*) *function-body*)...)\n&nbsp;&nbsp;&nbsp;&nbsp;*body-of-labels*)\n\n### Other Special Forms\n\nA few more special forms do not fit neatly into any category.\nWe have already seen the two special forms for creating constants and functions, `quote` and `function.`\nThese are so common that they have abbreviations: `'x` for `(quote x`) and `#'f` for `(function f).`\n\nThe special form `progn` can be used to evaluate a sequence of forms and return the value of the last one:\n\n```lisp\n(progn (setf x 0) (setf x (+ x 1)) x) => 1\n```\n\n`progn` is the equivalent of a `begin...end` block in other languages, but it is used very infrequently in Lisp.\nThere are two reasons for this.\nFirst, programs written in a functional style never need a sequence of actions, because they don't have side effects.\nSecond, even when side effects are used, many special forms allow for a body which is a sequence - an implicit `progn.`\nI can only think of three places where a `progn` is justified.\nFirst, to implement side effects in a branch of a two-branched conditional, one could use either an `if` with a `progn,` or a `cond`:\n\n```lisp\n(if (> x 100)\n    (progn (print \"too big\")\n           (setf x 100))\n    x)\n\n(cond ((> x 100)\n       (print \"too big\")\n       (setf x 100))\n      (t x))\n```\n\nIf the conditional had only one branch, then `when` or `unless` should be used, since they allow an implicit `progn`.\nIf there are more than two branches, then `cond` should be used.\n\nSecond, `progn` is sometimes needed in macros that expand into more than one top-level form, as in the `defun*` macro on page 326, [section 10.3](chapter10.md#s0020).\nThird, a progn is sometimes needed in an `unwind-protect`, an advanced macro.\nAn example of this is the `with-resource` macro on [page 338](chapter10.md#p338), [section 10.4](chapter10.md#s0025).\n\nThe forms `trace` and `untrace` are used to control debugging information about entry and exit to a function:\n\n```lisp\n> (trace length9) => (LENGTH9)\n> (length9 '(a b c))=>\n(1 ENTER LENGTH9: (A B C))\n  (2 ENTER LENGTH9: (B C))\n    (3 ENTER LENGTH9: (C))\n      (4 ENTER LENGTH9: NIL)\n      (4 EXIT LENGTH9: 0)\n    (3 EXIT LENGTH9: 1)\n  (2 EXIT LENGTH9: 2)\n(1 EXIT LENGTH9: 3)\n3\n\n> (untrace length9) => (LENGTH9)\n\n> (length9 '(a b c)) => 3\n```\n\nFinally, the special form `return` can be used to break out of a block of code.\nBlocks are set up by the special form `block`, or by the looping forms `(do, do*, dolist, dotimes`, or `loop`).\nFor example, the following function computes the product of a list of numbers, but if any number is zero, then the whole product must be zero, so we immediately return zero from the `dolist` loop.\nNote that this returns from the `dolist` only, not from the function itself (although in this case, the value returned by `dolist` becomes the value returned by the function, because it is the last expression in the function).\nI have used uppercase letters in `RETURN` to emphasize the fact that it is an unusual step to exit from a loop.\n\n```lisp\n(defun product (numbers)\n  \"Multiply all the numbers together to compute their product.\"\n  (let ((prod 1))\n    (dolist (n numbers prod)\n      (if (= n 0)\n          (RETURN 0)\n          (setf prod (* n prod))))))\n```\n\n### Macros\n\nThe preceding discussion has been somewhat cavalier with the term \"special form.\"\nActually, some of these special forms are really *macros*, forms that the compiler expands into some other code.\nCommon Lisp provides a number of built-in macros and allows the user to extend the language by defining new macros.\n(There is no way for the user to define new special forms, however.)\n\nMacros are defined with the special form `defmacro`.\nSuppose we wanted to define a macro, `while`, that would act like the `while` loop statement of Pascal.\nWriting a macro is a four-step process:\n\n* Decide if the macro is really necessary.\n* Write down the syntax of the macro.\n* Figure out what the macro should expand into.\n* Use `defmacro` to implement the syntax/expansion correspondence.\n\nThe first step in writing a macro is to recognize that every time you write one, you are defining a new language that is just like Lisp except for your new macro.\nThe programmer who thinks that way will rightfully be extremely frugal in defining macros.\n(Besides, when someone asks, \"What did you get done today?\" it sounds more impressive to say \"I defined a new language and wrote a compiler for it\" than to say \"I just hacked up a couple of macros.\")\nIntroducing a macro puts much more memory strain on the reader of your program than does introducing a function, variable or data type, so it should not be taken lightly.\nIntroduce macros only when there is a clear need, and when the macro fits in well with your existing system.\nAs C.A.R. Hoare put it, \"One thing the language designer should not do is to include untried ideas of his own.\"\n\nThe next step is to decide what code the macro should expand into.\nIt is a good idea to follow established Lisp conventions for macro syntax whenever possible.\nLook at the looping macros `(dolist, dotimes, do-symbols),` the defining macros `(defun, defvar, defparameter, defstruct),` or the I/O macros `(with-open-file`, `with-open-stream`, `with-input-from-string)`, for example.\nIf you follow the naming and syntax conventions for one of these instead of inventing your own conventions, you'll be doing the reader of your program a favor.\nFor `while,` a good syntax is:\n\n> `(while` *test body...*)\n\nThe third step is to write the code that you want a macro call to expand into:\n\n```lisp\nloop\n  unless test (return nil))\n  body\n```\n\nThe final step is to write the definition of the macro, using `defmacro`.\nA `defmacro` form is similar to a `defun` in that it has a parameter list, optional documentation string, and body.\nThere are a few differences in what is allowed in the parameter list, which will be covered later.\nHere is a definition of the macro `while`, which takes a test and a body, and builds up the `loop` code shown previously:\n\n```lisp\n(defmacro while (test &rest body)\n  \"Repeat body while test is true.\"\n  (list* 'loop\n         (list 'unless test '(return nil))\n         body))\n```\n\n(The function `list*` is like `list`, except that the last argument is appended onto the end of the list of the other arguments.)\nWe can see what this macro expands into by using `macroexpand`, and see how it runs by typing in an example:\n\n```lisp\n> (macroexpand-1 '(while (< i 10)\n                   (print (* i i))\n                   (setf i (+ i 1))))=>\n(LOOP (UNLESS (< I 10) (RETURN NIL))\n      (PRINT (* I I))\n      (SETF I (+ I 1)))\n> (setf i 7) =>7\n> (while (< i 10)\n    (print (* i i))\n    (setf i (+ i 1)))\n49\n64\n81\nNIL\n```\n\n[Section 24.6](chapter24.md) (page 853) describes a more complicated macro and some details on the pitfalls of writing complicated macros (page 855).\n\n### Backquote Notation\n\nThe hardest part about defining `while` is building the code that is the expansion of the macro.\nIt would be nice if there was a more immediate way of building code.\nThe following version of `while` following attempts to do just that.\nIt defines the local variable `code` to be a template for the code we want, and then substitutes the real values of the variables test and body for the placeholders in the code.\nThis is done with the function `subst`; (`subst` *new old tree*) substitutes *new* for each occurrence of *old* anywhere within *tree.*\n\n```lisp\n(defmacro while (test &rest body)\n  \"Repeat body while test is true.\"\n  (let ((code '(loop (unless test (return nil)) . body)))\n    (subst test 'test (subst body 'body code))))\n```\n\nThe need to build up code (and noncode data) from components is so frequent that there is a special notation for it, the *backquote* notation.\nThe backquote character ``\"`\"`` is similar to the quote character `\"'\"`.\nA backquote indicates that what follows is *mostly* a literal expression but may contain some components that are to be evaluated.\nAnything marked by a leading comma `\",\"` is evaluated and inserted into the structure, and anything marked with a leading `\",@\"` must evaluate to a list that is spliced into the structure: each element of the list is inserted, without the top-level parentheses.\nThe notation is covered in more detail in [section 23.5](chapter23.md#s0030).\nHere we use the combination of backquote and comma to rewrite `while`:\n\n```lisp\n(defmacro while (test &rest body)\n  \"Repeat body while test is true.\"\n  `(loop (unless ,test (return nil))\n         ,@body))\n```\n\nHere are some more examples of backquote.\nNote that at the end of a list, `\",@\"` has the same effect as `\".\"` followed by `\",\"`.\nIn the middle of a list, only `\",@\"`is a possibility.\n\n```lisp\n> (setf test1 '(a test)) => (A TEST)\n\n> `(this is ,test1) => (THIS IS (A TEST))\n\n> `(this is ,@test1) => (THIS IS A TEST)\n\n> `(this is . ,test1) => (THIS IS A TEST)\n\n> `(this is ,@test1 -- this is only ,@test1) =>\n(THIS IS A TEST -- THIS IS ONLY A TEST)\n```\n\nThis completes the section on special forms and macros.\nThe remaining sections of this chapter give an overview of the important built-in functions in Common Lisp.\n\n## 3.3 Functions on Lists\n\nFor the sake of example, assume we have the following assignments:\n\n```lisp\n(setf x '(a b c))\n(setf y '(1 2 3))\n```\n\nThe most important functions on lists are summarized here.\nThe more complicated ones are explained more thoroughly when they are used.\n\n| []()             |                        |                                                |\n|------------------|------------------------|------------------------------------------------|\n| `(first x)`      | => `a`                 | first element of a list                        |\n| `(second x)`     | => `b`                 | second element of a list                       |\n| `(third x)`      | => `c`                 | third element of a list                        |\n| `(nth 0 x)`      | => `a`                 | nth element of a list, `0`-based               |\n| `(rest x)`       | => `(b c)`             | all but the first element                      |\n| `(car x)`        | => `a`                 | another name for the first element of a list   |\n| `(cdr x)`        | => `(b c)`             | another name for all but the first element     |\n| `(last x)`       | => `(c)`               | last cons cell in a list                       |\n| `(length x)`     | => 3                   | number of elements in a list                   |\n| `(reverse x)`    | => `(c b a)`           | puts list in reverse order                     |\n| `(cons 0 y)`     | => `(0 1 2 3)`         | add to front of list                           |\n| `(append x y)`   | => `(a b c 1 2 3)`     | append together elements                       |\n| `(list x y)`     | => `((a b c) (1 2 3))` | make a new list                                |\n| `(list* 1 2 x)`  | => `(1 2 a b c)`       | append last argument to others                 |\n| `(null nil)`     | => `T`                 | predicate is true of the empty list            |\n| `(null x)`       | => `nil`               | ... and false for everything else              |\n| `(listp x)`      | => `T`                 | predicate is true of any list, including `nil` |\n| `(listp 3)`      | => `nil`               | ... and is false for nonlists                  |\n| `(consp x)`      | => `t`                 | predicate is true of non-nil lists             |\n| `(consp nil)`    | => `nil`               | ... and false for atoms, including `nil`       |\n| `(equal x x)`    | => `t`                 | true for lists that look the same              |\n| `(equal x y)`    | => `nil`                  | ... and false for lists that look different    |\n| `(sort y #'>)`   | => `(3 2 1)`           | sort a list according to a comparison function |\n| `(subseq x 1 2)` | => `(B)`               | subsequence with given start and end points    |\n\nWe said that (`cons` *a b*) builds a longer list by adding element *a* to the front of list *b,* but what if *b* is not a list?\nThis is not an error; the result is an object *x* such that (`first` *x*) => *a* (`rest`*x*) => *b,* and where *x* prints as (*a* . *b*).\nThis is known as *dotted pair* notation.\nIf *b* is a list, then the usual list notation is used for output rather than the dotted pair notation.\nBut either notation can be used for input.\n\nSo far we have been thinking of lists as sequences, using phrases like \"a list of three elements.\"\nThe list is a convenient abstraction, but the actual implementation of lists relies on lower-level building blocks called *cons cells.*\nA cons cell is a data structure with two fields: a first and a rest.\nWhat we have been calling \"a list of three elements\" can also be seen as a single cons cell, whose first field points to the first element and whose rest field points to another cons cell that is a cons cell representing a list of two elements.\nThis second cons cell has a rest field that is a third cons cell, one whose rest field is nil.\nAll proper lists have a last cons cell whose rest field is nil.\n[Figure 3.1](#fig-03-01) shows the cons cell notation for the three-element list (`one two three`), as well as for the result of (`cons 'one 'two`).\n\n| <a id=\"fig-03-01\"></a>[]() |\n|---|\n| <img src=\"images/chapter3/fig-03-01.svg\" onerror=\"this.src='images/chapter3/fig-03-01.png'; this.onerror=null;\" alt=\"Figure 3.1: Cons Cell Diagrams\" /> |\n| **Figure 3.1: Cons Cell Diagrams** |\n\n&#9635; **Exercise 3.2 [s]** The function cons can be seen as a special case of one of the other functions listed previously.\nWhich one?\n\n&#9635; **Exercise 3.3 [m]** Write a function that will print an expression in dotted pair notation.\nUse the built-in function `princ` to print each component of the expression.\n\n&#9635; **Exercise 3.4 [m]** Write a function that, like the regular `print` function, will print an expression in dotted pair notation when necessary but will use normal list notation when possible.\n\n## 3.4 Equality and Internal Representation\n\nIn Lisp there are five major equality predicates, because not all objects are created equally equal.\nThe numeric equality predicate, `=`, tests if two numbers are the same.\nIt is an error to apply `=` to non-numbers.\nThe other equality predicates operate on any kind of object, but to understand the difference between them, we need to understand some of the internals of Lisp.\n\nWhen Lisp reads a symbol in two different places, the result is guaranteed to be the exact same symbol.\nThe Lisp system maintains a symbol table that the function read uses to map between characters and symbols.\nBut when a list is read (or built) in two different places, the results are *not* identically the same, even though the corresponding elements may be.\nThis is because `read` calls `cons` to build up the list, and each call to `cons` returns a new cons cell.\n[Figure 3.2](#fig-03-02) shows two lists, `x` and `Y`, which are both equal to (`one two`), but which are composed of different cons cells, and hence are not identical.\n[Figure 3.3](#fig-03-03) shows that the expression (`rest x`) does not generate new cons cells, but rather shares structure with `x`, and that the expression (`cons 'zero x`) generates exactly one new cons cell, whose rest is `x`.\n\n| <a id=\"fig-03-02\"></a>[]() |\n|---|\n| <img src=\"images/chapter3/fig-03-02.svg\" onerror=\"this.src='images/chapter3/fig-03-02.png'; this.onerror=null;\" alt=\"Figure 3.2: Equal But Nonidentical Lists\" /> |\n| **Figure 3.2: Equal But Nonidentical Lists** |\n\n| <a id=\"fig-03-03\"></a>[]() |\n|---|\n| <img src=\"images/chapter3/fig-03-03.svg\" onerror=\"this.src='images/chapter3/fig-03-03.png'; this.onerror=null;\" alt=\"Figure 3.3: Parts of Lists\" /> |\n| **Figure 3.3: Parts of Lists** |\n\nWhen two mathematically equal numbers are read (or computed) in two places, they may or may not be the same, depending on what the designers of your implementation felt was more efficient.\nIn most systems, two equal fixnums will be identical, but equal numbers of other types will not (except possibly short floats).\nCommon Lisp provides four equality predicates of increasing generality.\nAll four begin with the letters `eq`, with more letters meaning the predicate considers more objects to be equal.\nThe simplest predicate is `eq`, which tests for the exact same object.\nNext, `eql` tests for objects that are either `eq` or are equivalent numbers.\n`equal` tests for objects that are either `eql` or are lists or strings with `eql` elements.\nFinally, `equalp` is like `equal` except it also matches upper- and lowercase characters and numbers of different types.\nThe following table summarizes the results of applying each of the four predicates to various values of *x* and *y*.\nThe `?` value means that the result depends on your implementation: two integers that are `eql` may or may not be `eq`.\n\n| *x*     | *y*     | `eq`  | `eql` | `equal` | `equalp` |\n|---------|---------|-------|-------|---------|----------|\n| `'X`    | `'x`    | `T`   | `T`   | `T`     | `T`      |\n| `'0`    | `'0`    | `?`   | `T`   | `T`     | `T`      |\n| `'(x)`  | `'(x)`  | `nil` | `nil` | `T`     | `T`      |\n| `'\"xy\"` | `'\"xy\"` | `nil` | `nil` | `T`     | `T`      |\n| `'\"Xy\"` | `'\"xY\"` | `nil` | `nil` | `nil`   | `T`      |\n| `'0`    | `'0.0`  | `nil` | `nil` | `nil`   | `T`      |\n| `'0`    | `'1`    | `nil` | `nil` | `nil`   | `nil`    |\n\nIn addition, there are specialized equality predicates such as =, `tree-equal, char-equal,` and `string-equal,` which compare numbers, trees, characters, and strings, respectively.\n\n## 3.5 Functions on Sequences\n\nCommon Lisp is in a transitional position halfway between the Lisps of the past and the Lisps of the future.\nNowhere is that more apparent than in the sequence functions.\nThe earliest Lisps dealt only with symbols, numbers, and lists, and provided list functions like `append` and `length.`\nMore modern Lisps added support for vectors, strings, and other data types, and introduced the term *sequence* to refer to both vectors and lists.\n(A vector is a one-dimensional array.\nIt can be represented more compactly than a list, because there is no need to store the `rest` pointers.\nIt is also more efficient to get at the *n*th element of a vector, because there is no need to follow a chain of pointers.)\nModern Lisps also support strings that are vectors of characters, and hence also a subtype of sequence.\n\nWith the new data types came the problem of naming functions that operated on them.\nIn some cases, Common Lisp chose to extend an old function: `length` can apply to vectors as well as lists.\nIn other cases, the old names were reserved for the list functions, and new names were invented for generic sequence functions.\nFor example, `append` and `mapcar` only work on lists, but `concatenate` and `map` work on any kind of sequence.\nIn still other cases, new functions were invented for specific data types.\nFor example, there are seven functions to pick the nth element out of a sequence.\nThe most general is `elt`, which works on any kind of sequence, but there are specific functions for lists, arrays, strings, bit vectors, simple bit vectors, and simple vectors.\nConfusingly, `nth` is the only one that takes the index as the first argument:\n\n* `(nth` *n list*)\n* `(elt` *sequence n*)\n* `(aref` *array n*)\n* `(char` *string n*)\n* `(bit` *bit vector n*)\n* `(sbit` *simple-bit vector n*)\n* `(svref` *simple-vector n*)\n\nThe most important sequence functions are listed elsewhere in this chapter, depending on their particular purpose.\n\n## 3.6 Functions for Maintaining Tables\n\nLisp lists can be used to represent a one-dimensional sequence of objects.\nBecause they are so versatile, they have been put to other purposes, such as representing tables of information.\nThe *association list* is a type of list used to implement tables.\nAn association list is a list of dotted pairs, where each pair consists of a *key* and a *value.* Together, the list of pairs form a table: given a key, we can retrieve the corresponding value from the table, or verify that there is no such key stored in the table.\nHere's an example for looking up the names of states by their two-letter abbreviation.\nThe function `assoc` is used.\nIt returns the key/value pair (if there is one).\nTo get the value, we just take the `cdr` of the result returned by `assoc`.\n\n```lisp\n(setf state-table\n  '((AL . Alabama) (AK . Alaska) (AZ . Arizona) (AR . Arkansas)))\n\n> (assoc 'AK state-table) => (AK . ALASKA)\n\n> (cdr (assoc 'AK state-table)) => ALASKA\n\n> (assoc 'TX state-table) => NIL\n```\n\nIf we want to search the table by value rather than by key, we can use rassoc:\n\n```lisp\n> (rassoc 'Arizona state-table) => (AZ . ARIZONA)\n> (car (rassoc 'Arizona state-table)) => AZ\n```\n\nManaging a table with `assoc` is simple, but there is one drawback: we have to search through the whole list one element at a time.\nIf the list is very long, this may take a while.\n\nAnother way to manage tables is with *hash tables.*\nThese are designed to handle large amounts of data efficiently but have a degree of overhead that can make them inappropriate for small tables.\nThe function `gethash` works much like `get` - it takes two arguments, a key and a table.\nThe table itself is initialized with a call to `make-hash-table` and modified with a `setf` of `gethash`:\n\n```lisp\n(setf table (make-hash-table))\n\n(setf (gethash 'AL table) 'Alabama)\n(setf (gethash 'AK table) 'Alaska)\n(setf (gethash 'AZ table) 'Arizona)\n(setf (gethash 'AR table) 'Arkansas)\n```\n\nHere we retrieve values from the table:\n\n```lisp\n> (gethash 'AK table) => ALASKA\n> (gethash 'TX table) => NIL\n```\n\nThe function `remhash` removes a key/value pair from a hash table, `clrhash` removes all pairs, and `maphash` can be used to map over the key/value pairs.\nThe keys to hash tables are not restricted; they can be any Lisp object.\nThere are many more details on the implementation of hash tables in Common Lisp, and an extensive literature on their theory.\n\nA third way to represent table is with *property lists.*\nA property list is a list of alternating key/value pairs.\nProperty lists (sometimes called p-lists or plists) and association lists (sometimes called a-lists or alists) are similar:\n\n`a-list`: ((*key*<sub>1</sub> . *val*<sub>1</sub>) (*key*<sub>2</sub> .\n*val*<sub>2</sub>) ... (*key<sub>n</sub> . val<sub>n</sub>*))\n\n`p-list`: (*key*<sub>1</sub> *val*<sub>1</sub> *key*<sub>2</sub> *val*<sub>2</sub> ... *key<sub>n</sub> val<sub>n</sub>*)\n\nGiven this representation, there is little to choose between a-lists and p-lists.\nThey are slightly different permutations of the same information.\nThe difference is in how they are normally used.\nEvery symbol has a property list associated with it.\nThat means we can associate a property/value pair directly with a symbol.\nMost programs use only a few different properties but have many instances of property/value pairs for each property.\nThus, each symbol's p-list will likely be short.\nIn our example, we are only interested in one property: the state associated with each abbreviation.\nThat means that the property lists will be very short indeed: one property for each abbreviation, instead of a list of 50 pairs in the association list implementation.\n\nProperty values are retrieved with the function get, which takes two arguments: the first is a symbol for which we are seeking information, and the second is the property of that symbol that we are interested in.\nget returns the value of that property, if one has been stored.\nProperty/value pairs can be stored under a symbol with a `setf` form.\nA table would be built as follows:\n\n```lisp\n(setf (get 'AL 'state) 'Alabama)\n(setf (get 'AK 'state) 'Alaska)\n(setf (get 'AZ 'state) 'Arizona)\n(setf (get 'AR 'state) 'Arkansas)\n```\n\nNow we can retrieve values with get:\n\n```lisp\n> (get 'AK 'state) => ALASKA\n> (get 'TX 'state) => NIL\n```\n\nThis will be faster because we can go immediately from a symbol to its lone property value, regardless of the number of symbols that have properties.\nHowever, if a given symbol has more than one property, then we still have to search linearly through the property list.\nAs Abraham Lincoln might have said, you can make some of the table lookups faster some of the time, but you can't make all the table lookups faster all of the time.\nNotice that there is no equivalent of rassoc using property lists; if you want to get from a state to its abbreviation, you could store the abbreviation under a property of the state, but that would be a separate `setf` form, as in:\n\n```lisp\n(setf (get 'Arizona 'abbrev) 'AZ)\n```\n\nIn fact, when source, property, and value are all symbols, there are quite a few possibilities for how to use properties.\nWe could have mimicked the a-list approach, and listed all the properties under a single symbol, using setf on the function `symbol-plist` (which gives a symbol's complete property list):\n\n```lisp\n(setf (symbol-plist 'state-table)\n      '(AL Alabama AK Alaska AZ Arizona AR Arkansas))\n> (get 'state-table 'AL) => ALASKA\n> (get 'state-table 'Alaska) => NIL\n```\n\nProperty lists have a long history in Lisp, but they are falling out of favor as new alternatives such as hash tables are introduced.\nThere are two main reasons why property lists are avoided.\nFirst, because symbols and their property lists are global, it is easy to get conflicts when trying to put together two programs that use property lists.\nIf two programs use the same property for different purposes, they cannot be used together.\nEven if two programs use *different* properties on the same symbols, they will slow each other down.\nSecond, property lists are messy.\nThere is no way to remove quickly every element of a table implemented with property lists.\nIn contrast, this can be done trivially with `clrhash` on hash tables, or by setting an association list to nil.\n\n## 3.7 Functions on Trees\n\nMany Common Lisp functions treat the expression `((a b) ((c)) (d e))` as a sequence of three elements, but there are a few functions that treat it as a tree with five non-null leaves.\nThe function `copy-tree` creates a copy of a tree, and `tree-equal` tests if two trees are equal by traversing cons cells, but not other complex data like vectors or strings.\nIn that respect, `tree-equal` is similar to `equal`, but `tree-equal` is more powerful because it allows a `:test keyword`:\n\n```lisp\n> (setf tree '((a b) ((c)) (d e)))\n\n> (tree-equal tree (copy-tree tree)) => T\n\n(defun same-shape-tree (a b)\n  \"Are two trees the same except for the leaves?\"\n  (tree-equal a b :test #'true))\n\n(defun true (&rest ignore) t)\n\n> (same-shape-tree tree '((1 2) ((3)) (4 5))) => T\n> (same-shape-tree tree '((1 2) (3) (4 5))) => NIL\n```\n\n[Figure 3.4](#fig-03-04) shows the tree `((a b) ((c)) (d e))` as a cons cell diagram.\n\n| <a id=\"fig-03-04\"></a>[]() |\n|---|\n| <img src=\"images/chapter3/fig-03-04.svg\" onerror=\"this.src='images/chapter3/fig-03-04.png'; this.onerror=null;\" alt=\"Figure 3.4: Cons Cell Diagram of a Tree\" /> |\n| **Figure 3.4: Cons Cell Diagram of a Tree** |\n\nThere are also two functions for substituting a new expression for an old one anywhere within a tree.\n`subst` substitutes a single value for another, while `sublis` takes a list of substitutions in the form of an association list of (*old . new*) pairs.\nNote that the order of old and new in the a-list for `sublis` is reversed from the order of arguments to `subst`.\nThe name `sublis` is uncharacteristically short and confusing; a better name would be `subst-list`.\n\n```lisp\n> (subst 'new 'old '(old ((very old)))) => (NEW ((VERY NEW)))\n\n> (sublis '((old . new)) '(old ((very old)))) => (NEW ((VERY NEW)))\n\n> (subst 'new 'old 'old) => NEW\n\n(defun english->french (words)\n  (sublis '((are . va) (book . libre) (friend . ami)\n            (hello . bonjour) (how . comment) (my . mon)\n            (red . rouge) (you . tu))\n          words))\n\n> (english->french '(hello my friend - how are you today?)) =>\n(BONJOUR MON AMI - COMMENT VA TU TODAY?)\n```\n\n## 3.8 Functions on Numbers\n\nThe most commonly used functions on numbers are listed here.\nThere are quite a few other numeric functions that have been omitted.\n\n| []()           |          |                                                                |\n|----------------|----------|----------------------------------------------------------------|\n| `(+ 4 2)`      | => `6`   | add                                                            |\n| `(- 4 2)`      | => `2`   | subtract                                                       |\n| `(* 4 2)`      | => `8`   | multiply                                                       |\n| `(/ 4 2)`      | => `2`   | divide                                                         |\n| `(> 100 99)`   | => `t`   | greater than (also `>=`, greater than or equal to)             |\n| `(= 100 100)`  | => `t`   | equal (also `/=`, not equal)                                   |\n| `(< 99 100)`   | => `t`   | less than (also `<=`, less than or equal to)                   |\n| `(random 100)` | => `42`  | random integer from 0 to 99                                    |\n| `(expt 4 2)`   | => `16`  | exponentiation (also exp, *e<sup>x</sup>* and `log`)           |\n| `(sin pi)`     | => `0.0` | sine function (also `cos`, `tan,` etc.)                        |\n| `(asin 0)`     | => `0.0` | arcsine or sin<sup>-1</sup> function (also `acos, atan`, etc.) |\n| `(min 2 3 4)`  | => `2`   | minimum (also `max`)                                           |\n| `(abs -3)`     | => `3`   | absolute value                                                 |\n| `(sqrt 4)`     | => `2`   | square root                                                    |\n| `(round 4.1)`  | => `4`   | round off (also `truncate, floor, ceiling`)                    |\n| `(rem 11 5)`   | => `1`   | remainder (also `mod`)                                         |\n\n## 3.9 Functions on Sets\n\nOne of the important uses of lists is to represent sets.\nCommon Lisp provides functions that treat lists in just that way.\nFor example, to see what elements the sets *r* = {*a, b, c, d*} and *s* = {*c, d, e*} have in common, we could use:\n\n```lisp\n> (setf r '(a b c d)) => (A B C D)\n> (setf s '(c d e)) => (C D E)\n> (intersection r s) => (C D)\n```\n\nThis implementation returned (`C D`) as the answer, but another might return (`D C`).\nThey are equivalent sets, so either is valid, and your program should not depend on the order of elements in the result.\nHere are the main functions on sets:\n\n| []()                   |                  |                                               |\n|------------------------|------------------|-----------------------------------------------|\n| `(intersection r s)`   | => `(c d)`       | find common elements of two sets              |\n| `(union r s)`          | => `(a b c d e)` | find all elements in either of two sets       |\n| `(set-difference r s)` | => `(a b)`       | find elements in one but not other set        |\n| `(member 'd r)`        | => `(d)`         | check if an element is a member of a set      |\n| `(subsetp s r)`        | => `nil`         | see if all elements of one set are in another |\n| `(adjoin 'b s`)        | => `(b c d e)`   | add an element to a set                       |\n| `(adjoin 'c s)`        | => `(c d e)`     | ... but don't add duplicates                  |\n\nIt is also possible to represent a set with a sequence of bits, given a particular universe of discourse.\nFor example, if every set we are interested in must be a subset of (`a b c d e`), then we can use the bit sequence 11110 to represent (`a b c d`), 00000 to represent the empty set, and 11001 to represent (`a b e`).\nThe bit sequence can be represented in Common Lisp as a bit vector, or as an integer in binary notation.\nFor example, (`a b e`) would be the bit vector `#*11001` or the integer 25, which can also be written as `#b11001`.\n\nThe advantage of using bit sequences is that it takes less space to encode a set, assuming a small universe.\nComputation will be faster, because the computer's underlying instruction set will typically process 32 elements at a time.\n\nCommon Lisp provides a full complement of functions on both bit vectors and integers.\nThe following table lists some, their correspondence to the list functions.\n\n| `lists`          | `integers` | `bit vectors` |\n|------------------|------------|---------------|\n| `intersection`   | `logand`   | `bit-and`     |\n| `union`          | `logior`   | `bit-ior`     |\n| `set-difference` | `logandc2` | `bit-andc2`   |\n| `member`         | `logbitp`  | `bit`         |\n| `length`         | `logcount` |               |\n\nFor example,\n\n```lisp\n(intersection '(a b c d) '(a b e)) =>  (A B)\n(bit-and      #*11110    #*11001)  =>  #*11000\n(logand       #b11110    #b11001)  =>  24 = #b11000\n```\n\n## 3.10 Destructive Functions\n\nIn mathematics, a function is something that computes an output value given some input arguments.\nFunctions do not \"do\" anything, they just compute results.\nFor example, if I tell you that *x* = 4 and *y* = 5 and ask you to apply the function \"plus\" to *x* and *y,* I expect you to tell me 9.\nIf I then ask, \"Now what is the value of *x*?\" it would be surprising if *x* had changed.\nIn mathematics, applying an operator to *x* can have no effect on the value of *x.*\n\nIn Lisp, some functions *are* able to take effect beyond just computing the result.\n<a id=\"tfn03-2\"></a>\nThese \"functions\" are not functions in the mathematical sense,<sup>[2](#fn03-2)</sup> and in other languages they are known as \"procedures.\"\nOf course, most of the Lisp functions *are* true mathematical functions, but the few that are not can cause great problems.\nThey can also be quite useful in certain situations.\nFor both reasons, they are worth knowing about.\n\nConsider the following:\n\n```lisp\n> (setf x '(a b c)) => (A B C)\n> (setf y '(1 2 3)) => (1 2 3)\n> (append x y) => (A B C 1 2 3)\n```\n\n`append` is a pure function, so after evaluating the call to `append,` we can rightfully expect that `x` and `y` retain their values.\nNow consider this:\n\n```lisp\n> (nconc x y) => (A B C 1 2 3)\n> x => (A B C 1 2 3)\n> y => (1 2 3)\n```\n\nThe function `nconc` computes the same result as `append,` but it has the side effect of altering its first argument.\nIt is called a *destructive* function, because it destroys existing structures, replacing them with new ones.\nThis means that there is quite a conceptual load on the programmer who dares to use `nconc`.\nHe or she must be aware that the first argument may be altered, and plan accordingly.\nThis is far more complicated than the case with nondestructive functions, where the programmer need worry only about the results of a function call.\n\nThe advantage of `nconc` is that it doesn't use any storage.\nWhile `append` must make a complete copy of `x` and then have that copy end with `y`, `nconc` does not need to copy anything.\nInstead, it just changes the rest field of the last element of `x` to point to `y.`\nSo use destructive functions when you need to conserve storage, but be aware of the consequences.\n\nBesides `nconc`, many of the destructive functions have names that start with `n`, including `nreverse, nintersection, nunion, nset-difference`, and `nsubst`.\nAn important exception is `delete`, which is the name used for the destructive version of `remove`.\nOf course, the `setf` special form can also be used to alter structures, but it is the destructive functions that are most dangerous, because it is easier to overlook their effects.\n\n&#9635; **Exercise 3.5 [h]** (Exercise in altering structure.)\nWrite a program that will play the role of the guesser in the game Twenty Questions.\nThe user of the program will have in mind any type of thing.\nThe program will ask questions of the user, which must be answered yes or no, or \"it\" when the program has guessed it.\nIf the program runs out of guesses, it gives up and asks the user what \"it\" was.\nAt first the program will not play well, but each time it plays, it will remember the user's replies and use them for subsequent guesses.\n\n## 3.11 Overview of Data Types\n\nThis chapter has been organized around functions, with similar functions grouped together.\nBut there is another way of organizing the Common Lisp world: by considering the different data types.\nThis is useful for two reasons.\nFirst, it gives an alternative way of seeing the variety of available functionality.\nSecond, the data types themselves are objects in the Common Lisp language, and as we shall see, there are functions that manipulate data types.\nThese are useful mainly for testing objects (as with the typecase macro) and for making declarations.\n\nHere is a table of the most commonly used data types:\n\n| Type         | Example        | Explanation                                                |\n|--------------|----------------|------------------------------------------------------------|\n| `character`  | `#\\c`          | A single letter, number, or punctuation mark.              |\n| `number`     | `42`           | The most common numbers are floats and integers.           |\n| `float`      | `3.14159`      | A number with a decimal point.                             |\n| `integer`    | `42`           | A whole number, of either fixed or indefinite size:        |\n| `fixnum`     | `123`          | An integer that fits in a single word of storage.          |\n| `bignum`     | `123456789`    | An integer of unbounded size.                              |\n| `function`   | `#'sin`        | A function can be applied to an argument list.             |\n| `symbol`     | `sin`          | Symbols can name fns and vars, and are themselves objects. |\n| `null`       | `nil`          | The object `nil` is the only object of type null.          |\n| `keyword`    | `:key`         | Keywords are a subtype of symbol.                          |\n| `sequence`   | `(a b c)`      | Sequences include lists and vectors.                       |\n| `list`       | `(a b c)`      | A list is either a `cons` or `null`.                       |\n| `vector`     | `#(a b c)`     | A vector is a subtype of sequence.                         |\n| `cons`       | `(a b c)`      | A cons is a non-nil list.                                  |\n| `atom`       | `t`            | An atom is anything that is not a cons.                    |\n| `string`     | `\"abc\"`        | A string is a type of vector of characters.                |\n| `array`      | `#lA(a b c)`   | Arrays include vectors and higher-dimensional arrays.      |\n| `structure`  | `#S(type ...)` | Structures are defined by `defstruct`.                     |\n| `hash-table` | ...            | Hash tables are created by `make-hash-table`.              |\n\nAlmost every data type has a *recognizer predicate* - a function that returns true for only elements of that type.\nIn general, a predicate is a function that always returns one of two values: true or false.\nIn Lisp, the false value is `nil`, and every other value is considered true, although the most common true value is `t`.\nIn most cases, the recognizer predicate's name is composed of the type name followed by `p: characterp` recognizes characters, `numberp` recognizes numbers, and so on.\nFor example, `(numberp 3)` returns `t` because 3 is a number, but `(numberp \"x\")` returns `nil` because `\"x\"` is a string, not a number.\n\nUnfortunately, Common Lisp is not completely regular.\nThere are no recognizers for fixnums, bignums, sequences, and structures.\nTwo recognizers, `null` and `atom`, do not end in `p.` Also note that there is a hyphen before the `p` in `hash-table-p,` because the type has a hyphen in it.\nIn addition, all the recognizers generated by `defstruct` have a hyphen before the `p.`\n\nThe function `type-of` returns the type of its argument, and `typep` tests if an object is of a specified type.\nThe function `subtypep` tests if one type can be determined to be a subtype of another.\nFor example:\n\n```lisp\n> (type-of 123) => FIXNUM\n\n> (typep 123 'fixnum) => T\n\n> (typep 123 'number) => T\n\n> (typep 123 'integer) => T\n\n> (typep 123.0 'integer) => NIL\n\n> (subtypep 'fixnum 'number) T\n```\n\nThe hierarchy of types is rather complicated in Common Lisp.\nAs the prior example shows, there are many different numeric types, and a number like 123 is considered to be of type `fixnum, integer,` and `number.`\nWe will see later that it is also of type `rational` and `t.`\n\nThe type hierarchy forms a graph, not just a tree.\nFor example, a vector is both a sequence and an array, although neither array nor sequence are subtypes of each other.\nSimilarly, `null` is a subtype of both `symbol` and `list.`\n\nThe following table shows a number of more specialized data types that are not used as often:\n\n| Type           | Example               | Explanation                                              |\n|----------------|-----------------------|----------------------------------------------------------|\n| `t`            | `42`                  | Every object is of type `t.`                             |\n| `nil`          |                       | No object is of type `nil`.                              |\n| `complex`      | `#C(0 1)`             | Imaginary numbers.                                       |\n| `bit`          | `0`                   | Zero or one.                                             |\n| `rational`     | `2/3`                 | Rationals include integers and ratios.                   |\n| `ratio`        | `2/3`                 | Exact fractional numbers.                                |\n| `simple-array` | `#lA(x y)`            | An array that is not displaced or adjustable.            |\n| `readtable`    | `...`                 | A mapping from characters to their meanings to read.     |\n| `package`      | `...`                 | A collection of symbols that form a module.              |\n| `pathname`     | `#P\"/usr/spool/mail\"` | A file or directory name.                                |\n| `stream`       | `...`                 | A pointer to an open file; used for reading or printing. |\n| `random-state` | `...`                 | A state used as a seed by `random.`                      |\n\nIn addition, there are even more specialized types, such as `short-float`, `compiled-function`, and `bit-vector`.\nIt is also possible to construct more exact types, such as (`vector (integer 0 3) 100`), which represents a vector of 100 elements, each of which is an integer from 0 to 3, inclusive.\n[Section 10.1](chapter10.md#s0010) gives more information on types and their use.\n\nWhile almost every type has a predicate, it is also true that there are predicates that are not type recognizers but rather recognize some more general condition.\nFor example, `oddp` is true only of odd integers, and `string-greaterp` is true if one string is alphabetically greater than another.\n\n## 3.12 Input/Output\n\nInput in Lisp is incredibly easy because a complete lexical and syntactic parser is available to the user.\nThe parser is called `read`.\nIt is used to read and return a single Lisp expression.\nIf you can design your application so that it reads Lisp expressions, then your input worries are over.\nNote that the expression parsed by `read` need not be a legal *evaluable* Lisp expression.\nThat is, you can read (`\"hello\" cons zzz`) just as well as (`+ 2 2`).\nIn cases where Lisp expressions are not adequate, the function `read-char` reads a single character, and `read-line` reads everything up to the next newline and returns it as a string.\n\nTo read from the terminal, the functions `read, read-char,` or `read-line` (with no arguments) return an expression, a character, and a string up to the end of line, respectively.\nIt is also possible to read from a file.\nThe function `open` or the macro `with-open-stream` can be used to open a file and associate it with a *stream,* Lisp's name for a descriptor of an input/output source.\nAll three read functions take three optional arguments.\nThe first is the stream to read from.\nThe second, if true, causes an error to be signaled at end of file.\nIf the second argument is nil, then the third argument indicates the value to return at end of file.\n\nOutput in Lisp is similar to output in other languages, such as C.\nThere are a few low-level functions to do specific kinds of output, and there is a very general function to do formatted output.\nThe function `print` prints any object on a new line, with a space following it.\n`prin1` will print any object without the new line and space.\nFor both functions, the object is printed in a form that could be processed by `read`.\nFor example, the string `\"hello there\"` would print as `\"hello there\".`\nThe function `princ` is used to print in a human-readable format.\nThe string in question would print as `hello there` with `princ`-the quote marks are not printed.\nThis means that `read` cannot recover the original form; `read` would interpret it as two symbols, not one string.\nThe function `write` accepts eleven different keyword arguments that control whether it acts like `prin1` or `princ`, among other things.\n\nThe output functions also take a stream as an optional argument.\nIn the following, we create the file `test.text` and print two expressions to it.\nThen we open the file for reading, and try to read back the first expression, a single character, and then two more expressions.\nNote that the `read-char` returns the character `#\\G`, so the following `read` reads the characters `OODBYE` and turns them into a symbol.\nThe final `read` hits the end of file, and so returns the specified value, `eof`.\n\n```lisp\n> (with-open-file (stream \"test.text\" :direction :output)\n    (print '(hello there) stream)\n    (princ 'goodbye stream)) =>\nGOODBYE        ; and creates the file test.text\n\n> (with-open-file (stream \"test.text\" :direction :input)\n    (list (read stream) (read-char stream) (read stream)\n          (read stream nil 'eof))) =>\n((HELLO THERE) #\\G OODBYE EOF)\n```\n\nThe function `terpri` stands for \"terminate print line,\" and it skips to the next line.\nThe function `fresh-line` also skips to the next line, unless it can be determined that the output is already at the start of a line.\n\nCommon Lisp also provides a very general function for doing formatted output, called `format.`\nThe first argument to `format` is always the stream to print to; use `t` to print to the terminal.\nThe second argument is the format string.\nIt is printed out verbatim, except for *format directives*, which begin with the character `\"~\"`.\nThese directives tell how to print out the remaining arguments.\nUsers of C's `printf` function or FORTRAN's `format` statement should be familiar with this idea.\nHere's an example:\n\n```lisp\n> (format t \"hello, world\")\nhello, world\nNIL\n```\n\nThings get interesting when we put in additional arguments and include format directives:\n\n```lisp\n> (format t \"~&~a plus ~s is ~f\" \"two\" \"two\" 4)\ntwo plus \"two\" is 4.0\nNIL\n```\n\nThe directive `~&` moves to a fresh line, `~a` prints the next argument as `princ` would, `~s` prints the next argument as `prin1` would, and `~f` prints a number in floating-point format.\nIf the argument is not a number, then `princ` is used.\n`format` always returns nil.\nThere are 26 different format directives.\nHere's a more complex example:\n\n```lisp\n> (let ((numbers '(1 2 3 4 5)))\n    (format t \"~&~{~r~^ plus ~} is ~@r\"\n            numbers (apply #'+ numbers)))\none plus two plus three plus four plus five is XV\nNIL\n```\n\nThe directive `~r` prints the next argument, which should be a number, in English, and `~@r` prints a number as a roman numeral.\nThe compound directive `~{...~}` takes the next argument, which must be a list, and formats each element of the list according to the format string inside the braces.\nFinally, the directive `~^` exits from the enclosing `~{...~}` loop if there are no more arguments.\nYou can see that `format`, like `loop`, comprises almost an entire programming language, which, also like `loop`, is not a very Lisplike language.\n\n## 3.13 Debugging Tools\n\nIn many languages, there are two strategies for debugging: (1) edit the program to insert print statements, recompile, and try again, or (2) use a debugging program to investigate (and perhaps alter) the internal state of the running program.\n\nCommon Lisp admits both these strategies, but it also offers a third: (3) add annotations that are not part of the program but have the effect of automatically altering the running program.\nThe advantage of the third strategy is that once you are done you don't have to go back and undo the changes you would have introduced in the first strategy.\nIn addition, Common Lisp provides functions that display information about the program.\nYou need not rely solely on looking at the source code.\n\nWe have already seen how `trace` and `untrace` can be used to provide debugging information (page 65).\nAnother useful tool is `step`, which can be used to halt execution before each subform is evaluated.\nThe form (`step` *expression*) will evaluate and return *expression*, but pauses at certain points to allow the user to inspect the computation, and possibly change things before proceeding to the next step.\nThe commands available to the user are implementation-dependent, but typing a `?` should give you a list of commands.\nAs an example, here we step through an expression twice, the first time giving commands to stop at each subevaluation, and the second time giving commands to skip to the next function call.\nIn this implementation, the commands are control characters, so they do not show up in the output.\n\nAll output, including the symbols <= and => are printed by the stepper itself; I have added no annotation.\n\n```lisp\n> (step (+ 3 4 (* 5 6 (/ 7 8))))\n<= (+ 3 4 (* 5 6 (/ 7 8)))\n  <= 3 => 3\n  <= 4 => 4\n  <= (* 5 6 (/ 7 8))\n  <= 5 => 5\n  <= 6 => 6\n  <= (/ 7 8)\n    <= 7 => 7\n  <= 8 => 8\n    <=(/ 7 8) => 7/8\n  <= (* 5 6 (/ 7 8)) => 105/4\n  <= (+ 3 4 (* 5 6 (/ 7 8))) => 133/4\n133/4\n\n> (step (+ 3 4 (* 5 6 (/ 7 8))))\n<= (+ 3 4 (* 5 6 (/ 7 8)))\n  /: 7 8 => 7/8\n  *: 5 6 7/8 => 105/4\n  +: 3 4 105/4 => 133/4\n<= (+ 3 4 (* 5 6 (/ 7 8))) => 133/4\n133/4\n```\n\nThe functions `describe`, `inspect`, `documentation`, and `apropos` provide information about the state of the current program.\n`apropos` prints information about all symbols whose name matches the argument:\n\n```lisp\n> (apropos 'string)\nMAKE-STRING            function (LENGTH &KEY INITIAL-ELEMENT)\nPRIN1-TO-STRING        function (OBJECT)\nPRINC-TO-STRING        function (OBJECT)\nSTRING                 function (X)\n...\n```\n\nOnce you know what object you are interested in, `describe` can give more information on it:\n\n```lisp\n> (describe 'make-string)\nSymbol MAKE-STRING is in LISP package.\nThe function definition is #<FUNCTION MAKE-STRING -42524322 >:\n  NAME:          MAKE-STRING\n  ARGLIST:       (LENGTH &KEY INITIAL-ELEMENT)\n  DOCUMENTATION: \"Creates and returns a string of LENGTH elements,\nall set to INITIAL-ELEMENT.\"\n  DEFINITION:    (LAMBDA (LENGTH &KEY INITIAL-ELEMENT)\n                   (MAKE-ARRAY LENGTH : ELEMENT-TYPE 'CHARACTER\n                               :INITIAL-ELEMENT (OR INITIAL-ELEMENT\n                                                    #\\SPACE)))\nMAKE-STRING has property INLINE: INLINE\nMAKE-STRING has property :SOURCE-FILE: #P\"SYS:KERNEL; STRINGS\"\n\n> (describe 1234.56)\n1234.56 is a single-precision floating-point number.\n  Sign 0, exponent #o211, 23-bit fraction #o6450754\n```\n\nIf all you want is a symbol's documentation string, the function `documentation` will do the trick:\n\n```lisp\n> (documentation 'first 'function) => \"Return the first element of LIST.\"\n> (documentation 'pi 'variable) => \"pi\"\n```\n\nIf you want to look at and possibly alter components of a complex structure, then `inspect` is the tool.\nIn some implementations it invokes a fancy, window-based browser.\n\nCommon Lisp also provides a debugger that is entered automatically when an error is signalled, either by an inadvertant error or by deliberate action on the part of the program.\nThe details of the debugger vary between implementations, but there are standard ways of entering it.\nThe function `break` enters the debugger after printing an optional message.\nIt is intended as the primary method for setting debugging break points.\n`break` is intended only for debugging purposes; when a program is deemed to be working, all calls to `break` should be removed.\nHowever, it is still a good idea to check for unusual conditions with `error`, `cerror`, `assert,` or `check-type`, which will be described in the following section.\n\n## 3.14 Antibugging Tools\n\nIt is a good idea to include *antibugging* checks in your code, in addition to doing normal debugging.\nAntibugging code checks for errors and possibly takes corrective action.\n\nThe functions `error` and `cerror` are used to signal an error condition.\nThese are intended to remain in the program even after it has been debugged.\nThe function `error` takes a format string and optional arguments.\nIt signals a fatal error; that is, it stops the program and does not offer the user any way of restarting it.\nFor example:\n\n```lisp\n(defun average (numbers)\n  (if (null numbers)\n      (error \"Average of the empty list is undefined.\")\n      (/ (reduce #'+ numbers)\n         (length numbers))))\n```\n\nIn many cases, a fatal error is a little drastic.\nThe function `cerror` stands for continuable error.\n`cerror` takes two format strings; the first prints a message indicating what happens if we continue, and the second prints the error message itself.\n`cerror` does not actually take any action to repair the error, it just allows the user to signal that continuing is alright.\nIn the following implementation, the user continues by typing `:continue`.\nIn ANSI Common Lisp, there are additional ways of specifying options for continuing.\n\n```lisp\n(defun average (numbers)\n  (if (null numbers)\n      (progn\n        (cerror \"Use 0 as the average.\"\n                \"Average of the empty list is undefined.\")\n        0)\n      (/ (reduce #'+ numbers)\n         (length numbers))))\n\n> (average '())\nError: Average of the empty list is undefined.\nError signaled by function AVERAGE.\nIf continued: Use 0 as the average.\n>> :continue\n0\n```\n\nIn this example, adding error checking nearly doubled the length of the code.\nThis is not unusual; there is a big difference between code that works on the expected input and code that covers all possible errors.\nCommon Lisp tries to make it easier to do error checking by providing a few special forms.\nThe form `ecase` stands for \"exhaustive case\" or \"error case.\"\nIt is like a normal case form, except that if none of the cases are satisfied, an error message is generated.\nThe form `ccase` stands for \"continuable case.\" It is like `ecase`, except that the error is continuable.\nThe system will ask for a new value for the test object until the user supplies one that matches one of the programmed cases.\n\nTo make it easier to include error checks without inflating the length of the code too much, Common Lisp provides the special forms `check-type` and `assert`.\nAs the name implies, `check-type` is used to check the type of an argument.\nIt signals a continuable error if the argument has the wrong type.\nFor example:\n\n```lisp\n(defun sqr (x)\n  \"Multiply x by itself.\"\n  (check-type x number)\n  (* x x))\n```\n\nIf `sqr` is called with a non-number argument, an appropriate error message is printed:\n\n```lisp\n> (sqr \"hello\")\nError: the argument X was \"hello\", which is not a NUMBER.\nIf continued: replace X with new value\n>> :continue 4\n16\n```\n\n`assert` is more general than `check-type`.\nIn the simplest form, assert tests an expression and signals an error if it is false.\nFor example:\n\n```lisp\n(defun sqr (x)\n  \"Multiply x by itself.\"\n  (assert (numberp x))\n  (* x x))\n```\n\nThere is no possibility of continuing from this kind of assertion.\nIt is also possible to give `assert` a list of places that can be modified in an attempt to make the assertion true.\nIn this example, the variable `x` is the only thing that can be changed:\n\n```lisp\n(defun sqr (x)\n  \"Multiply x by itself.\"\n  (assert (numberp x) (x))\n  (* x x))\n```\n\nIf the assertion is violated, an error message will be printed and the user will be given the option of continuing by altering `x`.\nIf `x` is given a value that satisfies the assertion, then the program continues.\n`assert` always returns nil.\n\nFinally, the user who wants more control over the error message can provide a format control string and optional arguments.\nSo the most complex syntax for assert is:\n\n> `(assert` *test-form* (*place...*) *format-ctl-string format-arg...*)\n\nHere is another example.\nThe assertion tests that the temperature of the bear's porridge is neither too hot nor too cold.\n\n```lisp\n(defun eat-porridge (bear)\n  (assert (< too-cold (temperature (bear-porridge bear)) too-hot)\n          (bear (bear-porridge bear))\n          \"~a's porridge is not just right: ~a\"\n          bear (hotness (bear-porridge bear)))\n  (eat (bear-porridge bear)))\n```\n\nIn the interaction below, the assertion failed, and the programmer's error message was printed, along with two possibilities for continuing.\nThe user selected one, typed in a call to `make-porridge` for the new value, and the function successfully continued.\n\n```lisp\n> (eat-porridge momma-bear)\nError: #<MOMMA BEAR>'s porridge is not just right: 39\nRestart actions (select using :continue):\n 0: Supply a new value for BEAR\n 1: Supply a new value for (BEAR-PORRIDGE BEAR)\n>> :continue 1\nForm to evaluate and use to replace (BEAR-PORRIDGE BEAR):\n(make-porridge :temperature just-right)\nnil\n```\n\nIt may seem like wasted effort to spend time writing assertions that (if all goes well) will never be used.\nHowever, for all but the perfect programmer, bugs do occur, and the time spent antibugging will more than pay for itself in saving debugging time.\n\nWhenever you develop a complex data structure, such as some kind of data base, it is a good idea to develop a corresponding consistency checker.\nA consistency checker is a function that will look over a data structure and test for all possible errors.\nWhen a new error is discovered, a check for it should be incorporated into the consistency checker.\nCalling the consistency checker is the fastest way to help isolate bugs in the data structure.\n\nIn addition, it is a good idea to keep a list of difficult test cases on hand.\nThat way, when the program is changed, it will be easy to see if the change reintroduces a bug that had been previously removed.\nThis is called *regression testing,* and [Waters (1991)](bibliography.md#bb1350) presents an interesting tool for maintaining a suite of regression tests.\nBut it is simple enough to maintain an informal test suite with a function that calls assert on a series of examples:\n\n```lisp\n(defun test-ex ()\n  \"Test the program EX on a series of examples.\"\n  (init-ex) ; Initialize the EX program first.\n  (assert (equal (ex 3 4) 5))\n  (assert (equal (ex 5 0) 0))\n  (assert (equal (ex 'x 0) 0)))\n```\n\n### Timing Tools\n\nA program is not complete just because it gives the right output.\nIt must also deliver the output in a timely fashion.\nThe form (`time` *expression*) can be used to see how long it takes to execute *expression.*\nSome implementations also print statistics on the amount of storage required.\nFor example:\n\n```lisp\n> (defun f (n) (dotimes (i n) nil)) => F\n> (time (f 10000)) => NIL\nEvaluation of (F 10000) took 4.347272 Seconds of elapsed time, including 0.0 seconds of paging time for 0 faults, Consed 27 words.\n\n> (compile 'f) => F\n\n> (time (f 10000)) => NIL\nEvaluation of (F 10000) took 0.011518 Seconds of elapsed time, including 0.0 seconds of paging time for 0 faults, Consed 0 words.\n```\n\nThis shows that the compiled version is over 300 times faster and uses less storage to boot.\nMost serious Common Lisp programmers work exclusively with compiled functions.\nHowever, it is usually a bad idea to worry too much about efficiency details while starting to develop a program.\nIt is better to design a flexible program, get it to work, and then modify the most frequently used parts to be more efficient.\nIn other words, separate the development stage from the fine-tuning stage.\n[Chapters 9](chapter9.md) and [10](chapter10.md) give more details on efficiency consideration, and [chapter 25](chapter25.md) gives more advice on debugging and antibugging techniques.\n\n## 3.15 Evaluation\n\nThere are three functions for doing evaluation in Lisp: `funcall, apply,` and `eval`.\n`funcall` is used to apply a function to individual arguments, while `apply` is used to apply a function to a list of arguments.\nActually, `apply` can be given one or more individual arguments before the final argument, which is always a list.\n`eval` is passed a single argument, which should be an entire form - a function or special form followed by its arguments, or perhaps an atom.\nThe following five forms are equivalent:\n\n```lisp\n> (+ 1 2 3 4)             => 10\n> (funcall #'+ 1 2 3 4)   => 10\n> (apply #'+ '(1 2 3 4))  => 10\n> (apply #'+ 1 2 '(3 4))  => 10\n> (eval '(+ 1 2 3 4))      => 10\n```\n\nIn the past, `eval` was seen as the key to Lisp's flexibility.\nIn modern Lisps with lexical scoping, such as Common Lisp, `eval` is used less often (in fact, in Scheme there is no `eval` at all).\nInstead, programmers are expected to use `lambda` to create a new function, and then `apply` or `funcall` the function.\nIn general, if you find yourself using `eval,` you are probably doing the wrong thing.\n\n## 3.16 Closures\n\nWhat does it mean to create a new function?\nCertainly every time a `function` (or `#')` special form is evaluated, a function is returned.\nBut in the examples we have seen and in the following one, it is always the *same* function that is returned.\n\n```lisp\n> (mapcar #'(lambda (x) (+ x x)) '(1 3 10)) => (2 6 20)\n```\n\nEvery time we evaluate the `#'(lambda ...)` form, it returns the function that doubles its argument.\nHowever, in the general case, a function consists of the body of the function coupled with any *free lexical variables* that the function references.\nSuch a pairing is called a *lexical closure,* or just a *closure,* because the lexical variables are enclosed within the function.\nConsider this example:\n\n```lisp\n(defun adder (c)\n  \"Return a function that adds c to its argument.\"\n  #'(lambda (x) (+ x c)))\n\n> (mapcar (adder 3) '(1 3 10)) => (4 6 13)\n\n> (mapcar (adder 10) '(1 3 10)) => (11 13 20)\n```\n\nEach time we call `adder` with a different value for `c`, it creates a different function, the function that adds `c` to its argument.\nSince each call to `adder` creates a new local variable named `c`, each function returned by `adder` is a unique function.\n\nHere is another example.\nThe function `bank-account` returns a closure that can be used as a representation of a bank account.\nThe closure captures the local variable balance.\nThe body of the closure provides code to access and modify the local variable.\n\n```lisp\n(defun bank-account (balance)\n  \"Open a bank account starting with the given balance.\"\n  #'(lambda (action amount)\n      (case action\n        (deposit  (setf balance (+ balance amount)))\n        (withdraw (setf balance (- balance amount))))))\n```\n\nIn the following, two calls to bank-account create two different closures, each with a separate value for the lexical variable `balance`.\nThe subsequent calls to the two closures change their respective balances, but there is no confusion between the two accounts.\n\n```lisp\n> (setf my-account (bank-account 500.00)) => #<CLOSURE 52330407>\n\n> (setf your-account (bank-account 250.00)) => #<CLOSURE 52331203>\n\n> (funcall my-account 'withdraw 75.00) => 425.0\n\n> (funcall your-account 'deposit 250.00) => 500.0\n\n> (funcall your-account 'withdraw 100.00) => 400.0\n\n> (funcall my-account 'withdraw 25.00) => 400.0\n```\n\nThis style of programming will be considered in more detail in [chapter 13](chapter13.md).\n\n## 3.17 Special Variables\n\nCommon Lisp provides for two kinds of variables: *lexical* and *special* variables.\nFor the beginner, it is tempting to equate the special variables in Common Lisp with global variables in other languages.\nUnfortunately, this is not quite correct and can lead to problems.\nIt is best to understand Common Lisp variables on their own terms.\n\nBy default, Common Lisp variables are *lexical variables.*\nLexical variables are introduced by some syntactic construct like `let` or `defun` and get their name from the fact that they may only be referred to by code that appears lexically within the body of the syntactic construct.\nThe body is called the *scope* of the variable.\n\nSo far, there is no difference between Common Lisp and other languages.\nThe interesting part is when we consider the *extent,* or lifetime, of a variable.\nIn other languages, the extent is the same as the scope: a new local variable is created when a block is entered, and the variable goes away when the block is exited.\nBut because it is possible to create new functions - closures - in Lisp, it is therefore possible for code that references a variable to live on after the scope of the variable has been exited.\nConsider again the `bank-account` function, which creates a closure representing a bank account:\n\n```lisp\n(defun bank-account (balance)\n  \"Open a bank account starting with the given balance.\"\n  #'(lambda (action amount)\n      (case action\n        (deposit (setf balance (+ balance amount)))\n        (withdraw (setf balance (- balance amount))))))\n```\n\nThe function introduces the lexical variable `balance`.\nThe scope of `balance` is the body of the function, and therefore references to `balance` can occur only within this scope.\nWhat happens when `bank-account` is called and exited?\nOnce the body of the function has been left, no other code can refer to that instance of `balance.`\nThe scope has been exited, but the extent of `balance` lives on.\nWe can call the closure, and it can reference `balance`, because the code that created the closure appeared lexically within the scope of `balance`.\n\nIn summary, Common Lisp lexical variables are different because they can be captured inside closures and referred to even after the flow of control has left their scope.\n\nNow we will consider special variables.\nA variable is made special by a `defvar` or `defparameter` form.\nFor example, if we say\n\n```lisp\n(defvar *counter* 0)\n```\n\nthen we can refer to the special variable `*counter*` anywhere in our program.\nThis is just like a familiar global variable.\nThe tricky part is that the global binding of `*counter*` can be shadowed by a local binding for that variable.\nIn most languages, the local binding would introduce a local lexical variable, but in Common Lisp, special variables can be bound both locally and globally.\nHere is an example:\n\n```lisp\n(defun report ()\n  (format t \"Counter = ~d\" *counter*))\n\n> (report)\nCounter = 0\nNIL\n\n> (let ((*counter* 100))\n    (report))\nCounter = 100\nNIL\n\n> (report)\nCounter = 0\nNIL\n```\n\nThere are three calls to `report` here.\nIn the first and third, `report` prints the global value of the special variable `*counter*`.\nIn the second call, the `let` form introduces a new binding for the special variable `*counter*`, which is again printed by `report.`\nOnce the scope of the `let` is exited, the new binding is disestablished, so the final call to `report` uses the global value again.\n\nIn summary, Common Lisp special variables are different because they have global scope but admit the possibility of local (dynamic) shadowing.\nRemember: A lexical variable has lexical scope and indefinite extent.\nA special variable has indefinite scope and dynamic extent.\n\nThe function call (`symbol-value` *var*), where *var* evaluates to a symbol, can be used to get at the current value of a special variable.\nTo set a special variable, the following two forms are completely equivalent:\n\n> `(setf (symbol-value` *var*) *value*) \\\n> `(set` *var value*)\n\nwhere both *var* and *value* are evaluated.\nThere are no corresponding forms for accessing and setting lexical variables.\nSpecial variables set up a mapping between symbols and values that is accessible to the running program.\nThis is unlike lexical variables (and all variables in traditional languages) where symbols (identifiers) have significance only while the program is being compiled.\nOnce the program is running, the identifiers have been compiled away and cannot be used to access the variables; only code that appears within the scope of a lexical variable can reference that variable.\n\n&#9635; **Exercise 3.6 [s]** Given the following initialization for the lexical variable `a` and the special variable `*b*`, what will be the value of the `let` form?\n\n```lisp\n(setf a 'global-a)\n(defvar *b* 'global-b)\n\n(defun fn () *b*)\n\n(let ((a 'local-a)\n      (*b* 'local-b))\n  (list a *b* (fn) (symbol-value 'a) (symbol-value '*b*)))\n```\n\n## 3.18 Multiple Values\n\nThroughout this book we have spoken of \"the value returned by a function.\"\nHistorically, Lisp was designed so that every function returns a value, even those functions that are more like procedures than like functions.\nBut sometimes we want a single function to return more than one piece of information.\nOf course, we can do that by making up a list or structure to hold the information, but then we have to go to the trouble of defining the structure, building an instance each time, and then taking that instance apart to look at the pieces.\nConsider the function `round`.\nOne way it can be used is to round off a floating-point number to the nearest integer.\nSo (`round 5.1`) is 5.\nSometimes, though not always, the programmer is also interested in the fractional part.\nThe function `round` serves both interested and disinterested programmers by returning two values: the rounded integer and the remaining fraction:\n\n```lisp\n> (round 5.1) => 5 .1\n```\n\nThere are two values after the => because `round` returns two values.\nMost of the time, multiple values are ignored, and only the first value is used.\nSo (`* 2 (round 5.1)`) is 10, just as if `round` had only returned a single value.\nIf you want to get at multiple values, you have to use a special form, such as `multiple-value-bind`:\n\n```lisp\n(defun show-both (x)\n  (multiple-value-bind (int rem)\n      (round x)\n    (format t \"~f = ~d + ~f\" x int rem)))\n\n> (show-both 5.1)\n5.1 = 5 + 0.1\n```\n\nYou can write functions of your own that return multiple values using the function `values`, which returns its arguments as multiple values:\n\n```lisp\n> (values 1 2 3) => 1 2 3\n```\n\nMultiple values are a good solution because they are unobtrusive until they are needed.\nMost of the time when we are using `round,` we are only interested in the integer value.\nIf `round` did not use multiple values, if it packaged the two values up into a list or structure, then it would be harder to use in the normal cases.\n\nIt is also possible to return no values from a function with (`values`).\nThis is sometimes used by procedures that are called for effect, such as printing.\nFor example, `describe` is defined to print information and then return no values:\n\n```\n> (describe 'x)\nSymbol X is in the USER package.\nIt has no value, definition or properties.\n```\n\nHowever, when (`values`) or any other expression returning no values is nested in a context where a value is expected, it still obeys the Lisp rule of one-value-per-expression and returns `nil`.\nIn the following example, `describe` returns no values, but then `list` in effect asks for the first value and gets `nil`.\n\n```\n> (list (describe 'x))\nSymbol X is in AILP package.\nIt has no value, definition or properties.\n(NIL)\n```\n\n## 3.19 More about Parameters\n\nCommon Lisp provides the user with a lot of flexibility in specifying the parameters to a function, and hence the arguments that the function accepts.\nFollowing is a program that gives practice in arithmetic.\nIt asks the user a series of *n* problems, where each problem tests the arithmetic operator op (which can be `+`, `-`, `*`, or `/`, or perhaps another binary operator).\nThe arguments to the operator will be random integers from 0 to range.\nHere is the program:\n\n```lisp\n(defun math-quiz (op range n)\n  \"Ask the user a series of math problems.\"\n  (dotimes (i n)\n    (problem (random range) op (random range))))\n\n(defun problem (x op y)\n  \"Ask a math problem, read a reply, and say if it is correct.\"\n  (format t \"~&How much is ~d ~a ~d?\" x op y)\n  (if (eql (read) (funcall op x y))\n      (princ \"Correct!\")\n      (princ \"Sorry, that's not right.\")))\n```\n\nand here is an example of its use:\n\n```lisp\n> (math-quiz '+ 100 2)\nHow much is 32 + 60? 92\nCorrect!\nHow much is 91 + 19? 100\nSorry, that's not right.\n```\n\nOne problem with the function `math-quiz` is that it requires the user to type three arguments: the operator, a range, and the number of iterations.\nThe user must remember the order of the arguments, and remember to quote the operator.\nThis is quite a lot to expect from a user who presumably is just learning to add!\n\nCommon Lisp provides two ways of dealing with this problem.\nFirst, a programmer can specify that certain arguments are *optional* and provide default values for those arguments.\nFor example, in `math-quiz` we can arrange to make `+` be the default operator, `100` be the default number range, and `10` be the default number of examples with the following definition:\n\n```lisp\n(defun math-quiz (&optional (op '+) (range 100) (n 10))\n  \"Ask the user a series of math problems.\"\n  (dotimes (i n)\n    (problem (random range) op (random range))))\n```\n\nNow (`math-quiz`) means the same as (`math-quiz '+ 100 10`).\nIf an optional parameter appears alone without a default value, then the default is `nil`.\nOptional parameters are handy; however, what if the user is happy with the operator and range but wants to change the number of iterations?\nOptional parameters are still position-dependent, so the only solution is to type in all three arguments: (`math-quiz '+ 100 5`).\n\nCommon Lisp also allows for parameters that are position-independent.\nThese *keyword* parameters are explicitly named in the function call.\nThey are useful when there are a number of parameters that normally take default values but occasionally need specific values.\nFor example, we could have defined `math-quiz` as:\n\n```lisp\n(defun math-quiz (&key (op '+) (range 100) (n 10))\n  \"Ask the user a series of math problems.\"\n  (dotimes (i n)\n    (problem (random range) op (random range))))\n```\n\nNow (`math-quiz :n 5`) and (`math-quiz :op '+ :n 5 :range 100`) mean the same.\nKeyword arguments are specified by the parameter name preceded by a colon, and followed by the value.\nThe keyword/value pairs can come in any order.\n\nA symbol starting with a colon is called a *keyword*, and can be used anywhere, not just in argument lists.\nThe term *keyword* is used differently in Lisp than in many other languages.\nFor example, in Pascal, keywords (or *reserved* words) are syntactic symbols, like `if, else, begin`, and `end`.\nIn Lisp we call such symbols *special form operators* or just *special forms.*\n<a id=\"tfn03-3\"></a>\nLisp keywords are symbols that happen to reside in the keyword package.<sup>[3](#fn03-3)</sup>\nThey have no special syntactic meaning, although they do have the unusual property of being self-evaluating: they are constants that evaluate to themselves, unlike other symbols, which evaluate to whatever value was stored in the variable named by the symbol.\nKeywords also happen to be used in specifying `&key` argument lists, but that is by virtue of their value, not by virtue of some syntax rule.\nIt is important to remember that keywords are used in the function call, but normal nonkeyword symbols are used as parameters in the function definition.\n\nJust to make things a little more confusing, the symbols `&optional, &rest,` and `&key` are called *lambda-list keywords*, for historical reasons.\nUnlike the colon in real keywords, the `&` in lambda-list keywords has no special significance.\nConsider these annotated examples:\n\n```lisp\n> :xyz => :XYZ                            ; keywords are self-evaluating\n\n> &optional =>                            ; lambda-list keywords are normal symbols\nError: the symbol &optional has no value\n\n> '&optional => &OPTIONAL\n\n> (defun f (&xyz) (+ &xyz &xyz)) => F     ;& has no significance\n\n> (f 3) => 6\n\n> (defun f (:xyz) (+ :xyz :xyz)) =>\nError: the keyword :xyz appears in a variable list.\nKeywords are constants, and so cannot be used as names of variables.\n\n> (defun g (&key x y) (list x y)) => G\n\n> (let ((keys '(:x :y :z)))              ; keyword args can be computed\n   (g (second keys) 1 (first keys) 2)) => (2 1)\n```\n\nMany of the functions presented in this chapter take keyword arguments that make them more versatile.\nFor example, remember the function `find`, which can be used to look for a particular element in a sequence:\n\n```lisp\n> (find 3 '(1 2 3 4 -5 6.0)) => 3\n```\nIt turns out that `find` takes several optional keyword arguments.\nFor example, suppose we tried to find `6` in this sequence:\n\n```lisp\n> (find 6 '(1 2 3 4 -5 6.0)) => nil\n```\n\nThis fails because `find` tests for equality with `eql`, and `6` is not `eql` to `6.0`.\nHowever, `6` is `equalp` to 6.0, so we could use the `:test` keyword:\n\n```lisp\n> (find 6 '(1 2 3 4 -5 6.0) :test #'equalp) => 6.0\n```\n\nIn fact, we can specify any binary predicate for the `:test` keyword; it doesn't have to be an equality predicate.\nFor example, we could find the first number that `4` is less than:\n\n```lisp\n> (find 4 '(1 2 3 4 -5 6.0) :test #'<) => 6.0\n```\n\nNow suppose we don't care about the sign of the numbers; if we look for `5`, we want to find the `-5`.\nWe can handle this with the key keyword to take the absolute value of each element of the list with the `abs` function:\n\n```lisp\n> (find 5 '(1 2 3 4 -5 6.0) :key #'abs) => -5\n```\n\nKeyword parameters significantly extend the usefulness of built-in functions, and they can do the same for functions you define.\nAmong the built-in functions, the most common keywords fall into two main groups: `:test`, `:test-not` and `:key,` which are used for matching functions, and `:start`, `:end,` and `:from-end,` which are used on sequence functions.\nSome functions accept both sets of keywords.\n(*Common Lisp the Language*, 2d edition, discourages the use of `:test-not` keywords, although they are still a part of the language.)\n\nThe matching functions include `sublis`, `position`, `subst`, `union`, `intersection`, `set-difference`, `remove`, `remove-if`, `subsetp`, `assoc`, `find,` and `member.`\nBy default, each tests if some item is `eql` to one or more of a series of other objects.\nThis test can be changed by supplying some other predicate as the argument to `:test`, or it can be reversed by specifying `:test-not.`\nIn addition, the comparison can be made against some part of the object rather than the whole object by specifying a selector function as the `:key` argument.\n\nThe sequence functions include `remove`, `remove-if`, `position,` and `find`.\nThe most common type of sequence is the list, but strings and vectors can also be used as sequences.\nA sequence function performs some action repeatedly for some elements of a sequence.\nThe default is to go through the sequence from beginning to end, but the reverse order can be specified with `:from-end t` and a subsequence can be specifed by supplying a number for the `:start` or `:end` keyword.\nThe first element of a sequence is numbered 0, not 1, so be careful.\n\nAs an example of keyword parameters, suppose we wanted to write sequence functions that are similar to `find` and `find-if`, except that they return a list of all matching elements rather than just the first matching element.\nWe will call the new functions `find-all` and `find-all-if`.\nAnother way to look at these functions is as variations of remove.\nInstead of removing items that match, they keep all the items that match, and remove the ones that don't.\nViewed this way, we can see that the function `find-all-if` is actually the same function as `remove-if-not`.\nIt is sometimes useful to have two names for the same function viewed in different ways (like `not` and `null`).\nThe new name could be defined with a `defun`, but it is easier to just copy over the definition:\n\n```lisp\n(setf (symbol-function 'find-all-if) #'remove-if-not)\n```\n\nUnfortunately, there is no built-in function that corresponds exactly to `find-all`, so we will have to define it.\nFortunately, `remove` can do most of the work.\nAll we have to do is arrange to pass remove the complement of the `:test` predicate.\nFor example, finding all elements that are equal to 1 in a list is equivalent to removing elements that are not equal to 1:\n\n```lisp\n> (setf nums '(1 2 3 2 1)) => (1 2 3 2 1)\n\n> (find-all 1 nums :test #'=) ≡ (remove 1 nums :test #'/=) => (1 1)\n```\n\nNow what we need is a higher-order function that returns the complement of a function.\nIn other words, given `=`, we want to return `/=`.\nThis function is called `complement` in ANSI Common Lisp, but it was not defined in earlier versions, so it is given here:\n\n```lisp\n(defun complement (fn)\n  \"If FN returns y, then (complement FN) returns (not y).\"\n  ;; This function is built-in in ANSI Common Lisp,\n  ;; but is defined here for those with non-ANSI compilers.\n  #'(lambda (&rest args) (not (apply fn args))))\n```\n\nWhen `find-all` is called with a given `:test` predicate, all we have to do is call `remove` with the complement as the `:test` predicate.\nThis is true even when the `:test` function is not specified, and therefore defaults to `eql`.\nWe should also test for when the user specifies the `:test-not` predicate, which is used to specify that the match succeeds when the predicate is false.\nIt is an error to specify both a `:test` and `:test-not` argument to the same call, so we need not test for that case.\nThe definition is:\n\n```lisp\n(defun find-all (item sequence &rest keyword-args\n                 &key (test #'eql) test-not &allow-other-keys)\n  \"Find all those elements of sequence that match item,\n  according to the keywords.  Doesn't alter sequence.\"\n  (if test-not\n      (apply #'remove item sequence\n             :test-not (complement test-not) keyword-args)\n      (apply #'remove item sequence\n             :test (complement test) keyword-args)))\n```\n\nThe only hard part about this definition is understanding the parameter list.\nThe `&rest` accumulates all the keyword/value pairs in the variable `keyword-args`.\nIn addition to the `&rest` parameter, two specific keyword parameters, `:test` and `:test-not`, are specified.\nAny time you put a `&key` in a parameter list, you need an `&allow-other-keys` if, in fact, other keywords are allowed.\nIn this case we want to accept keywords like `:start` and `:key` and pass them on to `remove`.\n\nAll the keyword/value pairs will be accumulated in the list `keyword-args`, including the `:test` or `:test-not` values.\nSo we will have:\n\n```lisp\n(find-all 1 nums :test #'= :key #'abs)\n  = (remove 1 nums :test (complement #'=) :test #'= :key #'abs)\n  => (1 1)\n```\n\nNote that the call to `remove` will contain two `:test` keywords.\nThis is not an error; Common Lisp declares that the leftmost value is the one that counts.\n\n&#9635; **Exercise 3.7 [s]** Why do you think the leftmost of two keys is the one that counts, rather than the rightmost?\n\n&#9635; **Exercise 3.8 [m]** Some versions of Kyoto Common Lisp (KCL) have a bug wherein they use the rightmost value when more than one keyword/value pair is specified for the same keyword.\nChange the definition of `find-all` so that it works in KCL.\n\nThere are two more lambda-list keywords that are sometimes used by advanced programmers.\nFirst, within a macro definition (but not a function definition), the symbol `&body` can be used as a synonym for `&rest`.\nThe difference is that `&body` instructs certain formatting programs to indent the rest as a body.\nThus, if we defined the macro:\n\n```lisp\n(defmacro while2 (test &body body)\n  \"Repeat body while test is true.\"\n  `(loop (if (not ,test) (return nil))\n         . ,body))\n```\n\nThen the automatic indentation of `while2` (on certain systems) is prettier than `while`:\n\n```lisp\n(while (< i 10)\n       (print (* i i))\n       (setf i (+ i 1)))\n\n(while2 (< i 10)\n  (print (* i i))\n  (setf i (+ i 1)))\n```\n\nFinally, an `&aux` can be used to bind a new local variable or variables, as if bound with `let*`.\nPersonally, I consider this an abomination, because `&aux` variables are not parameters at all and thus have no place in a parameter list.\nI think they should be clearly distinguished as local variables with a `let`.\nBut some good programmers do use `&aux`, presumably to save space on the page or screen.\nAgainst my better judgement, I show an example:\n\n```lisp\n(defun length14 (list &aux (len 0))\n  (dolist (element list len)\n    (incf len)))\n```\n\n## 3.20 The Rest of Lisp\n\nThere is a lot more to Common Lisp than what we have seen here, but this overview should be enough for the reader to comprehend the programs in the chapters to come.\nThe serious Lisp programmer will further his or her education by continuing to consult reference books and online documentation.\nYou may also find part V of this book to be helpful, particularly [chapter 24](chapter24.md), which covers advanced features of Common Lisp (such as packages and error handling) and [chapter 25](chapter25.md), which is a collection of troubleshooting hints for the perplexed Lisper.\n\nWhile it may be distracting for the beginner to be continually looking at some reference source, the alternative - to explain every new function in complete detail as it is introduced - would be even more distracting.\nIt would interrupt the description of the AI programs, which is what this book is all about.\n\n## 3.21 Exercises\n\n&#9635; **Exercise 3.9 [m]** Write a version of `length` using the function `reduce`.\n\n&#9635; **Exercise 3.10 [m]** Use a reference manual or `describe` to figure out what the functions `lcm` and `nreconc` do.\n\n&#9635; **Exercise 3.11** [m] There is a built-in Common Lisp function that, given a key, a value, and an association list, returns a new association list that is extended to include the key/value pair.\nWhat is the name of this function?\n\n&#9635; **Exercise 3.12 [m]** Write a single expression using format that will take a list of words and print them as a sentence, with the first word capitalized and a period after the last word.\nYou will have to consult a reference to learn new `format` directives.\n\n## 3.22 Answers\n\n**Answer 3.2** `(cons` *a b*) = (`list*` *a b*)\n\n**Answer 3.3**\n\n```lisp\n(defun dprint (x)\n  \"Print an expression in dotted pair notation.\"\n  (cond ((atom x) (princ x))\n        (t (princ \"(\")\n           (dprint (first x))\n           (pr-rest (rest x))\n           (princ \")\")\n           x)))\n\n(defun pr-rest (x)\n  (princ \" . \")\n  (dprint x))\n```\n\n**Answer 3.4** Use the same `dprint` function defined in the last exercise, but change `pr-rest`.\n\n```lisp\n(defun pr-rest (x)\n  (cond ((null x))\n        ((atom x) (princ \" . \") (princ x))\n        (t (princ \" \") (dprint (first x)) (pr-rest (rest x)))))\n```\n\n**Answer 3.5** We will keep a data base called `*db*`.\nThe data base is organized into a tree structure of nodes.\nEach node has three fields: the name of the object it represents, a node to go to if the answer is yes, and a node for when the answer is no.\nWe traverse the nodes until we either get an \"it\" reply or have to give up.\nIn the latter case, we destructively modify the data base to contain the new information.\n\n```lisp\n(defstruct node\n  name\n  (yes nil)\n  (no nil))\n\n(defvar *db*\n  (make-node :name 'animal\n             :yes (make-node :name 'mammal)\n             :no (make-node\n                   :name 'vegetable\n                   :no (make-node :name 'mineral))))\n\n\n(defun questions (&optional (node *db*))\n  (format t \"~&Is it a ~a? \" (node-name node))\n  (case (read)\n    ((y yes) (if (not (null (node-yes node)))\n                 (questions (node-yes node))\n                 (setf (node-yes node) (give-up))))\n    ((n no)  (if (not (null (node-no node)))\n                 (questions (node-no node))\n                 (setf (node-no node) (give-up))))\n    (it 'aha!)\n    (t (format t \"Reply with YES, NO, or IT if I have guessed it.\")\n       (questions node))))\n\n(defun give-up ()\n  (format t \"~&I give up - what is it? \")\n  (make-node :name (read)))\n```\n\nHere it is used:\n\n```lisp\n> (questions)\nIs it a ANIMAL? yes\nIs it a MAMMAL? yes\nI give up - what is it? bear\n#S(NODE :NAME BEAR)\n\n> (questions)\nIs it a ANIMAL? yes\nIs it a MAMMAL? no\nI give up - what is it? penguin\n#S(NODE :NAME PENGUIN)\n\n> (questions)\nIs it a ANIMAL? yes\nIs it a MAMMAL? yes\nIs it a BEAR? it\nAHA!\n```\n\n**Answer 3.6** The value is (`LOCAL-A LOCAL-B LOCAL-B GLOBAL-A LOCAL-B`).\n\nThe `let` form binds `a` lexically and `*b*` dynamically, so the references to `a` and `*b*` (including the reference to `*b*` within `fn`) all get the local values.\nThe function `symbol-value` always treats its argument as a special variable, so it ignores the lexical binding for a and returns the global binding instead.\nHowever, the `symbol-value` of `*b*` is the local dynamic value.\n\n**Answer 3.7** There are two good reasons: First, it makes it faster to search through the argument list: just search until you find the key, not all the way to the end.\nSecond, in the case where you want to override an existing keyword and pass the argument list on to another function, it is cheaper to `cons` the new keyword/value pair on the front of a list than to append it to the end of a list.\n\n**Answer 3.9**\n\n```lisp\n(defun length-r (list)\n  (reduce #'+ (mapcar #'(lambda (x) 1) list)))\n```\n\nor more efficiently:\n\n```lisp\n(defun length-r (list)\n  (reduce #'(lambda (x y) (+ x 1)) list\n          :initial-value 0))\n```\n\nor, with an ANSI-compliant Common Lisp, you can specify a `:` key\n\n```lisp\n(defun length-r (list)\n  (reduce #'+ list :key #'(lambda (x) 1)))\n```\n\n**Answer 3.12** `(format t \"~@(~{~a~^ ~}.~)\" '(this is a test))`\n\n----------------------\n\n<a id=\"fn03-1\"></a><sup>[1](#tfn03-1)</sup>\nAssociation lists are covered in section 3.6.\n\n<a id=\"fn03-2\"></a><sup>[2](#tfn03-2)</sup>\nIn mathematics, a function must associate a unique output value with each input value.\n\n<a id=\"fn03-3\"></a><sup>[3](#tfn03-3)</sup>\nA *package* is a symbol table: a mapping between strings and the symbols they name.\n"
  },
  {
    "path": "docs/chapter4.md",
    "content": "# Chapter 4\n## GPS: The General Problem Solver\n\n> *There are now in the world machines that think.*\n\n> -Herbert Simon\n\n> Nobel Prize-winning AI researcher\n\nThe General Problem Solver, developed in 1957 by Alan Newell and Herbert Simon, embodied a grandiose vision: a single computer program that could solve *any* problem, given a suitable description of the problem.\nGPS caused quite a stir when it was introduced, and some people in AI felt it would sweep in a grand new era of intelligent machines.\nSimon went so far as to make this statement about his creation:\n\n> *It is not my aim to surprise or shock you.... But the simplest way I can summarize is to say that there are now in the world machines that think, that learn and create.\nMoreover, their ability to do these things is going to increase rapidly until-in a visible future-the range of problems they can handle will be coextensive with the range to which the human mind has been applied.*\n\nAlthough GPS never lived up to these exaggerated claims, it was still an important program for historical reasons.\nIt was the first program to separate its problem solving strategy from its knowledge of particular problems, and it spurred much further research in problem solving.\nFor all these reasons, it is a fitting object of study.\n\nThe original GPS program had a number of minor features that made it quite complex.\nIn addition, it was written in an obsolete low-level language, IPL, that added gratuitous complexity.\nIn fact, the confusing nature of IPL was probably an important reason for the grand claims about GPS.\nIf the program was that complicated, it *must* do something important.\nWe will be ignoring some of the subtleties of the original program, and we will use Common Lisp, a much more perspicuous language than IPL.\nThe result will be a version of GPS that is quite simple, yet illustrates some important points about AI.\n\nOn one level, this chapter is about GPS.\nBut on another level, it is about the process of developing an AI computer program.\nWe distinguish five stages in the development of a program.\nFirst is the problem description, which is a rough idea-usually written in English prose-of what we want to do.\nSecond is the program specification, where we redescribe the problem in terms that are closer to a computable procedure.\nThe third stage is the implementation of the program in a programming language such as Common Lisp, the fourth is testing, and the fifth is debugging and analysis.\nThe boundaries between these stages are fluid, and the stages need not be completed in the order stated.\nProblems at any stage can lead to a change in the previous stage, or even to complete redesign or abandonment of the project.\nA programmer may prefer to complete only a partial description or specification, proceed directly to implementation and testing, and then return to complete the specification based on a better understanding.\n\nWe follow all five stages in the development of our versions of GPS, with the hope that the reader will understand GPS better and will also come to understand better how to write a program of his or her own.\nTo summarize, the five stages of an AI programming project are:\n\n1.  **Describe** the problem in vague terms\n\n2.  **Specify** the problem in algorithmic terms\n\n3.  **Implement** the problem in a programming language\n\n4.  **Test** the program on representative examples\n\n5.  **Debug** and **analyze** the resulting program, and repeat the process\n\n\n## 4.1 Stage 1: Description\n\nAs our problem description, we will start with a quote from Newell and Simon's 1972 book, *Human Problem Solving:*\n\n> *The main methods of GPS jointly embody the heuristic of means-ends analysis.\nMeans-ends analysis is typified by the following kind of common-sense argument:*\n\n*I want to take my son to nursery school.\nWhat's the difference between what I have and what I want?\nOne of distance.\nWhat changes distance?\nMy automobile.\nMy automobile won't work.\nWhat is needed to make it work?\nA new battery.\nWhat has new batteries?\nAn auto repair shop.\nI want the repair shop to put in a new battery; but the shop doesn't know I need one.\nWhat is the difficulty?\nOne of communication.\nWhat allows communication?\nA telephone... and so on.*\n\n> *The kind of analysis-classifying things in terms of the functions they serve and oscillating among ends, functions required, and means that perform them-forms the basic system of heuristic of GPS.*\n\nOf course, this kind of analysis is not exactly new.\nThe theory of means-ends analysis was laid down quite elegantly by Aristotle 2300 years earlier in the chapter entitled \"The nature of deliberation and its objects\" of the *Nicomachean Ethics* (Book III.\n3,1112b):\n\n> *We deliberate not about ends, but about means.\nFor a doctor does not deliberate whether he shall heal, nor an orator whether he shall persuade, nor a statesman whether he shall produce law and order, nor does anyone else deliberate about his end.\nThey assume the end and consider how and by what means it is attained; and if it seems to be produced by several means they consider by which it is most easily and best produced, while if it is achieved by one only they consider how it will be achieved by this and by what means this will be achieved, till they come to the first cause, which in the order of discovery is last... and what is last in the order of analysis seems to be first in the order of becoming.\nAnd if we come on an impossibility, we give up the search, e.g., if we need money and this cannot be got; but if a thing appears possible we try to do it.*\n\nGiven this description of a theory of problem solving, how should we go about writing a program?\nFirst, we try to understand more fully the procedure outlined in the quotes.\nThe main idea is to solve a problem using a process called means-ends analysis, where the problem is stated in terms of what we want to happen.\nIn Newell and Simon's example, the problem is to get the kid to school, but in general we would like the program to be able to solve a broad class of problems.\nWe can solve a problem if we can find some way to eliminate \"the difference between what I have and what I want.\" For example, if what I have is a child at home, and what I want is a child at school, then driving may be a solution, because we know that driving leads to a change in location.\nWe should be aware that using means-ends analysis is a choice: it is also possible to start from the current situation and search forward to the goal, or to employ a mixture of different search strategies.\n\nSome actions require the solving of *preconditions* as subproblems.\nBefore we can drive the car, we need to solve the subproblem of getting the car in working condition.\nIt may be that the car is already working, in which case we need do nothing to solve the subproblem.\nSo a problem is solved either by taking appropriate action directly, or by first solving for the preconditions of an appropriate action and then taking the action.\nIt is clear we will need some description of allowable actions, along with their preconditions and effects.\nWe will also need to develop a definition of appropriateness.\nHowever, if we can define these notions better, it seems we won't need any new notions.\nThus, we will arbitrarily decide that the problem description is complete, and move on to the problem specification.\n\n## 4.2 Stage 2: Specification\n\nAt this point we have an idea-admittedly vague-of what it means to solve a problem in `GPS`. We can refine these notions into representations that are closer to Lisp as follows:\n\n*   We can represent the current state of the world-\"what I have\"-or the goal state-\"what I want\"-as sets of conditions.\nCommon Lisp doesn't have a data type for sets, but it does have lists, which can be used to implement sets.\nEach condition can be represented by a symbol.\nThus, a typical goal might be the list of two conditions (`rich famous`), and a typical current state might be (`unknown poor`).\n\n*   We need a list of allowable operators.\nThis list will be constant over the course of a problem, or even a series of problems, but we want to be able to change it and tackle a new problem domain.\n\n*   An operator can be represented as a structure composed of an action, a list of preconditions, and a list of effects.\nWe can place limits on the kinds of possible effects by saying that an effect either adds or deletes a condition from the current state.\nThus, the list of effects can be split into an add-list and a delete-list.\nThis was the approach taken by the Strips<a id=\"tfn04-1\"></a><sup>[1](#fn04-1)</sup>\nimplementation of GPS, which we will be in effect reconstructing in this chapter.\nThe original GPS allowed more flexibility in the specification of effects, but flexibility leads to inefficiency.\n\n*   A complete problem is described to GPS in terms of a starting state, a goal state, and a set of known operators.\nThus, GPS will be a function of three arguments.\nFor example, a sample call might be:\n```lisp\n(GPS '(unknown poor) '(rich famous) list-of-ops)\n```\nIn other words, starting from the state of being poor and unknown, achieve the state of being rich and famous, using any combination of the known operators.\nGPS should return a true value only if it solves the problem, and it should print a record of the actions taken.\nThe simplest approach is to go through the conditions in the goal state one at a time and try to achieve each one.\nIf they can all be achieved, then the problem is solved.\n\n*   A single goal condition can be achieved in two ways.\nIf it is already in the current state, the goal is trivially achieved with no effort.\nOtherwise, we have to find some appropriate operator and try to apply it.\n\n*   An operator is appropriate if one of the effects of the operator is to add the goal in question to the current state; in other words, if the goal is in the operator's add-list.\n\n*   We can apply an operator if we can achieve all the preconditions.\nBut this is easy, because we just defined the notion of achieving a goal in the previous paragraph.\nOnce the preconditions have been achieved, applying an operator means executing the action and updating the current state in term of the operator's add-list and delete-list.\nSince our program is just a simulation-it won't be actually driving a car or dialling a telephone-we must be content simply to print out the action, rather than taking any real action.\n\n## 4.3 Stage 3: Implementation\n\nThe specification is complete enough to lead directly to a complete Common Lisp program.\n[Figure 4.1](#f0010) summarizes the variables, data types, and functions that make up the GPS program, along with some of the Common Lisp functions used to implement it.\n\n| Symbol             | Use                                                   |\n| ------             | ---                                                   |\n|                    | **Top-Level Function**                                |\n| `GPS`              | Solve a goal from a state using a list of operators.  |\n|                    | **Special Variables**                                 |\n| `*state*`          | The current state, a list of conditions.              |\n| `*ops*`            | A list of available operators.                        |\n|                    | **Data Types**                                        |\n| `op`               | An operation with preconds, add-list and del-list.    |\n|                    | **Functions**                                         |\n| `achieve`          | Achieve an individual goal.                           |\n| `appropriate-p`    | Decide if an operator is appropriate for a goal.      |\n| `apply-op`         | Apply operator to current state.                      |\n|                    | **Selected Common Lisp Functions**                    |\n| `member`           | Test if an element is a member of a list. (p.78)       |\n| `set-difference`   | All elements in one set but not the other.            |\n| `union`            | All elements in either of the two sets.               |\n| `every`            | Test if every element of a list passes a test. (p. 62)|\n| `some`             | Test if any element of a list passes a test.          |\n|                    | **Previously Defined Functions**                      |\n| `find-all`         | A list of all matching elements. (p. 101)             |\n\nHere is the complete GPS program itself:\n\n```lisp\n(defvar *state* nil \"The current state: a list of conditions.\")\n\n(defvar *ops* nil \"A list of available operators.\")\n\n(defstruct op \"An operation\"\n  (action nil) (preconds nil) (add-list nil) (del-list nil))\n\n(defun GPS (*state* goals *ops*)\n  \"General Problem Solver: achieve all goals using *ops*.\"\n  (if (every #'achieve goals) 'solved))\n\n(defun achieve (goal)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (or (member goal *state*)\n    (some #'apply-op\n      (find-all goal *ops* :test #'appropriate-p))))\n\n(defun appropriate-p (goal op)\n  \"An op is appropriate to a goal if it is in its add list.\"\n  (member goal (op-add-list op)))\n\n(defun apply-op (op)\n  \"Print a message and update *state* if op is applicable.\"\n  (when (every #'achieve (op-preconds op))\n    (print (list 'executing (op-action op)))\n    (setf *state* (set-difference *state* (op-del-list op)))\n    (setf *state* (union *state* (op-add-list op)))\n  t))\n```\nWe can see the program is made up of seven definitions.\nThese correspond to the seven items in the specification above.\nIn general, you shouldn't expect such a perfect fit between specification and implementation.\nThere are two `defvar` forms, one `defstruct`, and four `defun` forms.\nThese are the Common Lisp forms for defining variables, structures, and functions, respectively.\nThey are the most common top-level forms in Lisp, but there is nothing magic about them; they are just special forms that have the side effect of adding new definitions to the Lisp environment.\n\nThe two `defvar` forms, repeated below, declare special variables named `*state*` and `*ops*,` which can then be accessed from anywhere in the program.\n\n```lisp\n(defvar *state* nil \"The current state: a list of conditions.\")\n(defvar *ops* nil \"A list of available operators.\")\n```\nThe `defstruct` form defines a structure called an `op`, which has slots called `action`, `preconds`, `add-list`, and `del-list`.\nStructures in Common Lisp are similar to structures in C, or records in Pascal.\nThe `defstruct` automatically defines a constructor function, which is called `make-op`, and an access function for each slot of the structure.\nThe access functions are called `op-action`, `op-preconds`, `op-add-list`, and `op-del-list`.\nThe `defstruct` also defines a copier function, `copy-op`, a predicate, `op-p`, and `setf` definitions for changing each slot.\nNone of those are used in the GPS program.\nRoughly speaking, it is as if the `defstruct` form\n\n```lisp\n(defstruct op \"An operation\"\n  (action nil) (preconds nil) (add-list nil) (del-list nil))\n```\nexpanded into the following definitions:\n\n```lisp\n(defun make-op (&key action preconds add-list del-list)\n  (vector 'op action preconds add-list del-list))\n\n(defun op-action (op) (elt op 1))\n\n(defun op-preconds (op) (elt op 2))\n\n(defun op-add-list (op) (elt op 3))\n\n(defun op-del-list (op) (elt op 4))\n\n(defun copy-op (op) (copy-seq op))\n\n(defun op-p (op)\n  (and (vectorp op) (eq (elt op 0) 'op)))\n\n(setf (documentation 'op 'structure) \"An operation\")\n```\nNext in the GPS program are four function definitions.\nThe main function, `GPS`, is passed three arguments.\nThe first is the current state of the world, the second the goal state, and the third a list of allowable operators.\nThe body of the function says simply that if we can achieve every one of the goals we have been given, then the problem is solved.\nThe unstated alternative is that otherwise, the problem is not solved.\n\nThe function `achieve` is given as an argument a single goal.\nThe function succeeds if that goal is already true in the current state (in which case we don't have to do anything) or if we can apply an appropriate operator.\nThis is accomplished by first building the list of appropriate operators and then testing each in turn until one can be applied.\n`achieve` calls `find-all`, which we defined on [page 101](chapter3.md#p101).\nIn this use, `find-all` returns a list of operators that match the current goal, according to the predicate `appropriate-p`.\n\nThe function `appropriate-p` tests if an operator is appropriate for achieving a goal.\n(It follows the Lisp naming convention that predicates end in `-p`.)\n\nFinally, the function `apply-op` says that if we can achieve all the preconditions for an appropriate operator, then we can apply the operator.\nThis involves printing a message to that effect and changing the state of the world by deleting what was in the delete-list and adding what was in the add-list.\n`apply-op` is also a predicate; it returns `t` only when the operator can be applied.\n\n## 4.4 Stage 4: Test\n\nThis section will define a list of operators applicable to the \"driving to nursery school\" domain and will show how to pose and solve some problems in that domain.\nFirst, we need to construct the list of operators for the domain.\nThe `defstruct` form for the type `op` automatically defines the function `make-op`, which can be used as follows:\n\n```lisp\n(make-op :action 'drive-son-to-school\n    :preconds '(son-at-home car-works)\n    :add-list '(son-at-school)\n    :del-list '(son-at-home))\n```\nThis expression returns an operator whose action is the symbol `drive-son-to-school` and whose preconditions, add-list and delete-list are the specified lists.\nThe intent of this operator is that whenever the son is at home and the car works, `drive-son-to-school` can be applied, changing the state by deleting the fact that the son is at home, and adding the fact that he is at school.\n\nIt should be noted that using long hyphenated atoms like `son-at-home` is a useful approach only for very simple examples like this one.\nA better representation would break the atom into its components: perhaps (`at son home`).\nThe problem with the atom-based approach is one of combinatorics.\nIf there are 10 predicates (such as `at`) and 10 people or objects, then there will be 10 x 10 x 10 = 1000 possible hyphenated atoms, but only 20 components.\nClearly, it would be easier to describe the components.\nIn this chapter we stick with the hyphenated atoms because it is simpler, and we do not need to describe the whole world.\nSubsequent chapters take knowledge representation more seriously.\n\nWith this operator as a model, we can define other operators corresponding to Newell and Simon's quote on [page 109](chapter4.md#p109).\nThere will be an operator for installing a battery, telling the repair shop the problem, and telephoning the shop.\nWe can fill in the \"and so on\" by adding operators for looking up the shop's phone number and for giving the shop money:\n\n```lisp\n(defparameter *school-ops*\n  (list\n    (make-op :action 'drive-son-to-school\n      :preconds '(son-at-home car-works)\n      :add-list '(son-at-school)\n      :del-list '(son-at-home))\n    (make-op :action 'shop-installs-battery\n      :preconds '(car-needs-battery shop-knows-problem shop-has-money)\n      :add-list '(car-works))\n    (make-op :action 'tell-shop-problem\n      :preconds '(in-communication-with-shop)\n      :add-list '(shop-knows-problem))\n    (make-op :action 'telephone-shop\n      :preconds '(know-phone-number)\n      :add-list '(in-communication-with-shop))\n    (make-op :action 'look-up-number\n      :preconds '(have-phone-book)\n      :add-list '(know-phone-number))\n    (make-op :action 'give-shop-money\n      :preconds '(have-money)\n      :add-list '(shop-has-money)\n      :del-list '(have-money))))\n```\nThe next step is to pose some problems to GPS and examine the solutions.\nFollowing are three sample problems.\nIn each case, the goal is the same: to achieve the single condition `son-at-school`.\nThe list of available operators is also the same in each problem; the difference is in the initial state.\nEach of the three examples consists of the prompt, \">\", which is printed by the Lisp system, followed by a call to GPS, \" ( `gps`... )\", which is typed by the user, then the output from the program, \"(`EXECUTING`...)\", and finally the result of the function call, which can be either `SOLVED` or `NIL`.\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n    '(son-at-school)\n    *school-ops*)\n(EXECUTING LOOK-UP-NUMBER)\n(EXECUTING TELEPHONE-SHOP)\n(EXECUTING TELL-SHOP-PROBLEM)\n(EXECUTING GIVE-SHOP-MONEY)\n(EXECUTING SHOP-INSTALLS-BATTERY)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n> (gps '(son-at-home car-needs-battery have-money)\n    '(son-at-school)\n    *school-ops*)\nNIL\n> (gps '(son-at-home car-works)\n    '(son-at-school)\n    *school-ops*)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n```\nIn all three examples the goal is to have the son at school.\nThe only operator that has `son-at-school` in its add-list is `drive-son-to-school`, so GPS selects that operator initially.\nBefore it can execute the operator, GPS has to solve for the preconditions.\nIn the first example, the program ends up working backward through the operators `shop-installs-battery`, `give-shop-money`, `tell-shop-problem`, and `telephone-shop` to `look-up-number`, which has no outstanding preconditions.\nThus, the `look-up-number` action can be executed, and the program moves on to the other actions.\nAs Aristotle said, \"What is the last in the order of analysis seems to be first in the order of becoming.\"\n\nThe second example starts out exactly the same, but the `look-up-number` operator fails because its precondition, `have-phone-book`, cannot be achieved.\nKnowing the phone number is a precondition, directly or indirectly, of all the operators, so no action is taken and GPS returns `NIL`.\n\nFinally, the third example is much more direct; the initial state specifies that the car works, so the driving operator can be applied immediately.\n\n## 4.5 Stage 5: Analysis, or \"We Lied about the G\"\n\nIn the sections that follow, we examine the question of just how general this General Problem Solver is.\nThe next four sections point out limitations of our version of GPS, and we will show how to correct these limitations in a second version of the program.\n\nOne might ask if \"limitations\" is just a euphemism for \"bugs.\" Are we \"enhancing\" the program, or are we \"correcting\" it?\nThere are no clear answers on this point, because we never insisted on an unambiguous problem description or specification.\nAI programming is largely exploratory programming; the aim is often to discover more about the problem area rather than to meet a clearly defined specification.\nThis is in contrast to a more traditional notion of programming, where the problem is completely specified before the first line of code is written.\n\n## 4.6 The Running Around the Block Problem\n\nRepresenting the operator \"driving from home to school\" is easy: the precondition and delete-list includes being at home, and the add-list includes being at school.\nBut suppose we wanted to represent \"running around the block.\" There would be no net change of location, so does that mean there would be no add or delete-list?\nIf so, there would be no reason ever to apply the operator.\nPerhaps the add-list should contain something like \"got some exercise\" or \"feel tired,\" or something more general like \"experience running around the block.\" We will return to this question later.\n\n## 4.7 The Clobbered Sibling Goal Problem\n\nConsider the problem of not only getting the child to school but also having some money left over to use for the rest of the day.\nGPS can easily solve this problem from the following initial condition:\n\n```lisp\n(gps '(son-at-home have-money car-works)\n    '(have-money son-at-school)\n    *school-ops*)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n```\nHowever, in the next example GPS incorrectly reports success, when in fact it has spent the money on the battery.\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n    '(have-money son-at-school)\n    *school-ops*)\n(EXECUTING LOOK-UP-NUMBER)\n(EXECUTING TELEPHONE-SHOP)\n(EXECUTING TELL-SHOP-PROBLEM)\n(EXECUTING GIVE-SHOP-MONEY)\n(EXECUTING SHOP-INSTALLS-BATTERY)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nSOLVED\n```\nThe \"bug\" is that GPS uses the expression (`every #'achieve goals`) to achieve a set of goals.\nIf this expression returns true, it means that every one of the goals has been achieved in sequence, but it doesn't mean they are all still true at the end.\nIn other words, the goal (`have-money son-at-school`), which we intended to mean \"end up in a state where both have-money and son-at-school are true,\" was interpreted by GPS to mean \"first achieve `have-money`, and then achieve `son-at-school`.\" Sometimes achieving one goal can undo another, previously achieved goal.\nWe will call this the \"prerequisite clobbers sibling goal\" problem.<a id=\"tfn04-2\"></a><sup>[2](#fn04-2)</sup>\nThat is, `have-money` and `son-at-school` are sibling goals, one of the prerequisites for the plan for `son-at-school` is `car-works`, and achieving that goal clobbers the `have-money` goal.\n\nModifying the program to recognize the \"prerequisite clobbers sibling goal\" problem is straightforward.\nFirst note that we call `(every #'achieve` *something*`)` twice within the program, so let's replace those two forms with `(achieve-all` *something*`)`.\nWe can then define `achieve-all` as follows:\n\n```lisp\n(defun achieve-all (goals)\n  \"Try to achieve each goal, then make sure they still hold.\"\n  (and (every #'achieve goals) (subsetp goals *state*)))\n```\nThe Common Lisp function subsetp returns true if its first argument is a subset of its second.\nIn `achieve-all`, it returns true if every one of the goals is still in the current state after achieving all the goals.\nThis is just what we wanted to test.\n\nThe introduction of `achieve-all` prevents GPS from returning true when one of the goals gets clobbered, but it doesn't force GPS to replan and try to recover from a clobbered goal.\nWe won't consider that possibility now, but we will take it up again in the section on the blocks world domain, which was Sussman's primary example.\n\n## 4.8 The Leaping before You Look Problem\n\nAnother way to address the \"prerequisite clobbers sibling goal\" problem is just to be more careful about the order of goals in a goal list.\nIf we want to get the kid to school and still have some money left, why not just specify the goal as (`son-at-school have-money`) rather than (`have-money son-at-school`)?\nLet's see what happens when we try that:\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n    '(son-at-school have-money)\n    *school-ops*)\n(EXECUTING LOOK-UP-NUMBER)\n(EXECUTING TELEPHONE-SHOP)\n(EXECUTING TELL-SHOP-PROBLEM)\n(EXECUTING GIVE-SHOP-MONEY)\n(EXECUTING SHOP-INSTALLS-BATTERY)\n(EXECUTING DRIVE-SON-TO-SCHOOL)\nNIL\n```\nGPS returns nil, reflecting the fact that the goal cannot be achieved, but only after executing all actions up to and including driving to school.\nI call this the \"leaping before you look\" problem, because if you asked the program to solve for the two goals `(jump-off-cliff land-safely)` it would happily jump first, only to discover that it had no operator to land safely.\nThis is less than prudent behavior.\n\nThe problem arises because planning and execution are interleaved.\nOnce the preconditions for an operator are achieved, the action is taken-and `*state*` is irrevocably changed-even if this action may eventually lead to a dead end.\nAn alternative would be to replace the single global `*state*` with distinct local state variables, such that a new variable is created for each new state.\nThis alternative is a good one for another, independent reason, as we shall see in the next section.\n\n## 4.9 The Recursive Subgoal Problem\n\nIn our simulated nursery school world there is only one way to find out a phone number: to look it up in the phone book.\nSuppose we want to add an operator for finding out a phone number by asking someone.\nOf course, in order to ask someone something, you need to be in communication with him or her.\nThe asking-for-a-phone-number operator could be implemented as follows:\n\n```lisp\n(push (make-op :action 'ask-phone-number\n      :preconds '(in-communication-with-shop)\n      :add-list '(know-phone-number))\n    *school-ops*)\n```\n(The special form ( `push` *item list*) puts the item on the front of the list; it is equivalent to (setf *list* (`cons` *item list*) ) in the simple case.)\nUnfortunately, something unexpected happens when we attempt to solve seemingly simple problems with this new set of operators.\nConsider the following:\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money)\n    '(son-at-school)\n    *school-ops*)\n>>TRAP 14877 (SYSTEM:PDL-OVERFLOW EH: :REGULAR)\nThe regular push-down list has overflown.\nWhile in the function ACHIEVE <- EVERY <- REMOVE\n```\nThe error message (which will vary from one implementation of Common Lisp to another) means that too many recursively nested function calls were made.\nThis indicates either a very complex problem or, more commonly, a bug in the program leading to infinite recursion.\nOne way to try to see the cause of the bug is to trace a relevant function, such as `achieve`:\n\n`> (trace achieve)`=> `(ACHIEVE)`\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money)\n    '(son-at-school)\n    *school-ops*)\n(1 ENTER ACHIEVE: SON-AT-SCHOOL)\n  (2 ENTER ACHIEVE: SON-AT-HOME)\n  (2 EXIT ACHIEVE: (SON-AT-HOME CAR-NEEDS-BATTERY HAVE-MONEY))\n  (2 ENTER ACHIEVE: CAR-WORKS)\n    (3 ENTER ACHIEVE: CAR-NEEDS-BATTERY)\n    (3 EXIT ACHIEVE: (CAR-NEEDS-BATTERY HAVE-MONEY))\n    (3 ENTER ACHIEVE: SHOP-KNOWS-PROBLEM)\n      (4 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP)\n        (5 ENTER ACHIEVE: KNOW-PHONE-NUMBER)\n          (6 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP)\n            (7 ENTER ACHIEVE: KNOW-PHONE-NUMBER)\n              (8 ENTER ACHIEVE: IN-COMMUNICATION-WITH-SHOP)\n                (9 ENTER ACHIEVE: KNOW-PHONE-NUMBER)\n```\nThe output from trace gives us the necessary clues.\nNewell and Simon talk of \"oscillating among ends, functions required, and means that perform them.\" Here it seems we have an infinite oscillation between being in communication with the shop (levels 4, 6, 8,...) and knowing the shop's phone number (levels 5, 7, 9,...).\nThe reasoning is as follows: we want the shop to know about the problem with the battery, and this requires being in communication with him or her.\nOne way to get in communication is to phone, but we don't have a phone book to look up the number.\nWe could ask them their phone number, but this requires being in communication with them.\nAs Aristotle put it, \"If we are to be always deliberating, we shall have to go on to infinity.\" We will call this the \"recursive subgoal\" problem: trying to solve a problem in terms of itself.\nOne way to avoid the problem is to have `achieve` keep track of all the goals that are being worked on and give up if it sees a loop in the goal stack.\n\n## 4.10 The Lack of Intermediate Information Problem\n\nWhen GPS fails to find a solution, it just returns `nil`.\nThis is annoying in cases where the user expected a solution to be found, because it gives no information about the cause of failure.\nThe user could always trace some function, as we traced `achieve` above, but the output from trace is rarely exactly the information desired.\nIt would be nice to have a general debugging output tool where the programmer could insert print statements into his code and have them selectively printed, depending on the information desired.\n\nThe function `dbg` provides this capability.\n`dbg` prints output in the same way as `format`, but it will only print when debugging output is desired.\nEach call to `dbg` is accompanied by an identifier that is used to specify a class of debugging messages.\nThe functions `debug` and `undebug` are used to add or remove message classes to the list of classes that should be printed.\nIn this chapter, all the debugging output will use the identifier `:gps`.\nOther programs will use other identifiers, and a complex program will use many identifiers.\n\nA call to `dbg` will result in output if the first argument to `dbg`, the identifier, is one that was specified in a call to `debug`.\nThe other arguments to `dbg` are a format string followed by a list of arguments to be printed according to the format string.\nIn other words, we will write functions that include calls to `dbg` like:\n\n```lisp\n(dbg :gps \"The current goal is: ~a\" goal)\n```\n\nIf we have turned on debugging with `(debug :gps)`, then calls to `dbg` with the identifier `:gps` will print output.\nThe output is turned off with `(undebug :gps)`.\n`debug` and `undebug` are designed to be similar to `trace` and `untrace`, in that they turn diagnostic output on and off.\nThey also follow the convention that `debug` with no arguments returns the current list of identifiers, and that `undebug` with no arguments turns all debugging off.\nHowever, they differ from `trace` and `untrace` in that they are functions, not macros.\nIf you use only keywords and integers for identifiers, then you won't notice the difference.\n\nTwo new built-in features are introduced here.\nFirst, `*debug-io*` is the stream normally used for debugging input/output.\nIn all previous calls to `format` we have used `t` as the stream argument, which causes output to go to the `*standard-output*` stream.\nSending different types of output to different streams allows the user some flexibility.\nFor example, debugging output could be directed to a separate window, or it could be copied to a file.\nSecond, the function `fresh-line` advances to the next line of output, unless the output stream is already at the start of the line.\n\n```lisp\n(defvar *dbg-ids* nil \"Identifiers used by dbg\")\n\n(defun dbg (id format-string &rest args)\n  \"Print debugging info if (DEBUG ID) has been specified.\"\n  (when (member id *dbg-ids*)\n    (fresh-line *debug-io*)\n    (apply #'format *debug-io* format-string args)))\n\n(defun debug (&rest ids)\n  \"Start dbg output on the given ids.\"\n  (setf *dbg-ids* (union ids *dbg-ids*)))\n\n(defun undebug (&rest ids)\n \"Stop dbg on the ids. With no ids, stop dbg altogether.\"\n  (setf *dbg-ids* (if (null ids) nil\n            (set-difference *dbg-ids* ids))))\n```\nSometimes it is easier to view debugging output if it is indented according to some pattern, such as the depth of nested calls to a function.\nTo generate indented output, the function `dbg-indent` is defined:\n\n```lisp\n(defun dbg-indent (id indent format-string &rest args)\n  \"Print indented debugging info if (DEBUG ID) has been specified.\"\n  (when (member id *dbg-ids*)\n    (fresh-line *debug-io*)\n    (dotimes (i indent) (princ \" \" *debug-io*))\n    (apply #'format *debug-io* format-string args)))\n```\n## 4.11 GPS Version 2: A More General Problem Solver\n\nAt this point we are ready to put together a new version of GPS with solutions for the \"running around the block,\" \"prerequisite clobbers sibling goal,\" \"leaping before you look,\" and \"recursive subgoal\" problems.\nThe glossary for the new version is in [figure 4.2](#f0015).\n\n\n| Symbol             | Use                                                   |\n| ------             | ---                                                   |\n|                    | **Top-Level Function**                                |\n| `GPS`              | Solve a goal from a state using a list of operators.  |\n|                    | **Special Variables**                                 |\n| `*ops*`            | A list of available operators.                        |\n|                    | **Data Types**                                        |\n| `op`               | An operation with preconds, add-list and del-list.    |\n|                    | **Major Functions**                                   |\n| `achieve-all`      | Achieve a list of goals.                              |\n| `achieve`          | Achieve an individual goal.                           |\n| `appropriate-p`    | Decide if an operator is appropriate for a goal.      |\n| `apply-op`         | Apply operator to current state.                      |\n|                    | **Auxiliary Functions**                               |\n| `executing-p`      | Is a condition an *executing* form?                   |\n| `starts-with`      | Is the argument a list that starts with a given atom? |\n| `convert-op`       | Convert an operator to use the *executing* convention.|\n| `op`               | Create an operator.                                   |\n| `use`              | Use a list of operators.                              |\n| `member-equal`     | Test if an element is equal to a member of a list.    |\n|                    | **Selected Common Lisp Functions**                    |\n| `member`           | Test if an element is a member of a list. (p.78)      |\n| `set-difference`   | All elements in one set but not the other.            |\n| `subsetp`          | Is one set wholly contained in another?               |\n| `union`            | All elements in either of the two sets.               |\n| `every`            | Test if every element of a list passes a test. (p. 62)|\n| `some`             | Test if any element of a list passes a test.          |\n| `remove-if`        | Remove all items satisfying a test.                   |\n|                    | **Previously Defined Functions**                      |\n| `find-all`         | A list of all matching elements. (p. 101)             |\n| `find-all-if`      | A list of all elements satisfying a predicate.        |\n\nThe most important change is that, instead of printing a message when each operator is applied, we will instead have `GPS` return the resulting state.\nA list of \"messages\" in each state indicates what actions have been taken.\nEach message is actually a condition, a list of the form (executing *operator*).\nThis solves the \"running around the block\" problem: we could call `GPS` with an initial goal of `((executing run-around-block))`, and it would execute the `run-around-block` operator, thereby satisfying the goal.\nThe following code defines a new function, `op`, which builds operators that include the message in their add-list.\n\n```lisp\n(defun executing-p (x)\n  \"Is x of the form: (executing ...) ?\"\n  (starts-with x 'executing))\n\n(defun starts-with (list x)\n  \"Is this a list whose first element is x?\"\n  (and (consp list) (eql (first list) x)))\n\n(defun convert-op (op)\n  \"Make op conform to the (EXECUTING op) convention.\"\n  (unless (some #'executing-p (op-add-list op))\n    (push (list 'executing (op-action op)) (op-add-list op)))\n  op)\n\n(defun op (action &key preconds add-list del-list)\n  \"Make a new operator that obeys the (EXECUTING op) convention.\"\n  (convert-op\n    (make-op :action action :preconds preconds\n          :add-list add-list :del-list del-list)))\n```\nOperators built by `op` will be correct, but we can convert existing operators using `convert-op` directly:\n\n```lisp\n(mapc #'convert-op *school-ops*)\n```\n\nThis is an example of exploratory programming: instead of starting all over when we discover a limitation of the first version, we can use Lisp to alter existing data structures for the new version of the program.\n\nThe definition of the variable `*ops*` and the structure `op` are exactly the same as before, and the rest of the program consists of five functions we have already seen: `GPS`, `achieve-all`, `achieve`, `appropriate-p`, and `apply-op`.\nAt the top level, the function `GPS` calls `achieve-all`, which returns either `nil` or a valid state.\nFrom this we remove all the atoms, which leaves only the elements of the final state that are lists-in other words, the actions of the form (`executing` *operator*).\nThus, the value of `GPS` itself is the list of actions taken to arrive at the final state.\n`GPS` no longer returns `SOLVED` when it finds a solution, but it still obeys the convention of returning nil for failure, and non-nil for success.\nIn general, it is a good idea to have a program return a meaningful value rather than print that value, if there is the possibility that some other program might ever want to use the value.\n\n```lisp\n(defvar *ops* nil \"A list of available operators.\")\n\n(defstruct op \"An operation\"\n  (action nil) (preconds nil) (add-list nil) (del-list nil))\n\n(defun GPS (state goals &optional (*ops* *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (remove-if #'atom (achieve-all (cons '(start) state) goals nil)))\n```\n\nThe first major change in version 2 is evident from the first line of the program: there is no `*state*` variable.\nInstead, the program keeps track of local state variables.\nThis is to solve the \"leaping before you look\" problem, as outlined before.\nThe functions `achieve`, `achieve-all`, and `apply-op` all take an extra argument which is the current state, and all return a new state as their value.\nThey also must still obey the convention of returning nil when they fail.\n\nThus we have a potential ambiguity: does nil represent failure, or does it represent a valid state that happens to have no conditions?\nWe resolve the ambiguity by adopting the convention that all states must have at least one condition.\nThis convention is enforced by the function `GPS`.\nInstead of calling (`achieve-all state goals nil`), `GPS` calls `(achieve-all (cons '(start) state) goals nil)`.\nSo even if the user passes `GPS` a null initial state, it will pass on a state containing `(start)` to `achieve-all`.\nFrom then on, we are guaranteed that no state will ever become nil, because the only function that builds a new state is `apply-op`, and we can see by looking at the last line of `apply-op` that it always appends something onto the state it is returning.\n(An `add-list` can never be nil, because if it were, the operator would not be appropriate.\nBesides, every operator includes the (executing ...) condition.)\n\nNote that the final value we return from `GPS` has all the atoms removed, so we end up reporting only the actions performed, since they are represented by conditions of the form (`executing *action*`).\nAdding the `(start)` condition at the beginning also serves to differentiate between a problem that cannot be solved and one that is solved without executing any actions.\nFailure returns nil, while a solution with no steps will at least include the `(start)` condition, if nothing else.\n\nFunctions that return nil as an indication of failure and return some useful value otherwise are known as *semipredicates*.\nThey are error prone in just these cases where nil might be construed as a useful value.\nBe careful when defining and using semipredicates: (1) Decide if nil could ever be a meaningful value.\n(2) Insure that the *user* can't corrupt the program by supplying nil as a value.\nIn this program, `GPS` is the only function the user should call, so once we have accounted for it, we're covered.\n(3) Insure that the *program* can't supply nil as a value.\nWe did this by seeing that there was only one place in the program where new states were constructed, and that this new state was formed by appending a one-element list onto another state.\nBy following this three-step procedure, we have an informal proof that the semipredicates involving states will function properly.\nThis kind of informal proof procedure is a common element of good program design.\n\nThe other big change in version 2 is the introduction of a goal stack to solve the recursive subgoal problem.\nThe program keeps track of the goals it is working on and immediately fails if a goal appears as a subgoal of itself.\nThis test is made in the second clause of `achieve`.\n\nThe function `achieve-all` tries to achieve each one of the goals in turn, setting the variable `current-state` to be the value returned from each successive call to `achieve`.\nIf all goals are achieved in turn, and if all the goals still hold at the end (as `subsetp` checks for), then the final state is returned; otherwise the function fails, returning nil.\n\nMost of the work is done by `achieve`, which gets passed a state, a single goal condition, and the stack of goals worked on so far.\nIf the condition is already in the state, then `achieve` succeeds and returns the state.\nOn the other hand, if the goal condition is already in the goal stack, then there is no sense continuing-we will be stuck in an endless loop-so `achieve` returns nil.\nOtherwise, `achieve` looks through the list of operators, trying to find one appropriate to apply.\n\n```lisp\n(defun achieve-all (state goals goal-stack)\n  \"Achieve each goal, and make sure they still hold at the end.\"\n  (let ((current-state state))\n    (if (and (every #'(lambda (g)\n            (setf current-state\n              (achieve current-state g goal-stack)))\n          goals)\n        (subsetp goals current-state :test #'equal))\n      current-state)))\n\n(defun achieve (state goal goal-stack)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Goal: ~a\" goal)\n  (cond ((member-equal goal state) state)\n      ((member-equal goal goal-stack) nil)\n      (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n          (find-all goal *ops* :test #'appropriate-p)))))\n```\n\nThe goal `( (executing run-around-block) )` is a list of one condition, where the condition happens to be a two-element list.\nAllowing lists as conditions gives us more flexibility, but we also have to be careful.\nThe problem is that not all lists that look alike actually are the same.\nThe predicate `equal` essentially tests to see if its two arguments look alike, while the predicate `eql` tests to see if its two arguments actually are identical.\nSince functions like `member` use `eql` by default, we have to specify with a `:test` keyword that we want `equal` instead.\nSince this is done several times, we introduce the function `member-equal`.\nIn fact, we could have carried the abstraction one step further and defined `member-situation`, a function to test if a condition is true in a situation.\nThis would allow the user to change the matching function from `eql` to `equal`, and to anything else that might be useful.\n\n```lisp\n(defun member-equal (item list)\n  (member item list :test #'equal))\n```\n\nThe function `apply-op`, which used to change the state irrevocably and print a message reflecting this, now returns the new state instead of printing anything.\nIt first computes the state that would result from achieving all the preconditions of the operator.\nIf it is possible to arrive at such a state, then `apply-op` returns a new state derived from this state by adding what's in the add-list and removing everything in the delete-list.\n\n```lisp\n(defun apply-op (state goal op goal-stack)\n  \"Return a new, transformed state if op is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Consider: ~a\" (op-action op))\n  (let ((state2 (achieve-all state (op-preconds op)\n            (cons goal goal-stack))))\n    (unless (null state2)\n      ;; Return an updated state\n      (dbg-indent :gps (length goal-stack) \"Action: ~a\" (op-action op))\n      (append (remove-if #'(lambda (x)\n            (member-equal x (op-del-list op)))\n          state2)\n        (op-add-list op)))))\n\n(defun appropriate-p (goal op)\n  \"An op is appropriate to a goal if it is in its add-list.\"\n  (member-equal goal (op-add-list op)))\n```\n\nThere is one last complication in the way we compute the new state.\nIn version 1 of GPS, states were (conceptually) unordered sets of conditions, so we could use `union` and `set-difference` to operate on them.\nIn version 2, states become ordered lists, because we need to preserve the ordering of actions.\nThus, we have to use the functions `append` and `remove-if`, since these are defined to preserve order, while `union` and `set-difference` are not.\n\nFinally, the last difference in version 2 is that it introduces a new function: `use`.\nThis function is intended to be used as a sort of declaration that a given list of operators is to be used for a series of problems.\n\n```lisp\n(defun use (oplist)\n  \"Use oplist as the default list of operators.\"\n  ;; Return something useful, but not too verbose:\n  ;; the number of operators.\n   (length (setf *ops* oplist)))\n```\n\nCalling use sets the parameter `*ops*`, so that it need not be specified on each call to GPS.\nAccordingly, in the definition of GPS itself the third argument, `*ops*`, is now optional; if it is not supplied, a default will be used.\nThe default value for `*ops*` is given as `*ops*`.\nThis may seem redundant or superfluous-how could a variable be its own default?\nThe answer is that the two occurrences of `*ops*` look alike, but they actually refer to two completely separate bindings of the special variable `*ops*`.\nMost of the time, variables in parameter lists are local variables, but there is no rule against binding a special variable as a parameter.\nRemember that the effect of binding a special variable is that all references to the special variable that occur anywhere in the program-even outside the lexical scope of the function-refer to the new binding of the special variable.\nSo after a sequence of calls we eventually reach achieve, which references `*ops*`, and it will see the newly bound value of `*ops*`.\n\nThe definition of GPS is repeated here, along with an alternate version that binds a local variable and explicitly sets and resets the special variable `*ops*`.\nClearly, the idiom of binding a special variable is more concise, and while it can be initially confusing, it is useful once understood.\n\n```lisp\n(defun GPS (state goals &optional (*ops* *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (remove-if #'atom (achieve-all (cons '(start) state) goals nil)))\n\n(defun GPS (state goals &optional (ops *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (let ((old-ops *ops*))\n    (setf *ops* ops)\n    (let ((result (remove-if #'atom (achieve-all\n                  (cons'(start) state)\n                  goals nil ))))\n      (setf *ops* old-ops)\n      result)))\n```\n\nNow let's see how version 2 performs.\nWe use the list of operators that includes the \"asking the shop their phone number\" operator.\nFirst we make sure it will still do the examples version 1 did:\n\n```lisp\n> (use *school-ops*) => 7\n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n      '(son-at-school))\n((START)\n  (EXECUTING LOOK-UP-NUMBER)\n  (EXECUTING TELEPHONE-SHOP)\n  (EXECUTING TELL-SHOP-PROBLEM)\n  (EXECUTING GIVE-SHOP-MONEY)\n  (EXECUTING SHOP-INSTALLS-BATTERY)\n  (EXECUTING DRIVE-SON-TO-SCHOOL))\n\n> (debug :gps) => (:GPS)\n\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n      '(son-at-school))\nGoal: SON-AT-SCHOOL\nConsider: DRIVE-SON-TO-SCHOOL\n  Goal: SON-AT-HOME\n  Goal: CAR-WORKS\n  Consider: SHOP-INSTALLS-BATTERY\n    Goal: CAR-NEEDS-BATTERY\n    Goal: SHOP-KNOWS-PROBLEM\n    Consider: TELL-SHOP-PROBLEM\n      Goal: IN-COMMUNICATION-WITH-SHOP\n      Consider: TELEPHONE-SHOP\n        Goal: KNOW-PHONE-NUMBER\n        Consider: ASK-PHONE-NUMBER\n          Goal: IN-COMMUNICATION-WITH-SHOP\n        Consider: LOOK-UP-NUMBER\n          Goal: HAVE-PHONE-BOOK\n        Action: LOOK-UP-NUMBER\n      Action: TELEPHONE-SHOP\n    Action: TELL-SHOP-PROBLEM\n    Goal: SHOP-HAS-MONEY\n    Consider: GIVE-SHOP-MONEY\n      Goal: HAVE-MONEY\n    Action: GIVE-SHOP-MONEY\n  Action: SHOP-INSTALLS-BATTERY\nAction: DRIVE-SON-TO-SCHOOL\n((START)\n  (EXECUTING LOOK-UP-NUMBER)\n  (EXECUTING TELEPHONE-SHOP)\n  (EXECUTING TELL-SHOP-PROBLEM)\n  (EXECUTING GIVE-SHOP-MONEY)\n  (EXECUTING SHOP-INSTALLS-BATTERY)\n  (EXECUTING DRIVE-SON-TO-SCHOOL))\n\n> (undebug) => NIL\n\n> (gps '(son-at-home car-works)\n      '(son-at-school))\n((START)\n  (EXECUTING DRIVE-SON-TO-SCHOOL))\n```\n\nNow we see that version 2 can also handle the three cases that version 1 got wrong.\nIn each case, the program avoids an infinite loop, and also avoids leaping before it looks.\n\n```lisp\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n      '(have-money son-at-school))\nNIL\n> (gps '(son-at-home car-needs-battery have-money have-phone-book)\n      '(son-at-school have-money))\nNIL\n(gps '(son-at-home car-needs-battery have-money)\n      '(son-at-school) )\nNIL\n```\n\nFinally, we see that this version of GPS also works on trivial problems requiring no action:\n\n`> (gps '(son-at-home) '(son-at-home))`=> `((START))`\n\n## 4.12 The New Domain Problem: Monkey and Bananas\n\nTo show that GPS is at all general, we have to make it work in different domains.\nWe will start with a \"classic\" AI problem.<a id=\"tfn04-3\"></a><sup>[3](#fn04-3)</sup>\nImagine the following scenario: a hungry monkey is standing at the doorway to a room.\nIn the middle of the room is a bunch of bananas suspended from the ceiling by a rope, well out of the monkey's reach.\nThere is a chair near the door, which is light enough for the monkey to push and tall enough to reach almost to the bananas.\nJust to make things complicated, assume the monkey is holding a toy ball and can only hold one thing at a time.\n\nIn trying to represent this scenario, we have some flexibility in choosing what to put in the current state and what to put in with the operators.\nFor now, assume we define the operators as follows:\n\n```lisp\n(defparameter *banana-ops*\n  (list\n    (op\n      'climb-on-chair\n      :preconds '(chair-at-middle-room at-middle-room on-floor)\n      :add-list '(at-bananas on-chair)\n      :del-list '(at-middle-room on-floor))\n    (op\n      'push-chair-from-door-to-middle-room\n      :preconds '(chair-at-door at-door)\n      :add-list '(chair-at-middle-room at-middle-room)\n      :del-list '(chair-at-door at-door))\n    (op\n      'walk-from-door-to-middle-room\n      :preconds '(at-door on-floor)\n      :add-list '(at-middle-room)\n      :del-list '(at-door))\n    (op\n      'grasp-bananas\n      :preconds '(at-bananas empty-handed)\n      :add-list '(has-bananas)\n      :del-list '(empty-handed))\n    (op\n      'drop-ball\n      :preconds '(has-ball)\n      :add-list '(empty-handed)\n      :del-list '(has-ball))\n    (op\n      'eat-bananas\n      :preconds '(has-bananas)\n      :add-list '(empty-handed not-hungry)\n      :del-list '(has-bananas hungry))))\n```\n\nUsing these operators, we could pose the problem of becoming not-hungry, given the initial state of being at the door, standing on the floor, holding the ball, hungry, and with the chair at the door.\n`GPS` can find a solution to this problem:\n\n`> (use *banana-ops*)`=> `6`\n\n```lisp\n> (GPS '(at-door on-floor has-ball hungry chair-at-door)\n      '(not-hungry))\n((START)\n  (EXECUTING PUSH-CHAIR-FROM-DOOR-TO-MIDDLE-ROOM)\n  (EXECUTING CLIMB-ON-CHAIR)\n  (EXECUTING DROP-BALL)\n  (EXECUTING GRASP-BANANAS)\n  (EXECUTING EAT-BANANAS))\n```\n\nNotice we did not need to make any changes at all to the `GPS` program.\nWe just used a different set of operators.\n\n## 4.13 The Maze Searching Domain\n\nNow we will consider another \"classic\" problem, maze searching.\nWe will assume a particular maze, diagrammed here.\n\n<a id=\"diagram-04-01\"></a>\n<img src=\"images/chapter4/diagram-04-01.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-01.png'; this.onerror=null;\"\n  alt=\"Diagram 4.1\" />\n\nIt is much easier to define some functions to help build the operators for this domain than it would be to type in all the operators directly.\nThe following code defines a set of operators for mazes in general, and for this maze in particular:\n\n```lisp\n(defun make-maze-ops (pair)\n  \"Make maze ops in both directions\"\n  (list (make-maze-op (first pair) (second pair))\n      (make-maze-op (second pair) (first pair))))\n(defun make-maze-op (here there)\n  \"Make an operator to move between two places\"\n  (op\n    '(move from ,here to ,there)\n    :preconds '((at ,here))\n    :add-list '((at ,there))\n    :del-list '((at ,here))))\n(defparameter *maze-ops*\n  (mappend #'make-maze-ops\n    '((1 2) (2 3) (3 4) (4 9) (9 14) (9 8) (8 7) (7 12) (12 13)\n      (12 11) (11 6) (11 16) (16 17) (17 22) (21 22) (22 23)\n      (23 18) (23 24) (24 19) (19 20) (20 15) (15 10) (10 5) (20 25))))\n```\n\nNote the backquote notation, ( ' ).\nIt is covered in [section 3.2](chapter3.md#s0020), [page 67](chapter3.md#p67).\n\nWe can now use this list of operators to solve several problems with this maze.\nAnd we could easily create another maze by giving another list of connections.\nNote that there is nothing that says the places in the maze are arranged in a five-by-five layout-that is just one way of visualizing the connectivity\n\n`> (use *maze-ops*)`=> `48`\n\n```lisp\n> (gps '((at 1)) '((at 25)))\n((START)\n  (EXECUTING-(MOVE-FROM-1 TO 2))\n  (EXECUTING-(MOVE-FROM-2 TO 3))\n  (EXECUTING-(MOVE-FROM-3 TO 4))\n  (EXECUTING-(MOVE-FROM-4 TO 9))\n  (EXECUTING-(MOVE-FROM-9 TO 8))\n  (EXECUTING-(MOVE-FROM-8 TO 7))\n  (EXECUTING-(MOVE-FROM-7 TO 12))\n  (EXECUTING-(MOVE-FROM-12 TO 11))\n  (EXECUTING-(MOVE-FROM-11 TO 16))\n  (EXECUTING-(MOVE-FROM-16 TO 17))\n  (EXECUTING-(MOVE-FROM-17 TO 22))\n  (EXECUTING-(MOVE-FROM-22 TO 23))\n  (EXECUTING-(MOVE-FROM-23 TO 24))\n  (EXECUTING-(MOVE-FROM-24 TO 19))\n  (EXECUTING-(MOVE-FROM-19 TO 20))\n  (EXECUTING-(MOVE-FROM-20 TO 25))\n  (AT 25))\n```\n\nThere is one subtle bug that the maze domain points out.\nWe wanted GPS to return a list of the actions executed.\nHowever, in order to account for the case where the goal can be achieved with no action, I included `(START)` in the value returned by GPS.\nThese examples include the `START` and `EXECUTING` forms but also a list of the form (AT *n*), for some *n*.\nThis is the bug.\nIf we go back and look at the function `GPS`, we find that it reports the result by removing all atoms from the state returned by `achieve-all`.\nThis is a \"pun\"-we said remove atoms, when we really meant to remove all conditions except the `(START)` and `(EXECUTING *action*)` forms.\nUp to now, all these conditions were atoms, so this approach worked.\nThe maze domain introduced conditions of the form (`AT` *n*), so for the first time there was a problem.\nThe moral is that when a programmer uses puns-saying what's convenient instead of what's really happening-there's bound to be trouble.\nWhat we really want to do is not to remove atoms but to find all elements that denote actions.\nThe code below says what we mean:\n\n```lisp\n(defun GPS (state goals &optional (*ops* *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (find-all-if #'action-p\n        (achieve-all (cons '(start) state) goals nil)))\n(defun action-p (x)\n  \"Is x something that is (start) or (executing ...)?\"\n  (or (equal x '(start)) (executing-p x)))\n```\n\nThe domain of maze solving also points out an advantage of version 2: that it returns a representation of the actions taken rather than just printing them out.\nThe reason this is an advantage is that we may want to use the results for something, rather than just look at them.\nSuppose we wanted a function that gives us a path through a maze as a list of locations to visit in turn.\nWe could do this by calling GPS as a subfunction and then manipulating the results:\n\n```lisp\n(defun find-path (start end)\n  \"Search a maze for a path from start to end.\"\n  (let ((results (GPS '((at .start)) '((at .end)))))\n    (unless (null results)\n      (cons start (mapcar #'destination\n              (remove '(start) results\n                  :test #'equal))))))\n(defun destination (action)\n  \"Find the Y in (executing (move from X to Y))\"\n  (fifth (second action)))\n```\n\nThe function `find-path` calls GPS to get the `results`.\nIf this is `nil`, there is no answer, but if it is not, then take the `rest` of `results` (in other words, ignore the `(START)` part).\nPick out the destination, `*y*,` from each `(EXECUTING (MOVE FROM x TO y))` form, and remember to include the starting point.\n\n`> (use *maze-ops*)`=> `48`\n\n`> (find-path 1 25)`=>\n\n```lisp\n(1 2 3 4 9 8 7 12 11 16 17 22 23 24 19 20 25)\n```\n\n`> (find-path 1 1)`=> `(1)`\n\n`> (equal (find-path 1 25) (reverse (find-path 25 1)))`=> `T`\n\n## 4.14 The Blocks World Domain\n\nAnother domain that has attracted more than its share of attention in AI circles is the blocks world domain.\nImagine a child's set of building blocks on a table top.\nThe problem is to move the blocks from their starting configuration into some goal configuration.\nWe will assume that each block can have only one other block directly on top of it, although they can be stacked to arbitrary height.\nThe only action that can be taken in this world is to move a single block that has nothing on top of it either to the top of another block or onto the table that represents the block world.\nWe will create an operator for each possible block move.\n\n```lisp\n(defun make-block-ops (blocks)\n  (let ((ops nil))\n    (dolist (a blocks)\n      (dolist (b blocks)\n        (unless (equal a b)\n          (dolist (c blocks)\n            (unless (or (equal c a) (equal c b))\n              (push (move-op a b c) ops)))\n          (push (move-op a 'table b) ops)\n          (push (move-op a b 'table) ops))))\n    ops))\n(defun move-op (a b c)\n  \"Make an operator to move A from B to C.\"\n  (op\n      '(move ,a from ,b to ,c)\n      :preconds '((space on ,a) (space on ,c) (,a on ,b))\n      :add-list (move-ons a b c)\n      :del-list (move-ons a c b)))\n(defun move-ons (a b c)\n  (if (eq b 'table)\n      '((,a on ,c))\n      '((.a on ,c) (space on ,b))))\n```\n\nNow we try these operators out on some problems.\nThe simplest possible problem is stacking one block on another:\n\n<a id=\"diagram-04-02\"></a>\n<img src=\"images/chapter4/diagram-04-02.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-02.png'; this.onerror=null;\"\n  alt=\"Diagram 4.2\" />\n\n`> (use (make-block-ops '(a b)))`=> `4`\n\n```lisp\n> (gps '((a on table) (b on table) (space on a) (space on b)\n      (space on table))\n    '((a on b) (b on table)))\n((START)\n  (EXECUTING (MOVE A FROM TABLE TO B)))\n```\n\nHere is a slightly more complex problem: inverting a stack of two blocks.\nThis time we show the debugging output.\n\n<a id=\"diagram-04-03\"></a>\n<img src=\"images/chapter4/diagram-04-03.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-03.png'; this.onerror=null;\"\n  alt=\"Diagram 4.3\" />\n\n`> (debug :gps)`=> `(:GPS)`\n\n```lisp\n> (gps '((a on b) (b on table) (space on a) (space on table))\n      '((b on a)))\nGoal: (B ON A)\nConsider: (MOVE B FROM TABLE TO A)\n  Goal: (SPACE ON B)\n  Consider: (MOVE A FROM B TO TABLE)\n    Goal: (SPACE ON A)\n    Goal: (SPACE ON TABLE)\n    Goal: (A ON B)\n  Action: (MOVE A FROM B TO TABLE)\n  Goal: (SPACE ON A)\n  Goal: (B ON TABLE)\nAction: (MOVE B FROM TABLE TO A)\n((START)\n  (EXECUTING (MOVE A FROM B TO TABLE))\n  (EXECUTING (MOVE B FROM TABLE TO A)))\n```\n\n`> (undebug)`=> `NIL`\n\nSometimes it matters what order you try the conjuncts in.\nFor example, you can't have your cake and eat it too, but you can take a picture of your cake and eat it too, as long as you take the picture *before* eating it.\nIn the blocks world, we have:\n\n<a id=\"diagram-04-04\"></a>\n<img src=\"images/chapter4/diagram-04-04.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-04.png'; this.onerror=null;\"\n  alt=\"Diagram 4.4\" />\n\n```lisp\n> (use (make-block-ops '(a b c))) 18\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n      '((b on a) (c on b)))\n((START)\n  (EXECUTING (MOVE A FROM B TO TABLE))\n  (EXECUTING (MOVE B FROM C TO A))\n  (EXECUTING (MOVE C FROM TABLE TO B)))\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n      '((c on b) (b on a)))\nNIL\n```\n\nIn the first case, the tower was built by putting B on A first, and then C on B.\nIn the second case, the program gets C on B first, but clobbers that goal while getting B on A.\nThe \"prerequisite clobbers sibling goal\" situation is recognized, but the program doesn't do anything about it.\nOne thing we could do is try to vary the order of the conjunct goals.\nThat is, we could change `achieve-all` as follows:\n\n```lisp\n(defun achieve-all (state goals goal-stack)\n  \"Achieve each goal, trying several orderings.\"\n  (some #'(lambda (goals) (achieve-each state goals goal-stack))\n      (orderings goals)))\n\n(defun achieve-each (state goals goal-stack)\n  \"Achieve each goal, and make sure they still hold at the end.\"\n  (let ((current-state state))\n    (if (and (every #'(lambda (g)\n            (setf current-state\n              (achieve current-state g goal-stack)))\n          goals)\n        (subsetp goals current-state :test #'equal))\n      current-state)))\n\n(defun orderings (l)\n  (if (> (length l) l)\n      (list l (reverse l))\n      (list l)))\n```\n\nNow we can represent the goal either way, and we'll still get an answer.\nNotice that we only consider two orderings: the order given and the reversed order.\nObviously, for goal sets of one or two conjuncts this is all the orderings.\nIn general, if there is only one interaction per goal set, then one of these two orders will work.\nThus, we are assuming that \"prerequisite clobbers sibling goal\" interactions are rare, and that there will seldom be more than one interaction per goal set.\nAnother possibility would be to consider all possible permutations of the goals, but that could take a long time with large goal sets.\n\nAnother consideration is the efficiency of solutions.\nConsider the simple task of getting block C on the table in the following diagram:\n\n<a id=\"diagram-04-05\"></a>\n<img src=\"images/chapter4/diagram-04-05.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-05.png'; this.onerror=null;\"\n  alt=\"Diagram 4.5\" />\n\n```lisp\n> (gps '((c on a) (a on table) (b on table)\n      (space on c) (space on b) (space on table))\n    '((c on table)))\n((START)\n  (EXECUTING (MOVE C FROM A TO B))\n  (EXECUTING (MOVE C FROM B TO TABLE)))\n```\n\nThe solution is correct, but there is an easier solution that moves C directly to the table.\nThe simpler solution was not found because of an accident: it happens that `make-block-ops` defines the operators so that moving C from B to the table comes before moving C from A to the table.\nSo the first operator is tried, and it succeeds provided C is on B.\nThus, the two-step solution is found before the one-step solution is ever considered.\nThe following example takes four steps when it could be done in two:\n\n<a id=\"diagram-04-06\"></a>\n<img src=\"images/chapter4/diagram-04-06.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-06.png'; this.onerror=null;\"\n  alt=\"Diagram 4.6\" />\n\n```lisp\n> (gps '((c on a) (a on table) (b on table)\n      (space on c) (space on b) (space on table))\n    '((c on table) (a on b)))\n((START)\n  (EXECUTING (MOVE C FROM A TO B))\n  (EXECUTING (MOVE C FROM B TO TABLE))\n  (EXECUTING (MOVE A FROM TABLE TO C))\n  (EXECUTING (MOVE A FROM C TO B)))\n```\n\nHow could we find shorter solutions?\nOne way would be to do a full-fledged search: shorter solutions are tried first, temporarily abandoned when something else looks more promising, and then reconsidered later on.\nThis approach is taken up in [chapter 6](chapter6.md), using a general searching function.\nA less drastic solution is to do a limited rearrangement of the order in which operators are searched: the ones with fewer unfulfilled preconditions are tried first.\nIn particular, this means that operators with all preconditions filled would always be tried before other operators.\nTo implement this approach, we change `achieve`:\n\n```lisp\n(defun achieve (state goal goal-stack)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Goal:~a\" goal)\n  (cond ((member-equal goal state) state)\n      ((member-equal goal goal-stack) nil)\n      (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n          (appropriate-ops goal state))))) ;***\n\n(defun appropriate-ops (goal state)\n  \"Return a list of appropriate operators,\n  sorted by the number of unfulfilled preconditions.\"\n  (sort (copy-list (find-all goal *ops* :test #'appropriate-p)) #'<\n      :key #'(lambda (op)\n          (count-if #'(lambda (precond)\n              (not (member-equal precond state)))\n            (op-preconds op)))))\n```\n\nNow we get the solutions we wanted:\n\n<!-- 4.7 is a copy of 4.6 -->\n<a id=\"diagram-04-07\"></a>\n<img src=\"images/chapter4/diagram-04-06.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-06.png'; this.onerror=null;\"\n  alt=\"Diagram 4.6\" />\n\n```lisp\n> (gps '((c on a) (a on table) (b on table)\n      (space on c) (space on b) (space on table))\n    '((c on table) (a on b)))\n((START)\n  (EXECUTING (MOVE C FROM A TO TABLE))\n  (EXECUTING (MOVE A FROM TABLE TO B)))\n```\n\n<!-- 4.8 is a copy of 4.4 -->\n<a id=\"diagram-04-08\"></a>\n<img src=\"images/chapter4/diagram-04-04.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-04.png'; this.onerror=null;\"\n  alt=\"Diagram 4.8\" />\n\n```lisp\n(gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n      '((b on a) (c on b)))\n((START)\n  (EXECUTING (MOVE A FROM B TO TABLE))\n  (EXECUTING (MOVE B FROM C TO A))\n  (EXECUTING (MOVE C FROM TABLE TO B)))\n> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n      '((c on b) (b on a)))\n((START)\n  (EXECUTING (MOVE A FROM B TO TABLE))\n  (EXECUTING (MOVE B FROM C TO A))\n  (EXECUTING (MOVE C FROM TABLE TO B)))\n```\n\n### The Sussman Anomaly\n\nSurprisingly, there are problems that can't be solved by *any* reordering of goals.\nConsider:\n\n<a id=\"diagram-04-09\"></a>\n<img src=\"images/chapter4/diagram-04-09.svg\"\n  onerror=\"this.src='images/chapter4/diagram-04-09.png'; this.onerror=null;\"\n  alt=\"Diagram 4.9\" />\n\nThis doesn't look too hard, so let's see how our GPS handles it:\n\n```lisp\n> (setf start '((c on a) (a on table) (b on table) (space on c)\n                (space on b) (space on table)))\n((C ON A) (A ON TABLE) (B ON TABLE) (SPACE ON C)\n (SPACE ON B) (SPACE ON TABLE))\n\n> (gps start '((a on b) (b on c))) => NIL\n\n> (gps start '((b on c) (a on b))) => NIL\n```\n\nThere is a \"prerequisite clobbers sibling goal\" problem regardless of which way we order the conjuncts!\nIn other words, no combination of plans for the two individual goals can solve the conjunction of the two goals.\nThis is a surprising fact, and the example has come to be known as \"the Sussman anomaly.\"<a id=\"tfn04-4\"></a><sup>[4](#fn04-4)</sup>\nWe will return to this problem in [chapter 6](chapter6.md).\n\n## 4.15 Stage 5 Repeated: Analysis of Version 2\n\nWe have shown that GPS is extensible to multiple domains.\nThe main point is that we didn't need to change the program itself to get the new domains to work; we just changed the list of operators passed to GPS.\nExperience in different domains did suggest changes that could be made, and we showed how to incorporate a few changes.\nAlthough version 2 is a big improvement over version 1, it still leaves much to be desired.\nNow we will discover a few of the most troubling problems.\n\n## 4.16 The Not Looking after You Don't Leap Problem\n\nWe solved the \"leaping before you look\" problem by introducing variables to hold a representation of possible future states, rather than just a single variable representing the current state.\nThis prevents GPS from taking an ill-advised action, but we shall see that even with all the repair strategies introduced in the last section, it doesn't guarantee that a solution will be found whenever one is possible.\n\nTo see the problem, add another operator to the front of the `*school-ops*` list and turn the debugging output back on:\n\n```lisp\n(use (push (op 'taxi-son-to-school\n        :preconds '(son-at-home have-money)\n        :add-list '(son-at-school)\n        :del-list '(son-at-home have-money))\n      *school-ops*))\n(debug :gps)\n```\n\nNow, consider the problem of getting the child to school without using any money:\n\n```lisp\n> (gps '(son-at-home have-money car-works)\n      '(son-at-school have-money))\nGoal: SON-AT-SCHOOL\nConsider: TAXI-SON-TO-SCHOOL\n  Goal: SON-AT-HOME\n  Goal: HAVE-MONEY\nAction: TAXI-SON-TO-SCHOOL\nGoal: HAVE-MONEY\nGoal: HAVE-MONEY\nGoal: SON-AT-SCHOOL\nConsider: TAXI-SON-TO-SCHOOL\n  Goal: SON-AT-HOME\n  Goal: HAVE-MONEY\nAction: TAXI-SON-TO-SCHOOL\nNIL\n```\n\nThe first five lines of output successfully solve the `son-at-school` goal with the `TAXI-SON-TO-SCHOOL` action.\nThe next line shows an unsuccessful attempt to solve the `have-money` goal.\nThe next step is to try the other ordering.\nThis time, the `have-money` goal is tried first, and succeeds.\nThen, the `son-at-school` goal is achieved again by the `TAXI-SON-TO-SCHOOL` action.\nBut the check for consistency in `achieve-each` fails, and there are no repairs available.\nThe goal fails, even though there is a valid solution: driving to school.\n\nThe problem is that `achieve` uses `some` to look at the `appropriate-ops`.\nThus, if there is some appropriate operator, `achieve` succeeds.\nIf there is only one goal, this will yield a correct solution.\nHowever, if there are multiple goals, as in this case, achieve will still only find one way to fulfil the first goal.\nIf the first solution is a bad one, the only recourse is to try to repair it.\nIn domains like the block world and maze world, repair often works, because all steps are reversible.\nBut in the taxi example, no amount of plan repair can get the money back once it is spent, so the whole plan fails.\n\nThere are two ways around this problem.\nThe first approach is to examine all possible solutions, not just the first solution that achieves each subgoal.\nThe language Prolog, to be discussed in [chapter 11](chapter11.md), does just that.\nThe second approach is to have achieve and `achieve-all` keep track of a list of goals that must be *protected*.\nIn the taxi example, we would trivially achieve the `have-money` goal and then try to achieve `son-at-school`, while protecting the goal `have-money`.\nAn operator would only be appropriate if it didn't delete any protected goals.\nThis approach still requires some kind of repair or search through multiple solution paths.\nIf we tried only one ordering-achieving `son-at-school` and then trying to protect it while achieving `have-money`-then we would not find the solution.\nDavid Warren's WARPLAN planner makes good use of the idea of protected goals.\n\n## 4.17 The Lack of Descriptive Power Problem\n\nIt would be a lot more economical, in the maze domain, to have one operator that says we can move from here to there if we are at \"here,\" and if there is a connection from \"here\" to \"there.\" Then the input to a particular problem could list the valid connections, and we could solve any maze with this single operator.\nSimilarly, we have defined an operator where the monkey pushes the chair from the door to the middle of the room, but it would be better to have an operator where the monkey can push the chair from wherever it is to any other nearby location, or better yet, an operator to push any \"pushable\" object from one location to a nearby one, as long as there is no intervening obstacle.\nThe conclusion is that we would like to have variables in the operators, so we could say something like:\n\n```lisp\n(op\n  '(push X from A to B)\n  :preconds '((monkey at A) (X at A) (pushable X) (path A B))\n  :add-list '((monkey at B) (X at B))\n  :del-list '((monkey at A) (X at A)))\n```\n\nOften we want to characterize a state in terms of something more abstract than a list of conditions.\nFor example, in solving a chess problem, the goal is to have the opponent in checkmate, a situation that cannot be economically described in terms of primitives like `(black king on A 4)`, so we need to be able to state some kind of constraint on the goal state, rather than just listing its components.\nWe might want to be able to achieve a disjunction or negation of conditions, where the current formalism allows only a conjunction.\n\nIt also is important, in many domains, to be able to state problems dealing with time: we want to achieve *X* before time *T*<sub>0</sub>, and then achieve *Y* before time *T*<sub>2</sub>, but not before *T*<sub>1</sub>.\nScheduling work on a factory floor or building a house are examples of planning where time plays an important role.\n\nOften there are costs associated with actions, and we want to find a solution with minimal, or near-minimal costs.\nThe cost might be as simple as the number of operators required for a solution-we saw in the blocks world domain that sometimes an operator that could be applied immediately was ignored, and an operator that needed several preconditions satisfied was chosen instead.\nOr we may be satisfied with a partial solution, if a complete solution is impossible or too expensive.\nWe may also want to take the cost (and time) of computation into account.\n\n## 4.18 The Perfect Information Problem\n\nAll the operators we have seen so far have unambiguous results; they add or delete certain things from the current state, and GPS always knows exactly what they are going to do.\nIn the real world, things are rarely so cut and dried.\nGoing back to the problem of becoming rich, one relevant operator would be playing the lottery.\nThis operator has the effect of consuming a few dollars, and once in a while paying off a large sum.\nBut we have no way to represent a payoff \"once in a while.\" Similarly, we have no way to represent unexpected difficulties of any kind.\nIn the nursery school problem, we could represent the problem with the car battery by having GPS explicitly check to see if the car was working, or if it needed a battery, every time the program considered the driving operator.\nIn the real world, we are seldom this careful; we get in the car, and only when it doesn't start do we consider the possibility of a dead battery.\n\n## 4.19 The Interacting Goals Problem\n\nPeople tend to have multiple goals, rather than working on one at a time.\nNot only do I want to get the kid to nursery school, but I want to avoid getting hit by another car, get to my job on time, get my work done, meet my friends, have some fun, continue breathing, and so on.\nI also have to discover goals on my own, rather than work on a set of predefined goals passed to me by someone else.\nSome goals I can keep in the background for years, and then work on them when the opportunity presents itself.\nThere is never a notion of satisfying all possible goals.\nRather, there is a continual process of achieving some goals, partially achieving others, and deferring or abandoning still others.\n\nIn addition to having active goals, people also are aware of undesirable situations that they are trying to avoid.\nFor example, suppose I have a goal of visiting a friend in the hospital.\nThis requires being at the hospital.\nOne applicable operator might be to walk to the hospital, while another would be to severely injure myself and wait for the ambulance to take me there.\nThe second operator achieves the goal just as well (perhaps faster), but it has an undesirable side effect.\nThis could be addressed either with a notion of solution cost, as outlined in the last section, or with a list of background goals that every solution attempts to protect.\n\nHerb Simon coined the term \"satisficing\" to describe the strategy of satisfying a reasonable number of goals to a reasonable degree, while abandoning or postponing other goals.\nGPS only knows success and failure, and thus has no way of maximizing partial success.\n\n## 4.20 The End of GPS\n\nThese last four sections give a hint as to the scope of the limitations of GPS.\nIn fact, it is not a very general problem solver at all.\nIt *is* general in the sense that the algorithm is not tied to a particular domain; we can change domain by changing the operators.\nBut GPS fails to be general in that it can't solve many interesting problems.\nIt is confined to small tricks and games.\n\nThere is an important yet subtle reason why GPS was destined to fail, a reason that was not widely appreciated in 1957 but now is at the core of computer science.\nIt is now recognized that there are problems that computers can't solve-not because a theoretically correct program can't be written, but because the execution of the program will take too long.\nA large number of problems can be shown to fall into the class of \"NP-hard\" problems.\nComputing a solution to these problems takes time that grows exponentially as the size of the problem grows.\nThis is a property of the problems themselves, and holds no matter how clever the programmer is.\nExponential growth means that problems that can be solved in seconds for, say, a five-input case may take trillions of years when there are 100 inputs.\nBuying a faster computer won't help much.\nAfter all, if a problem would take a trillion years to solve on your computer, it won't help much to buy 1000 computers each 1000 times faster than the one you have: you're still left with a million years wait.\nFor a theoretical computer scientist, discovering that a problem is NP-hard is an end in itself.\nBut for an AI worker, it means that the wrong question is being asked.\nMany problems are NP-hard when we insist on the optimal solution but are much easier when we accept a solution that might not be the best.\n\nThe input to `GPS` is essentially a program, and the execution of GPS is the execution of that program.\nIf GPS's input language is general enough to express any program, then there will be problems that can't be solved, either because they take too long to execute or because they have no solution.\nModern problem-solving programs recognize this fundamental limitation, and either limit the class of problems they try to solve or consider ways of finding approximate or partial solutions.\nSome problem solvers also monitor their own execution time and know enough to give up when a problem is too hard.\n\nThe following quote from Drew McDermott's article \"Artificial Intelligence Meets Natural Stupidity\" sums up the current feeling about GPS.\nKeep it in mind the next time you have to name a program.\n\n> *Remember GPS?\nBy now, \"GPS\" is a colorless term denoting a particularly stupid program to solve puzzles.\nBut it originally meant \"General Problem Solver \" which caused everybody a lot of needless excitement and distraction.\nIt should have been called *lfgns *-\"Local Feature-Guided Network Searcher.\"*\n\nNonetheless, GPS has been a useful vehicle for exploring programming in general, and AI programming in particular.\nMore importantly, it has been a useful vehicle for exploring \"the nature of deliberation.\" Surely we'll admit that Aristotle was a smarter person than you or me, yet with the aid of the computational model of mind as a guiding metaphor, and the further aid of a working computer program to help explore the metaphor, we have been led to a more thorough appreciation of means-ends analysis-at least within the computational model.\nWe must resist the temptation to believe that all thinking follows this model.\n\nThe appeal of AI can be seen as a split between means and ends.\nThe end of a successful AI project can be a program that accomplishes some useful task better, faster, or cheaper than it could be before.\nBy that measure, GPS is a mostly a failure, as it doesn't solve many problems particularly well.\nBut the means toward that end involved an investigation and formalization of the problem-solving process.\nBy that measure, our reconstruction of GPS is a success to the degree in which it leads the reader to a better understanding of the issues.\n\n## 4.21 History and References\n\nThe original GPS is documented in Newell and Simon's 1963 paper and in their 1972 book, *Human Problem Solving*, as well as in Ernst and Newell 1969.\nThe implementation in this chapter is based on the Strips program (Fikes and Nilsson 1971).\n\nThere are other important planning programs.\nEarl Sacerdoti's Abstrips program was a modification of Strips that allowed for hierarchical planning.\nThe idea was to sketch out a skeletal plan that solved the entire program at an abstract level, and then fill in the details.\nDavid Warren's Warplan planner is covered in Warren 1974a,b and in a section of Coelho and Cotta 1988.\nAustin Tate's Nonlin system (Tate 1977) achieved greater efficiency by considering a plan as a partially ordered sequence of operations rather than as a strictly ordered sequence of situations.\nDavid Chapman's Tweak synthesizes and formalizes the state of the art in planning as of 1987.\n\nAll of these papers-and quite a few other important planning papers-are reprinted in Allen, Hendler, and Tate 1990.\n\n## 4.22 Exercises\n\n**Exercise  4.1 [m]** It is possible to implement dbg using a single call to format.\nCan you figure out the format directives to do this?\n\n**Exercise  4.2 [m]** Write a function that generates all permutations of its input.\n\n**Exercise  4.3 [h]** GPS does not recognize the situation where a goal is accidentally solved as part of achieving another goal.\nConsider the goal of eating dessert.\nAssume that there are two operators available: eating ice cream (which requires having the ice cream) and eating cake (which requires having the cake).\nAssume that we can buy a cake, and that the bakery has a deal where it gives out free ice cream to each customer who purchases and eats a cake.\n(1) Design a list of operators to represent this situation.\n(2) Give gps the goal of eating dessert.\nShow that, with the right list of operators, `gps` will decide to eat ice cream, then decide to buy and eat the cake in order to get the free ice cream, and then go ahead and eat the ice cream, even though the goal of eating dessert has already been achieved by eating the cake.\n(3) Fix gps so that it does not manifest this problem.\n\nThe following exercises address the problems in version 2 of the program.\n\n**Exercise  4.4 [h]** *The Not Looking after You Don't Leap Problem*.\nWrite a program that keeps track of the remaining goals so that it does not get stuck considering only one possible operation when others will eventually lead to the goal.\nHint: have achieve take an extra argument indicating the goals that remain to be achieved after the current goal is achieved.\n`achieve` should succeed only if it can achieve the current goal and also `achieve-all` the remaining goals.\n\n**Exercise  4.5 [d]** Write a planning program that, like Warren's Warplan, keeps track of the list of goals that remain to be done as well as the list of goals that have been achieved and should not be undone.\nThe program should never undo a goal that has been achieved, but it should allow for the possibility of reordering steps that have already been taken.\nIn this way, the program will solve the Sussman anomaly and similar problems.\n\n**Exercise  4.6 [d]** *The Lack of Descriptive Power Problem*.\nRead [chapters 5](chapter5.md) and [6](chapter6.md) to learn about pattern matching.\nWrite a version of GPS that uses the pattern matching tools, and thus allows variables in the operators.\nApply it to the maze and blocks world domains.\nYour program will be more efficient if, like Chapman's Tweak program, you allow for the possibility of variables that remain unbound as long as possible.\n\n**Exercise  4.7 [d]** Speculate on the design of a planner that can address the *Perfect Information* and *Interacting Goals* problems.\n\n## 4.23 Answers\n\n**Answer 4.1** In this version, the format string `\"~&~V@T~?\"` breaks down as follows: `\"~&\"` means go to a fresh line; `\"~V@T\"` means insert spaces `(@T)` but use the next argument `(V)` to get the number of spaces.\nThe `\"~?\"` is the indirection operator: use the next argument as a format string, and the argument following that as the list of arguments for the format string.\n\n```lisp\n(defun dbg-indent (id indent format-string &rest args)\n  \"Print indented debugging info if (DEBUG ID) has been specified.\"\n  (when (member id *dbg-ids*)\n    (format *debug-io* \"~&~V@T~?\" (* 2 indent) format-string args)))\n```\n\n**Answer 4.2** Here is one solution.\nThe sophisticated Lisp programmer should also see the exercise on [page 680](chapter19.md#p680).\n\n```lisp\n(defun permutations (bag)\n  \"Return a list of all the permutations of the input.\"\n  ;; If the input is nil, there is only one permutation:\n  ;; nil itself\n  (if (null bag)\n      '(())\n      ;; Otherwise, take an element, e, out of the bag\n      ;; Generate all permutations of the remaining elements,\n      ;; And add e to the front of each of these.\n      ;; Do this for all possible e to generate all permutations,\n      (mapcan #'(lambda (e)\n          (mapcar #'(lambda (p) (cons e p))\n            (permutations\n              (remove e bag :count 1 :test #'eq))))\n        bag)))\n```\n\n----------------------\n\n<a id=\"fn04-1\"></a><sup>[1](#tfn04-1)</sup>\nStrips is the Stanford Research Institute Problem Solver, designed by [Richard Fikes and Nils Nilsson (1971)](bibliography.md#bb0405).\n\n<a id=\"fn04-2\"></a><sup>[2](#tfn04-2)</sup>\nGerald Sussman, in his book *A Computer Model of Skill Acquisition,* uses the term \"prerequisite clobbers brother goal\" or PCBG.\nI prefer to be gender neutral, even at the risk of being labeled a historical revisionist.\n\n<a id=\"fn04-3\"></a><sup>[3](#tfn04-3)</sup>\nOriginally posed by [Saul Amarel (1968)](bibliography.md#bb0045).\n\n<a id=\"fn04-4\"></a><sup>[4](#tfn04-4)</sup>\nA footnote in Waldinger 1977 says, \"This problem was proposed by Allen Brown.\nPerhaps many children thought of it earlier but did not recognize that it was hard.\" The problem is named after Gerald Sussman because he popularized it in Sussman 1973.\n"
  },
  {
    "path": "docs/chapter5.md",
    "content": "# Chapter 5\n## ELIZA: Dialog with a Machine\n\n> *It is said that to explain is to explain away.*\n\n> -Joseph Weizenbaum\n\n> MIT computer scientist\n\nThis chapter and the rest of part I will examine three more well-known AI programs of the 1960s.\nELIZA held a conversation with the user in which it simulated a psychotherapist.\nSTUDENT solved word problems of the kind found in high school algebra books, and MACSYMA solved a variety of symbolic mathematical problems, including differential and integral calculus.\nWe will develop versions of the first two programs that duplicate most of the essential features, but for the third we will implement only a tiny fraction of the original program's capabilities.\n\nAll three programs make heavy use of a technique called pattern matching.\nPart I serves to show the versatility-and also the limitations-of this technique.\n\nOf the three programs, the first two process input in plain English, and the last two solve non-trivial problems in mathematics, so there is some basis for describing them as being \"intelligent.\"\nOn the other hand, we shall see that this intelligence is largely an illusion, and that ELIZA in particular was actually designed to demonstrate this illusion, not to be a \"serious\" AI program.\n\nELIZA was one of the first programs to feature English output as well as input.\nThe program was named after the heroine of *Pygmalion,* who was taught to speak proper English by a dedicated teacher.\nELIZA's principal developer, MIT professor Joseph Weizenbaum, published a paper on ELIZA in the January 1966 issue of the *Communications of the Association for Computing Machinery.*\nThe introduction to that paper is reproduced in its entirety here:\n\n> *It is said that to explain is to explain away.\nThis maxim is nowhere so well fulfilled as in the area of computer programming, especially in what is called heuristic programming and artificial intelligence.\nFor in those realms machines are made to behave in wondrous ways, often sufficient to dazzle even the most experienced observer.\nBut once a particular program is unmasked, once its inner workings are explained in language sufficiently plain to induce understanding, its magic crumbles away; it stands revealed as a mere collection of procedures, each quite comprehensible.\nThe observer says to himself, \"I could have written that.\" With that thought he moves the program in question from the shelf marked \"intelligent,\" to that reserved for curios, fit to be discussed only with people less enlightened than he.*\n\n> *The object of this paper is to cause just such a re-evaluation of the program about to be \"explained.\" Few programs ever needed it more.*\n\nLet me point out in passing that the main object of this book is to cause the reader to say to him or herself, \"I could have written that.\" It is hoped that in some cases this will be because the reader has gained something, and not solely because the programs in question have lost their ability to dazzle.\n\nLet's start our investigation of ELIZA by looking at a sample dialog from the Weizenbaum article.\nELIZA was designed to be instructed by a variety of scripts, or patterns of interaction.\nIn fact it had several scripts, including ones in German and Welsh.\nBut the only script that was used to any extent was in English, and it made ELIZA emulate a Rogerian psychoanalyst.\nRogerians are \"nondirective\"-they try to let the patient reveal himself.\nThis is an easy script for ELIZA to follow, because it involves being passive and reacting, rather than volunteering new information.\nIn the listing that follows, the user's input is in mixed case, and ELIZA's response is in capitals:\n\n```text\nMen are all alike.\nIN WHAT WAY\nThey're always bugging us about something or another.\nCAN YOU BE MORE SPECIFIC\nWell, my boyfriend made me come here.\nYOUR BOYFRIEND MADE YOU COME HERE\nHe says I'm depressed much of the time.\nI AM SORRY TO HEAR YOU ARE DEPRESSED\nIt's true. I am unhappy.\nDO YOU THINK COMING HERE WILL HELP YOU NOT TO BE UNHAPPY\nI need some help, that much seems certain.\nWHAT WOULD IT MEAN TO YOU IF YOU GOT SOME HELP\nPerhaps I could learn to get along with my mother.\nTELL ME MORE ABOUT YOUR FAMILY\n```\n\nThis seems quite impressive; the program is responding reasonably to a variety of inputs and appears to be exhibiting true \"understanding.\"\nBut, as Weizenbaum explains, this appearance is an illusion, and the program has finessed the difficult task of understanding by carefully recognizing, transforming, and echoing pieces of the input.\nThe procedure is to look for specific patterns, based on a key word or words in the input.\nFor example, whenever the program sees the words \"alike\" or \"same,\" it prints a message asking about similarity, in this case, \"`IN WHAT WAY.`\" Other patterns are more complicated.\nIn the next to last exchange, ELIZA first throws away everything after the comma, and then uses a pattern that looks for input of the form \"I need X\" and transforms it to the output \"What would it mean to you if you got X,\" where X is the phrase \"some help\" in this case.\nThe great advantage of this approach is that the response will make sense for a variety of inputs: \"I need a vacation\" will elicit \"What would it mean to you if you got a vacation.\" This will work automatically, without having to tell the program the difference between \"some help\" and \"a vacation.\" The disadvantage is that the program will sometimes make silly responses: \"I need this like a hole in the head\" will be answered with \"What would it mean to you if you got this like a hole in the head.\" In fact, the program only makes any sense at all if it is receiving input from someone who makes sense-and someone who interprets its answers charitably.\nWhen given \"I need gibble plix zzq,\" ELIZA would reply \"What would it mean to you if you got gibble plix zzq,\" without any inkling that something is wrong.\nAnother example of the original ELIZA program has it communicating with another program, PARRY, which was written by Dr. Kenneth Colby to mimic paranoid behavior.\nPart of the conversation follows, with ELIZA again in capitals and PARRY in mixed case:\n\n```text\nI don't understand your motives.\nWHY DON'T YOU UNDERSTAND MY MOTIVES?\nShouldn't I be?\nWHY DO YOU SAY THAT JUST NOW?\nThat's just the way it is.\nSUPPOSE THAT'S JUST THE WAY IT WERE NOT.\nSo?\nI AM NOT SURE I UNDERSTAND YOU FULLY.\nYou harp on the same questions too much.\nWHAT DOES THAT SIMILARITY SUGGEST TO YOU?\nI don't get you.\nDO YOU WISH THAT YOU DID GET I?\n```\n\nThis suggests that neither ELIZA nor PARRY had a deep understanding of the dialog.\nWhen there is a human to take on most of the burden of carrying forth the conversation, these programs can be convincing, but when the human is taken out of the conversation, the weaknesses of the programs are revealed.\n\n## 5.1 Describing and Specifying ELIZA\nNow that we have an idea of what ELIZA is like, we can begin the description and specification of the program, and eventually move to the implementation and debugging.\n\nThe ELIZA algorithm can be described simply as: (1) read an input, (2) find a pattern that matches the input, (3) transform the input into a response, and (4) print the response.\nThese four steps are repeated for each input.\n\nThe specification and implementation of steps (1) and (4) are trivial: for (1), use the built-in `read` function to read a list of words, and for (4) use `print` to print the list of words in the response.\n\nOf course, there are some drawbacks to this specification.\nThe user will have to type a real list-using parentheses-and the user can't use characters that are special to `read`, like quotation marks, commas, and periods.\nSo our input won't be as unconstrained as in the sample dialog, but that's a small price to pay for the convenience of having half of the problem neatly solved.\n\n## 5.2 Pattern Matching\nThe hard part comes with steps (2) and (3)-this notion of pattern matching and transformation.\nThere are four things to be concerned with: a general pattern and response, and a specific input and transformation of that input.\nSince we have agreed to represent the input as a list, it makes sense for the other components to be lists too.\nFor example, we might have:\n\n```text\nPattern: (i need a X)\nResponse: (what would it mean to you if you got a X ?)\n\nInput: (i need a vacation)\nTransformation: (what would it mean to you if you got a vacation ?)\n```\n\nThe pattern matcher must match the literals `i` with `i`, `need` with `need`, and `a` with `a`, as well as match the variable `X` with `vacation`.\nThis presupposes that there is some way of deciding that `X` is a variable and that `need` is not.\nWe must then arrange to substitute `vacation` for `X` within the response, in order to get the final transformation.\n\nIgnoring for a moment the problem of transforming the pattern into the response, we can see that this notion of pattern matching is just a generalization of the Lisp function `equal`.\nBelow we show the function `simple-equal`, which is like the built-in function `equal`,<a id=\"tfn05-1\"></a><sup>[1](#fn05-1)</sup>\nand the function `pat-match`, which is extended to handle pattern-matching variables:\n\n```lisp\n(defun simple-equal (x y)\n   \"Are x and y equal?  (Don't check inside strings.)\"\n   (if (or (atom x) (atom y))\n       (eql x y)\n       (and (simple-equal (first x) (first y))\n            (simple-equal (rest x) (rest y)))))\n\n(defun pat-match (pattern input)\n  \"Does pattern match input? Any variable can match anything.\"\n  (if (variable-p pattern)\n      t\n      (if (or (atom pattern) (atom input))\n          (eql pattern input)\n          (and (pat-match (first pattern) (first input))\n               (pat-match (rest pattern) (rest input))))))\n```\n\n&#9635; **Exercise 5.1 [s]** Would it be a good idea to replace the complex and form in `pat-match` with the simpler `(every #'pat-match pattern input)?`\n\nBefore we can go on, we need to decide on an implementation for pattern-matching variables.\nWe could, for instance, say that only a certain set of symbols, such as {X, Y, Z}, are variables.\nAlternately, we could define a structure of type `variable`, but then we'd have to type something verbose like `(make-variable :name' X )` every time we wanted one.\nAnother choice would be to use symbols, but to distinguish variables from constants by the name of the symbol.\nFor example, in Prolog, variables start with capital letters and constants with lowercase.\nBut Common Lisp is case-insensitive, so that won't work.\nInstead, there is a tradition in Lisp-based AI programs to have variables be symbols that start with the question mark character.\n\nSo far we have dealt with symbols as atoms-objects with no internal structure.\nBut things are always more complicated than they first appear and, as in Lisp as in physics, it turns out that even atoms have components.\nIn particular, symbols have names, which are strings and are accessible through the `symbol-name` function.\nStrings in turn have elements that are characters, accessible through the function `char`.\nThe character '?' is denoted by the self-evaluating escape sequence `#\\?`.\nSo the predicate `variable-p` can be defined as follows, and we now have a complete pattern matcher:\n\n```lisp\n(defun variable-p (x)\n  \"Is X a variable (a symbol beginning with '?')?\"\n  (and (symbolp x) (equal (char (symbol-name x) 0) #\\?)))\n\n> (pat-match '(I need a ?X) '(I need a vacation))\nT\n> (pat-match '(I need a ?X) '(I really need a vacation))\nNIL\n```\n\nIn each case we get the right answer, but we don't get any indication of what `?X` is, so we couldn't substitute it into the response.\nWe need to modify `pat-match` to return some kind of table of variables and corresponding values.\nIn making this choice, the experienced Common Lisp programmer can save some time by being opportunistic: recognizing when there is an existing function that will do a large part of the task at hand.\nWhat we want is to substitute values for variables throughout the response.\nThe alert programmer could refer to the index of this book or the Common Lisp reference manual and find the functions `substitute`, `subst`, and `sublis`.\nAll of these substitute some new expression for an old one within an expression.\nIt turns out that `sublis` is most appropriate because it is the only one that allows us to make several substitutions all at once.\n`sublis` takes two arguments, the first a list of old-new pairs, and the second an expression in which to make the substitutions.\nFor each one of the pairs, the `car` is replaced by the `cdr`.\nIn other words, we would form each pair with something like `(cons old new)`.\n(Such a list of pairs is known as an *association list*, or *a-list,* because it associates keys with values.\nSee section 3.6.)\nIn terms of the example above, we would use:\n\n```lisp\n> (sublis '((?X . vacation))\n          '(what would it mean to you if you got a ?X ?))\n(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)\n```\n\nNow we need to arrange for `pat-match` to return an a-list, rather than just `T` for success.\nHere's a first attempt:\n\n```lisp\n(defun pat-match (pattern input)\n   \"Does pattern match input? WARNING: buggy version.\"\n   (if (variable-p pattern)\n       (list (cons pattern input))\n       (if (or (atom pattern) (atom input))\n           (eql pattern input)\n           (append (pat-match (first pattern) (first input))\n                   (pat-match (rest pattern) (rest input))))))\n```\n\nThis implementation looks reasonable: it returns an a-list of one element if the pattern is a variable, and it appends alists if the pattern and input are both lists.\nHowever, there are several problems.\nFirst, the test `(eql pattern input)` may return `T`, which is not a list, so `append` will complain.\nSecond, the same test might return nil, which should indicate failure, but it will just be treated as a list, and will be appended to the rest of the answer.\nThird, we haven't distinguished between the case where the match fails-and returns nil-versus the case where everything matches, but there are no variables, so it returns the null a-list.\n(This is the semipredicate problem discussed on page 127.)\nFourth, we want the bindings of variables to agree-if `?X` is used twice in the pattern, we don't want it to match two different values in the input.\nFinally, it is inefficient for `pat-match` to check both the `first` and `rest` of lists, even when the corresponding `first` parts fail to match.\n(Isn't it amazing that there could be five bugs in a seven-line function?)\n\nWe can resolve these problems by agreeing on two major conventions.\nFirst, it is very convenient to make `pat-match` a true predicate, so we will agree that it returns `nil` only to indicate failure.\nThat means that we will need a non-nil value to represent the empty binding list.\nSecond, if we are going to be consistent about the values of variables, then the `first` will have to know what the `rest` is doing.\nWe can accomplish this by passing the binding list as a third argument to `pat-match`.\nWe make it an optional argument, because we want to be able to say simply `(pat-match *a b*)`.\n\nTo abstract away from these implementation decisions, we define the constants `fail` and `no-bindings` to represent the two problematic return values.\nThe special form `defconstant` is used to indicate that these values will not change.\n(It is customary to give special variables names beginning and ending with asterisks, but this convention usually is not followed for constants.\nThe reasoning is that asterisks shout out, \"Careful!\nI may be changed by something outside of this lexical scope.\" Constants, of course, will not be changed.)\n\n```lisp\n(defconstant fail nil \"Indicates pat-match failure\")\n\n(defconstant no-bindings '((t . t))\n  \"Indicates pat-match success, with no variables.\")\n```\n\nNext, we abstract away from `assoc` by introducing the following four functions:\n\n```lisp\n(defun get-binding (var bindings)\n  \"Find a (variable . value) pair in a binding list.\"\n  (assoc var bindings))\n\n(defun binding-val (binding)\n  \"Get the value part of a single binding.\"\n  (cdr binding))\n\n(defun lookup (var bindings)\n  \"Get the value part (for var) from a binding list.\"\n  (binding-val (get-binding var bindings)))\n\n(defun extend-bindings (var val bindings)\n  \"Add a (var . value) pair to a binding list.\"\n  (cons (cons var val) bindings))\n```\n\nNow that variables and bindings are defined, `pat-match` is easy.\nIt consists of five cases.\nFirst, if the binding list is `fail`, then the match fails (because some previous match must have failed).\nIf the pattern is a single variable, then the match returns whatever `match-variable` returns; either the existing binding list, an extended one, or `fail`.\nNext, if both pattern and input are lists, we first call `pat-match` recursively on the first element of each list.\nThis returns a binding list (or `fail`), which we use to match the rest of the lists.\nThis is the only case that invokes a nontrivial function, so it is a good idea to informally prove that the function will terminate: each of the two recursive calls reduces the size of both pattern and input, and `pat-match` checks the case of atomic patterns and inputs, so the function as a whole must eventually return an answer (unless both pattern and input are of infinite size).\nIf none of these four cases succeeds, then the match fails.\n\n```lisp\n(defun pat-match (pattern input &optional (bindings no-bindings))\n   \"Match pattern against input in the context of the bindings\"\n   (cond ((eq bindings fail) fail)\n         ((variable-p pattern)\n          (match-variable pattern input bindings))\n         ((eql pattern input) bindings)\n         ((and (consp pattern) (consp input))\n          (pat-match (rest pattern) (rest input)\n                     (pat-match (first pattern) (first input)\n                                bindings)))\n         (t fail)))\n\n(defun match-variable (var input bindings)\n  \"Does VAR match input? Uses (or updates) and returns bindings.\"\n  (let ((binding (get-binding var bindings)))\n    (cond ((not binding) (extend-bindings var input bindings))\n          ((equal input (binding-val binding)) bindings)\n          (t fail))))\n```\n\nWe can now test `pat-match` and see how it works:\n\n```lisp\n> (pat-match '(i need a ?X) '(i need a vacation))\n((?X . VACATION) (T . T))\n```\n\nThe answer is a list of variable bindings in dotted pair notation; each element of the list is a (`*variable . value*`) pair.\nThe `(T . T)` is a remnant from `no-bindings`.\nIt does no real harm, but we can eliminate it by making `extend-bindings` a little more complicated:\n\n```lisp\n(defun extend-bindings (var val bindings)\n   \"Add a (var . value) pair to a binding list. \"\n   (cons (cons var val)\n         ;; Once we add a \"real\" binding,\n         ;; we can get rid of the dummy no-bindings\n         (if (eq bindings no-bindings)\n             nil\n             bindings)))\n\n> (sublis (pat-match ' (i need a ?X) ' (i need a vacation))\n          '(what would it mean to you if you got a ?X ?))\n(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)\n\n> (pat-match ' (i need a ?X) ' (i really need a vacation))\nNIL\n\n> (pat-match ' (this is easy) ' (this is easy))\n((T . T))\n\n> (pat-match ' (?X is ?X) ' ((2 + 2) is 4))\nNIL\n\n> (pat-match ' (?X is ?X) ' ((2 + 2) is (2 + 2)))\n((?X 2 + 2))\n\n> (pat-match ' (?P need . ?X) ' (i need a long vacation))\n((?X A LONG VACATION) (?P . I ))\n```\n\nNotice the distinction between `NIL` and `((T . T))`.\nThe latter means that the match succeeded, but there were no bindings to return.\nAlso, remember that `(?X 2 + 2)` means the same as `(?X . (2 + 2))`.\n\nA more powerful implementation of `pat-match` is given in [chapter 6](chapter6.md).\nYet another implementation is given in section 10.4.\nIt is more efficient but more cumbersome to use.\n\n## 5.3 Segment Pattern Matching\nIn the pattern `(?P need . ?X)`, the variable `?X` matches the rest of the input list, regardless of its length.\nThis is in contrast to `?P`, which can only match a single element, namely, the first element of the input.\nFor many applications of pattern matching, this is fine; we only want to match corresponding elements.\nHowever, ELIZA is somewhat different in that we need to account for variables in any position that match a sequence of items in the input.\nWe will call such variables *segment variables.* We will need a notation to differentiate segment variables from normal variables.\nThe possibilities fall into two classes: either we use atoms to represent segment variables and distinguish them by some spelling convention (as we did to distinguish variables from constants) or we use a nonatomic construct.\nWe will choose the latter, using a list of the form (`?*`*variable*) to denote segment variables.\nThe symbol `?*` is chosen because it combines the notion of variable with the Kleenestar notation.\nSo, the behavior we want from `pat-match` is now:\n\n```lisp\n> (pat-match '((?* ?p) need (?* ?x))\n             '(Mr Hulot and I need a vacation))\n((?P MR HULOT AND I) (?X A VACATION))\n```\n\nIn other words, when both pattern and input are lists and the first element of the pattern is a segment variable, then the variable will match some initial part of the input, and the rest of the pattern will attempt to match the rest.\nWe can update `pat-match` to account for this by adding a single cond-clause.\nDefining the predicate to test for segment variables is also easy:\n\n```lisp\n (defun pat-match (pattern input &optional (bindings no-bindings))\n   \"Match pattern against input in the context of the bindings\"\n   (cond ((eq bindings fail) fail)\n         ((variable-p pattern)\n          (match-variable pattern input bindings))\n         ((eql pattern input) bindings)\n         ((segment-pattern-p pattern)                ; ***\n          (segment-match pattern input bindings))    ; ***\n         ((and (consp pattern) (consp input))\n          (pat-match (rest pattern) (rest input)\n                     (pat-match (first pattern) (first input)\n                                bindings)))\n         (t fail)))\n\n(defun segment-pattern-p (pattern)\n  \"Is this a segment matching pattern: ((?* var) . pat)\"\n  (and (consp pattern)\n       (starts-with (first pattern) '?*)))\n```\n\nIn writing `segment-match`, the important question is how much of the input the segment variable should match.\nOne answer is to look at the next element of the pattern (the one after the segment variable) and see at what position it occurs in the input.\nIf it doesn't occur, the total pattern can never match, and we should `fail`.\nIf it does occur, call its position `pos`.\nWe will want to match the variable against the initial part of the input, up to `pos`.\nBut first we have to see if the rest of the pattern matches the rest of the input.\nThis is done by a recursive call to `pat-match`.\nLet the result of this recursive call be named `b2`.\nIf `b2` succeeds, then we go ahead and match the segment variable against the initial subsequence.\n\nThe tricky part is when `b2` fails.\nWe don't want to give up completely, because it may be that if the segment variable matched a longer subsequence of the input, then the rest of the pattern would match the rest of the input.\nSo what we want is to try `segment-match` again, but forcing it to consider a longer match for the variable.\nThis is done by introducing an optional parameter, `start`, which is initially 0 and is increased with each failure.\nNotice that this policy rules out the possibility of any kind of variable following a segment variable.\n(Later we will remove this constraint.)\n\n```lisp\n(defun segment-match (pattern input bindings &optional (start 0))\n   \"Match the segment pattern ((?* var) . pat) against input.\"\n   (let ((var (second (first pattern)))\n         (pat (rest pattern)))\n     (if (null pat)\n         (match-variable var input bindings)\n         ;; We assume that pat starts with a constant\n         ;; In other words, a pattern can't have 2 consecutive vars\n         (let ((pos (position (first pat) input\n                              :start start :test #'equal)))\n           (if (null pos)\n               fail\n               (let ((b2 (pat-match pat (subseq input pos) bindings)))\n                 ;; If this match failed, try another longer one\n                 ;; If it worked, check that the variables match\n                 (if (eq b2 fail)\n                     (segment-match pattern input bindings (+ pos 1))\n                     (match-variable var (subseq input 0 pos) b2))))))))\n```\n\nSome examples of segment matching follow:\n\n```lisp\n> (pat-match '((?* ?p) need (?* ?x))\n       '(Mr Hulot and I need a vacation))\n((?P MR HULOT AND I) (?X A VACATION))\n\n> (pat-match '((?* ?x) is a (?* ?y)) '(what he is is a fool))\n((?X WHAT HE IS) (?Y FOOL))\n```\n\nThe first of these examples shows a fairly simple case: `?p` matches everything up to need, and `?x` matches the rest.\nThe next example involves the more complicated backup case.\nFirst `?x` matches everything up to the first `is` (this is position 2, since counting starts at 0 in Common Lisp).\nBut then the pattern `a` fails to match the input `is`, so `segment-match` tries again with starting position 3.\nThis time everything works; `is` matches `is`, `a` matches `a`, and `(?* ?y)` matches `fool`.\n\nUnfortunately, this version of `segment-match` does not match as much as it should.\nConsider the following example:\n\n```lisp\n> (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) ⇒ NIL\n```\n\nThis fails because `?x` is matched against the subsequence `(1 2)`, and then the remaining pattern successfully matches the remaining input, but the final call to `match-variable` fails, because `?x` has two different values.\nThe fix is to call `match-variable` before testing whether the `b2` fails, so that we will be sure to try `segment-match` again with a longer match no matter what the cause of the failure.\n\n```lisp\n(defun segment-match (pattern input bindings &optional (start 0))\n   \"Match the segment pattern ((?* var) . pat) against input.\"\n   (let ((var (second (first pattern)))\n         (pat (rest pattern)))\n     (if (null pat)\n         (match-variable var input bindings)\n         ;; We assume that pat starts with a constant\n         ;; In other words, a pattern can't have 2 consecutive vars\n         (let ((pos (position (first pat) input\n                              :start start :test #'equal)))\n           (if (null pos)\n               fail\n               (let ((b2 (pat-match\n                          pat (subseq input pos)\n                          (match-variable var (subseq input 0 pos)\n                                          bindings))))\n                 ;; If this match failed, try another longer one\n                 (if (eq b2 fail)\n                     (segment-match pattern input bindings (+ pos 1))\n                     b2)))))))\n```\n\nNow we see that the match goes through:\n\n```lisp\n> (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b))\n((?X 1 2 A B))\n```\n\nNote that this version of `segment-match` tries the shortest possible match first.\nIt would also be possible to try the longest match first.\n\n## 5.4 The ELIZA Program: A Rule-Based Translator\nNow that we have a working pattern matcher, we need some patterns to match.\nWhat's more, we want the patterns to be associated with responses.\nWe can do this by inventing a data structure called a `rule`, which consists of a pattern and one or more associated responses.\nThese are rules in the sense that they assert, \"If you see A, then respond with B or C, chosen at random.\" We will choose the simplest possible implementation for rules: as lists, where the first element is the pattern and the rest is a list of responses:\n\n```lisp\n(defun rule-pattern (rule) (first rule))\n\n(defun rule-responses (rule) (rest rule))\n```\n\nHere's an example of a rule:\n\n```lisp\n(((?* ?x) I want (?* ?y))\n (What would it mean if you got ?y)\n (Why do you want ?y)\n (Suppose you got ?y soon))\n```\n\nWhen applied to the input `(I want to test this program)`, this rule (when interpreted by the ELIZA program) would pick a response at random, substitute in the value of `?y`, and respond with, say, `(why do you want to test this program)`.\n\nNow that we know what an individual rule will do, we need to decide how to handle a set of rules.\nIf ELIZA is to be of any interest, it will have to have a variety of responses.\nSo several rules may all be applicable to the same input.\nOne possibility would be to choose a rule at random from among the rules having patterns that match the input.\n\nAnother possibility is just to accept the first rule that matches.\nThis implies that the rules form an ordered list, rather than an unordered set.\nThe clever ELIZA rule writer can take advantage of this ordering and arrange for the most specific rules to come first, while more vague rules are near the end of the list.\n\nThe original ELIZA had a system where each rule had a priority number associated with it.\nThe matching rule with the highest priority was chosen.\nNote that putting the rules in order achieves the same effect as having a priority number on each rule: the first rule implicitly has the highest priority, the second rule is next highest, and so on.\n\nHere is a short list of rules, selected from Weizenbaum's original article, but with the form of the rules updated to the form we are using.\nThe answer to exercise 5.18 contains a longer list of rules.\n\n```lisp\n(defparameter *eliza-rules*\n  '((((?* ?x) hello (?* ?y))\n     (How do you do. Please state your problem.))\n    (((?* ?x) I want (?* ?y))\n     (What would it mean if you got ?y)\n     (Why do you want ?y) (Suppose you got ?y soon))\n    (((?* ?x) if (?* ?y))\n     (Do you really think its likely that ?y) (Do you wish that ?y)\n     (What do you think about ?y) (Really-- if ?y))\n    (((?* ?x) no (?* ?y))\n     (Why not?) (You are being a bit negative)\n     (Are you saying \"NO\" just to be negative?))\n    (((?* ?x) I was (?* ?y))\n     (Were you really?) (Perhaps I already knew you were ?y)\n     (Why do you tell me you were ?y now?))\n    (((?* ?x) I feel (?* ?y))\n     (Do you often feel ?y ?))\n    (((?* ?x) I felt (?* ?y))\n     (What other feelings do you have?))))\n```\n\nFinally we are ready to define ELIZA proper.\nAs we said earlier, the main program should be a loop that reads input, transforms it, and prints the result.\nTransformation is done primarily by finding some rule such that its pattern matches the input, and then substituting the variables into the rule's response.\nThe program is summarized in figure 5.1.\n\nFigure 5.1: Glossary for the ELIZA Program\n\n| Symbol             | Use                                                   |\n| ------             | ---                                                   |\n|                    | **Top-Level Function**                                |\n| `eliza`            | Respond to user input using pattern matching rules.   |\n|                    | **Special Variables**                                 |\n| `*eliza-rules*`    | A list of transformation rules.                       |\n|                    | **Data Types**                                        |\n| `rule`             | An association of a pattern with a list of responses. |\n|                    | **Functions**                                         |\n| `eliza`            | Respond to user input using pattern matching rules.   |\n| `use-eliza-rules`  | Find some rule with which to transform the input.     |\n| `switch-viewpoint` | Change I to you and vice versa, and so on.            |\n| `flatten`          | Append together elements of a list.                   |\n|                    | **Selected Common Lisp Functions**                    |\n| `sublis`           | Substitute elements into a tree.                      |\n|                    | **Previously Defined Functions**                      |\n| `random-elt`       | Pick a random element from a list. (p. 36)            |\n| `pat-match`        | Match a pattern against an input, (p. 160)            |\n| `mappend`          | Append together the results of a mapcar.              |\n\nThere are a few minor complications.\nWe print a prompt to tell the user to input something.\nWe use the function `flatten` to insure that the output won't have embedded lists after variable substitution.\nAn important trick is to alter the input by swapping \"you\" for \"me\" and so on, since these terms are relative to the speaker.\nHere is the complete program:\n\n```lisp\n(defun eliza ()\n  \"Respond to user input using pattern matching rules.\"\n  (loop\n   (print 'eliza>)\n   (write (flatten (use-eliza-rules (read))) :pretty t)))\n\n (defun use-eliza-rules (input)\n   \"Find some rule with which to transform the input.\"\n   (some #'(lambda (rule)\n             (let ((result (pat-match (rule-pattern rule) input)))\n               (if (not (eq result fail))\n                   (sublis (switch-viewpoint result)\n                           (random-elt (rule-responses rule))))))\n         *eliza-rules*))\n\n(defun switch-viewpoint (words)\n  \"Change I to you and vice versa, and so on.\"\n  (sublis '((I . you) (you . I) (me . you) (am . are))\n          words))\n```\n\nNote the use of `write` with the `:pretty` keyword true.\nThis will give better formatted output in some cases.\nThe program makes use of the previously defined `random-elt`, and `flatten`, which is defined here using `mappend` and `mklist`, a function that is defined in the InterLisp dialect but not in Common Lisp.\n\n```lisp\n(defun flatten (the-list)\n  \"Append together elements (or lists) in the list.\"\n  (mappend #'mklist the-list))\n\n(defun mklist (x)\n  \"Return x if it is a list, otherwise (x).\"\n  (if (listp x)\n      x\n    (list x)))\n\n(defun mappend (fn the-list)\n  \"Apply fn to each element of list and append the result.\"\n  (apply #'append (mapcar fn the-list)))\n\n(defun random-elt (choices)\n  \"Choose an element from a list at random.\"\n  (elt choices (random (length choices))))\n```\n\nThe actual ELIZA program had a few complications that don't show up in this version.\nFirst, there was an alias method for associating several words with the same pattern; both \"mother\" and \"father\" could be associated with the \"family\" pattern.\nThere was also a synonym mechanism that would treat \"don't\" and \"do not\" or \"everybody\" and \"everyone\" the same.\nIn the case of input with several comma-separated phrases, each phrase was processed separately, and the response with the highest priority was selected.\nIn addition, the original ELIZA had a \"memory\" mechanism.\nWhen no pattern matched the input, it said something like \"Tell me more about X,\" where X is some input given earlier.\nFinally, our version has fewer rules.\nDespite the shortcomings of our version, it can occasionally hold up its end of a conversation, as shown below:\n\n```text\n> (eliza)\nELIZA> (hello there)\n(HOW DO YOU DO. PLEASE STATE YOUR PROBLEM.)\nELIZA> (i want to test this program)\n(WHAT WOULD IT MEAN IF YOU GOT TO TEST THIS PROGRAM)\nELIZA> (i could see if it works)\n(DO YOU REALLY THINK ITS LIKELY THAT IT WORKS)\nELIZA> (no not really)\n(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?)\nELIZA> (no)\n(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?)\nELIZA> (forget it-- i was wondering how general the program is)\n(WHY DO YOU TELL ME YOU WERE WONDERING HOW GENERAL THE PROGRAM IS NOW?)\nELIZA> (i felt like it)\n(WHAT OTHER FEELINGS DO YOU HAVE?)\nELIZA> (i feel this is enough)\n(DO YOU OFTEN FEEL THIS IS ENOUGH ?)\nELIZA> [Abort]\n```\n\nIn the end, it is the technique that is important-not the program.\nELIZA has been \"explained away\" and should rightfully be moved to the curio shelf.\nPattern matching in general remains important technique, and we will see it again in subsequent chapters.\nThe notion of a rule-based translator is also important.\nThe problem of understanding English (and other languages) remains an important part of AI.\nClearly, the problem of understanding English is not solved by ELIZA.\nIn part V, we will address the problem again, using more sophisticated techniques.\n\n## 5.5 History and References\nAs mentioned above, the original article describing ELIZA is Weizenbaum 1966.\nAnother dialog system using similar pattern-matching techniques is Kenneth Colby's (1975) PARRY.\nThis program simulated the conversation of a paranoid person well enough to fool several professional psychologists.\nAlthough the pattern matching techniques were simple, the model of belief maintained by the system was much more sophisticated than ELIZA.\nColby has suggested that dialog programs like ELIZA, augmented with some sort of belief model like PARRY, could be useful tools in treating mentally disturbed people.\nAccording to Colby, it would be inexpensive and effective to have patients converse with a specially designed program, one that could handle simple cases and alert doctors to patients that needed more help.\nWeizenbaum's book *Computer Power and Human Reason* (1976) discusses ELIZA and PARRY and takes a very critical view toward Colby's suggestion.\nOther interesting early work on dialog systems that model belief is reported by Allan Collins (1978) and Jamie Carbonell (1981).\n\n## 5.6 Exercises\n&#9635; **Exercise 5.2 [m]** Experiment with this version of ELIZA.\nShow some exchanges where it performs well, and some where it fails.\nTry to characterize the difference.\nWhich failures could be fixed by changing the rule set, which by changing the `pat-match` function (and the pattern language it defines), and which require a change to the `eliza` program itself?\n\n&#9635; **Exercise 5.3 [h]** Define a new set of rules that make ELIZA give stereotypical responses to some situation other than the doctor-patient relationship.\nOr, write a set of rules in a language other than English.\nTest and debug your new rule set.\n\n&#9635; **Exercise 5.4 [s]** We mentioned that our version of ELIZA cannot handle commas or double quote marks in the input.\nHowever, it seems to handle the apostrophe in both input and patterns.\nExplain.\n\n&#9635; **Exercise 5.5 [h]** Alter the input mechanism to handle commas and other punctuation characters.\nAlso arrange so that the user doesn't have to type parentheses around the whole input expression.\n(Hint: this can only be done using some Lisp functions we have not seen yet.\nLook at `read-line` and `read-from-string`.)\n\n&#9635; **Exercise 5.6 [m]** Modify ELIZA to have an explicit exit.\nAlso arrange so that the output is not printed in parentheses either.\n\n&#9635; **Exercise 5.7 [m]** Add the \"memory mechanism\" discussed previously to ELIZA.\nAlso add some way of defining synonyms like \"everyone\" and \"everybody.\"\n\n\n&#9635; **Exercise 5.8 [h]** It turns out that none of the rules in the given script uses a variable more than once-there is no rule of the form `(?x... ?x)`.\nWrite a pattern matcher that only adds bindings, never checks variables against previous bindings.\nUse the `time` special form to compare your function against the current version.\n\n&#9635; **Exercise 5.9 [h]** Winston and Horn's book *Lisp* presents a good pattern-matching program.\nCompare their implementation with this one.\nOne difference is that they handle the case where the first element of the pattern is a segment variable with the following code (translated into our notation):\n\n```lisp\n(or (pat-match (rest pattern) (rest input) bindings)\n  (pat-match pattern (rest input) bindings))\n```\n\nThis says that a segment variable matches either by matching the first element of the input, or by matching more than the first element.\nIt is much simpler than our approach using `position`, partly because they don't update the binding list.\nCan you change their code to handle bindings, and incorporate it into our version of `pat-match`?\nIs it still simpler?\nIs it more or less efficient?\n\n&#9635; **Exercise 5.10** What is wrong with the following definition of `simple-equal`?\n\n```lisp\n(defun simple-equal (x y)\n  \"Test if two lists or atoms are equal.\"\n  ;; Warning - incorrect\n  (or (eql x y)\n      (and (listp x) (listp y)\n     (simple-equal (first x) (first y))\n     (simple-equal (rest x) (rest y)))))\n```\n\n&#9635; **Exercise 5.11 [m]** Weigh the advantages of changing `no-bindings` to `nil`, and `fail` to something else.\n\n&#9635; **Exercise 5.12 [m]** Weigh the advantages of making `pat-match` return multiple values: the first would be true for a match and false for failure, and the second would be the binding list.\n\n&#9635; **Exercise 5.13 [m]** Suppose that there is a call to `segment-match` where the variable already has a binding.\n\nThe current definition will keep making recursive calls to `segment-match`, one for each possible matching position.\nBut this is silly-if the variable is already bound, there is only one sequence that it can possibly match against.\nChange the definition so that it looks only for this one sequence.\n\n&#9635; **Exercise 5.14 [m]** Define a version of `mappend` that, like `mapcar`, accepts any number of argument lists.\n\n&#9635; **Exercise 5.15 [m]** Give an informal proof that `segment-match` always terminates.\n\n&#9635; **Exercise 5.16 [s]** Trick question: There is an object in Lisp which, when passed to `variable-p`, results in an error.\nWhat is that object?\n\n&#9635; **Exercise 5.17 [m]** The current version of ELIZA takes an input, transforms it according to the first applicable rule, and outputs the result.\nOne can also imagine a system where the input might be transformed several times before the final output is printed.\nWould such a system be more powerful?\nIf so, in what way?\n\n&#9635; **Exercise 5.18 [h]** Read Weizenbaum's original article on ELIZA and transpose his list of rules into the notation used in this chapter.\n\n## 5.7 Answers\n### Answer 5.1\nNo.\nIf either the pattern or the input were shorter, but matched every existing element, the every expression would incorrectly return true.\n\n```lisp\n(every #'pat-match '(a b c) '(a)) ⇒ T\n```\n\nFurthermore, if either the pattern or the input were a dotted list, then the result of the every would be undefined-some implementations might signal an error, and others might just ignore the expression after the dot.\n\n```lisp\n(every #'pat-match '(a b . c) '(a b . d)) ⇒ T, NIL, or error.\n```\n\n### Answer 5.4\nThe expression `don't` may look like a single word, but to the Lisp reader it is composed of the two elements `don` and `'t`, or `(quote t )`.\nIf these elements are used consistently, they will match correctly, but they won't print quite right-there will be a space before the quote mark.\nIn fact the `:pretty t` argument to `write` is specified primarily to make `(quote t)` print as `'t`\n(See page 559 of Steele's *Common Lisp the Language*, 2d edition).\n\n### Answer 5.5\nOne way to do this is to read a whole line of text with `read-line` rather than `read`.\nThen, substitute spaces for any punctuation character in that string.\nFinally, wrap the string in parentheses, and read it back in as a list:\n\n```lisp\n(defun read-line-no-punct ()\n  \"Read an input line, ignoring punctuation.\"\n  (read-from-string\n   (concatenate 'string \"(\" (substitute-if #\\space #'punctuation-p\n             (read-line))\n    \")\")))\n\n(defun punctuation-p (char) (find char \".,;:'!?#-()\\\\\\\"\"))\n```\n\nThis could also be done by altering the readtable, as in section 23.5, page 821.\n\n### Answer 5.6\n\n```lisp\n (defun eliza ()\n   \"Respond to user input using pattern matching rules.\"\n   (loop\n     (print 'eliza>)\n     (let* ((input (read-line-no-punct))\n            (response (flatten (use-eliza-rules input))))\n       (print-with-spaces response)\n       (if (equal response '(good bye)) (RETURN)))))\n\n(defun print-with-spaces (list)\n  (mapc #'(lambda (x) (prin1 x) (princ \" \")) list))\n```\n\n***`or`***\n\n```lisp\n(defun print-with-spaces (list)\n  (format t \"~{~a ~}\" list))\n```\n\n### Answer 5.10\nHint: consider `(simple-equal '() '(nil . nil))`.\n\n### Answer 5.14\n\n```lisp\n(defun mappend (fn &rest list)\n  \"Apply fn to each element of lists and append the results.\"\n  (apply #'append (apply #'mapcar fn lists)))\n```\n\n### Answer 5.16\nIt must be a symbol, because for nonsymbols, `variable-p` just returns nil.\nGetting the `symbol-name` of a symbol is just accessing a slot, so that can't cause an error.\nThe only thing left is `elt`; if the symbol name is the empty string, then accessing element zero of the empty string is an error.\nIndeed, there is a symbol whose name is the empty string: the symbol.\n\n### Answer 5.17\nAmong other things, a recursive transformation system could be used to handle abbreviations.\nThat is, a form like \"don't\" could be transformed into \"do not\" and then processed again.\nThat way, the other rules need only work on inputs matching \"do not.\"\n\n### Answer 5.18\nThe following includes most of Weizenbaum's rules:\n\n```lisp\n(defparameter *eliza-rules*\n  '((((?* ?x) hello (?* ?y))\n     (How do you do. Please state your problem.))\n    (((?* ?x) computer (?* ?y))\n     (Do computers worry you?) (What do you think about machines?)\n     (Why do you mention computers?)\n     (What do you think machines have to do with your problem?))\n    (((?* ?x) name (?* ?y))\n     (I am not interested in names))\n    (((?* ?x) sorry (?* ?y))\n     (Please don't apologize) (Apologies are not necessary)\n     (What feelings do you have when you apologize))\n    (((?* ?x) I remember (?* ?y))\n     (Do you often think of ?y)\n     (Does thinking of ?y bring anything else to mind?)\n     (What else do you remember) (Why do you recall ?y right now?)\n     (What in the present situation reminds you of ?y)\n     (What is the connection between me and ?y))\n    (((?* ?x) do you remember (?* ?y))\n     (Did you think I would forget ?y ?)\n     (Why do you think I should recall ?y now)\n     (What about ?y) (You mentioned ?y))\n    (((?* ?x) if (?* ?y))\n     (Do you really think its likely that ?y) (Do you wish that ?y)\n     (What do you think about ?y) (Really-- if ?y))\n    (((?* ?x) I dreamt (?* ?y))\n     (Really-- ?y) (Have you ever fantasized ?y while you were awake?)\n     (Have you dreamt ?y before?))\n    (((?* ?x) dream about (?* ?y))\n     (How do you feel about ?y in reality?))\n    (((?* ?x) dream (?* ?y))\n     (What does this dream suggest to you?) (Do you dream often?)\n     (What persons appear in your dreams?)\n     (Don't you believe that dream has to do with your problem?))\n    (((?* ?x) my mother (?* ?y))\n     (Who else in your family ?y) (Tell me more about your family))\n    (((?* ?x) my father (?* ?y))\n     (Your father) (Does he influence you strongly?)\n     (What else comes to mind when you think of your father?))\n    (((?* ?x) I want (?* ?y))\n     (What would it mean if you got ?y)\n     (Why do you want ?y) (Suppose you got ?y soon))\n    (((?* ?x) I am glad (?* ?y))\n     (How have I helped you to be ?y) (What makes you happy just now)\n     (Can you explain why you are suddenly ?y))\n    (((?* ?x) I am sad (?* ?y))\n     (I am sorry to hear you are depressed)\n     (I'm sure it's not pleasant to be sad))\n    (((?* ?x) are like (?* ?y))\n     (What resemblance do you see between ?x and ?y))\n    (((?* ?x) is like (?* ?y))\n     (In what way is it that ?x is like ?y)\n     (What resemblance do you see?)\n     (Could there really be some connection?) (How?))\n    (((?* ?x) alike (?* ?y))\n     (In what way?) (What similarities are there?))\n    (((?* ?x) same (?* ?y))\n     (What other connections do you see?))\n    (((?* ?x) I was (?* ?y))\n     (Were you really?) (Perhaps I already knew you were ?y)\n     (Why do you tell me you were ?y now?))\n    (((?* ?x) was I (?* ?y))\n     (What if you were ?y ?) (Do you think you were ?y)\n     (What would it mean if you were ?y))\n    (((?* ?x) I am (?* ?y))\n     (In what way are you ?y) (Do you want to be ?y ?))\n    (((?* ?x) am I (?* ?y))\n     (Do you believe you are ?y) (Would you want to be ?y)\n     (You wish I would tell you you are ?y)\n     (What would it mean if you were ?y))\n    (((?* ?x) am (?* ?y))\n     (Why do you say \"AM?\") (I don't understand that))\n    (((?* ?x) are you (?* ?y))\n     (Why are you interested in whether I am ?y or not?)\n     (Would you prefer if I weren't ?y)\n     (Perhaps I am ?y in your fantasies))\n    (((?* ?x) you are (?* ?y))\n     (What makes you think I am ?y ?))\n    (((?* ?x) because (?* ?y))\n     (Is that the real reason?) (What other reasons might there be?)\n     (Does that reason seem to explain anything else?))\n    (((?* ?x) were you (?* ?y))\n     (Perhaps I was ?y) (What do you think?) (What if I had been ?y))\n    (((?* ?x) I can't (?* ?y))\n     (Maybe you could ?y now) (What if you could ?y ?))\n    (((?* ?x) I feel (?* ?y))\n     (Do you often feel ?y ?))\n    (((?* ?x) I felt (?* ?y))\n     (What other feelings do you have?))\n    (((?* ?x) I (?* ?y) you (?* ?z))\n     (Perhaps in your fantasy we ?y each other))\n    (((?* ?x) why don't you (?* ?y))\n     (Should you ?y yourself?)\n     (Do you believe I don't ?y) (Perhaps I will ?y in good time))\n    (((?* ?x) yes (?* ?y))\n     (You seem quite positive) (You are sure) (I understand))\n    (((?* ?x) no (?* ?y))\n     (Why not?) (You are being a bit negative)\n     (Are you saying \"NO\" just to be negative?))\n    (((?* ?x) someone (?* ?y))\n     (Can you be more specific?))\n    (((?* ?x) everyone (?* ?y))\n     (surely not everyone) (Can you think of anyone in particular?)\n     (Who for example?) (You are thinking of a special person))\n    (((?* ?x) always (?* ?y))\n     (Can you think of a specific example) (When?)\n     (What incident are you thinking of?) (Really-- always))\n    (((?* ?x) what (?* ?y))\n     (Why do you ask?) (Does that question interest you?)\n     (What is it you really want to know?) (What do you think?)\n     (What comes to your mind when you ask that?))\n    (((?* ?x) perhaps (?* ?y))\n     (You do not seem quite certain))\n    (((?* ?x) are (?* ?y))\n     (Did you think they might not be ?y)\n     (Possibly they are ?y))\n    (((?* ?x))\n     (Very interesting) (I am not sure I understand you fully)\n     (What does that suggest to you?) (Please continue) (Go on)\n     (Do you feel strongly about discussing such things?))))\n```\n\n----------------------\n\n<a id=\"fn05-1\"></a><sup>[1](#tfn05-1)</sup>\nThe difference is that `simple-equal` does not handle strings.\n"
  },
  {
    "path": "docs/chapter6.md",
    "content": "# Chapter 6\n## Building Software Tools\n\n> *Man is a tool-using animal...Without tools he is nothing with tools he is all.*\n\n> -Thomas Carlyle (1795-1881)\n\nIn [chapters 4](chapter4.md) and [5](chapter5.md) we were concerned with building two particular programs, GPS and ELIZA. In this chapter, we will reexamine those two programs to discover some common patterns.\nThose patterns will be abstracted out to form reusable software tools that will prove helpful in subsequent chapters.\n\n## 6.1 An Interactive Interpreter Tool\n\nThe structure of the function `eliza` is a common one.\nIt is repeated below:\n\n```lisp\n(defun eliza ()\n  \"Respond to user input using pattern matching rules.\"\n  (loop\n    (print 'eliza>)\n    (print (flatten (use-eliza-rules (read))))))\n```\n\nMany other applications use this pattern, including Lisp itself.\nThe top level of Lisp could be defined as:\n\n```lisp\n(defun lisp ()\n  (loop\n    (print '>)\n    (print (eval (read)))))\n```\n\nThe top level of a Lisp system has historically been called the \"read-eval-print loop.\" Most modern Lisps print a prompt before reading input, so it should really be called the \"prompt-read-eval-print loop,\" but there was no prompt in some early systems like MacLisp, so the shorter name stuck.\nIf we left out the prompt, we could write a complete Lisp interpreter using just four symbols:\n\n```lisp\n(loop (print (eval (read))))\n```\n\nIt may seem facetious to say those four symbols and eight parentheses constitute a Lisp interpreter.\nWhen we write that line, have we really accomplished anything?\nOne answer to that question is to consider what we would have to do to write a Lisp (or Pascal) interpreter in Pascal.\nWe would need a lexical analyzer and a symbol table manager.\nThis is a considerable amount of work, but it is all handled by `read`.\nWe would need a syntactic parser to assemble the lexical tokens into statements.\n`read` also handles this, but only because Lisp statements have trivial syntax: the syntax of lists and atoms.\nThus `read` serves fine as a syntactic parser for Lisp, but would fail for Pascal.\nNext, we need the evaluation or interpretation part of the interpreter; `eval` does this nicely, and could handle Pascal just as well if we parsed Pascal syntax into Lisp expressions.\n`print` does much less work than `read` or `eval`, but is still quite handy.\n\nThe important point is not whether one line of code can be considered an implementation of Lisp; it is to recognize common patterns of computation.\nBoth `eliza` and `lisp` can be seen as interactive interpreters that read some input, transform or evaluate the input in some way, print the result, and then go back for more input.\nWe can extract the following common pattern:\n\n```lisp\n(defun *program* ()\n  (loop\n    (print *prompt*)\n    (print (*transform* (read)))))\n```\n\nThere are two ways to make use of recurring patterns like this: formally and informally.\nThe informal alternative is to treat the pattern as a cliche or idiom that will occur frequently in our writing of programs but will vary from use to use.\nWhen we want to write a new program, we remember writing or reading a similar one, go back and look at the first program, copy the relevant sections, and then modify them for the new program.\nIf the borrowing is extensive, it would be good practice to insert a comment in the new program citing the original, but there would be no \"official\" connection between the original and the derived program.\n\nThe formal alternative is to create an abstraction, in the form of functions and perhaps data structures, and refer explicitly to that abstraction in each new application-in other words, to capture the abstraction in the form of a useable software tool.\nThe interpreter pattern could be abstracted into a function as follows:\n\n```lisp\n(defun interactive-interpreter (prompt transformer)\n  \"Read an expression, transform it, and print the result.\"\n  (loop\n    (print prompt)\n    (print (funcall transformer (read)))))\n```\n\nThis function could then be used in writing each new interpreter:\n\n```lisp\n(defun lisp ()\n  (interactive-interpreter '> #'eval))\n\n(defun eliza ()\n  (interactive-interpreter 'eliza>\n    #'(lambda (x) (flatten (use-eliza-rules x)))))\n```\n\nOr, with the help of the higher-order function compose:\n\n```lisp\n(defun compose (f g)\n  \"Return the function that computes (f (g x)).\"\n  #'(lambda (x) (funcall f (funcall g x))))\n\n(defun eliza ()\n  (interactive-interpreter 'eliza>\n    (compose #'flatten #'use-eliza-rules)))\n```\n\nThere are two differences between the formal and informal approaches.\nFirst, they look different.\nIf the abstraction is a simple one, as this one is, then it is probably easier to read an expression that has the loop explicitly written out than to read one that calls `interactive-interpreter`, since that requires finding the definition of `interactive-interpreter` and understanding it as well.\n\nThe other difference shows up in what's called *maintenance*.\nSuppose we find a missing feature in the definition of the interactive interpreter.\nOne such omission is that the `loop` has no exit.\nI have been assuming that the user can terminate the loop by hitting some interrupt (or break, or abort) key.\nA cleaner implementation would allow the user to give the interpreter an explicit termination command.\nAnother useful feature would be to handle errors within the interpreter.\nIf we use the informal approach, then adding such a feature to one program would have no effect on the others.\nBut if we use the formal approach, then improving `interactive-interpreter` would automatically bring the new features to all the programs that use it.\n\nThe following version of `interactive-interpreter` adds two new features.\nFirst, it uses the macro `handler-case`<a id=\"tfn06-1\"></a><sup>[1](#fn06-1)</sup> to handle errors.\nThis macro evaluates its first argument, and normally just returns that value.\nHowever, if an error occurs, the subsequent arguments are checked for an error condition that matches the error that occurred.\nIn this use, the case `error` matches all errors, and the action taken is to print the error condition and continue.\n\nThis version also allows the prompt to be either a string or a function of no arguments that will be called to print the prompt.\nThe function `prompt-generator`, for example, returns a function that will print prompts of the form [1], [2], and so forth.\n\n```lisp\n(defun interactive-interpreter (prompt transformer)\n  \"Read an expression, transform it, and print the result.\"\n  (loop\n    (handler-case\n      (progn\n        (if (stringp prompt)\n            (print prompt)\n            (funcall prompt))\n        (print (funcall transformer (read))))\n      ;; In case of error, do this:\n      (error (condition)\n        (format t \"~&;; Error ~a ignored, back to top level.\"\n                condition)))))\n\n(defun prompt-generator (&optional (num 0) (ctl-string \"[~d] \"))\n  \"Return a function that prints prompts like [l], [2], etc.\"\n  #'(lambda () (format t ctl-string (incf num))))\n```\n\n## 6.2 A Pattern-Matching Tool\n\nThe `pat-match` function was a pattern matcher defined specifically for the ELIZA program.\nSubsequent programs will need pattern matchers too, and rather than write specialized matchers for each new program, it is easier to define one general pattern matcher that can serve most needs, and is extensible in case novel needs come up.\n\nThe problem in designing a \"general\" tool is deciding what features to provide.\nWe can try to define features that might be useful, but it is also a good idea to make the list of features open-ended, so that new ones can be easily added when needed.\n\nFeatures can be added by generalizing or specializing existing ones.\nFor example, we provide segment variables that match zero or more input elements.\nWe can specialize this by providing for a kind of segment variable that matches one or more elements, or for an optional variable that matches zero or one element.\nAnother possibility is to generalize segment variables to specify a match of *m* to *n* elements, for any specified *m* and *n*.\nThese ideas come from experience with notations for writing regular expressions, as well as from very general heuristics for generalization, such as \"consider important special cases\" and \"zero and one are likely to be important special cases.\"\n\nAnother useful feature is to allow the user to specify an arbitrary predicate that a match must satisfy.\nThe notation `(?is ?n numberp)` could be used to match any expression that is a number and bind it to the variable `?n`.\nThis would look like:\n\n```lisp\n> (pat-match '(x = (?is ?n numberp)) '(x = 34)) => ((?n . 34))\n> (pat-match '(x = (?is ?n numberp)) '(x = x)) => NIL\n```\n\nSince patterns are like boolean expressions, it makes sense to allow boolean operators on them.\nFollowing the question-mark convention, we will use `?and`, `?or` and `?not` for the operators.<a id=\"tfn06-2\"></a><sup>[2](#fn06-2)</sup>\nHere is a pattern to match a relational expression with one of three relations.\nIt succeeds because the `<` matches one of the three possibilities specified by `(?or < = >).`\n\n```lisp\n> (pat-match '(?x (?or < = >) ?y) '(3 < 4)) => ((?Y . 4) (?X . 3))\n```\n\nHere is an example of an `?and` pattern that checks if an expression is both a number and odd:\n\n```lisp\n> (pat-match '(x = (?and (?is ?n numberp) (?is ?n oddp))) '(x = 3)) => ((?N . 3))\n```\n\nThe next pattern uses `?not` to insure that two parts are not equal:\n\n```lisp\n> (pat-match '(?x /= (?not ?x)) '(3 /= 4)) => ((?X . 3))\n```\n\nThe segment matching notation we have seen before.\nIt is augmented to allow for three possibilities: zero or more expressions; one or more expressions; and zero or one expressions.\nFinally, the notation `(?if *exp*)` can be used to test a relationship between several variables.\nIt has to be listed as a segment pattern rather than a single pattern because it does not consume any of the input at all:\n\n```lisp\n> (pat-match '(?x > ?y (?if (> ?x ?y))) '(4 > 3)) =>\n((?Y . 3) (?X . 4))\n```\n\nWhen the description of a problem gets this complicated, it is a good idea to attempt a more formal specification.\nThe following table describes a grammar of patterns, using the same grammar rule format described in [chapter 2](chapter2.md).\n\n| []()            |                         |                                                   |\n|-----------------|-------------------------|---------------------------------------------------|\n| *pat*=>         | *var*                   | match any one expression                          |\n|                 | *constant*              | match just this atom                              |\n|                 | *segment-pat*           | match something against a sequence                |\n|                 | *single-pat*            | match something against one expression            |\n|                 | (*pat . pat*)           | match the first and the rest                      |\n| *single-pat*=>  | (`?is` *var predicate*) | test predicate on one expression                  |\n|                 | (`?or` *pat*...)        | match any pattern on one expression               |\n|                 | (`?and` *pat*...)       | match every pattern on one expression             |\n|                 | (`?not` *pat*...)       | succeed if pattern(s) do not match                |\n| *segment-pat*=> | ((`?*` *var*)...)       | match zero or more expressions                    |\n|                 | ((`?+` *var*) ... )     | match one or more expressions                     |\n|                 | ((`??` *var*) ... )     | match zero or one expression                      |\n|                 | ((`?if` *exp* )...)     | test if exp (which may contain variables) is true |\n| *var* =>        | `?`*chars*              | a symbol starting with ?                          |\n| *constant* =>   | *atom*                  | any nonvariable atom                              |\n\nDespite the added complexity, all patterns can still be classified into five cases.\nThe pattern must be either a variable, constant, a (generalized) segment pattern, a (generalized) single-element pattern, or a cons of two patterns.\nThe following definition of `pat-match` reflects the five cases (along with two checks for failure):\n\n```lisp\n(defun pat-match (pattern input &optional (bindings no-bindings))\n  \"Match pattern against input in the context of the bindings\"\n  (cond ((eq bindings fail) fail)\n    ((variable-p pattern)\n      (match-variable pattern input bindings))\n    ((eql pattern input) bindings)\n    ((segment-pattern-p pattern)\n      (segment-matcher pattern input bindings))\n    ((single-pattern-p pattern) ; ***\n      (single-matcher pattern input bindings)) ; ***\n    ((and (consp pattern) (consp input))\n      (pat-match (rest pattern) (rest input)\n            (pat-match (first pattern) (first input)\n                bindings)))\n    (t fail)))\n```\n\nFor completeness, we repeat here the necessary constants and low-level functions from ELIZA:\n\n```lisp\n(defconstant fail nil \"Indicates pat-match failure\")\n\n(defconstant no-bindings '((t . t))\n  \"Indicates pat-match success, with no variables.\")\n\n(defun variable-p (x)\n  \"Is x a variable (a symbol beginning with '?')?\"\n  (and (symbolp x) (equal (elt (symbol-name x) 0) #\\?)))\n\n(defun get-binding (var bindings)\n  \"Find a (variable . value) pair in a binding list.\"\n  (assoc var bindings))\n\n(defun binding-var (binding)\n  \"Get the variable part of a single binding.\"\n  (car binding))\n\n(defun binding-val (binding)\n  \"Get the value part of a single binding.\"\n  (cdr binding))\n\n(defun make-binding (var val) (cons var val))\n\n(defun lookup (var bindings)\n  \"Get the value part (for var) from a binding list.\"\n  (binding-val (get-binding var bindings)))\n\n(defun extend-bindings (var val bindings)\n  \"Add a (var . value) pair to a binding list.\"\n  (cons (make-binding var val)\n    ;; Once we add a \"real\" binding,\n    ;; we can get rid of the dummy no-bindings\n    (if (eq bindings no-bindings)\n      nil\n      bindings)))\n\n(defun match-variable (var input bindings)\n  \"Does VAR match input? Uses (or updates) and returns bindings.\"\n  (let ((binding (get-binding var bindings)))\n    (cond ((not binding) (extend-bindings var input bindings))\n      ((equal input (binding-val binding)) bindings)\n      (t fail))))\n```\n\nThe next step is to define the predicates that recognize generalized segment and single-element patterns, and the matching functions that operate on them.\nWe could implement `segment-matcher` and `single-matcher` with case statements that consider all possible cases.\nHowever, that would make it difficult to extend the matcher.\nA programmer who wanted to add a new kind of segment pattern would have to edit the definitions of both `segment-pattern-p` and `segment-matcher` to install the new feature.\nThis by itself may not be too bad, but consider what happens when two programmers each add independent features.\nIf you want to use both, then neither version of `segment-matcher` (or `segment-pattern-p`) will do.\nYou'll have to edit the functions again, just to merge the two extensions.\n\nThe solution to this dilemma is to write one version of `segment-pattern-p` and `segment-matcher`, once and for all, but to have these functions refer to a table of pattern/action pairs.\nThe table would say \"if you see `?*` in the pattern, then use the function `segment-match`,\" and so on.\nThen programmers who want to extend the matcher just add entries to the table, and it is trivial to merge different extensions (unless of course two programmers have chosen the same symbol to mark different actions).\n\nThis style of programming, where pattern/action pairs are stored in a table, is called *data*-*driven programming*.\nIt is a very flexible style that is appropriate for writing extensible systems.\n\nThere are many ways to implement tables in Common Lisp, as discussed in [section 3.6](chapter3.md#s0080), [page 73](chapter3.md#p73).\nIn this case, the keys to the table will be symbols  (like `?*`), and it is fine if the representation of the table is distributed across memory.\nThus, property lists are an appropriate choice.\nWe will have two tables, represented by the `segment-match` property and the `single-match` property of symbols like `?*`.\nThe value of each property will be the name of a function that implements the match.\nHere are the table entries to implement the grammar listed previously:\n\n```lisp\n(setf (get '?is 'single-match) 'match-is)\n(setf (get '?or 'single-match) 'match-or)\n(setf (get '?and 'single-match) 'match-and)\n(setf (get '?not 'single-match) 'match-not)\n(setf (get '?* 'segment-match) 'segment-match)\n(setf (get '?+ 'segment-match) 'segment-match+)\n(setf (get '?? 'segment-match) 'segment-match?)\n(setf (get '?if 'segment-match) 'match-if)\n```\n\nWith the table defined, we need to do two things.\nFirst, define the \"glue\" that holds the table together: the predicates and action-taking functions.\nA function that looks up a data-driven function and calls it (such as `segment-matcher` and `single-matcher`) is called a *dispatch function*.\n\n```lisp\n(defun segment-pattern-p (pattern)\n  \"Is this a segment-matching pattern like ((?* var) . pat)?\"\n  (and (consp pattern) (consp (first pattern))\n    (symbolp (first (first pattern)))\n    (segment-match-fn (first (first pattern)))))\n\n(defun single-pattern-p (pattern)\n  \"Is this a single-matching pattern?\n  E.g. (?is x predicate) (?and . patterns) (?or . patterns).\"\n  (and (consp pattern)\n      (single-match-fn (first pattern))))\n\n(defun segment-matcher (pattern input bindings)\n  \"Call the right function for this kind of segment pattern.\"\n  (funcall (segment-match-fn (first (first pattern)))\n        pattern input bindings))\n\n(defun single-matcher (pattern input bindings)\n  \"Call the right function for this kind of single pattern.\"\n  (funcall (single-match-fn (first pattern))\n        (rest pattern) input bindings))\n\n(defun segment-match-fn (x)\n  \"Get the segment-match function for x,\n  if it is a symbol that has one.\"\n  (when (symbolp x) (get x 'segment-match)))\n\n(defun single-match-fn (x)\n  \"Get the single-match function for x,\n  if it is a symbol that has one.\"\n  (when (symbolp x) (get x 'single-match)))\n```\n\nThe last thing to do is define the individual matching functions.\nFirst, the single-pattern matching functions:\n\n```lisp\n(defun match-is (var-and-pred input bindings)\n  \"Succeed and bind var if the input satisfies pred,\n  where var-and-pred is the list (var pred).\"\n  (let* ((var (first var-and-pred))\n      (pred (second var-and-pred))\n      (new-bindings (pat-match var input bindings)))\n    (if (or (eq new-bindings fail)\n        (not (funcall pred input)))\n      fail\n      new-bindings)))\n\n(defun match-and (patterns input bindings)\n  \"Succeed if all the patterns match the input.\"\n  (cond ((eq bindings fail) fail)\n      ((null patterns) bindings)\n      (t (match-and (rest patterns) input\n              (pat-match (first patterns) input\n                  bindings)))))\n\n(defun match-or (patterns input bindings)\n  \"Succeed if any one of the patterns match the input.\"\n  (if (null patterns)\n      fail\n        (let ((new-bindings (pat-match (first patterns)\n                    input bindings)))\n        (if (eq new-bindings fail)\n          (match-or (rest patterns) input bindings)\n          new-bindings))))\n\n(defun match-not (patterns input bindings)\n  \"Succeed if none of the patterns match the input\n  This will never bind any variables.\"\n  (if (match-or patterns input bindings)\n      fail\n      bindings))\n```\n\nNow the segment-pattern matching functions.\n`segment-match` is similar to the version presented as part of ELIZA. The difference is in how we determine `pos`, the position of the first element of the input that could match the next element of the pattern after the segment variable.\nIn ELIZA, we assumed that the segment variable was either the last element of the pattern or was followed by a constant.\nIn the following version, we allow nonconstant patterns to follow segment variables.\nThe function `first-match-pos` is added to handle this.\nIf the following element is in fact a constant, the same calculation is done using `position`.\nIf it is not a constant, then we just return the first possible starting position-unless that would put us past the end of the input, in which case we return nil to indicate failure:\n\n```lisp\n(defun segment-match (pattern input bindings &optional (start 0))\n  \"Match the segment pattern ((?* var) . pat) against input.\"\n  (let ((var (second (first pattern)))\n      (pat (rest pattern)))\n    (if (null pat)\n      (match-variable var input bindings)\n      (let ((pos (first-match-pos (first pat) input start)))\n        (if (null pos)\n            fail\n            (let ((b2 (pat-match\n                    pat (subseq input pos)\n                    (match-variable var (subseq input 0 pos)\n                        bindings))))\n              ;; If this match failed, try another longer one\n              (if (eq b2 fail)\n                (segment-match pattern input bindings (+ pos 1))\n                b2)))))))\n\n(defun first-match-pos (pat1 input start)\n  \"Find the first position that pat1 could possibly match input,\n  starting at position start. If pat1 is non-constant, then just  return start.\"\n  (cond ((and (atom pat1) (not (variable-p pat1)))\n         (position pat1 input :start start :test #'equal))\n        ((<= start (length input)) start)\n        (t nil)))\n```\n\nIn the first example below, the segment variable `?x` matches the sequence (`b c`).\nIn the second example, there are two segment variables in a row.\nThe first successful match is achieved with the first variable, `?x`, matching the empty sequence, and the second one, `?y`, matching (`b c`).\n\n```lisp\n> (pat-match '(a (?* ?x) d) '(a b c d)) => ((?X B C))\n> (pat-match '(a (?* ?x) (?* ?y) d) '(a b c d))=> ((?Y B C) (?X))\n```\n\nIn the next example, `?x` is first matched against nil and `?y` against (`b c d` ), but that fails, so we try matching `?x` against a segment of length one.\nThat fails too, but finally the match succeeds with `?x` matching the two-element segment (`b c`), and `?y` matching (`d`).\n\n```lisp\n > (pat-match  '(a (?* ?x) (?* ?y) ?x ?y)  '(a b c d (b c) (d))) => ((?Y D) (?X B C))\n```\nGiven `segment-match`, it is easy to define the function to match one-or-more elements and the function to match zero-or-one element:\n\n```lisp\n(defun segment-match+ (pattern input bindings)\n  \"Match one or more elements of input.\"\n  (segment-match pattern input bindings 1))\n\n(defun segment-match? (pattern input bindings)\n  \"Match zero or one element of input.\"\n  (let ((var (second (first pattern)))\n      (pat (rest pattern)))\n    (or (pat-match (cons var pat) input bindings)\n      (pat-match pat input bindings))))\n```\n\nFinally, we supply the function to test an arbitrary piece of Lisp code.\nIt does this by evaluating the code with the bindings implied by the binding list.\nThis is one of the few cases where it is appropriate to call `eval`: when we want to give the user unrestricted access to the Lisp interpreter.\n\n```lisp\n(defun match-if (pattern input bindings)\n  \"Test an arbitrary expression involving variables\n  The pattern looks like ((?if code) . rest).\"\n  (and (progv (mapcar #'car bindings)\n        (mapcar #'cdr bindings)\n      (eval (second (first pattern))))\n    (pat-match (rest pattern) input bindings)))\n```\n\nHere are two examples using `?if`.\nThe first succeeds because `(+  3 4)` is indeed `7`, and the second fails because `(>  3 4)` is false.\n\n```lisp\n> (pat-match  '(?x ?op ?y is ?z (?if (eql (?op ?x ?y) ?z))) '(3 + 4 is 7)) => ((?Z . 7) (?Y . 4) (?OP . +) (?X . 3))\n> (pat-match  '(?x ?op ?y (?if (?op ?x ?y))) '(3 > 4)) => NIL\n```\n\nThe syntax we have defined for patterns has two virtues: first, the syntax is very general, so it is easy to extend.\nSecond, the syntax can be easily manipulated by `pat-match`.\nHowever, there is one drawback: the syntax is a little verbose, and some may find it ugly.\nCompare the following two patterns:\n\n```lisp\n(a (?* ?x) (?* ?y) d)\n(a ?x* ?y* d)\n```\n\nMany readers find the second pattern easier to understand at a glance.\nWe could change `pat-match` to allow for patterns of the form `?x*`, but that would mean `pat-match` would have a lot more work to do on every match.\nAn alternative is to leave `pat-match` as is, but define another level of syntax for use by human readers only.\nThat is, a programmer could type the second expression above, and have it translated into the first, which would then be processed by `pat-match.`\n\nIn other words, we will define a facility to define a kind of pattern-matching macro that will be expanded the first time the pattern is seen.\nIt is better to do this expansion once than to complicate `pat-match` and in effect do the expansion every time a pattern is used.\n(Of course, if a pattern is only used once, then there is no advantage.\nBut in most programs, each pattern will be used again and again.)\n\nWe need to define two functions: one to define pattern-matching macros, and another to expand patterns that may contain these macros.\nWe will only allow symbols to be macros, so it is reasonable to store the expansions on each symbol's property list:\n\n```lisp\n(defun pat-match-abbrev (symbol expansion)\n  \"Define symbol as a macro standing for a pat-match pattern.\"\n  (setf (get symbol 'expand-pat-match-abbrev)\n    (expand-pat-match-abbrev expansion))\n\n(defun expand-pat-match-abbrev (pat)\n  \"Expand out all pattern matching abbreviations in pat.\"\n  (cond ((and (symbolp pat) (get pat 'expand-pat-match-abbrev)))\n      ((atom pat) pat)\n      (t (cons (expand-pat-match-abbrev (first pat))\n          (expand-pat-match-abbrev (rest pat))))))\n```\n\nWe would use this facility as follows:\n\n```lisp\n> (pat-match-abbrev '?x* '(?* ?x)) => (?* ?X)\n> (pat-match-abbrev '?y* '(?* ?y)) => (?* ?Y)\n> (setf axyd (expand-pat-match-abbrev '(a ?x* ?y* d))) => (A (?* ?X) (?* ?Y) D)\n> (pat-match axyd '(a b c d)) => ((?Y B C) (?X))\n```\n\n**Exercise  6**.**1** [**m**] Go back and change the ELIZA rules to use the abbreviation facility.\nDoes this make the rules easier to read?\n\n**Exercise  6**.**2** [**h**] In the few prior examples, every time there was a binding of pattern variables that satisfied the input, that binding was found.\nInformally, show that `pat-match` will always find such a binding, or show a counterexample where it fails to find one.\n\n## 6.3 A Rule-Based Translator Tool\n\nAs we have defined it, the pattern matcher matches one input against one pattern.\nIn `eliza`, we need to match each input against a number of patterns, and then return a result based on the rule that contains the first pattern that matches.\nTo refresh your memory, here is the function `use-eliza-rules`:\n\n```lisp\n(defun use-eliza-rules (input)\n  \"Find some rule with which to transform the input.\"\n  (some #'(lambda (rule)\n      (let ((result (pat-match (rule-pattern rule) input)))\n        (if (not (eq result fail))\n          (sublis (switch-viewpoint result)\n            (random-elt (rule-responses rule))))))\n    *eliza-rules*))\n```\n\nIt turns out that this will be a quite common thing to do: search through a list of rules for one that matches, and take action according to that rule.\nTo turn the structure of `use-eliza-rules` into a software tool, we will allow the user to specify each of the following:\n\n*   What kind of rule to use.\nEvery rule will be characterized by an if-part and a then-part, but the ways of getting at those two parts may vary.\n\n*   What list of rules to use.\nIn general, each application will have its own list of rules.\n\n*   How to see if a rule matches.\nBy default, we will use `pat-match`, but it should be possible to use other matchers.\n\n*   What to do when a rule matches.\nOnce we have determined which rule to use, we have to determine what it means to use it.\nThe default is just to substitute the bindings of the match into the then-part of the rule.\n\nThe rule-based translator tool now looks like this:\n\n```lisp\n(defun rule-based-translator\n      (input rules &key (matcher #'pat-match)\n        (rule-if #'first) (rule-then #'rest) (action #'sublis))\n  \"Find the first rule in rules that matches input,\n  and apply the action to that rule.\"\n  (some\n    #'(lambda (rule)\n        (let ((result (funcall matcher (funcall rule-if rule)\n                input)))\n        (if (not (eq result fail))\n          (funcall action result (funcall rule-then rule)))))\n    rules))\n\n(defun use-eliza-rules (input)\n  \"Find some rule with which to transform the input.\"\n  (rule-based-translator input *eliza-rules*\n    :action #'(lambda (bindings responses)\n          (sublis (switch-viewpoint bindings)\n                (random-elt responses)))))\n```\n\n## 6.4 A Set of Searching Tools\n\nThe GPS program can be seen as a problem in *search*.\nIn general, a search problem involves exploring from some starting state and investigating neighboring states until a solution is reached.\nAs in GPS, *state* means a description of any situation or state of affairs.\nEach state may have several neighbors, so there will be a choice of how to search.\nWe can travel down one path until we see it is a dead end, or we can consider lots of different paths at the same time, expanding each path step by step.\nSearch problems are called *nondeterministic* because there is no way to determine what is the best step to take next.\nAI problems, by their very nature, tend to be nondeterministic.\nThis can be a source of confusion for programmers who are used to deterministic problems.\nIn this section we will try to clear up that confusion.\nThis section also serves as an example of how higher-order functions can be used to implement general tools that can be specified by passing in specific functions.\n\nAbstractly, a search problem can be characterized by four features:\n\n*   The *start* state.\n\n*   The *goal* state (or states).\n\n*   The *successors*, or states that can be reached from any other state.\n\n*   The *strategy* that determines the *order* in which we search.\n\nThe first three features are part of the problem, while the fourth is part of the solution.\nIn GPS, the starting state was given, along with a description of the goal states.\nThe successors of a state were determined by consulting the operators.\nThe search strategy was means-ends analysis.\nThis was never spelled out explicitly but was implicit in the structure of the whole program.\nIn this section we will formulate a general searching tool, show how it can be used to implement several different search strategies, and then show how GPS could be implemented with this tool.\n\nThe first notion we have to define is the *state space*, or set of all possible states.\nWe can view the states as nodes and the successor relation as links in a graph.\nSome state space graphs will have a small number of states, while others have an infinite number, but they can still be solved if we search cleverly.\nSome graphs will have a regular structure, while others will appear random.\nWe will start by considering only trees-that is, graphs where a state can be reached by only one unique sequence of successor links.\nHere is a tree:\n\n<a id=\"diagram-06-01\"></a>\n<img src=\"images/chapter6/diagram-06-01.svg\"\n  onerror=\"this.src='images/chapter6/diagram-06-01.png'; this.onerror=null;\"\n  alt=\"Diagram 6.1\" />\n\n### Searching Trees\n\nWe will call our first searching tool `tree-search`, because it is designed to search state spaces that are in the form of trees.\nIt takes four arguments: (1) a list of valid starting states, (2) a predicate to decide if we have reached a goal state, (3) a function to generate the successors of a state, and (4) a function that decides in what order to search.\nThe first argument is a list rather than a single state so that `tree-search` can recursively call itself after it has explored several paths through the state space.\nThink of the first argument not as a starting state but as a list of possible states from which the goal may be reached.\nThis lists represents the fringe of the tree that has been explored so far.\n`tree-search` has three cases: If there are no more states to consider, then give up and return `fail`.\nIf the first possible state is a goal state, then return the successful state.\nOtherwise, generate the successors of the first state and combine them with the other states.\nOrder this combined list according to the particular search strategy and continue searching.\nNote that `tree-search` itself does not specify any particular searching strategy.\n\n```lisp\n(defun tree-search (states goal-p successors combiner)\n  \"Find a state that satisfies goal-p.  Start with states,\n  and search according to successors and combiner.\"\n  (dbg :search \"~&; ; Search: ~  a\" states)\n  (cond ((null states) fail)\n      ((funcall goal-p (first states)) (first states))\n      (t (tree-search\n          (funcall combiner\n                (funcall successors (first states))\n                (rest states))\n          goal-p successors combiner))))\n```\n\nThe first strategy we will consider is called *depth-first search*.\nIn depth-first search, the longest paths are considered first.\nIn other words, we generate the successors of a state, and then work on the first successor first.\nWe only return to one of the subsequent successors if we arrive at a state that has no successors at all.\nThis strategy can be implemented by simply appending the previous states to the end of the list of new successors on each iteration.\nThe function `depth-first-search` takes a single starting state, a goal predicate, and a successor function.\nIt packages the starting state into a list as expected by `tree-search`, and specifies append as the combining function:\n\n```lisp\n(defun depth-first-search (start goal-p successors)\n  \"Search new states first until goal is reached.\"\n  (tree-search (list start) goal-p successors #'append))\n```\n\nLet's see how we can search through the binary tree defined previously.\nFirst, we define the successor function `binary-tree`.\nIt returns a list of two states, the two numbers that are twice the input state and one more than twice the input state.\nSo the successors of 1 will be 2 and 3, and the successors of 2 will be 4 and 5.\nThe `binary-tree` function generates an infinite tree of which the first 15 nodes are diagrammed in our example.\n\n```lisp\n(defun binary-tree (x) (list (* 2 x) (+  1 (* 2 x))))\n```\n\nTo make it easier to specify a goal, we define the function `is` as a function that returns a predicate that tests for a particular value.\nNote that `is` does not do the test itself.\nRather, it returns a function that can be called to perform tests:\n\n```lisp\n(defun is (value) #'(lambda (x) (eql x value)))\n```\n\nNow we can turn on the debugging output and search through the binary tree, starting at 1, and looking for, say, 12, as the goal state.\nEach line of debugging output shows the list of states that have been generated as successors but not yet examined:\n\n```lisp\n> (debug :search) => (SEARCH)\n> (depth-first-search 1 (is 12) #'binary-tree)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (4 5 3)\n;; Search: (8 9 5 3)\n;; Search: (16 17 9 5 3)\n;; Search: (32 33 17 9 5 3)\n;; Search: (64 65 33 17 9 5 3)\n;; Search: (128 129 65 33 17 9 5 3)\n;; Search: (256 257 129 65 33 17 9 5 3)\n;; Search: (512 513 257 129 65 33 17 9 5 3)\n;; Search: (1024 1025 513 257 129 65 33 17 9 5 3)\n;; Search: (2048 2049 1025 513 257 129 65 33 17 9 5 3)\n[Abort]\n```\n\nThe problem is that we are searching an infinite tree, and the depth-first search strategy just dives down the left-hand branch at every step.\nThe only way to stop the doomed search is to type an interrupt character.\n\nAn alternative strategy is *breadth-first search*, where the shortest path is extended first at each step.\nIt can be implemented simply by appending the new successor states to the end of the existing states:\n\n```lisp\n(defun prepend (x y) \"Prepend y to start of x\" (append y x))\n\n(defun breadth-first-search (start goal-p successors)\n  \"Search old states first until goal is reached.\"\n  (tree-search (list start) goal-p successors #'prepend))\n```\n\nThe only difference between depth-first and breadth-first search is the difference between `append` and `prepend`.\nHere we see `breadth-first-search` in action:\n\n```lisp\n> (breadth-first-search 1 (is 12) 'binary-tree)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 4 5)\n;; Search: (4 5 6 7)\n;; Search: (5 6 7 8 9)\n;; Search: (6 7 8 9 10 11)\n;; Search: (7 8 9 10 11 12 13)\n;; Search: (8 9 10 11 12 13 14 15)\n;; Search: (9 10 11 12 13 14 15 16 17)\n;; Search: (10 11 12 13 14 15 16 17 18 19)\n;; Search: (11 12 13 14 15 16 17 18 19 20 21)\n;; Search: (12 13 14 15 16 17 18 19 20 21 22 23)\n12\n```\n\nBreadth-first search ends up searching each node in numerical order, and so it will eventually find any goal.\nIt is methodical, but therefore plodding.\nDepth-first search will be much faster - if it happens to find the goal at all.\nFor example, if we were looking for 2048, depth-first search would find it in 12 steps, while breadth-first would take 2048 steps.\nBreadth-first search also requires more storage, because it saves more intermediate states.\n\nIf the search tree is finite, then either breadth-first or depth-first will eventually find the goal.\nBoth methods search the entire state space, but in a different order.\nWe will now show a depth-first search of the 15-node binary tree diagrammed previously.\nIt takes about the same amount of time to find the goal (12) as it did with breadth-first search.\nIt would have taken more time to find 15; less to find 8.\nThe big difference is in the number of states considered at one time.\nAt most, depth-first search considers four at a time; in general it will need to store only *log2n* states to search a *n-node* tree, while breadth-first search needs to store *n/2* states.\n\n```lisp\n(defun finite-binary-tree (n)\n \"Return a successor function that generates a binary tree\n with n nodes.\"\n #'(lambda (x)\n     (remove-if #'(lambda (child) (> child n))\n        (binary-tree x))))\n(depth-first-search 1 (is 12) (finite-binary-tree 15))\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (4 5 3)\n;; Search: (8 9 5 3)\n;; Search: (9 5 3)\n;; Search: (5 3)\n;; Search: (10 11 3)\n;; Search: (11 3)\n;; Search: (3)\n;; Search: (6 7)\n;; Search: (12 13 7)\n12\n```\n\n### Guiding the Search\n\nWhile breadth-first search is more methodical, neither strategy is able to take advantage of any knowledge about the state space.\nThey both search blindly.\nIn most real applications we will have some estimate of how far a state is from the solution.\nIn such cases, we can implement a *best-first search*.\nThe name is not quite accurate; if we could really search best first, that would not be a search at all.\nThe name refers to the fact that the state that *appears* to be best is searched first.\n\nTo implement best-first search we need to add one more piece of information: a cost function that gives an estimate of how far a given state is from the goal.\n\nFor the binary tree example, we will use as a cost estimate the numeric difference from the goal.\nSo if we are looking for 12, then 12 has cost 0, 8 has cost 4 and 2048 has cost 2036.\nThe higher-order function `diff`, shown in the following, returns a cost function that computes the difference from a goal.\nThe higher-order function sorter takes a cost function as an argument and returns a combiner function that takes the lists of old and new states, appends them together, and sorts the result based on the cost function, lowest cost first.\n(The built-in function `sort` sorts a list according to a comparison function.\nIn this case the smaller numbers come first.\n`sort` takes an optional `:key` argument that says how to compute the score for each element.\nBe careful - `sort` is a destructive function.)\n\n```lisp\n(defun diff (num)\n  \"Return the function that finds the difference from num.\"\n  #'(lambda (x) (abs (- x num))))\n\n(defun sorter (cost-fn)\n  \"Return a combiner function that sorts according to cost-fn.\"\n  #'(lambda (new old)\n      (sort (append new old) #'< :key cost-fn)))\n\n(defun best-first-search (start goal-p successors cost-fn)\n  \"Search lowest cost states first until goal is reached.\"\n  (tree-search (list start) goal-p successors (sorter cost-fn)))\n```\n\nNow, using the difference from the goal as the cost function, we can search using best-first search:\n\n```lisp\n> (best-first-search 1 (is 12) #'binary-tree (diff 12))\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (14 15 6 2)\n;; Search: (15 6 2 28 29)\n;; Search: (6 2 28 29 30 31)\n;; Search: (12 13 2 28 29 30 31)\n12\n```\n\nThe more we know about the state space, the better we can search.\nFor example, if we know that all successors are greater than the states they come from, then we can use a cost function that gives a very high cost for numbers above the goal.\nThe function `price-is-right` is like `diff`, except that it gives a high penalty for going over the goal.<a id=\"tfn06-3\"></a><sup>[3](#fn06-3)</sup>\nUsing this cost function leads to a near-optimal search on this example.\nIt makes the \"mistake\" of searching 7 before 6 (because 7 is closer to 12), but does not waste time searching 14 and 15:\n\n```lisp\n(defun price-is-right (price)\n  \"Return a function that measures the difference from price,\n  but gives a big penalty for going over price.\"\n  #'(lambda (x) (if (> x price)\n              most-positive-fixnum\n              (- price x))))\n\n> (best-first-search 1 (is 12) #'binary-tree (price-is-right 12)) ;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (6 2 14 15)\n;; Search: (12 2 13 14 15)\n12\n```\n\nAll the searching methods we have seen so far consider ever-increasing lists of states as they search.\nFor problems where there is only one solution, or a small number of solutions, this is unavoidable.\nTo find a needle in a haystack, you need to look at a lot of hay.\nBut for problems with many solutions, it may be worthwhile to discard unpromising paths.\nThis runs the risk of failing to find a solution at all, but it can save enough space and time to offset the risk.\nA best-first search that keeps only a fixed number of alternative states at any one time is known as a *beam search*.\nThink of searching as shining a light through the dark of the state space.\nIn other search strategies the light spreads out as we search deeper, but in beam search the light remains tightly focused.\nBeam search is a variant of best-first search, but it is also similar to depth-first search.\nThe difference is that beam search looks down several paths at once, instead of just one, and chooses the best one to look at next.\nBut it gives up the ability to backtrack indefinitely.\nThe function `beam-search` is just like `best-first-search`, except that after we sort the states, we then take only the first `beam-width` states.\nThis is done with `subseq`; `(subseq list start end)` returns the sublist that starts at position *start* and ends just before position *end*.\n\n```lisp\n(defun beam-search (start goal-p successors cost-fn beam-width)\n  \"Search highest scoring states first until goal is reached,\n  but never consider more than beam-width states at a time.\"\n  (tree-search (list start) goal-p successors\n        #'(lambda (old new)\n          (let ((sorted (funcall (sorter cost-fn) old new)))\n            (if (> beam-width (length sorted))\n              sorted\n              (subseq sorted 0 beam-width))))))\n```\n\nWe can successfully search for 12 in the binary tree using a beam width of only 2:\n\n```lisp\n> (beam-search 1 (is 12) #'binary-tree (price-is-right 12) 2)\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6)\n;; Search: (6 14)\n;; Search: (12 13)\n12\n```\n\nHowever, if we go back to the scoring function that just takes the difference from 12, then beam search fails.\nWhen it generates 14 and 15, it throws away 6, and thus loses its only chance to find the goal:\n\n```lisp\n> (beam-search 1 (is 12) #'binary-tree (diff 12) 2)\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6)\n;; Search: (14 15)\n;; Search: (15 28)\n;; Search: (28 30)\n;; Search: (30 56)\n;; Search: (56 60)\n;; Search: (60 112)\n;; Search: (112 120)\n;; Search: (120 224)\n[Abort]\n```\n\nThis search would succeed if we gave a beam width of 3.\nThis illustrates a general principle: we can find a goal either by looking at more states, or by being smarter about the states we look at.\nThat means having a better ordering function.\n\nNotice that with a beam width of infinity we get best-first search.\nWith a beam width of 1, we get depth-first search with no backup.\nThis could be called \"depth-only search,\" but it is more commonly known as *hill-climbing*.\nThink of a mountaineer trying to reach a peak in a heavy fog.\nOne strategy would be for the mountaineer to look at adjacent locations, climb to the highest one, and look again.\nThis strategy may eventually hit the peak, but it may also get stuck at the top of a foothill, or *local maximum*.\nAnother strategy would be for the mountaineer to turn back and try again when the fog lifts, but in AI, unfortunately, the fog rarely lifts.<a id=\"tfn06-4\"></a><sup>[4](#fn06-4)</sup>\n\nAs a concrete example of a problem that can be solved by search, consider the task of planning a flight across the North American continent in a small airplane, one whose range is limited to 1000 kilometers.\nSuppose we have a list of selected cities with airports, along with their position in longitude and latitude:\n\n```lisp\n(defstruct (city (:type list)) name long lat)\n\n(defparameter *cities*\n   '((Atlanta        84.23 33.45)      (Los-Angeles       118.15 34.03)\n   (Boston           71.05 42.21)      (Memphis           90.03 35.09)\n   (Chicago          87.37 41.50)      (New-York          73.58 40.47)\n   (Denver           105.00 39.45)     (Oklahoma-City     97.28 35.26)\n   (Eugene           123.05 44.03)     (Pittsburgh        79.57 40.27)\n   (Flagstaff        111.41 35.13)     (Quebec            71.11 46.49)\n   (Grand-Jct        108.37 39.05)     (Reno              119.49 39.30)\n   (Houston          105.00 34.00)     (San-Francisco     122.26 37.47)\n   (Indianapolis     86.10 39.46)      (Tampa             82.27 27.57)\n   (Jacksonville     81.40 30.22)      (Victoria          123.21 48.25)\n   (Kansas-City      94.35 39.06)      (Wilmington        77.57 34.14)))\n```\n\nThis example introduces a new option to `defstruct`.\nInstead of just giving the name of the structure, it is also possible to use:\n\n```lisp\n(defstruct (structure-name (option value)...) \"optional doc\" slot...)\n```\n\nFor city, the option `:type` is specified as `list`.\nThis means that cities will be implemented as lists of three elements, as they are in the initial value for `*cities*`.\n\nThe cities are shown on the map in [figure 6.1](#fig-06-01), which has connections between all cities within the 1000 kilometer range of each other.<a id=\"tfn06-5\"></a><sup>[5](#fn06-5)</sup>\nThis map was drawn with the help of `air-distance`, a function that returns the distance in kilometers between two cities \"as the crow flies.\"\nIt will be defined later.\nTwo other useful functions are `neighbors`, which finds all the cities within 1000 kilometers, and `city`, which maps from a name to a city.\nThe former uses `find-all-if`, which was defined on [page 101](chapter3.md#p101) as a synonym for `remove-if-not`.\n\n| <a id=\"fig-06-01\"></a>[]() |\n|---|\n| <img src=\"images/chapter6/fig-06-01.svg\" onerror=\"this.src='images/chapter6/fig-06-01.png'; this.onerror=null;\" alt=\"Figure 6.1\" /> |\n| **Figure 6.1: A Map of Some Cities** |\n\n```lisp\n(defun neighbors (city)\n  \"Find all cities within 1000 kilometers.\"\n  (find-all-if #'(lambda (c)\n          (and (not (eq c city))\n              (< (air-distance c city) 1000.0)))\n        *cities*))\n\n(defun city (name)\n  \"Find the city with this name.\"\n  (assoc name *cities*))\n```\n\nWe are now ready to plan a trip.\nThe function `trip` takes the name of a starting and destination city and does a beam search of width one, considering all neighbors as successors to a state.\nThe cost for a state is the air distance to the destination city:\n\n```lisp\n(defun trip (start dest)\n  \"Search for a way from the start to dest.\"\n  (beam-search start (is dest) #'neighbors\n          #'(lambda (c) (air-distance c dest))\n          1))\n```\n\nHere we plan a trip from San Francisco to Boston.\nThe result seems to be the best possible path:\n\n```lisp\n> (trip (city 'san-francisco) (city 'boston))\n;; Search: ((SAN-FRANCISCO 122.26 37.47))\n;; Search: ((RENO 119.49 39.3))\n;; Search: ((GRAND-JCT 108.37 39.05))\n;; Search: ((DENVER 105.0 39.45))\n;; Search: ((KANSAS-CITY 94.35 39.06))\n;; Search: ((INDIANAPOLIS 86.1 39.46))\n;; Search: ((PITTSBURGH 79.57 40.27))\n;; Search: ((BOSTON 71.05 42.21))\n(BOSTON 71.05 42.21)\n```\n\nBut look what happens when we plan the return trip.\nThere are two detours, to Chicago and Flagstaff:\n\n```lisp\n> (trip (city 'boston) (city 'san-francisco))\n;; Search: ((BOSTON 71.05 42.21))\n;; Search: ((PITTSBURGH 79.57 40.27))\n;; Search: ((CHICAGO 87.37 41.5))\n;; Search: ((KANSAS-CITY 94.35 39.06))\n;; Search: ((DENVER 105.0 39.45))\n;; Search: ((FLAGSTAFF 111.41 35.13))\n;; Search: ((RENO 119.49 39.3))\n;; Search: ((SAN-FRANCISCO 122.26 37.47))\n(SAN-FRANCISCO 122.26 37.47)\n```\n\nWhy did `trip` go from Denver to San Francisco via Flagstaff?\nBecause Flagstaff is closer to the destination than Grand Junction.\nThe problem is that we are minimizing the distance to the destination at each step, when we should be minimizing the sum of the distance to the destination plus the distance already traveled.\n\n### Search Paths\n\nTo minimize the total distance, we need some way to talk about the *path* that leads to the goal.\nBut the functions we have defined so far only deal with individual states along the way.\nRepresenting paths would lead to another advantage: we could return the path as the solution, rather than just return the goal state.\nAs it is, `trip` only returns the goal state, not the path to it.\nSo there is no way to determine what `trip` has done, except by reading the debugging output.\n\nThe data structure path is designed to solve both these problems.\nA path has four fields: the current state, the previous partial path that this path is extending, the cost of the path so far, and an estimate of the total cost to reach the goal.\nHere is the structure definition for path.\nIt uses the `:print-function` option to say that all paths are to be printed with the function `print-path`, which will be defined below.\n\n```lisp\n(defstruct (path (:print-function print-path))\n    state (previous nil) (cost-so-far 0) (total-cost 0))\n```\n\nThe next question is how to integrate paths into the searching routines with the least amount of disruption.\nClearly, it would be better to make one change to `tree-search` rather than to change `depth-first-search`, `breadth-first-search`, and `beam-search`.\nHowever, looking back at the definition of `tree-search`, we see that it makes no assumptions about the structure of states, other than the fact that they can be manipulated by the goal predicate, successor, and combiner functions.\nThis suggests that we can use `tree-search` unchanged if we pass it paths instead of states, and give it functions that can process paths.\n\nIn the following redefinition of `trip`, the `beam-search` function is called with five arguments.\nInstead of passing it a city as the start state, we pass a path that has the city as its state field.\nThe goal predicate should test whether its argument is a path whose state is the destination; we assume (and later define) a version of `is` that accommodates this.\nThe successor function is the most difficult.\nInstead of just generating a list of neighbors, we want to first generate the neighbors, then make each one into a path that extends the current path, but with an updated cost so far and total estimated cost.\nThe function `path-saver` returns a function that will do just that.\nFinally, the cost function we are trying to minimize is `path-total-cost`, and we provide a beam width, which is now an optional argument to `trip` that defaults to one:\n\n```lisp\n(defun trip (start dest &optional (beam-width 1))\n  \"Search for the best path from the start to dest.\"\n  (beam-search\n    (make-path :state start)\n    (is dest :key #'path-state)\n    (path-saver #'neighbors #'air-distance\n          #'(lambda (c) (air-distance c dest)))\n#'path-total-cost\nbeam-width))\n```\n\nThe calculation of `air-distance` involves some complicated conversion of longitude and latitude to `x-y-z` coordinates.\nSince this is a problem in solid geometry, not AI, the code is presented without further comment:\n\n```lisp\n(defconstant earth-diameter 12765.0\n  \"Diameter of planet earth in kilometers.\")\n(defun air-distance (city1 city2)\n  \"The great circle distance between two cities.\"\n  (let ((d (distance (xyz-coords city1) (xyz-coords city2))))\n    ;; d is the straight-line chord between the two cities,\n    ;; The length of the subtending arc is given by:\n    (* earth-diameter (asin (/ d 2)))))\n\n(defun xyz-coords (city)\n  \"Returns the x,y,z coordinates of a point on a sphere.\n  The center is (0 0 0) and the north pole is (0 0 1).\"\n  (let ((psi (deg->radians (city-lat city)))\n        (phi (deg->radians (city-long city))))\n      (list (* (cos psi) (cos phi))\n            (* (cos psi) (sin phi))\n            (sin psi))))\n\n(defun distance (point1 point2)\n  \"The Euclidean distance between two points.\n  The points are coordinates in n-dimensional space.\"\n  (sqrt (reduce #'+ (mapcar #'(lambda (a b) (expt (- a b) 2))\n                point1 point2))))\n\n(defun deg->radians (deg)\n  \"Convert degrees and minutes to radians.\"\n  (* (+ (truncate deg) (* (rem  deg 1) 100/60)) pi 1/180))\n```\n\nBefore showing the auxiliary functions that implement this, here are some examples that show what it can do.\nWith a beam width of 1, the detour to Flagstaff is eliminated, but the one to Chicago remains.\nWith a beam width of 3, the correct optimal path is found.\nIn the following examples, each call to the new version of `trip` returns a path, which is printed by `show-city-path`:\n\n```lisp\n> (show-city-path (trip (city 'san-francisco) (city 'boston) 1))\n#<Path 4514.8  km: San-Francisco - Reno - Grand-Jct - Denver -\n  Kansas-City - Indianapolis - Pittsburgh - Boston  >\n> (show-city-path (trip (city 'boston) (city 'san-francisco) 1))\n#<Path 4577.3  km: Boston - Pittsburgh - Chicago - Kansas-City -\n  Denver - Grand-Jct - Reno - San-Francisco  >\n> (show-city-path (trip (city 'boston) (city 'san-francisco) 3))\n#<Path 4514.8  km: Boston - Pittsburgh - Indianapolis -\n  Kansas-City - Denver - Grand-Jct - Reno - San-Francisco  >\n```\n\nThis example shows how search is susceptible to irregularities in the search space.\nIt was easy to find the correct path from west to east, but the return trip required more search, because Flagstaff is a falsely promising step.\nIn general, there may be even worse dead ends lurking in the search space.\nLook what happens when we limit the airplane's range to 700 kilometers.\nThe map is shown in [figure 6.2](#fig-06-02).\n\n| <a id=\"fig-06-02\"></a>[]() |\n|---|\n| <img src=\"images/chapter6/fig-06-02.svg\" onerror=\"this.src='images/chapter6/fig-06-02.png'; this.onerror=null;\" alt=\"Figure 6.2\" /> |\n| **Figure 6.2: A Map of Cities within 700 km** |\n\nIf we try to plan a trip from Tampa to Quebec, we can run into problems with the dead end at Wilmington, North Carolina.\nWith a beam width of 1, the path to Jacksonville and then Wilmington will be tried first.\nFrom there, each step of the path alternates between Atlanta and Wilmington.\nThe search never gets any closer to the goal.\nBut with a beam width of 2, the path from Tampa to Atlanta is not discarded, and it is eventually continued on to Indianapolis and eventually to Quebec.\nSo the capability to back up is essential in avoiding dead ends.\n\nNow for the implementation details.\nThe function `is` still returns a predicate that tests for a value, but now it accepts `:key` and `:test` keywords:\n\n```lisp\n(defun is (value &key (key #'identity) (test #'eql))\n  \"Returns a predicate that tests for a given value.\"\n  #'(lambda (path) (funcall test value (funcall key path))))\n```\n\nThe `path-saver` function returns a function that will take a path as an argument and generate successors paths.\n`path-saver` takes as an argument a successor function that operates on bare states.\nIt calls this function and, for each state returned, builds up a path that extends the existing path and stores the cost of the path so far as well as the estimated total cost:\n\n```lisp\n(defun path-saver (successors cost-fn cost-left-fn)\n  #'(lambda (old-path)\n      (let ((old-state (path-state old-path)))\n        (mapcar\n          #'(lambda (new-state)\n            (let ((old-cost\n                  (+ (path-cost-so-far old-path)\n                      (funcall cost-fn old-state new-state))))\n              (make-path\n                :state new-state\n                :previous old-path\n                :cost-so-far old-cost\n                :total-cost (+ old-cost (funcall cost-left-fn\n                        new-state)))))\n          (funcall successors old-state)))))\n```\n\nBy default a path structure would be printed as `#S ( PATH ... )`.\nBut because each path has a `previous` field that is filled by another path, this output would get quite verbose.\nThat is why we installed `print-path` as the print function for paths when we defined the structure.\nIt uses the notation `#<...>`, which is a Common Lisp convention for printing output that can not be reconstructed by `read`.\nThe function `show-city-path` prints a more complete representation of a path.\nWe also define `map-path` to iterate over a path, collecting values:\n\n```lisp\n(defun print-path (path &optional (stream t) depth)\n  (declare (ignore depth))\n  (format stream \"#<Path to ~a cost ~,lf>\"\n        (path-state path) (path-total-cost path)))\n\n(defun show-city-path (path &optional (stream t))\n  \"Show the length of a path, and the cities along it.\"\n  (format stream \"#<Path ~,lf km: ~{~:(~a~)~^- ~}>\"\n        (path-total-cost path)\n        (reverse (map-path #'city-name path)))\n  (values))\n\n(defun map-path (fn path)\n  \"Call fn on each state in the path, collecting results.\"\n  (if (null path)\n      nil\n      (cons (funcall fn (path-state path))\n          (map-path fn (path-previous path)))))\n```\n\n### Guessing versus Guaranteeing a Good Solution\n\nElementary AI textbooks place a great emphasis on search algorithms that are guaranteed to find the best solution.\nHowever, in practice these algorithms are hardly ever used.\nThe problem is that guaranteeing the best solution requires looking at a lot of other solutions in order to rule them out.\nFor problems with large search spaces, this usually takes too much time.\nThe alternative is to use an algorithm that will probably return a solution that is close to the best solution, but gives no guarantee.\nSuch algorithms, traditionally known as *non-admissible heuristic search* algorithms, can be much faster.\n\nOf the algorithms we have seen so far, best-first search almost, but not quite, guarantees the best solution.\nThe problem is that it terminates a little too early.\nSuppose it has calculated three paths, of cost 90, 95 and 110.\nIt will expand the 90 path next.\nSuppose this leads to a solution of total cost 100.\nBest-first search will then return that solution.\nBut it is possible that the 95 path could lead to a solution with a total cost less than 100.\nPerhaps the 95 path is only one unit away from the goal, so it could result in a complete path of length 96.\nThis means that an optimal search should examine the 95 path (but not the 110 path) before exiting.\n\nDepth-first search and beam search, on the other hand, are definitely heuristic algorithms.\nDepth-first search finds a solution without any regard to its cost.\nWith beam search, picking a good value for the beam width can lead to a good, quick solution, while picking the wrong value can lead to failure, or to a poor solution.\nOne way out of this dilemma is to start with a narrow beam width, and if that does not lead to an acceptable solution, widen the beam and try again.\nWe will call this *iterative widening*, although that is not a standard term.\nThere are many variations on this theme, but here is a simple one:\n\n```lisp\n(defun iter-wide-search (start goal-p successors cost-fn\n                &key (width 1) (max 100))\n  \"Search, increasing beam width from width to max.\n  Return the first solution found at any width.\"\n  (dbg :search \"; Width: ~d\" width)\n  (unless (> width max)\n    (or (beam-search start goal-p successors cost-fn width)\n      (iter-wide-search start goal-p successors cost-fn\n                        :width (+ width 1) :max max))))\n```\n\nHere `iter-wide-search` is used to search through a binary tree, failing with beam width 1 and 2, and eventually succeeding with beam width 3:\n\n```lisp\n> (iter-wide-search 1 (is 12) (finite-binary-tree 15) (diff 12))\nWidth: 1\n;; Search: (1)\n;; Search: (3)\n;; Search: (7)\n;; Search: (14)\n; Width: 2\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6)\n;; Search: (14 15)\n;; Search: (15)\n;; Search: NIL\n; Width: 3\n;; Search: (1)\n;; Search: (3 2)\n;; Search: (7 6 2)\n;; Search: (14 15 6)\n;; Search: (15 6)\n;; Search: (6)\n;; Search: (12 13)\n12\n```\n\nThe name iterative widening is derived from the established term *iterative deepening*.\nIterative deepening is used to control depth-first search when we don't know the depth of the desired solution.\nThe idea is first to limit the search to a depth of 1, then 2, and so on.\nThat way we are guaranteed to find a solution at the minimum depth, just as in breadth-first search, but without wasting as much storage space.\nOf course, iterative deepening does waste some time because at each increasing depth it repeats all the work it did at the previous depth.\nBut suppose that the average state has ten successors.\nThat means that increasing the depth by one results in ten times more search, so only 10% of the time is wasted on repeated work.\nSo iterative deepening uses only slightly more time and much less space.\nWe will see it again in [chapters 11](chapter11.md) and [18](chapter18.md).\n\n### Searching Graphs\n\nSo far, `tree-search` has been the workhorse behind all the searching routines.\nThis is curious, when we consider that the city problem involves a graph that is not a tree at all.\nThe reason `tree-search` works is that any graph can be treated as a tree, if we ignore the fact that certain nodes are identical.\nFor example, the graph in [figure 6.3](#fig-06-03) can be rendered as a tree.\n[Figure 6.4](#f0025) shows only the top four levels of the tree; each of the bottom nodes (except the 6s) needs to be expanded further.\n\n\n| <a id=\"fig-06-03\"></a>[]() |\n|---|\n| <img src=\"images/chapter6/fig-06-03.svg\" onerror=\"this.src='images/chapter6/fig-06-03.png'; this.onerror=null;\" alt=\"Figure 6.3\" /> |\n| **Figure 6.3: A Graph with Six Nodes** |\n\n| <a id=\"fig-06-04\"></a>[]() |\n|---|\n| <img src=\"images/chapter6/fig-06-04.svg\" onerror=\"this.src='images/chapter6/fig-06-04.png'; this.onerror=null;\" alt=\"Figure 6.4\" /> |\n| **Figure 6.4: The Corresponding Tree** |\n\nIn searching for paths through the graph of cities, we were implicitly turning the graph into a tree.\nThat is, if `tree-search` found two paths from Pittsburgh to Kansas City (via Chicago or Indianapolis), then it would treat them as two independent paths, just as if there were two distinct Kansas Cities.\nThis made the algorithms simpler, but it also doubles the number of paths left to examine.\nIf the destination is San Francisco, we will have to search for a path from Kansas City to San Francisco twice instead of once.\nIn fact, even though the graph has only 22 cities, the tree is infinite, because we can go back and forth between adjacent cities any number of times.\nSo, while it is possible to treat the graph as a tree, there are potential savings in treating it as a true graph.\n\nThe function `graph-search` does just that.\nIt is similar to `tree-search`, but accepts two additional arguments: a comparison function that tests if two states are equal, and a list of states that are no longer being considered, but were examined in the past.\nThe difference between `graph-search` and `tree-search` is in the call to `new-states`, which generates successors but eliminates states that are in either the list of states currently being considered or the list of old states considered in the past.\n\n```lisp\n(defun graph-search (states goal-p successors combiner &optional (state= #'eql) old-states)\n \"Find a state that satisfies goal-p. Start with states,and search according to successors and combiner.\n  Don't try the same state twice.\"\n  (dbg :search \"~&;; Search: ~a\" states)\n  (cond ((null states) fail)\n        ((funcall goal-p (first states)) (first states))\n        (t (graph-search\n            (funcall\n              combiner\n              (new-states states successors state= old-states)\n              (rest states))\n            goal-p successors combiner state=\n            (adjoin (first states) old-states\n                      :test state=)))))\n\n(defun new-states (states successors state= old-states)\n  \"Generate successor states that have not been seen before.\"\n  (remove-if\n    #'(lambda (state)\n      (or (member state states :test state=)\n        (member state old-states :test state=)))\n      (funcall successors (first states))))\n```\n\nUsing the successor function `next2`, we can search the graph shown here either as a tree or as a graph.\nIf we search it as a graph, it takes fewer iterations and less storage space to find the goal.\nOf course, there is additional overhead to test for identical states, but on graphs like this one we get an exponential speed-up for a constant amount of overhead.\n\n```lisp\n(defun next2 (x) (list (+ x 1) (+ x 2)))\n\n> (tree-search '(1) (is 6) #'next2 #'prepend)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 3 4)\n;; Search: (3 4 4 5)\n;; Search:(4 4 5 4 5)\n;; Search: (4 5 4 5 5 6)\n;; Search: (5 4 5 5 6 5 6)\n;; Search: (4 5 5 6 5 6 6 7)\n;; Search: (5 5 6 5 6 6 7 5 6)\n;; Search: (5 6 5 6 6 7 5 6 6 7)\n;; Search: (6 5 6 6 7 5 6 6 7 6 7)\n6\n> (graph-search '(1) (is 6) #'next2 #'prepend)\n;; Search: (1)\n;; Search: (2 3)\n;; Search: (3 4)\n;; Search: (4 5)\n;; Search: (5 6)\n;; Search: (6 7)\n6\n```\n\nThe next step is to extend the `graph-search` algorithm to handle paths.\nThe complication is in deciding which path to keep when two paths reach the same state.\nIf we have a cost function, then the answer is easy: keep the path with the cheaper cost.\nBest-first search of a graph removing duplicate states is called A* search.\n\nA* search is more complicated than `graph-search` because of the need both to add and to delete paths to the lists of current and old paths.\nFor each new successor state, there are three possibilities.\nThe new state may be in the list of current paths, in the list of old paths, or in neither.\nWithin the first two cases, there are two subcases.\nIf the new path is more expensive than the old one, then ignore the new path - it can not lead to a better solution.\nIf the new path is cheaper than a corresponding path in the list of current paths, then replace it with the new path.\nIf it is cheaper than a corresponding path in the list of the old paths, then remove that old path, and put the new path in the list of current paths.\n\nAlso, rather than sort the paths by total cost on each iteration, they are kept sorted, and new paths are inserted into the proper place one at a time using `insert-path`.\nTwo more functions, `better-path` and `find-path`, are used to compare paths and see if a state has already appeared.\n\n```lisp\n(defun a*-search (paths goal-p successors cost-fn cost-left-fn\n                  &optional (state= #'eql) old-paths)\n  \"Find a path whose state satisfies goal-p.  Start with paths,\n  and expand successors, exploring least cost first.\n  When there are duplicate states, keep the one with the\n  lower cost and discard the other.\"\n  (dbg :search \";; Search: ~a\" paths)\n  (cond\n    ((null paths) fail)\n    ((funcall goal-p (path-state (first paths)))\n     (values (first paths) paths))\n    (t (let* ((path (pop paths))\n              (state (path-state path)))\n         ;; Update PATHS and OLD-PATHS to reflect\n         ;; the new successors of STATE:\n         (setf old-paths (insert-path path old-paths))\n         (dolist (state2 (funcall successors state))\n           (let* ((cost (+ (path-cost-so-far path)\n                           (funcall cost-fn state state2)))\n                  (cost2 (funcall cost-left-fn state2))\n                  (path2 (make-path\n                           :state state2 :previous path\n                           :cost-so-far cost\n                           :total-cost (+ cost cost2)))\n                  (old nil))\n             ;; Place the new path, path2, in the right list:\n             (cond\n               ((setf old (find-path state2 paths state=))\n                (when (better-path path2 old)\n                  (setf paths (insert-path\n                                path2 (delete old paths)))))\n               ((setf old (find-path state2 old-paths state=))\n                (when (better-path path2 old)\n                  (setf paths (insert-path path2 paths))\n                  (setf old-paths (delete old old-paths))))\n               (t (setf paths (insert-path path2 paths))))))\n         ;; Finally, call A* again with the updated path lists:\n         (a*-search paths goal-p successors cost-fn cost-left-fn\n                    state= old-paths)))))\n```\n\nHere are the three auxiliary functions:\n\n```lisp\n(defun find-path (state paths state=)\n  \"Find the path with this state among a list of paths.\"\n  (find state paths :key #'path-state :test state=))\n\n(defun better-path (pathl path2)\n  \"Is path1 cheaper than path2?\"\n  (< (path-total-cost path1) (path-total-cost path2)))\n\n(defun insert-path (path paths)\n  \"Put path into the right position, sorted by total cost.\"\n  ;; MERGE is a built-in function\n  (merge 'list (list path) paths #'< :key #'path-total-cost))\n\n(defun path-states (path)\n  \"Collect the states along this path.\"\n  (if (null path)\n      nil\n      (cons (path-state path)\n            (path-states (path-previous path)))))\n```\n\nBelow we use `a*-search` to search for 6 in the graph previously shown in [figure 6.3](#fig-06-03).\nThe cost function is a constant 1 for each step.\nIn other words, the total cost is the length of the path.\nThe heuristic evaluation function is just the difference from the goal.\nThe A* algorithm needs just three search steps to come up with the optimal solution.\nContrast that to the graph search algorithm, which needed five steps, and the tree search algorithm, which needed ten steps-and neither of them found the optimal solution.\n\n```lisp\n> (path-states\n      (a*-search (list (make-path :state 1)) (is 6)\n                    #'next2 #'(lambda (x y) 1) (diff 6)))\n;; Search: (#<Path to 1 cost 0.0  >)\n;; Search: (#<Path to 3 cost 4.0  > #<Path to 2 cost 5.0  >)\n;; Search: (#<Path to 5 cost 3.0  > #<Path to 4 cost 4.0  >\n                #<Path to 2 cost 5.0  >)\n;; Search: (#<Path to 6 cost 3.0  > #<Path to 7 cost 4.0  >\n                #<Path to 4 cost 4.0  > #<Path to 2 cost 5.0  >)\n(6 5 3 1)\n```\n\nIt may seem limiting that these search functions all return a single answer.\nIn some applications, we may want to look at several solutions, or at all possible solutions.\nOther applications are more naturally seen as optimization problems, where we don't know ahead of time what counts as achieving the goal but are just trying to find some action with a low cost.\n\nIt turns out that the functions we have defined are not limiting at all in this respect.\nThey can be used to serve both these new purposes-provided we carefully specify the goal predicate.\nTo find all solutions to a problem, all we have to do is pass in a goal predicate that always fails, but saves all the solutions in a list.\nThe goal predicate will see all possible solutions and save away just the ones that are real solutions.\nOf course, if the search space is infinite this will never terminate, so the user has to be careful in applying this technique.\nIt would also be possible to write a goal predicate that stopped the search after finding a certain number of solutions, or after looking at a certain number of states.\nHere is a function that finds all solutions, using beam search:\n\n```lisp\n(defun search-all (start goal-p successors cost-fn beam-width)\n  \"Find all solutions to a search problem, using beam search.\"\n  ;; Be careful: this can lead to an infinite loop.\n  (let ((solutions nil))\n    (beam-search\n      start #'(lambda (x)\n              (when (funcall goal-p x) (push x solutions))\n              nil)\n      successors cost-fn beam-width)\n  solutions))\n```\n\n## 6.5 GPS as Search\n\nThe GPS program can be seen as a problem in search.\nFor example, in the three-block blocks world, there are only 13 different states.\nThey could be arranged in a graph and searched just as we searched for a route between cities.\n[Figure 6.5](#fig-06-05) shows this graph.\n\n| <a id=\"fig-06-05\"></a>[]() |\n|---|\n| <img src=\"images/chapter6/fig-06-05.svg\" onerror=\"this.src='images/chapter6/fig-06-05.png'; this.onerror=null;\" alt=\"Figure 6.5\" /> |\n| **Figure 6.5: The Blocks World as a Graph** |\n\nThe function `search-gps` does just that.\nLike the gps function on [page 135](chapter4.md#p135), it computes a final state and then picks out the actions that lead to that state.\nBut it computes the state with a beam search.\nThe goal predicate tests if the current state satisfies every condition in the goal, the successor function finds all applicable operators and applies them, and the cost function simply sums the number of actions taken so far, plus the number of conditions that are not yet satisfied:\n\n```lisp\n(defun search-gps (start goal &optional (beam-width 10))\n  \"Search for a sequence of operators leading to goal.\"\n  (find-all-if\n    #'action-p\n    (beam-search\n      (cons '(start) start)\n      #'(lambda (state) (subsetp goal state :test #'equal))\n      #'gps-successors\n      #'(lambda (state)\n          (+ (count-if #'action-p state)\n             (count-if #'(lambda (con)\n                           (not (member-equal con state)))\n                       goal)))\n      beam-width)))\n```\n\nHere is the successor function:\n\n```lisp\n(defun gps-successors (state)\n  \"Return a list of states reachable from this one using ops.\"\n  (mapcar\n    #'(lambda (op)\n        (append\n          (remove-if #'(lambda (x)\n                         (member-equal x (op-del-list op)))\n                     state)\n          (op-add-list op)))\n    (applicable-ops state)))\n\n(defun applicable-ops (state)\n  \"Return a list of all ops that are applicable now.\"\n  (find-all-if\n    #'(lambda (op)\n        (subsetp (op-preconds op) state :test #'equal))\n    *ops*))\n```\n\nThe search technique finds good solutions quickly for a variety of problems.\nHere we see the solution to the Sussman anomaly in the three-block blocks world:\n\n```lisp\n(setf start '((c on a) (a on table) (b on table) (space on c)\n            (space on b) (space on table)))\n> (search-gps start '((a on b) (b on c)))\n((START)\n  (EXECUTING (MOVE C FROM A TO TABLE))\n  (EXECUTING (MOVE B FROM TABLE TO C))\n  (EXECUTING (MOVE A FROM TABLE TO B)))\n> (search-gps start '((b on c) (a on b)))\n((START)\n  (EXECUTING (MOVE C FROM A TO TABLE))\n  (EXECUTING (MOVE B FROM TABLE TO C))\n  (EXECUTING (MOVE A FROM TABLE TO B)))\n```\n\nIn these solutions we search forward from the start to the goal; this is quite different from the means-ends approach of searching backward from the goal for an appropriate operator.\nBut we could formulate means-ends analysis as forward search simply by reversing start and goal: GPS's goal state is the search's start state, and the search's goal predicate tests to see if a state matches GPS's start state.\nThis is left as an exercise.\n\n## 6.6 History and References\n\nPattern matching is one of the most important tools for AI.\nAs such, it is covered in most textbooks on Lisp.\nGood treatments include Abelson and Sussman (1984), [Wilensky (1986)](bibliography.md#bb1390), [Winston and Horn (1988)](bibliography.md#bb1410), and [Kreutzer and McKenzie (1990)](bibliography.md#bb0680).\nAn overview is presented in the \"pattern-matching\" entry in *Encyclopedia of AI* ([Shapiro 1990](bibliography.md#bb1085)).\n\nNilsson's *Problem*-*Solving Methods in Artificial Intelligence* (1971) was an early text-book that emphasized search as the most important defining characteristic of AI.\nMore recent texts give less importance to search; Winston's *Artificial Intelligence* (1984) gives a balanced overview, and his *Lisp* (1988) provides implementations of some of the algorithms.\nThey are at a lower level of abstraction than the ones in this chapter.\nIterative deepening was first presented by [Korf (1985)](bibliography.md#bb0640), and iterative broadening by [Ginsberg and Harvey (1990)](bibliography.md#bb0470).\n\n## 6.7 Exercises\n\n**Exercise  6**.**3** [**m**] Write a version of `interactive-interpreter` that is more general than the one defined in this chapter.\nDecide what features can be specified, and provide defaults for them.\n\n**Exercise  6**.**4** [**m**] Define a version of `compose` that allows any number of arguments, not just two.\nHint: You may want to use the function `reduce`.\n\n**Exercise  6**.**5** [**m**] Define a version of `compose` that allows any number of arguments but is more efficient than the answer to the previous exercise.\nHint: try to make decisions when `compose` is called to build the resulting function, rather than making the same decisions over and over each time the resulting function is called.\n\n**Exercise  6**.**6** [**m**] One problem with `pat-match` is that it gives special significance to symbols starting with `?`, which means that they can not be used to match a literal pattern.\nDefine a pattern that matches the input literally, so that such symbols can be matched.\n\n**Exercise  6**.**7** [**m**] Discuss the pros and cons of data-driven programming compared to the conventional approach.\n\n**Exercise  6**.**8** [**m**] Write a version of `tree-search` using an explicit loop rather than recursion.\n\n**Exercise  6**.**9** [**m**] The `sorter` function is inefficient for two reasons: it calls `append`, which has to make a copy of the first argument, and it sorts the entire result, rather than just inserting the new states into the already sorted *old* states.\nWrite a more efficient `sorter`.\n\n**Exercise  6**.**10** [**m**] Write versions of `graph-search` and `a*-search` that use hash tables rather than lists to test whether a state has been seen before.\n\n**Exercise  6**.**11** [**m**] Write a function that calls `beam-search` to find the first *n* solutions to a problem and returns them in a list.\n\n**Exercise  6**.**12** [**m**] On personal computers without floating-point hardware, the `air-distance` calculation will be rather slow.\nIf this is a problem for you, arrange to compute the `xyz-coords` of each city only once and then store them, or store a complete table of air distances between cities.\nAlso precompute and store the neighbors of each city.\n\n**Exercise  6**.**13** [**d**] Write a version of GPS that uses A* search instead of beam search.\nCompare the two versions in a variety of domains.\n\n**Exercise  6**.**14** [**d**] Write a version of GPS that allows costs for each operator.\nFor example, driving the child to school might have a cost of 2, but calling a limousine to transport the child might have a cost of 100.\nUse these costs instead of a constant cost of 1 for each operation.\n\n**Exercise  6**.**15** [**d**] Write a version of GPS that uses the searching tools but does means-ends analysis.\n\n## 6.8 Answers\n\n**Answer 6**.**2** Unfortunately, `pat-match` does not always find the answer.\nThe problem is that it will only rebind a segment variable based on a failure to match the rest of the pattern after the segment variable.\nIn all the examples above, the \"rest of the pattern after the segment variable\" was the whole pattern, so `pat-match` always worked properly.\nBut if a segment variable appears nested inside a list, then the rest of the segment variable's sublist is only a part of the rest of the whole pattern, as the following example shows:\n\n```lisp\n> (pat-match '(((?* ?x) (?* ?y)) ?x ?y) '((a b c d ) (a b) (c d))) => NIL\n```\n\nThe correct answer with `?x` bound to `(a b)` and `?y` bound to `(c d)` is not found because the inner segment match succeeds with `?x` bound to `( )` and `?y` bound to `(a b c d)`, and once we leave the inner match and return to the top level, there is no going back for alternative bindings.\n\n**Answer 6**.**3** The following version lets the user specify all four components of the prompt-read-eval-print loop, as well as the streams to use for input and output.\nDefaults are set up as for a Lisp interpreter.\n\n```lisp\n(defun interactive-interpreter\n        (&key (read #'read) (eval #'eval) (print #'print)\n          (prompt \"> \") (input t) (output t))\n  \"Read an expression, evaluate it, and print the result.\"\n  (loop\n    (fresh-line output)\n    (princ prompt output)\n      (funcall print (funcall eval (funcall read input))\n              output)))\n```\n\nHere is another version that does all of the above and also handles multiple values and binds the various \"history variables\" that the Lisp top-level binds.\n\n```lisp\n(defun interactive-interpreter\n      (&key (read #'read) (eval #'eval) (print #'print)\n      (prompt \"> \") (input t) (output t))\n  \"Read an expression, evaluate it, and print the result(s).\n  Does multiple values and binds: * ** ***-+ ++ +++/ // ///\"\n  (let (* ** *** - + ++ +++ / // /// vals)\n    ;; The above variables are all special, except VALS\n    ;; The variable - holds the current input\n    ;; * *** *** are the 3 most recent values\n    ;; + ++ +++ are the 3 most recent inputs\n    ;;/ // /// are the 3 most recent lists of multiple-values\n    (loop\n      (fresh-line output)\n      (princ prompt output)\n      ;; First read and evaluate an expression\n      (setf - (funcall read input)\n          vals (multiple-value-list (funcall eval -)))\n      ;; Now update the history variables\n   (setf +++ ++     /// //     *** (first ///)\n         ++ +       // /       ** (first //)\n         + -        / vals     * (first /))\n      ;; Finally print the computed value(s)\n      (dolist (value vals)\n        (funcall print value output)))))\n```\n\n**Answer 6**.**4**\n\n```lisp\n(defun compose (&rest functions)\n  \"Return the function that is the composition of all the args. i.e.\n(compose f g h) = (lambda (x) (f (g (h x)))).\"\n#'(lambda (x)\n      (reduce #'funcall functions :from-end t :initial-value x)))\n```\n\n**Answer 6**.**5**\n\n```lisp\n(defun compose (&rest functions)\n  \"Return the function that is the composition of all the args. i.e.\n(compose f g h) = (lambda (x) (f (g (h x)))).\"\n  (case (length functions)\n    (0 #'identity)\n    (1 (first functions))\n    (2 (let ((f (first functions))\n            (g (second functions)))\n        #'(lambda (x) (funcall f (funcall g x)))))\n    (t #'(lambda (x)\n          (reduce #'funcall functions :from-end t\n                  :initia1-value x)))))\n```\n\n**Answer 6**.**8**\n\n```lisp\n(defun tree-search (states goal-p successors combiner)\n\"Find a state that satisfies goal-p.\nStart with states, and search according to successors and combiner.\"\n  (loop\n    (cond ((null states) (RETURN fail))\n          ((funcall goal-p (first states))\n          (RETURN (first states))\n          (t (setf states\n                  (funcall combiner\n                          (funcall successors (first states))\n                          (rest states))))))))\n```\n\n**Answer 6**.**9**\n\n```lisp\n(defun sorter (cost-fn)\n  \"Return a combiner function that sorts according to cost-fn.\"\n  #'(lambda (new old)\n      (merge 'list (sort new #'> :key cost-fn)\n          old #'> :key cost-fn)))\n```\n\n**Answer 6**.**11**\n\n```lisp\n(defun search-n (start n goal-p successors cost-fn beam-width)\n  \"Find n solutions to a search problem, using beam search.\"\n  (let ((solutions nil))\n    (beam-search\n      start #'(lambda (x)\n          (cond ((not (funcall goal-p x)) nil)\n              ((= n 0) x)\n              (t (decf n)\n                  (push x solutions)\n                  nil)))\n      successors cost-fn beam-width)\n    solutions))\n```\n\n----------------------\n\n<a id=\"fn06-1\"></a><sup>[1](#tfn06-1)</sup>\nThe macro `handler-case` is only in ANSI Common Lisp.\n\n<a id=\"fn06-2\"></a><sup>[2](#tfn06-2)</sup>\nAn alternative would be to reserve the question mark for variables only and use another notation for these match operators.\nKeywords would be a good choice, such as `:and`, `:or`, `:is`, etc.\n\n<a id=\"fn06-3\"></a><sup>[3](#tfn06-3)</sup>\nThe built-in constant `most-positive-fixnum` is a large integer, the largest that can be expressed without using bignums.\nIts value depends on the implementation, but in most Lisps it is over 16 million.\n\n<a id=\"fn06-4\"></a><sup>[4](#tfn06-4)</sup>\nIn [chapter 8](chapter8.md) we will see an example where the fog did lift: symbolic integration was once handled as a problem in search, but new mathematical results now make it possible to solve the same class of integration problems without search.\n\n<a id=\"fn06-5\"></a><sup>[5](#tfn06-5)</sup>\nThe astute reader will recognize that this graph is not a tree.\nThe difference between trees and graphs and the implications for searching will be covered later.\n"
  },
  {
    "path": "docs/chapter7.md",
    "content": "# Chapter 7\n## STUDENT: Solving Algebra Word Problems\n\n> *[This] is an example par excellence* of the power of using meaning to solve linguistic problems.\n>\n> -[Marvin Minsky (1968)](bibliography.md#bb0845)\n>\n> MIT computer scientist\n\nSTUDENT was another early language understanding program, written by Daniel Bobrow as his Ph.D.\nresearch project in 1964.\nIt was designed to read and solve the kind of word problems found in high school algebra books.\nAn example is:\n\n> If the number of customers Tom gets is twice the square of 20% of the number of advertisements he runs, and the number of advertisements is 45, then what is the number of customers Tom gets?\n\nSTUDENT could correctly reply that the number of customers is 162.\nTo do this, STUDENT must be far more sophisticated than ELIZA; it must process and \"understand\" a great deal of the input, rather than just concentrate on a few key words.\nAnd it must compute a response, rather than just fill in blanks.\nHowever, we shall see that the STUDENT program uses little more than the pattern-matching techniques of ELIZA to translate the input into a set of algebraic equations.\nFrom there, it must know enough algebra to solve the equations, but that is not very difficult.\n\nThe version of STUDENT we develop here is nearly a full implementation of the original.\nHowever, remember that while the original was state-of-the-art as of 1964, AI has made some progress in a quarter century, as subsequent chapters will attempt to show.\n\n## 7.1 Translating English into Equations\n\nThe description of STUDENT is:\n\n1.  Break the input into phrases that will represent equations.\n\n2.  Break each phrase into a pair of phrases on either side of the = sign.\n\n3.  Break these phrases down further into sums and products, and so on, until finally we bottom out with numbers and variables.\n(By \"variable\" here, I mean \"mathematical variable,\" which is distinct from the idea of a \"pattern-matching variable\" as used in `pat-match` in [chapter 6](chapter6.md)).\n\n4.  Translate each English phrase into a mathematical expression.\nWe use the idea of a rule-based translator as developed for ELIZA.\n\n5.  Solve the resulting mathematical equations, coming up with a value for each unknown variable.\n\n6.  Print the values of all the variables.\n\nFor example, we might have a pattern of the form (`If ?x then ?y`), with an associated response that says that `?x` and `?y` will each be equations or lists of equations.\nApplying the pattern to the input above, `?y` would have the value (`what is the number of customers Tomgets`).\nAnother pattern of the form (`?x is ?y`) could have a response corresponding to an equation where `?x` and `?y` are the two sides of the equation.\nWe could then make up a mathematical variable for (`what`) and another for (`the number of customers Tom gets`).\nWe would recognize this later phrase as a variable because there are no patterns to break it down further.\nIn contrast, the phrase (`twice the square of 20 per cent of the number of advertisements he runs`) could match a pattern of the form (`twice ?x`) and transform to `(* 2 (the square of 20 per cent of the number of advertisements he runs)),` and by further applying patterns of the form (`the square of ?x`) and (`?x per cent of ?y`) we could arrive at a final response of `(* 2 (expt (* (/ 20 100) n) 2))`, where `n` is the variable generated by (`the number of advertisements he runs`).\n\nThus, we need to represent variables, expressions, equations, and sets of equations.\nThe easiest thing to do is to use something we know: represent them just as Lisp itself does.\nVariables will be symbols, expressions and equations will be nested lists with prefix operators, and sets of equations will be lists of equations.\nWith that in mind, we can define a list of pattern-response rules corresponding to the type of statements found in algebra word problems.\nThe structure definition for a rule is repeated here, and the structure `exp`, an expression, is added.\n`lhs` and `rhs` stand for left-and right-hand side, respectively.\nNote that the constructor `mkexp` is defined as a constructor that builds expressions without taking keyword arguments.\nIn general, the notation (`:constructor` *fn args*) creates a constructor function with the given name and argument list.<a id=\"tfn07-1\"></a><sup>[1](#fn07-1)</sup>\n\n```lisp\n(defstruct (rule (:type list)) pattern response)\n\n(defstruct (exp (:type list)\n                (:constructor mkexp (lhs op rhs)))\n  op lhs rhs)\n\n(defun exp-p (x) (consp x))\n(defun exp-args (x) (rest x))\n```\n\nWe ignored commas and periods in ELIZA, but they are crucial for STUDENT, so we must make allowances for them.\nThe problem is that a `\",\"` in Lisp normally can be used only within a backquote construction, and a `\".\"` normally can be used only as a decimal point or in a dotted pair.\nThe special meaning of these characters to the Lisp reader can be escaped either by preceding the character with a backslash (`\\,`) or by surrounding the character by vertical bars (`|,|`).\n\n```lisp\n(pat-match-abbrev '?x* '(?* ?x))\n(pat-match-abbrev '?y* '(?* ?y))\n\n(defparameter *student-rules* (mapcar #'expand-pat-match-abbrev\n  '(((?x* |.|)                  ?x)\n    ((?x* |.| ?y*)          (?x ?y))\n    ((if ?x* |,| then ?y*)  (?x ?y))\n    ((if ?x* then ?y*)      (?x ?y))\n    ((if ?x* |,| ?y*)       (?x ?y))\n    ((?x* |,| and ?y*)      (?x ?y))\n    ((find ?x* and ?y*)     ((= to-find-1 ?x) (= to-find-2 ?y)))\n    ((find ?x*)             (= to-find ?x))\n    ((?x* equals ?y*)       (= ?x ?y))\n    ((?x* same as ?y*)      (= ?x ?y))\n    ((?x* = ?y*)            (= ?x ?y))\n    ((?x* is equal to ?y*)  (= ?x ?y))\n    ((?x* is ?y*)           (= ?x ?y))\n    ((?x* - ?y*)            (- ?x ?y))\n    ((?x* minus ?y*)        (- ?x ?y))\n    ((difference between ?x* and ?y*)  (- ?y ?x))\n    ((difference ?x* and ?y*)          (- ?y ?x))\n    ((?x* + ?y*)            (+ ?x ?y))\n    ((?x* plus ?y*)         (+ ?x ?y))\n    ((sum ?x* and ?y*)      (+ ?x ?y))\n    ((product ?x* and ?y*)  (* ?x ?y))\n    ((?x* * ?y*)            (* ?x ?y))\n    ((?x* times ?y*)        (* ?x ?y))\n    ((?x* / ?y*)            (/ ?x ?y))\n    ((?x* per ?y*)          (/ ?x ?y))\n    ((?x* divided by ?y*)   (/ ?x ?y))\n    ((half ?x*)             (/ ?x 2))\n    ((one half ?x*)         (/ ?x 2))\n    ((twice ?x*)            (* 2 ?x))\n    ((square ?x*)           (* ?x ?x))\n    ((?x* % less than ?y*)  (* ?y (/ (- 100 ?x) 100)))\n    ((?x* % more than ?y*)  (* ?y (/ (+ 100 ?x) 100)))\n    ((?x* % ?y*)            (* (/ ?x 100) ?y)))))\n```\n\nThe main section of STUDENT will search through the list of rules for a response, just as ELIZA did.\nThe first point of deviation is that before we substitute the values of the `pat-match` variables into the response, we must first recursively translate the value of each variable, using the same list of pattern-response rules.\nThe other difference is that once we're done, we don't just print the response; instead we have to solve the set of equations and print the answers.\nThe program is summarized in figure 7.1.\n\n| Function                   | Description                                                          |\n|----------------------------|----------------------------------------------------------------------|\n|                            | **Top-Level Function**                                               |\n| `student`                  | Solve certain algebra word problems.                                 |\n|                            | **Special Variables**                                                |\n| `*student-rules*`          | A list of pattern/response pairs.                                    |\n|                            | **Data Types**                                                       |\n| `exp`                      | An operator and its arguments.                                       |\n| `rule`                     | A pattern and response.                                              |\n|                            | **Major Functions**                                                  |\n| `translate-to-expression`  | Translate an English phrase into an equation or expression.          |\n| `translate-pair`           | Translate the value part of the pair into an equation or expression. |\n| `create-list-of-equations` | Separate out equations embedded in nested parens.                    |\n| `solve-equations`          | Print the equations and their solution.                              |\n| `solve`                    | Solve a system of equations by constraint propagation.               |\n|                            | **Auxiliary Functions**                                              |\n| `isolate`                  | Isolate the lone variable on the left-hand side of an expression.    |\n| `noise-word-p`             | Is this a low-content word that can be safely ignored?               |\n| `make-variable`            | Create a variable name based on the given list of words.             |\n| `print-equations`          | Print a list of equations.                                           |\n| `inverse-op`               | For example, the inverse of `+` is `-`.                              |\n| `unknown-p`                | Is the argument an unknown (variable)?                               |\n| `in-exp`                   | True if `x` appears anywhere in exp.                                 |\n| `no-unknown`               | Returns true if there are no unknowns in exp.                        |\n| `one-unknown`              | Returns the single unknown in exp, if there is exactly one.          |\n| `commutative-p`            | Is the operator commutative?                                         |\n| `solve-arithmetic`         | Perform arithmetic on rhs of an equation.                            |\n| `binary-exp-p`             | Is this a binary expression?                                         |\n| `prefix->infix`            | Translate prefix to infix expressions.                               |\n| `mkexp`                    | Make an expression.                                                  |\n|                            | **Previously Defined Functions**                                     |\n| `pat-match`                | Match pattern against an input. (p. 180)                             |\n| `rule-based-translator`    | Apply a set of rules. (p. 189)                                       |\n\nFigure 7.1: Glossary for the STUDENT Program\n\nBefore looking carefully at the program, let's try a sample problem: \"If z is 3, what is twice z?\" Applying the rules to the input gives the following trace:\n\n```lisp\nInput: (If z is 3, what is twice z)\nRule: ((if ?x |,| ?y)            (?x ?y))\nBinding: ((?x . (z is 3)) (?y . (what is twice z)))\n  Input: (z is 3)\n  Rule: ((?x is ?y)                  (= ?x ?y))\n  Result: (= z 3)\n  Input: (what is twice z ?)\n  Rule: ((?x is ?y)                  (= ?x ?y))\n  Binding:((?x . what) (?y . (twice z)))\n    Input: (twice z)\n    Rule: ((twice ?x)                (* 2 ?x))\n    Result: (* 2 z)\n  Result: (= what (* 2 z))\nResult: ((= z 3) (= what (* 2 z)))\n```\n\nThere are two minor complications.\nFirst, we agreed to implement sets of equations as lists of equations.\nFor this example, everything worked out, and the response was a list of two equations.\nBut if nested patterns are used, the response could be something like `((= a 5) ((= b (+ a 1)) (= c (+ a b))))`, which is not a list of equations.\nThe function `create-list-of-equations` transforms a response like this into a proper list of equations.\nThe other complication is choosing variable names.\nGiven a list of words like (`the number of customers Tom gets`), we want to choose a symbol to represent it.\nWe will see below that the symbol `customers` is chosen, but that there are other possibilities.\n\nHere is the main function for STUDENT.\nIt first removes words that have no content, then translates the input to one big expression with `translate-to-expression`, and breaks that into separate equations with `create-list-of-equations`.\nFinally, the function `solve-equations` does the mathematics and prints the solution.\n\n```lisp\n(defun student (words)\n  \"Solve certain Algebra Word Problems.\"\n  (solve-equations\n    (create-list-of-equations\n      (translate-to-expression (remove-if #'noise-word-p words)))))\n```\n\nThe function `translate-to-expression` is a rule-based translator.\nIt either finds some rule in `*student-rules*` to transform the input, or it assumes that the entire input represents a single variable.\nThe function `translate-pair` takes a variable/value binding pair and translates the value by a recursive call to `translate-to-expression.`\n\n```lisp\n(defun translate-to-expression (words)\n  \"Translate an English phrase into an equation or expression.\"\n  (or (rule-based-translator\n        words *student-rules*\n        :rule-if #'rule-pattern :rule-then #'rule-response\n        :action #'(lambda (bindings response)\n                    (sublis (mapcar #'translate-pair bindings)\n                              response)))\n      (make-variable words)))\n\n(defun translate-pair (pair)\n  \"Translate the value part of the pair into an equation or expression.\"\n  (cons (binding-var pair)\n        (translate-to-expression (binding-val pair))))\n```\n\nThe function `create-list-of-equations` takes a single expression containing embedded equations and separates them into a list of equations:\n\n```lisp\n(defun create-list-of-equations (exp)\n  \"Separate out equations embedded in nested parens.\"\n  (cond ((null exp) nil)\n        ((atom (first exp)) (list exp))\n        (t (append (create-list-of-equations (first exp))\n                   (create-list-of-equations (rest exp))))))\n```\n\nFinally, the function `make-variable` creates a variable to represent a list of words.\nWe do that by first removing all \"noise words\" from the input, and then taking the first symbol that remains.\nSo, for example, \"the distance John traveled\" and \"the distance traveled by John\" will both be represented by the same variable, `distance,` which is certainly the right thing to do.\nHowever, \"the distance Mary traveled\" will also be represented by the same variable, which is certainly a mistake.\nFor (`the number of customers Tom gets`), the variable will be `customers`, since `the, of` and `number` are all noise words.\nThis will match (`the customers mentioned above`) and (`the number of customers`), but not (`Tom's customers`).\nFor now, we will accept the first-non-noise-word solution, but note that exercise 7.3 asks for a correction.\n\n```lisp\n(defun make-variable (words)\n  \"Create a variable name based on the given list of words\"\n    ;; The list of words will already have noise words removed\n  (first words))\n\n(defun noise-word-p (word)\n  \"Is this a low-content word which can be safely ignored?\"\n  (member word '(a an the this number of $)))\n```\n\n## 7.2 Solving Algebraic Equations\n\nThe next step is to write the equation-solving section of STUDENT.\nThis is more an exercise in elementary algebra than in AI, but it is a good example of a symbol-manipulation task, and thus an interesting programming problem.\n\nThe STUDENT program mentioned the function `solve-equations`, passing it one argument, a list of equations to be solved.\n`solve-equations` prints the list of equations, attempts to solve them using `solve`, and prints the result.\n\n```lisp\n(defun solve-equations (equations)\n  \"Print the equations and their solution\"\n  (print-equations \"The equations to be solved are:\" equations)\n  (print-equations \"The solution is:\" (solve equations nil)))\n```\n\nThe real work is done by solve, which has the following specification: (1) Find an equation with exactly one occurrence of an unknown in it.\n(2) Transform that equation so that the unknown is isolated on the left-hand side.\nThis can be done if we limit the operators to `+`, `-`, `*`, and `/`.\n(3) Evaluate the arithmetic on the right-hand side, yielding a numeric value for the unknown.\n(4) Substitute the numeric value for the unknown in all the other equations, and remember the known value.\nThen try to solve the resulting set of equations.\n(5) If step (1) fails-if there is no equation with exactly one unknown-then just return the known values and don't try to solve anything else.\n\nThe function `solve` is passed a system of equations, along with a list of known variable/value pairs.\nInitially no variables are known, so this list will be empty.\n`solve` goes through the list of equations searching for an equation with exactly one unknown.\nIf it can find such an equation, it calls `isolate` to solve the equation in terms of that one unknown.\n`solve` then substitutes the value for the variable throughout the list of equations and calls itself recursively on the resulting list.\nEach time `solve` calls itself, it removes one equation from the list of equations to be solved, and adds one to the list of known variable/value pairs.\nSince the list of equations is always growing shorter, `solve` must eventually terminate.\n\n```lisp\n(defun solve (equations known)\n  \"Solve a system of equations by constraint propagation.\"\n  ;; Try to solve for one equation, and substitute its value into\n  ;; the others. If that doesn't work, return what is known.\n  (or (some #'(lambda (equation)\n                (let ((x (one-unknown equation)))\n                  (when x\n                    (let ((answer (solve-arithmetic\n           (isolate equation x))))\n                      (solve (subst (exp-rhs answer) (exp-lhs answer)\n                                    (remove equation equations))\n                             (cons answer known))))))\n            equations)\n      known))\n```\n\n`isolate` is passed an equation guaranteed to have one unknown.\nIt returns an equivalent equation with the unknown isolated on the left-hand side.\nThere are five cases to consider: when the unknown is alone on the left, we're done.\nThe second case is when the unknown is anywhere on the right-hand side.\nBecause '=' is commutative, we can reduce the problem to solving the equivalent equation with left- and right-hand sides reversed.\n\nNext we have to deal with the case where the unknown is in a complex expression on the left-hand side.\nBecause we are allowing four operators and the unknown can be either on the right or the left, there are eight possibilities.\nLetting X stand for an expression containing the unknown and A and B stand for expressions with no unknowns, the possibilities and their solutions are as follows:\n\n| []()                   |                        |\n|------------------------|------------------------|\n| (1) `X*A=B` => `X=B/A` | (5) `A*X=B` => `X=B/A` |\n| (2) `X+A=B` => `X=B-A` | (6) `A+X=B` => `X=B-A` |\n| (3) `X/A=B` => `X=B*A` | (7) `A/X=B` => `X=A/B` |\n| (4) `X-A=B` => `X=B+A` | (8) `A-X=B` => `X=A-B` |\n\nPossibilities (1) through (4) are handled by case III, (5) and (6) by case IV, and (7) and (8) by case V.\nIn each case, the transformation does not give us the final answer, since X need not be the unknown; it might be a complex expression involving the unknown.\nSo we have to call isolate again on the resulting equation.\nThe reader should try to verify that transformations (1) to (8) are valid, and that cases III to V implement them properly.\n\n```lisp\n(defun isolate (e x)\n  \"Isolate the lone x in e on the left-hand side of e.\"\n  ;; This assumes there is exactly one x in e,\n  ;; and that e is an equation.\n  (cond ((eq (exp-lhs e) x)\n         ;; Case I: X = A -> X = n\n         e)\n        ((in-exp x (exp-rhs e))\n         ;; Case II: A = f(X) -> f(X) = A\n         (isolate (mkexp (exp-rhs e) '= (exp-lhs e)) x))\n        ((in-exp x (exp-lhs (exp-lhs e)))\n         ;; Case III: f(X)*A = B -> f(X) = B/A\n         (isolate (mkexp (exp-lhs (exp-lhs e)) '=\n                         (mkexp (exp-rhs e)\n                                (inverse-op (exp-op (exp-lhs e)))\n                                (exp-rhs (exp-lhs e)))) x))\n        ((commutative-p (exp-op (exp-lhs e)))\n         ;; Case IV: A*f(X) = B -> f(X) = B/A\n         (isolate (mkexp (exp-rhs (exp-lhs e)) '=\n                         (mkexp (exp-rhs e)\n                                (inverse-op (exp-op (exp-lhs e)))\n                                (exp-lhs (exp-lhs e)))) x))\n        (t ;; Case V: A/f(X) = B -> f(X) = A/B\n         (isolate (mkexp (exp-rhs (exp-lhs e)) '=\n                         (mkexp (exp-lhs (exp-lhs e))\n                                (exp-op (exp-lhs e))\n                                (exp-rhs e))) x))))\n```\n\nRecall that to prove a function is correct, we have to prove both that it gives the correct answer when it terminates and that it will eventually terminate.\nFor a recursive function with several alternative cases, we must show that each alternative is valid, and also that each alternative gets closer to the end in some way (that any recursive calls involve 'simpler' arguments).\nFor `isolate`, elementary algebra will show that each step is valid-or at least *nearly* valid.\nDividing both sides of an equation by 0 does not yield an equivalent equation, and we never checked for that.\nIt's also possible that similar errors could sneak in during the call to `eval`.\nHowever, if we assume the equation does have a single valid solution, then `isolate` performs only legal transformations.\n\nThe hard part is to prove that `isolate` terminates.\nCase I clearly terminates, and the others all contribute towards isolating the unknown on the left-hand side.\nFor any equation, the sequence will be first a possible use of case II, followed by a number of recursive calls using cases III to V.\nThe number of calls is bounded by the number of subexpressions in the equation, since each successive call effectively removes an expression from the left and places it on the right.\nTherefore, assuming the input is of finite size, we must eventually reach a recursive call to `isolate` that will use case I and terminate.\n\nWhen `isolate` returns, the right-hand side must consist only of numbers and operators.\nWe could easily write a function to evaluate such an expression.\nHowever, we don't have to go to that effort, since the function already exists.\nThe data structure `exp` was carefully selected to be the same structure (lists with prefix functions) used by Lisp itself for its own expressions.\nSo Lisp will find the right-hand side to be an acceptable expression, one that could be evaluated if typed in to the top level.\nLisp evaluates expressions by calling the function `eval`, so we can call `eval` directly and have it return a number.\nThe function `solve-arithmetic` returns an equation of the form (= *var number*).\n\nAuxiliary functions for `solve` are shown below.\nMost are straightforward, but I will remark on a few of them.\nThe function `prefix->infix` takes an expression in prefix notation and converts it to a fully parenthesized infix expression.\nUnlike `isolate`, it assumes the expressions will be implemented as lists.\n`prefix->infix` is used by `print-equations` to produce more readable output.\n\n```lisp\n(defun print-equations (header equations)\n  \"Print a list of equations.\"\n  (format t \"~%~a~{~%  ~{ ~a~}~}~%\" header\n          (mapcar #'prefix->infix equations)))\n\n(defconstant operators-and-inverses\n  '((+ -) (- +) (* /) (/ *) (= =)))\n\n(defun inverse-op (op)\n  (second (assoc op operators-and-inverses)))\n\n(defun unknown-p (exp)\n  (symbolp exp))\n\n(defun in-exp (x exp)\n  \"True if x appears anywhere in exp\"\n  (or (eq x exp)\n      (and (listp exp)\n           (or (in-exp x (exp-lhs exp)) (in-exp x (exp-rhs exp))))))\n\n(defun no-unknown (exp)\n  \"Returns true if there are no unknowns in exp.\"\n  (cond ((unknown-p exp) nil)\n        ((atom exp) t)\n        ((no-unknown (exp-lhs exp)) (no-unknown (exp-rhs exp)))\n        (t nil)))\n\n(defun one-unknown (exp)\n  \"Returns the single unknown in exp, if there is exactly one.\"\n  (cond ((unknown-p exp) exp)\n        ((atom exp) nil)\n        ((no-unknown (exp-lhs exp)) (one-unknown (exp-rhs exp)))\n        ((no-unknown (exp-rhs exp)) (one-unknown (exp-lhs exp)))\n        (t nil)))\n\n(defun commutative-p (op)\n  \"Is operator commutative?\"\n  (member op '(+ * =)))\n\n(defun solve-arithmetic (equation)\n  \"Do the arithmetic for the right-hand side.\"\n  ;; This assumes that the right-hand side is in the right form.\n  (mkexp (exp-lhs equation) '= (eval (exp-rhs equation))))\n\n(defun binary-exp-p (x)\n  (and (exp-p x) (= (length (exp-args x)) 2)))\n\n(defun prefix->infix (exp)\n  \"Translate prefix to infix expressions.\"\n  (if (atom exp) exp\n      (mapcar #'prefix->infix\n              (if (binary-exp-p exp)\n                  (list (exp-lhs exp) (exp-op exp) (exp-rhs exp))\n                  exp))))\n```\n\nHere's an example of `solve-equations` in action, with a system of two equations.\nThe reader should go through the trace, discovering which case was used at each call to `isolate`, and verifying that each step is accurate.\n\n```lisp\n> (trace isolate solve)\n(isolate solve)\n> (solve-equations '((= (+  3 4) (* (- 5 (+  2 x)) 7))\n                            (= (+ (* 3 x) y) 12)))\nThe equations to be solved are:\n      (3 + 4) = ((5 - (2 + X)) * 7)\n      ((3 * X) + Y) = 12\n(1 ENTER SOLVE: ((= (+  3 4) (* (- 5 (+  2 X)) 7))\n                            (= (+ (* 3 X) Y) 12)) NIL)\n    (1 ENTER ISOLATE: (= (+  3 4) (* (- 5 (+  2 X)) 7)) X)\n        (2 ENTER ISOLATE: (= (* (- 5 (+  2 X)) 7) (+  3 4)) X)\n            (3 ENTER ISOLATE: (= (- 5 (+  2 X)) (/ (+  3 4) 7)) X)\n                (4 ENTER ISOLATE: (= (+  2 X) (- 5 (/ (+  3 4) 7))) X)\n                    (5 ENTER ISOLATE: (= X (- (- 5 (/ (+  3 4) 7)) 2)) X)\n                    (5 EXIT ISOLATE: (= X (- (- 5 (/ (+  3 4) 7)) 2)))\n                (4 EXIT ISOLATE: (= X (- (- 5 (/ (+  3 4) 7)) 2)))\n            (3 EXIT ISOLATE: (= X (- (- 5 (/ (+  3 4) 7)) 2)))\n        (2 EXIT ISOLATE: (= X (- (- 5 (/ (+  3 4) 7)) 2)))\n    (1 EXIT ISOLATE: (= X (- (- 5 (/ (+  3 4) 7)) 2)))\n    (2 ENTER SOLVE: ((= (+ (* 3 2) Y) 12)) ((= X 2)))\n        (1 ENTER ISOLATE: (= (+ (* 3 2) Y) 12) Y)\n          (2 ENTER ISOLATE: (= Y (- 12 (* 3 2))) Y)\n          (2 EXIT ISOLATE: (= Y (- 12 (* 3 2))))\n        (1 EXIT ISOLATE: (= Y (- 12 (* 3 2))))\n        (3 ENTER SOLVE: NIL ((= Y 6) (= X 2)))\n        (3 EXIT SOLVE: ((= Y 6) (= X 2)))\n    (2 EXIT SOLVE: ((= Y 6) (= X 2)))\n(1 EXIT SOLVE: ((= Y 6) (= X 2)))\nThe solution is:\n      Y = 6\n      X = 2\nNIL\n```\n\nNow let's tackle the `format` string `\"~%~a~{~% ~{ ~  a  ~}~}~*%\"*` in `print-equations.` This may look like random gibberish, but there is actually sense behind it.\n`format` processes the string by printing each character, except that `\"~\"` indicates some special formatting action, depending on the following character.\nThe combination `\"~%\"` prints a newline, and `\"~a\"` prints the next argument to `format` that has not been used yet.\nThus the first four characters of the format string, `\"~%~a\"`, print a newline followed by the argument `header`.\nThe combination `\"~{\"` treats the corresponding argument as a list, and processes each element according to the specification between the `\"~{\"` and the next `\"~}\"`.\nIn this case, `equations` is a list of equations, so each one gets printed with a newline (`\"~%\"`) followed by two spaces, followed by the processing of the equation itself as a list, where each element is printed in the `\"~a\"` format and preceded by a blank.\nThe `t` given as the first argument to `format` means to print to the standard output; another output stream may be specified there.\n\nOne of the annoying minor holes in Lisp is that there is no standard convention on where to print newlines!\nIn C, for example, the very first line of code in the reference manual is\n\n```lisp\nprintf(\"hello, world\\n\");\n```\n\nThis makes it clear that newlines are printed *after* each line.\nThis convention is so ingrained in the UNIX world that some UNIX programs will go into an infinite loop if the last line in a file is not terminated by a newline.\nIn Lisp, however, the function `print` puts in a newline *before* the object to be printed, and a space after.\nSome Lisp programs carry the newline-before policy over to `format`, and others use the newline-after policy.\nThis only becomes a problem when you want to combine two programs written under different policies.\nHow did the two competing policies arise?\nIn UNIX there was only one reasonable policy, because all input to the UNIX interpreter (the shell) is terminated by newlines, so there is no need for a newline-before.\nIn some Lisp interpreters, however, input can be terminated by a matching right parenthesis.\nIn that case, a newline-before is needed, lest the output appear on the same line as the input.\n\n**Exercise  7.1 [m]** Implement `print-equations` using only primitive printing functions such as `terpri` and `princ`, along with explicit loops.\n\n## 7.3 Examples\n\nNow we move on to examples, taken from Bobrow's thesis.\nIn the first example, it is necessary to insert a \"then\" before the word \"what\" to get the right answer:\n\n```lisp\n> (student '(If the number of customers Tom gets is twice the square of\n            20 % of the number of advertisements he runs |,|\n            and the number of advertisements is 45 |,|\n            then what is the number of customers Tom gets ?))\nThe equations to be solved are:\n      CUSTOMERS = (2 * (((20 / 100) * ADVERTISEMENTS) *\n                      ((20 / 100) * ADVERTISEMENTS)))\n      ADVERTISEMENTS = 45\n      WHAT = CUSTOMERS\nThe solution is:\n      WHAT = 162\n      CUSTOMERS = 162\n      ADVERTISEMENTS = 45\nNIL\n```\n\nNotice that our program prints the values for all variables it can solve for, while Bobrow's program only printed the values that were explicitly asked for in the text.\nThis is an example of \"more is less\"-it may look impressive to print all the answers, but it is actually easier to do so than to decide just what answers should be printed.\nThe following example is not solved correctly:\n\n```lisp\n> (student '(The daily cost of living for a group is the overhead cost plus\n            the running cost for each person times the number of people in\n            the group |.| This cost for one group equals $ 100 |,|\n            and the number of people in the group is 40 |.|\n            If the overhead cost is 10 times the running cost |,|\n            find the overhead and running cost for each person |.|))\nThe equations to be solved are:\n      DAILY = (OVERHEAD + (RUNNING * PEOPLE))\n      COST = 100\n      PEOPLE = 40\n      OVERHEAD = (10 * RUNNING)\n      TO-FIND-1 = OVERHEAD\n      TO-FIND-2 = RUNNING\nThe solution is:\n      PEOPLE = 40\n      COST = 100\nNIL\n```\n\nThis example points out two important limitations of our version of student as compared to Bobrow's.\nThe first problem is in naming of variables.\nThe phrases \"the daily cost of living for a group\" and \"this cost\" are meant to refer to the same quantity, but our program gives them the names `daily` and `cost` respectively.\nBobrow's program handled naming by first considering phrases to be the same only if they matched perfectly.\nIf the resulting set of equations could not be solved, he would try again, this time considering phrases with words in common to be identical.\n(See the following exercises.)\n\nThe other problem is in our `solve` function.\nAssuming we got the variables equated properly, `solve` would be able to boil the set of equations down to two:\n\n```lisp\n100 = (OVERHEAD + (RUNNING * 40))\nOVERHEAD = (10 * RUNNING)\n```\n\nThis is a set of two linear equations in two unknowns and has a unique solution at `RUNNING = 2, OVERHEAD = 20`.\nBut our version of `solve` couldn't find this solution, since it looks for equations with one unknown.\nHere is another example that `student` handles well:\n\n```lisp\n> (student '(Fran's age divided by Robin's height is one half Kelly's IQ |.|\n            Kelly's IQ minus 80 is Robin's height |.|\n            If Robin is 4 feet tall |,| how old is Fran ?))\nThe equations to be solved are:\n      (FRAN / ROBIN) = (KELLY / 2)\n      (KELLY - 80) = ROBIN\n      ROBIN = 4\n      HOW = FRAN\nThe solution is:\n      HOW = 168\n      FRAN = 168\n      KELLY = 84\n      ROBIN = 4\nNIL\n```\n\nBut a slight variation leads to a problem:\n\n```lisp\n> (student '(Fran's age divided by Robin's height is one half Kelly's IQ |.|\n            Kelly's IQ minus 80 is Robin's height |.|\n            If Robin is 0 feet tall |,| how old is Fran ?))\nThe equations to be solved are:\n      (FRAN / ROBIN) = (KELLY / 2)\n      (KELLY - 80) = ROBIN\n      ROBIN = 0\n      HOW = FRAN\nThe solution is:\n      HOW = 0\n      FRAN = 0\n      KELLY = 80\n      ROBIN = 0\nNIL\n```\n\nThere is no valid solution to this problem, because it involves dividing by zero (Robin's height).\nBut `student` is willing to transform the first equation into:\n\n```lisp\nFRAN = ROBIN * (KELLY / 2)\n```\n\nand then substitutes to get `0` for `FRAN`.\nWorse, dividing by zero could also come up inside `eval`:\n\n```lisp\n> (student '(Fran's age times Robin's height is one half Kelly's IQ |.|\n            Kelly's IQ minus 80 is Robin's height |.|\n            If Robin is 0 feet tall |,| how old is Fran ?))\nThe equations to be solved are:\n      (FRAN * ROBIN) = (KELLY / 2)\n      (KELLY - 80) = ROBIN\n      ROBIN = 0\n      HOW = FRAN\n>>Error: There was an attempt to divide a number by zero\n```\n\nHowever, one could claim that nasty examples with division by zero don't show up in algebra texts.\n\nIn summary, STUDENT behaves reasonably well, doing far more than the toy program ELIZA.\nSTUDENT is also quite efficient; on my machine it takes less than one second for each of the prior examples.\nHowever, it could still be extended to have more powerful equation-solving capabilities.\nIts linguistic coverage is another matter.\nWhile one could add new patterns, such patterns are really just tricks, and don't capture the underlying structure of English sentences.\nThat is why the STUDENT approach was abandoned as a research topic.\n\n## 7.4 History and References\n\nBobrow's Ph.D.\nthesis contains a complete description of STUDENT.\nIt is reprinted in [Minsky 1968](bibliography.md#bb0845).\nSince then, there have been several systems that address the same task, with increased sophistication in both their mathematical and linguistic ability.\n[Wong (1981)](bibliography.md#bb1420) describes a system that uses its understanding of the problem to get a better linguistic analysis.\n[Sterling et al.\n(1982)](bibliography.md#bb1195) present a much more powerful equation solver, but it does not accept natural language input.\nCertainly Bobrow's language analysis techniques were not very sophisticated by today's measures.\nBut that was largely the point: if you know that the language is describing an algebraic problem of a certain type, then you don't need to know very much linguistics to get the right answer most of the time.\n\n## 7.5 Exercises\n\n**Exercise  7.2 [h]** We said earlier that our program was unable to solve pairs of linear equations, such as:\n\n```lisp\n100 = (OVERHEAD + (RUNNING * 40))\nOVERHEAD = (10 * RUNNING)\n```\n\nThe original STUDENT could solve these equations.\nWrite a routine to do so.\nYou may assume there will be only two equations in two unknowns if you wish, or if you are more ambitious, you could solve a system of *n* linear equations with *n* unknowns.\n\n**Exercise  7.3 [h]** Implement a version of Bobrow's variable-naming algorithm.\nInstead of taking the first word of each equation, create a unique symbol, and associate with it the entire list of words.\nIn the first pass, each nonequal list of words will be considered a distinct variable.\nIf no solution is reached, word lists that share words in common are considered to be the same variable, and the solution is attempted again.\nFor example, an input that contains the phrases \"the rectangle's width\" and \"the width of the rectangle\" might assign these two phrases the variables `v1` and `v2`.\nIf an attempt to solve the problem yields no solutions, the program should realize that `v1` and `v2` have the words \"rectangle\" and \"width\" in common, and add the equation (`= v1 v2`) and try again.\nSince the variables are arbitrary symbols, the printing routine should probably print the phrases associated with each variable rather than the variable itself.\n\n**Exercise  7.4 [h]** The original STUDENT also had a set of \"common knowledge\" equations that it could use when necessary.\nThese were mostly facts about conversion factors, such as `(1 inch = 2.54 cm)`.\nAlso included were equations like `(distance equals rate times time)`, which could be used to solve problems like \"If the distance from Anabru to Champaign is 10 miles and the time it takes Sandy to travel this distance is 2 hours, what is Sandy's rate of speed?\"\nMake changes to incorporate this facility.\nIt probably only helps in conjunction with a solution to the previous exercise.\n\n**Exercise  7.5 [h]** Change `student` so that it prints values only for those variables that are being asked for in the problem.\nThat is, given the problem \"X is 3.\nY is 4.\nHow much is X + Y?\" it should not print values for X and Y.\n\n**Exercise  7.6 [m]** Try STUDENT on the following examples.\nMake sure you handle special characters properly:\n\n(a)  The price of a radio is 69.70 dollars.\nIf this price is 15% less than the marked price, find the marked price.\n\n(b)  The number of soldiers the Russians have is one half of the number of guns they have.\nThe number of guns they have is 7000.\nWhat is the number of soldiers they have?\n\n(c)  If the number of customers Tom gets is twice the square of 20% of the number of advertisements he runs, and the number of advertisements is 45, and the profit Tom receives is 10 times the number of customers he gets, then what is the profit?\n\n(d)  The average score is 73.\nThe maximum score is 97.\nWhat is the square of the difference between the average and the maximum?\n\n(e)  Tom is twice Mary's age, and Jane's age is half the difference between Mary and Tom.\nIf Mary is 18 years old, how old is Jane?\n\n(f)  What is 4 + 5 * 14 / 7?\n\n(g)  *x &times; b = c + d.\nb &times; c = x.\nx = b + b.\nb = 5.*\n\n**Exercise  7.7 [h]** `Student's` infix-to-prefix rules account for the priority of operators properly, but they don't handle associativity in the standard fashion.\nFor example, (`12 - 6 - 3`) translates to (`- 12 (- 6 3)`) or `9`, when the usual convention is to interpret this as (`- (- 12 6) 3`) or `3`.\nFix `student` to handle this convention.\n\n**Exercise  7.8 [d]** Find a mathematically oriented domain that is sufficiently limited so that STUDENT can solve problems in it.\nThe chemistry of solutions (calculating pH concentrations) might be an example.\nWrite the necessary `*student-rules*`, and test the resulting program.\n\n**Exercise  7.9 [m]** Analyze the complexity of `one-unknown` and implement a more efficient version.\n\n**Exercise  7.10 [h]** Bobrow's paper on STUDENT (1968) includes an appendix that abstractly characterizes all the problems that his system can solve.\nGenerate a similar characterization for this version of the program.\n\n## 7.6 Answers\n\n**Answer 7.1**\n\n```lisp\n(defun print-equations (header equations)\n    (terpri)\n    (princ header)\n    (dolist (equation equations)\n        (terpri)\n        (princ \" \")\n        (dolist (x (prefix->infix equation))\n            (princ \" \")\n            (princ x))))\n```\n\n**Answer 7.9** `one-unknown` is very inefficient because it searches each subcomponent of an expression twice.\nFor example, consider the equation:\n\n```lisp\n(= (+ (+ x 2) (+ 3 4)) (+ (+ 5 6) (+ 7 8)))\n```\n\nTo decide if this has one unknown, `one-unknown` will call `no-unknown` on the left-hand side, and since it fails, call it again on the right-hand side.\nAlthough there are only eight atoms to consider, it ends up calling `no-unknown 17` times and `one-unknown 4` times.\nIn general, for a tree of depth *n*, approximately 2<sup>*n*</sup> calls to `no-unknown` are made.\nThis is clearly wasteful; there should be no need to look at each component more than once.\n\nThe following version uses an auxiliary function, `find-one-unknown,` that has an accumulator parameter, `unknown.` This parameter can take on three possible values: nil, indicating that no unknown has been found; or the single unknown that has been found so far; or the number 2 indicating that two unknowns have been found and therefore the final result should be nil.\nThe function `find-one-unknown` has four cases: (1) If we have already found two unknowns, then return 2 to indicate this.\n(2) If the input expression is a nonatomic expression, then first look at its left-hand side for unknowns, and pass the result found in that side as the accumulator to a search of the right-hand side.\n(3) If the expression is an unknown, and if it is the second one found, return `2`; otherwise return the unknown itself.\n(4) If the expression is an atom that is not an unknown, then just return the accumulated result.\n\n```lisp\n(defun one-unknown (exp)\n    \"Returns the single unknown in exp, if there is exactly one.\"\n    (let ((answer (find-one-unknown exp nil)))\n        ;; If there were two unknowns, return nil;\n        ;; otherwise return the unknown (if there was one)\n        (if (eql answer 2)\n              nil\n              answer)))\n(defun find-one-unknown (exp unknown)\n    \"Assuming UNKNOWN is the unknown(s) found so far, decide\n    if there is exactly one unknown in the entire expression.\"\n    (cond ((eql unknown 2) 2)\n                ((exp-p exp)\n                    (find-one-unknown\n                        (exp-rhs exp)\n                        (find-one-unknown (exp-lhs exp) unknown)))\n                ((unknown-p exp)\n                    (if unknown\n                            2\n                            exp))\n                (t unknown)))\n```\n\n----------------------\n\n<a id=\"fn07-1\"></a><sup>[1](#tfn07-1)</sup>\nPage 316 of *Common Lisp the Language* says, \"Because a constructor of this type operates By Order of Arguments, it is sometimes known as a BOA constructor.\"\n"
  },
  {
    "path": "docs/chapter8.md",
    "content": "# Chapter 8\n## Symbolic Mathematics: A Simplification Program\n\n> *Our life is frittered away by detail....*\n\n> *Simplify, simplify.*\n\n> -Henry David Thoreau, *Walden* (1854)\n\n\"Symbolic mathematics\" is to numerical mathematics as algebra is to arithmetic: it deals with variables and expressions rather than just numbers.\nComputers were first developed primarily to solve arithmetic problems: to add up large columns of numbers, to multiply many-digit numbers, to solve systems of linear equations, and to calculate the trajectories of ballistics.\nEncouraged by success in these areas, people hoped that computers could also be used on more complex problems; to differentiate or integrate a mathematical expression and come up with another expression as the answer, rather than just a number.\nSeveral programs were developed along these lines in the 1960s and 1970s.\nThey were used primarily by professional mathematicians and physicists with access to large mainframe computers.\nRecently, programs like MATHLAB, DERIVE, and MATHEMATICA have given these capabilities to the average personal computer user.\n\nIt is interesting to look at some of the history of symbolic algebra, beginning in 1963 with SAINT, James Slagle's program to do symbolic integration.\nOriginally, SAINT was heralded as a triumph of AI.\nIt used general problem-solving techniques, similar in kind to GPS, to search for solutions to difficult problems.\nThe program worked its way through an integration problem by choosing among the techniques known to it and backing up when an approach failed to pan out.\nSAINT's behavior on such problems was originally similar to (and eventually much better than) the performance of undergraduate calculus students.\n\nOver time, the AI component of symbolic integration began to disappear.\nJoel Moses implemented a successor to SAINT called SIN.\nIt used many of the same techniques, but instead of relying on search to find the right combination of techniques, it had additional mathematical knowledge that led it to pick the right technique at each step, without any provision for backing up and trying an alternative.\nSIN solved more problems and was much faster than SAINT, although it was not perfect: it still occasionally made the wrong choice and failed to solve a problem it could have.\n\nBy 1970, the mathematician R.\nRisch and others developed algorithms for indefinite integration of any expression involving algebraic, logarithmic, or exponential extensions of rational functions.\nIn other words, given a \"normal\" function, the Risch algorithm will return either the indefinite integral of the function or an indication that no closed-form integral is possible in terms of elementary functions.\nSuch work effectively ended the era of considering integration as a problem in search.\n\nSIN was further refined, merged with parts of the Risch algorithm, and put into the evolving MACSYMA<a id=\"tfn08-1\"></a><sup>[1](#fn08-1)</sup> program.\nFor the most part, refinement of MACSYMA consisted of the incorporation of new algorithms.\nFew heuristics of any sort survive.\nToday MACSYMA is no longer considered an AI program.\nIt is used daily by scientists and mathematicians, while ELIZA and STUDENT are now but historical footnotes.\n\nWith ELIZA and STUDENT we were able to develop miniature programs that duplicated most of the features of the original.\nWe won't even try to develop a program worthy of the name MACSYMA; instead we will settle for a modest program to do symbolic simplification, which we will call (simply) `simplifier`.\nThen, we will extend `simplifier` to do differentiation, and some integration problems.\nThe idea is that given an expression like (2 - 1)*x* + 0, we want the program to compute the simplified form *x*.\n\nAccording to the *Mathematics Dictionary* (James and James 1949), the word \"simplified\" is \"probably the most indefinite term used seriously in mathematics.\" The problem is that \"simplified\" is relative to what you want to use the expression for next.\nWhich is simpler, *x*<sup>2</sup> + 3*x* + 2 or (*x* + 1)(*x* + 2)?\nThe first makes it easier to integrate or differentiate, the second easier to find roots.\nWe will be content to limit ourselves to \"obvious\" simplifications.\nFor example, *x* is almost always preferable to 1*x* + 0.\n\n## 8.1 Converting Infix to Prefix Notation\n\nWe will represent simplifications as a list of rules, much like the rules for STUDENT and ELIZA.\nBut since each simplification rule is an algebraic equation, we will store each one as an exp rather than as a `rule`.\nTo make things more legible, we will write each expression in infix form, but store them in the prefix form expected by `exp`.\nThis requires an `infix->prefix` function to convert infix expressions into prefix notation.\nWe have a choice as to how general we want our infix notation to be.\nConsider:\n\n```lisp\n(((a * (x ^ 2)) + (b * x)) + c)\n(a * x ^ 2 + b * x + c)\n(a x ^ 2 + b x + c)\na x^2 + b*x+c\n```\n\nThe first is fully parenthesized infix, the second makes use of operator precedence (multiplication binds tighter than addition and is thus performed first), and the third makes use of implicit multiplication as well as operator precedence.\nThe fourth requires a lexical analyzer to break Lisp symbols into pieces.\n\nSuppose we only wanted to handle the fully parenthesized case.\nTo write `infix->prefix`, one might first look at `prefix->infix` (on [page 228](chapter7.md#p228)) trying to adapt it to our new purposes.\nIn doing so, the careful reader might discover a surprise: `infix->prefix` and `prefix->infix` are in fact the exact same function!\nBoth leave atoms unchanged, and both transform three-element lists by swapping the `exp-op` and `exp-lhs`.\nBoth apply themselves recursively to the (possibly rearranged) input list.\nOnce we discover this fact, it would be tempting to avoid writing `infix->prefix`, and just call `prefix->infix` instead.\nAvoid this temptation at all costs.\nInstead, define `infix->prefix` as shown below.\nThe intent of your code will be clearer:\n\n```lisp\n(defun infix->prefix (infix-exp)\n \"Convert fully parenthesized infix-exp to a prefix expression\"\n ;; Don't use this version for non-fully parenthesized exps!\n (prefix->infix infix-exp))\n```\n\nAs we saw above, fully parenthesized infix can be quite ugly, with all those extra parentheses, so instead we will use operator precedence.\nThere are a number of ways of doing this, but the easiest way for us to proceed is to use our previously defined tool `rule-based-translator` and its subtool, `pat-match`.\nNote that the third clause of `infix->prefix`, the one that calls `rule-based-translator` is unusual in that it consists of a single expression.\nMost cond-clauses have two expressions: a test and a result, but ones like this mean, \"Evaluate the test, and if it is non-nil, return it.\nOtherwise go on to the next clause.\"\n\n```lisp\n(defun infix->prefix (exp)\n  \"Translate an infix expression into prefix notation.\"\n  ;; Note we cannot do implicit multiplication in this system\n  (cond ((atom exp) exp)\n        ((= (length exp) 1) (infix->prefix (first exp)))\n        ((rule-based-translator exp *infix->prefix-rules*\n           :rule-if #'rule-pattern :rule-then #'rule-response\n           :action\n           #'(lambda (bindings response)\n               (sublis (mapcar\n                         #'(lambda (pair)\n                             (cons (first pair)\n                                   (infix->prefix (rest pair))))\n                         bindings)\n                       response))))\n        ((symbolp (first exp))\n         (list (first exp) (infix->prefix (rest exp))))\n        (t (error \"Illegal exp\"))))\n```\n\nBecause we are doing mathematics in this chapter, we adopt the mathematical convention of using certain one-letter variables, and redefine `variable-p` so that variables are only the symbols `m` through `z`.\n\n```lisp\n(defun variable-p (exp)\n  \"Variables are the symbols M through Z.\"\n  ;; put x,y,z first to find them a little faster\n  (member exp '(x y z m n o p q r s t u v w)))\n\n;; Define x+ and y+ as a sequence:\n(pat-match-abbrev 'x+ '(?+ x))\n(pat-match-abbrev 'y+ '(?+ y))\n\n(defun rule-pattern (rule) (first rule))\n(defun rule-response (rule) (second rule))\n\n(defparameter *infix->prefix-rules*\n  (mapcar #'expand-pat-match-abbrev\n    '(((x+ = y+) (= x y))\n      ((- x+)    (- x))\n      ((+ x+)    (+ x))\n      ((x+ + y+) (+ x y))\n      ((x+ - y+) (- x y))\n      ((x+ * y+) (* x y))\n      ((x+ / y+) (/ x y))\n      ((x+ ^ y+) (^ x y)))))\n  \"A list of rules, ordered by precedence.\")\n```\n\n## 8.2 Simplification Rules\n\nNow we are ready to define the simplification rules.\nWe use the definition of the data types rule and exp ([page 221](chapter7.md#p221)) and `prefix->infix` ([page 228](chapter7.md#p228)) from STUDENT.\nThey are repeated here:\n\n```lisp\n(defstruct (rule (:type list)) pattern response)\n\n(defstruct (exp (:type list)\n                (:constructor mkexp (lhs op rhs)))\n  op lhs rhs)\n\n(defun exp-p (x) (consp x))\n(defun exp-args (x) (rest x))\n\n(defun prefix->infix (exp)\n  \"Translate prefix to infix expressions.\"\n  (if (atom exp) exp\n      (mapcar #'prefix->infix\n              (if (binary-exp-p exp)\n                  (list (exp-lhs exp) (exp-op exp) (exp-rhs exp))\n                  exp))))\n\n(defun binary-exp-p (x)\n  (and (exp-p x) (= (length (exp-args x)) 2)))\n```\n\nWe also use `rule-based-translator` ([page 188](chapter6.md#p188)) once again, this time on a list of simplification rules.\nA reasonable list of simplification rules is shown below.\nThis list covers the four arithmetic operators, addition, subtraction, multiplication, and division, as well as exponentiation (raising to a power), denoted by the symbol `^`.\n\nAgain, it is important to note that the rules are ordered, and that later rules will be applied only when earlier rules do not match.\nSo, for example, 0 / 0 simplifies to `undefined`, and not to 1 or 0, because the rule for 0 / 0 comes before the other rules.\nSee [exercise 8.8](#st0045) for a more complete treatment of this.\n\n```lisp\n(defparameter *simplification-rules* (mapcar #'infix->prefix '(\n  (x + 0  = x)\n  (0 + x  = x)\n  (x + x  = 2 * x)\n  (x - 0  = x)\n  (0 - x  = - x)\n  (x - x  = 0)\n  (- - x  = x)\n  (x * 1  = x)\n  (1 * x  = x)\n  (x * 0  = 0)\n  (0 * x  = 0)\n  (x * x  = x ^ 2)\n  (x / 0  = undefined)\n  (0 / x  = 0)\n  (x / 1  = x)\n  (x / x  = 1)\n  (0 ^ 0  = undefined)\n  (x ^ 0  = 1)\n  (0 ^ x  = 0)\n  (1 ^ x  = 1)\n  (x ^ 1  = x)\n  (x ^ -1 = 1 / x)\n  (x * (y / x) = y)\n  ((y / x) * x = y)\n  ((y * x) / x = y)\n  ((x * y) / x = y)\n  (x + - x = 0)\n  ((- x) + x = 0)\n  (x + y - x = y)\n  )))\n\n(defun ^ (x y) \"Exponentiation\" (expt x y))\n```\n\nWe are now ready to go ahead and write the simplifier.\nThe main function, `simplifier`, will repeatedly print a prompt, read an input, and print it in simplified form.\nInput and output is in infix and the computation is in prefix, so we need to convert accordingly; the function `simp` does this, and the function `simplify` takes care of a single prefix expression.\nIt is summarized in [figure 8.1](#f0010).\n\n| Symbol                   | Use                                                   |\n| ------                   | ---                                                   |\n|                          | **Top-Level Function**                                |\n| `simplifier`             | A rad-simplify-print loop.                            |\n| `simp`                   | Simplify an infix expression.                         |\n| `simplify`               | Simplify a prefix expression.                         |\n|                          | **Special Variables**                                 |\n| `*infix->prefix-rules*`  | Rules to translate from infix to prefix.              |\n| `*simplification-rules*` | Rules to simplify an expression.                      |\n|                          | **Data Types**                                        |\n| `exp`                    | A prefix expression                                   |\n|                          | **Auxiliary Functions**                               |\n| `simplify-exp`           | Simplify a non-atomic prefix expression.              |\n| `infix->prefix`          | Convert infix to prefix notation.                     |\n| `variable-p`             | The symbols m through z are variables.                |\n| `^`                      | An alias for `expt`, exponentiation.                  |\n| `evaluable`              | Decide if an expression can be numerically evaluated. |\n| `simp-rule`              | Transform a rule into proper format.                  |\n| `length=1`               | Is the argument a list of length 1?                   |\n|                          | **Previously Defined Functions**                      |\n| `pat-match`              | Match pattern against an input. (p. 180)              |\n| `rule-based-translator`  | Apply a set of rules. (p. 189)                        |\n| `pat-match-abbrev`       | Define an abbreviation for use in `pat-match`         |\n\n**Figure 8.1:** Glossary for the Simplifier\n\nHere is the program:\n\n```lisp\n(defun simplifier ()\n  \"Read a mathematical expression, simplify it, and print the result.\"\n  (loop\n    (print 'simplifier>)\n    (print (simp (read)))))\n\n(defun simp (inf) (prefix->infix (simplify (infix->prefix inf))))\n\n(defun simplify (exp)\n  \"Simplify an expression by first simplifying its components.\"\n  (if (atom exp) exp\n      (simplify-exp (mapcar #'simplify exp))))\n\n;;; simplify-exp is redefined below\n(defun simplify-exp (exp)\n  \"Simplify using a rule, or by doing arithmetic.\"\n  (cond ((rule-based-translator exp *simplification-rules*\n           :rule-if #'exp-lhs :rule-then #'exp-rhs\n           :action #'(lambda (bindings response)\n                       (simplify (sublis bindings response)))))\n        ((evaluable exp) (eval exp))\n        (t exp)))\n\n(defun evaluable (exp)\n  \"Is this an arithmetic expression that can be evaluated?\"\n  (and (every #'numberp (exp-args exp))\n       (or (member (exp-op exp) '(+ - * /))\n           (and (eq (exp-op exp) '^)\n                (integerp (second (exp-args exp)))))))\n```\n\nThe function `simplify` assures that any compound expression will be simplified by first simplifying the arguments and then calling `simplify-exp`.\nThis latter function searches through the simplification rules, much like `use-eliza-rules` and `translate-to-expression`.\nWhen it finds a match, `simplify-exp` substitutes in the proper variable values and calls `simplify` on the result.\n`simplify-exp` also has the ability to call `eval` to simplify an arithmetic expression to a number.\nAs in STUDENT, it is for the sake of this `eval` that we require expressions to be represented as lists in prefix notation.\nNumeric evaluation is done *after* checking the rules so that the rules can intercept expressions like `(/ 1 0)` and simplify them to `undefined`.\nIf we did the numeric evaluation first, these expressions would yield an error when passed to `eval`.\nBecause Common Lisp supports arbitrary precision rational numbers (fractions), we are guaranteed there will be no round-off error, unless the input explicitly includes inexact (floating-point) numbers.\nNotice that we allow computations involving the four arithmetic operators, but exponentiation is only allowed if the exponent is an integer.\nThat is because expressions like `(^ 4 1/2)` are not guaranteed to return 2 (the exact square root of 4); the answer might be 2.0 (an inexact number).\nAnother problem is that -2 is also a square root of 4, and in some contexts it is the correct one to use.\n\nThe following trace shows some examples of the simplifier in action.\nFirst we show that it can be used as a calculator; then we show more advanced problems.\n\n```lisp\n>(simplifier)\nSIMPLIFIER> (2 + 2)\n4\nSIMPLIFIER> (5 * 20 + 30 + 7)\n137\nSIMPLIFIER> (5 * x - (4 + 1) * x)\n0\nSIMPLIFIER> (y / z * (5 * x - (4 + 1) * x))\n0\nSIMPLIFIER> ((4 - 3) * x + (y / y - 1) * z)\nX\nSIMPLIFIER> (1 * f(x) + 0)\n(F X)\nSIMPLIFIER> (3 * 2 * X)\n(3 * (2 * X))\nSIMPLIFIER> [Abort]\n>\n```\n\nHere we have terminated the loop by hitting the abort key on the terminal.\n(The details of this mechanism varies from one implementation of Common Lisp to another.) The simplifier seems to work fairly well, although it errs on the last example: `(3 * (2 * X ) )` should simplify to `( 6 * X )`.\nIn the next section, we will correct that problem.\n\n## 8.3 Associativity and Commutativity\n\nWe could easily add a rule to rewrite `(3 * (2 * X))` as `((3 * 2) * X)` and hence `(6 * X)`.\nThe problem is that this rule would also rewrite `(X * (2 * 3))` as `((X * 2) * 3)`, unless we had a way to limit the rule to apply only when it would group numbers together.\nFortunately, `pat-match` does provide just this capability, with the `?is` pattern.\nWe could write this rule:\n\n```lisp\n(((?is n numberp) * ((?is m numberp) * x)) = ((n * m) * x))\n```\n\nThis transforms `(3 * (2 * x))` into `((3 * 2) * x)`, and hence into `(6 * x)`.\nUnfortunately, the problem is not as simple as that.\nWe also want to simplify `((2 * x) * (y * 3))` to `(6 *(x * y))`.\nWe can do a better job of gathering numbers together by adopting three conventions.\nFirst, make numbers first in products: change `x * 3` to `3 * x`.\nSecond, combine numbers in an outer expression with a number in an inner expression: change `3 * (5 * x)` to `(3 * 5) * x`.\nThird, move numbers out of inner expressions whenever possible: change `(3 * x) * y` to `3 * (x * y)`.\nWe adopt similar conventions for addition, except that we prefer numbers last there: `x + 1` instead of `1 + x`.\n\n```lisp\n;; Define n and m as numbers; s as a non-number:\n(pat-match-abbrev 'n '(?is n numberp))\n(pat-match-abbrev 'm '(?is m numberp))\n(pat-match-abbrev 's '(?is s not-numberp))\n\n(defun not-numberp (x) (not (numberp x)))\n\n(defun simp-rule (rule)\n  \"Transform a rule into proper format.\"\n  (let ((exp (infix->prefix rule)))\n    (mkexp (expand-pat-match-abbrev (exp-lhs exp))\n     (exp-op exp) (exp-rhs exp))))\n\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule\n  '((s * n = n * s)\n    (n * (m * x) = (n * m) * x)\n    (x * (n * y) = n * (x * y))\n    ((n * x) * y = n * (x * y))\n    (n + s = s + n)\n    ((x + m) + n = x + n + m)\n    (x + (y + n) = (x + y) + n)\n    ((x + n) + y = (x + y) + n)))))\n```\n\nWith the new rules in place, we are ready to try again.\nFor some problems we get just the right answers:\n\n```lisp\n> (simplifier)\nSIMPLIFIER > (3 * 2 * x)\n(6 * X)\nSIMPLIFIER > (2 * x * x * 3)\n(6 * (X ^ 2))\nSIMPLIFIER > (2 * x * 3 * y * 4 * z * 5 * 6)\n(720 * (X * (Y * Z)))\nSIMPLIFIER > (3 + x + 4 + x)\n((2 * X) + 7)\nSIMPLIFIER > (2 * x * 3 * x * 4 * (l / x) * 5 * 6)\n(720 * X)\n```\n\nUnfortunately, there are other problems that aren't simplified properly:\n\n```lisp\nSIMPLIFIER > (3 + x + 4 - x)\n((X + (4 - X)) + 3)\nSIMPLIFIER > (x + y + y + x)\n(X + (Y + (Y + X)))\nSIMPLIFIER > (3 * x + 4 * x)\n((3 * X) + (4 * X))\n```\n\nWe will return to these problems in [section 8.5](#s0030).\n\n**Exercise 8.1** Verify that the set of rules just prior does indeed implement the desired conventions, and that the conventions have the proper effect, and always terminate.\nAs an example of a potential problem, what would happen if we used the rule `(x * n = n * x)` instead of the rule `(s * n = n * s)`?\n\n## 8.4 Logs, Trig, and Differentiation\n\nIn the previous section, we restricted ourselves to the simple arithmetic functions, so as not to intimidate those who are a little leery of complex mathematics.\nIn this section, we add a little to the mathematical complexity, without having to alter the program itself one bit.\nThus, the mathematically shy can safely skip to the next section without feeling they are missing any of the fun.\n\nWe start off by representing some elementary properties of the logarithmic and trigonometric functions.\nThe new rules are similar to the \"zero and one\" rules we needed for the arithmetic operators, except here the constants `e` and `pi` (*e* = 2.71828... and *&pi;* = 3.14159...) are important in addition to 0 and 1.\nWe also throw in some rules relating logs and exponents, and for sums and differences of logs.\nThe rules assume that complex numbers are not allowed.\nIf they were, log *e<sup>x</sup>* (and even *x<sup>y</sup>*) would have multiple values, and it would be wrong to arbitrarily choose one of these values.\n\n```lisp\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule '(\n  (log 1         = 0)\n  (log 0         = undefined)\n  (log e         = 1)\n  (sin 0         = 0)\n  (sin pi        = 0)\n  (cos 0         = 1)\n  (cos pi        = -1)\n  (sin(pi / 2)   = 1)\n  (cos(pi / 2)   = 0)\n  (log (e ^ x)   = x)\n  (e ^ (log x)   = x)\n  ((x ^ y) * (x ^ z) = x ^ (y + z))\n  ((x ^ y) / (x ^ z) = x ^ (y - z))\n  (log x + log y = log(x * y))\n  (log x - log y = log(x / y))\n  ((sin x) ^ 2 + (cos x) ^ 2 = 1)\n  ))))\n```\n\nNow we would like to go a step further and extend the system to handle differentiation.\nThis is a favorite problem, and one which has historical significance: in the summer of 1958 John McCarthy decided to investigate differentiation as an interesting symbolic computation problem, which was difficult to express in the primitive programming languages of the day.\nThis investigation led him to see the importance of functional arguments and recursive functions in the field of symbolic computation.\nFor example, McCarthy invented what we now call `mapcar` to express the idea that the derivative of a sum is the sum of the derivative function applied to each argument.\nFurther work led McCarthy to the publication in October 1958 of MIT AI Lab Memo No.\n1: \"An Algebraic Language for the Manipulation of Symbolic Expressions,\" which defined the precursor of Lisp.\n\nIn McCarthy's work and in many subsequent texts you can see symbolic differentiation programs with a simplification routine tacked on the end to make the output more readable.\nHere, we take the opposite approach: the simplification routine is central, and differentiation is handled as just another operator, with its own set of simplification rules.\nWe will require a new infix-to-prefix translation rule.\nWhile we're at it, we'll add a rule for indefinite integration as well, although we won't write simplification rules for integration yet.\nHere are the new notations:\n\n| []()        |             |             |\n|-------------|-------------|-------------|\n| math        | infix       | prefix      |\n| *dy*/*dx*   | `d y / d x` | `(d y x)`   |\n| &int; *ydx* | `Int y d x` | `(int y x)` |\n\nAnd here are the necessary infix-to-prefix rules:\n\n```lisp\n(defparameter *infix->prefix-rules*\n  (mapcar #'expand-pat-match-abbrev\n    '(((x+ = y+) (= x y))\n      ((- x+)    (- x))\n      ((+ x+)    (+ x))\n      ((x+ + y+) (+ x y))\n      ((x+ - y+) (- x y))\n      ((d y+ / d x) (d y x))        ;*** New rule\n      ((Int y+ d x) (int y x))      ;*** New rule\n      ((x+ * y+) (* x y))\n      ((x+ / y+) (/ x y))\n      ((x+ ^ y+) (^ x y)))))\n```\n\nSince the new rule for differentiation occurs before the rule for division, there won't be any confusion with a differential being interpreted as a quotient.\nOn the other hand, there is a potential problem with integrals that contain `d` as a variable.\nThe user can always avoid the problem by using (`d`) instead of `d` inside an integral.\n\nNow we augment the simplification rules, by copying a differentiation table out of a reference book:\n\n```lisp\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule '(\n  (d x / d x       = 1)\n  (d (u + v) / d x = (d u / d x) + (d v / d x))\n  (d (u - v) / d x = (d u / d x) - (d v / d x))\n  (d (- u) / d x   = - (d u / d x))\n  (d (u * v) / d x = u * (d v / d x) + v * (d u / d x))\n  (d (u / v) / d x = (v * (d u / d x) - u * (d v / d x))\n                     / v ^ 2) ; [This corrects an error in the first printing]\n  (d (u ^ n) / d x = n * u ^ (n - 1) * (d u / d x))\n  (d (u ^ v) / d x = v * u ^ (v - 1) * (d u / d x)\n                   + u ^ v * (log u) * (d v / d x))\n  (d (log u) / d x = (d u / d x) / u)\n  (d (sin u) / d x = (cos u) * (d u / d x))\n  (d (cos u) / d x = - (sin u) * (d u / d x))\n  (d (e ^ u) / d x = (e ^ u) * (d u / d x))\n  (d u / d x       = 0)))))\n```\n\nWe have added a default rule, `(d u / d x = 0)`; this should only apply when the expression `u` is free of the variable `x` (that is, when `u` is not a function of `x`).\nWe could use `?if` to check this, but instead we rely on the fact that differentiation is closed over the list of operators described here-as long as we don't introduce any new operators, the answer will always be correct.\nNote that there are two rules for exponentiation, one for the case when the exponent is a number, and one when it is not.\nThis was not strictly necessary, as the second rule covers both cases, but that was the way the rules were written in the table of differentials I consulted, so I left both rules in.\n\n```lisp\nSIMPLIFIER > (d (x + x) / d x)\n2\nSIMPLIFIER > (d (a * x ^ 2 + b * x + c) / d x)\n((2 * (A * X)) + B)\nSIMPLIFIER > (d ((a * x ^ 2 + b * x + c) / x) / d x)\n((((A * (X ^ 2)) + ((B * X) + C)) - (X * ((2 * (A * X)) + B)))\n/ (X ^ 2))\nSIMPLIFIER > (log ((d (x + x) / d x) / 2))\n0\nSIMPLIFIER > (log(x + x) - log x)\n(LOG 2)\nSIMPLIFIER > (x ^ cos pi)\n(1 / X)\nSIMPLIFIER > (d (3 * x + (cos x) / x) / d x)\n((((COS X) - (X * (- (SIN X)))) / (X ^ 2)) + 3)\nSIMPLIFIER > (d ((cos x) / x) / d x)\n(((COS X) - (X * (- (SIN X)))) / (X ^ 2))\nSIMPLIFIER > (d (3 * x ^ 2 + 2 * x + 1) / d x)\n((6 * X) + 2)\nSIMPLIFIER > (sin(x + x) ^ 2 + cos(d x ^ 2 / d x) ^ 2)\n1\nSIMPLIFIER > (sin(x + x) * sin(d x ^ 2 / d x) +\n cos(2 * x) * cos(x * d 2 * y / d y))\n1\n```\n\nThe program handles differentiation problems well and is seemingly clever in its use of the identity sin<sup>2</sup>*x* + cos<sup>2</sup>*x* = 1.\n\n## 8.5 Limits of Rule-Based Approaches\n\nIn this section we return to some examples that pose problems for the simplifier.\nHere is a simple one:\n\n`SIMPLIFIER > (x + y + y + x)`=> `(X + (Y + (Y + X)))`\n\nWe would prefer `2 * (x + y)`.\nThe problem is that, although we went to great trouble to group numbers together, there was no effort to group non-numbers.\nWe could write rules of the form:\n\n```lisp\n(y + (y + x) = (2 * y) + x)\n(y + (x + y) = (2 * y) + x)\n```\n\nThese would work for the example at hand, but they would not work for `(x + y + z + y + x)`.\nFor that we would need more rules:\n\n```lisp\n(y + (z + (y + x)) = (2 * y) + x + z)\n(y + (z + (x + y)) = (2 * y) + x + z)\n(y + ((y + x) + z) = (2 * y) + x + z)\n(y + ((x + y) + z) = (2 * y) + x + z)\n```\n\nTo handle all the cases, we would need an infinite number of rules.\nThe pattern-matching language is not powerful enough to express this succinctly.\nIt might help if nested sums (and products) were unnested; that is, if we allowed + to take an arbitrary number of arguments instead of just one.\nOnce the arguments are grouped together, we could sort them, so that, say, all the `ys` appear before `z` and after `x`.\nThen like terms could be grouped together.\nWe have to be careful, though.\nConsider these examples:\n\n```lisp\nSIMPLIFIER > (3 * x + 4 * x)\n((3 * X) + (4 * X))\nSIMPLIFIER > (3 * x + y + x + 4 * x)\n((3 * X) + (Y + (X + (4 * X))))\n```\n\nWe would want `(3 * x)` to sort to the same place as `x` and `(4 * x )` so that they could all be combined to `(8 * x)`.\nIn [chapter 15](chapter15.md), we develop a new version of the program that handles this problem.\n\n## 8.6 Integration\n\nSo far, the algebraic manipulations have been straightforward.\nThere is a direct algorithm for computing the derivative of every expression.\nWhen we consider integrals, or antiderivatives,<a id=\"tfn08-2\"></a><sup>[2](#fn08-2)</sup> the picture is much more complicated.\nAs you may recall from freshman calculus, there is a fine art to computing integrals.\nIn this section, we try to see how far we can get by encoding just a few of the many tricks available to the calculus student.\n\nThe first step is to recognize that entries in the simplification table will not be enough.\nInstead, we will need an algorithm to evaluate or \"simplify\" integrals.\nWe will add a new case to `simplify-exp` to check each operator to see if it has a simplification function associated with it.\nThese simplification functions will be associated with operators through the functions `set-simp-fn` and `simp-fn`.\nIf an operator does have a simplification function, then that function will be called instead of consulting the simplification rules.\nThe simplification function can elect not to handle the expression after all by returning nil, in which case we continue with the other simplification methods.\n\n```lisp\n(defun simp-fn (op) (get op 'simp-fn))\n(defun set-simp-fn (op fn) (setf (get op 'simp-fn) fn))\n\n(defun simplify-exp (exp)\n  \"Simplify using a rule, or by doing arithmetic,\n  or by using the simp function supplied for this operator.\"\n  (cond ((simplify-by-fn exp))                             ;***\n        ((rule-based-translator exp *simplification-rules*\n           :rule-if #'exp-lhs :rule-then #'exp-rhs\n           :action #'(lambda (bindings response)\n                       (simplify (sublis bindings response)))))\n        ((evaluable exp) (eval exp))\n        (t exp)))\n\n(defun simplify-by-fn (exp)\n  \"If there is a simplification fn for this exp,\n  and if applying it gives a non-null result,\n  then simplify the result and return that.\"\n  (let* ((fn (simp-fn (exp-op exp)))\n         (result (if fn (funcall fn exp))))\n    (if (null result)\n        nil\n        (simplify result))))\n```\n\nFreshman calculus classes teach a variety of integration techniques.\nFortunately, one technique-the derivative-divides technique-can be adopted to solve most of the problems that come up at the freshman calculus level, perhaps 90% of the problems given on tests.\nThe basic rule is:\n\n&int;*f(x)dx* = &int;*f(u)<sup>du</sup>/<sub>dx</sub>dx*\n\nAs an example, consider &int;*xsin(x<sup>2</sup>)dx*.\nUsing the substitution *u* = *x*<sup>2</sup>, we can differentiate to get *du*/*dx* = 2*x*.\nThen by applying the basic rule, we get:\n\n&int;*xsin(x<sup>2</sup>)dx* = <sup>1</sup>/<sub>2</sub>&int;*sin(u)<sup>du</sup>/<sub>dx</sub>dx* = <sup>1</sup>/<sub>2</sub>&int;*sin(u)du*\n\nAssume we have a table of integrals that includes the rule &int;*sin(x)dx* = -*cos(x)*.\nThen we can get the final answer:\n\n-<sup>1</sup>/<sub>2</sub>*cos(x<sup>2</sup>)*.\n\nAbstracting from this example, the general algorithm for integrating an expression *y* with respect to *x* is:\n\n1. Pick a factor of *y*, calling it *f(u)*.\n\n2. Compute the derivative *du*/*dx*.\n\n3. Divide *y* by *f(u)* * *du*/*dx*, calling the quotient *k*.\n\n4. If *k* is a constant (with respect to *x*), then the result is *k* &int; *f*(*u*)*du*.\n\nThis algorithm is nondeterministic, as there may be many factors of *y*.\nIn our example, *f*(*u*) = sin(*x*<sup>2</sup>), *u* = *x*<sup>2</sup>, and *du*/*dx* = 2*x*.\nSo *k = <sup>1</sup>/<sub>2</sub>*, and the answer is -*<sup>1</sup>/<sub>2</sub>cos(x<sup>2</sup>)*.\n\nThe first step in implementing this technique is to make sure that division is done correctly.\nWe need to be able to pick out the factors of *y*, divide expressions, and then determine if a quotient is free of *x*.\nThe function `factorize` does this.\nIt keeps a list of factors and a running product of constant factors, and augments them with each call to the local function `fac`.\n\n```lisp\n(defun factorize (exp)\n  \"Return a list of the factors of exp^n,\n  where each factor is of the form (^ y n).\"\n  (let ((factors nil)\n        (constant 1))\n    (labels\n      ((fac (x n)\n         (cond\n           ((numberp x)\n            (setf constant (* constant (expt x n))))\n           ((starts-with x '*)\n            (fac (exp-lhs x) n)\n            (fac (exp-rhs x) n))\n           ((starts-with x '/)\n            (fac (exp-lhs x) n)\n            (fac (exp-rhs x) (- n)))\n           ((and (starts-with x '-) (length=1 (exp-args x)))\n            (setf constant (- constant))\n            (fac (exp-lhs x) n))\n           ((and (starts-with x '^) (numberp (exp-rhs x)))\n            (fac (exp-lhs x) (* n (exp-rhs x))))\n           (t (let ((factor (find x factors :key #'exp-lhs\n                                  :test #'equal)))\n                (if factor\n                    (incf (exp-rhs factor) n)\n                    (push `(^ ,x ,n) factors)))))))\n      ;; Body of factorize:\n      (fac exp 1)\n      (case constant\n        (0 '((^ 0 1)))\n        (1 factors)\n        (t `((^ ,constant 1) .,factors))))))\n```\n\n`factorize` maps from an expression to a list of factors, but we also need `unfactorize` to turn a list back into an expression:\n\n```lisp\n(defun unfactorize (factors)\n  \"Convert a list of factors back into prefix form.\"\n  (cond ((null factors) 1)\n        ((length=1 factors) (first factors))\n        (t `(* ,(first factors) ,(unfactorize (rest factors))))))\n```\n\nThe derivative-divides method requires a way of dividing two expressions.\nWe do this by factoring each expression and then dividing by cancelling factors.\nThere may be cases where, for example, two factors in the numerator could be multiplied together to cancel a factor in the denominator, but this possibility is not considered.\nIt turns out that most problems from freshman calculus do not require such sophistication.\n\n```lisp\n(defun divide-factors (numer denom)\n  \"Divide a list of factors by another, producing a third.\"\n  (let ((result (mapcar #'copy-list numer)))\n    (dolist (d denom)\n      (let ((factor (find (exp-lhs d) result :key #'exp-lhs\n                          :test #'equal)))\n        (if factor\n            (decf (exp-rhs factor) (exp-rhs d))\n            (push `(^ ,(exp-lhs d) ,(- (exp-rhs d))) result))))\n    (delete 0 result :key #'exp-rhs)))\n```\n\nFinally, the predicate `free-of` returns true if an expression does not have any occurrences of a particular variable in it.\n\n```lisp\n(defun free-of (exp var)\n  \"True if expression has no occurrence of var.\"\n  (not (find-anywhere var exp)))\n\n(defun find-anywhere (item tree)\n  \"Does item occur anywhere in tree?  If so, return it.\"\n  (cond ((eql item tree) tree)\n        ((atom tree) nil)\n        ((find-anywhere item (first tree)))\n        ((find-anywhere item (rest tree)))))\n```\n\nIn `factorize` we made use of the auxiliary function `length=1`.\nThe function call `(length=1 x)` is faster than `(= (length x) 1)` because the latter has to compute the length of the whole list, while the former merely has to see if the list has a `rest` element or not.\n\n```lisp\n(defun length=1 (x)\n  \"Is X a list of length 1?\"\n  (and (consp x) (null (rest x))))\n```\n\nGiven these preliminaries, the function `integrate` is fairly easy.\nWe start with some simple cases for integrating sums and constant expressions.\nThen, we factor the expression and split the list of factors into two: a list of constant factors, and a list of factors containing *x*.\n(This is done with `partition-if`, a combination of `remove-if` and `remove-if-not`.) Finally, we call `deriv-divides`, giving it a chance with each of the factors.\nIf none of them work, we return an expression indicating that the integral is unknown.\n\n```lisp\n(defun integrate (exp x)\n  ;; First try some trivial cases\n  (cond\n    ((free-of exp x) `(* ,exp x))          ; Int c dx = c*x\n    ((starts-with exp '+)                  ; Int f + g  =\n     `(+ ,(integrate (exp-lhs exp) x)      ;   Int f + Int g\n         ,(integrate (exp-rhs exp) x)))\n    ((starts-with exp '-)\n     (ecase (length (exp-args exp))\n       (1 (integrate (exp-lhs exp) x))     ; Int - f = - Int f\n       (2 `(- ,(integrate (exp-lhs exp) x) ; Int f - g  =\n              ,(integrate (exp-rhs exp) x)))))  ; Int f - Int g\n    ;; Now move the constant factors to the left of the integral\n    ((multiple-value-bind (const-factors x-factors)\n         (partition-if #'(lambda (factor) (free-of factor x))\n                       (factorize exp))\n       (identity ;simplify\n         `(* ,(unfactorize const-factors)\n             ;; And try to integrate:\n             ,(cond ((null x-factors) x)\n                    ((some #'(lambda (factor)\n                               (deriv-divides factor x-factors x))\n                           x-factors))\n                    ;; <other methods here>\n                    (t `(int? ,(unfactorize x-factors) ,x)))))))))\n\n(defun partition-if (pred list)\n  \"Return 2 values: elements of list that satisfy pred,\n  and elements that don't.\"\n  (let ((yes-list nil)\n        (no-list nil))\n    (dolist (item list)\n      (if (funcall pred item)\n          (push item yes-list)\n          (push item no-list)))\n    (values (nreverse yes-list) (nreverse no-list))))\n```\n\nNote that the place in integrate where other techniques could be added is marked.\nWe will only implement the derivative-divides method.\nIt turns out that the function is a little more complicated than the simple four-step algorithm outlined before:\n\n```lisp\n(defun deriv-divides (factor factors x)\n  (assert (starts-with factor '^))\n  (let* ((u (exp-lhs factor))              ; factor = u^n\n         (n (exp-rhs factor))\n         (k (divide-factors\n              factors (factorize `(* ,factor ,(deriv u x))))))\n    (cond ((free-of k x)\n           ;; Int k*u^n*du/dx dx = k*Int u^n du\n           ;;                    = k*u^(n+1)/(n+1) for n/=1\n           ;;                    = k*log(u) for n=1\n           (if (= n -1)\n               `(* ,(unfactorize k) (log ,u))\n               `(/ (* ,(unfactorize k) (^ ,u ,(+ n 1)))\n                   ,(+ n 1))))\n          ((and (= n 1) (in-integral-table? u))\n           ;; Int y'*f(y) dx = Int f(y) dy\n           (let ((k2 (divide-factors\n                       factors\n                       (factorize `(* ,u ,(deriv (exp-lhs u) x))))))\n             (if (free-of k2 x)\n                 `(* ,(integrate-from-table (exp-op u) (exp-lhs u))\n                     ,(unfactorize k2))))))))\n```\n\nThere are three cases.\nIn any case, all factors are of the form `(^ u n)`, so we separate the factor into a base, `u`, and exponent, `n`.\nIf *u* or *u*<sup>*n*</sup> evenly divides the original expression (here represented as factors), then we have an answer.\nBut we need to check the exponent, because *&int; u<sup>n</sup>du* is *u*<sup>*n*+1</sup>/(*n* + 1) for *n* &ne; -1, but it is log (*u*) for *n* = -1.\nBut there is a third case to consider.\nThe factor may be something like `(^ (sin (^ x 2)) 1)`, in which case we should consider *f*(*u*) = sin(*x*<sup>2</sup>).\nThis case is handled with the help of an integral table.\nWe don't need a derivative table, because we can just use the simplifier for that.\n\n```lisp\n(defun deriv (y x) (simplify `(d ,y ,x)))\n\n(defun integration-table (rules)\n  (dolist (i-rule rules)\n    ;; changed infix->prefix to simp-rule - norvig Jun 11 1996\n    (let ((rule (simp-rule i-rule)))\n      (setf (get (exp-op (exp-lhs (exp-lhs rule))) 'int)\n            rule))))\n\n\n(defun in-integral-table? (exp)\n  (and (exp-p exp) (get (exp-op exp) 'int)))\n\n(defun integrate-from-table (op arg)\n  (let ((rule (get op 'int)))\n    (subst arg (exp-lhs (exp-lhs (exp-lhs rule))) (exp-rhs rule))))\n\n(integration-table\n  '((Int log(x) d x = x * log(x) - x)\n    (Int exp(x) d x = exp(x))\n    (Int sin(x) d x = - cos(x))\n    (Int cos(x) d x = sin(x))\n    (Int tan(x) d x = - log(cos(x)))\n    (Int sinh(x) d x = cosh(x))\n    (Int cosh(x) d x = sinh(x))\n    (Int tanh(x) d x = log(cosh(x)))\n    ))\n```\n\nThe last step is to install integrate as the simplification function for the operator Int.\nThe obvious way to do this is:\n\n```lisp\n(set-simp-fn 'Int 'integrate)\n```\n\nUnfortunately, that does not quite work.\nThe problem is that integrate expects two arguments, corresponding to the two arguments *`y`* and *`x`* in `( Int *y x*)`.\nBut the convention for simplification functions is to pass them a single argument, consisting of the whole expression `( Int *y x*)`.\nWe could go back and edit `simplify-exp` to change the convention, but instead I choose to make the conversion this way:\n\n```lisp\n(set-simp-fn 'Int #'(lambda (exp)\n          (integrate (exp-lhs exp) (exp-rhs exp))))\n```\n\nHere are some examples, taken from chapters 8 and 9 of *Calculus* ([Loomis 1974](bibliography.md#bb0750)):\n\n```lisp\nSIMPLIFIER > (Int x * sin(x ^ 2) d x)\n(1/2 * (- (COS (X ^ 2))))\nSIMPLIFIER > (Int ((3 * x ^ 3) - 1 / (3 * x ^ 3)) d x)\n((3 * ((X ^ 4) / 4)) - (1/3 * ((X ^ -2) / -2)))\nSIMPLIFIER > (Int (3 * x + 2) ^ -2/3 d x)\n(((3 * X) + 2) ^ 1/3)\nSIMPLIFIER > (Int sin(x) ^ 2 * cos(x) d x)\n(((SIN X) ^ 3) / 3)\nSIMPLIFIER > (Int sin(x) / (1 + cos(x)) d x)\n(-1 * (LOG ((COS X) + 1)))\nSIMPLIFIER > (Int (2 * x + 1) / (x ^ 2 + x - 1) d x)\n(LOG ((X ^ 2) + (X - 1)))\nSIMPLIFIER > (Int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x)\n(8 * ((1/3 * (((X ^ 3) + 2) ^ -2)) / -2))\n```\n\nAll the answers are correct, although the last one could be made simpler.\nOne quick way to simplify such an expression is to factor and unfactor it, and then simplify again:\n\n```lisp\n(set-simp-fn 'Int\n    #'(lambda (exp)\n      (unfactorize\n        (factorize\n          (integrate (exp-lhs exp) (exp-rhs exp))))))\n```\n\nWith this change, we get:\n\n```lisp\nSIMPLIFIER > (Int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x)\n(-4/3 * (((X ^ 3) + 2) ^ -2))\n```\n\n## 8.7 History and References\n\nA brief history is given in the introduction to this chapter.\nAn interesting point is that the history of Lisp and of symbolic algebraic manipulation are deeply intertwined.\nIt is not too gross an exaggeration to say that Lisp was invented by John McCarthy to express the symbolic differentiation algorithm.\nAnd the development of the first high-quality Lisp system, MacLisp, was driven largely by the needs of MACSYMA, one of the first large Lisp systems.\nSee [McCarthy 1958](bibliography.md#bb0790) for early Lisp history and the differentiation algorithm, and [Martin and Fateman 1971](bibliography.md#bb0775) and [Moses (1975)](bibliography.md#bb0875) for more details on MACSYMA.\nA comprehensive book on computer algebra systems is [Davenport 1988](bibliography.md#bb0270).\nIt covers the MACSYMA and REDUCE systems as well as the algorithms behind those systems.\n\nBecause symbolic differentiation is historically important, it is presented in a number of text books, from the original Lisp 1.5 Primer ([Weissman 1967](bibliography.md#bb1370)) and Allen's influential [*Anatomy of Lisp* (1978)](bibliography.md#bb0040) to recent texts like [Brooks 1985](bibliography.md#bb0135), [Hennessey 1989](bibliography.md#bb0530), and [Tanimoto 1990](bibliography.md#bb1220).\nMany of these books use rules or data-driven programming, but each treats differentiation as the main task, with simplification as a separate problem.\nNone of them use the approach taken here, where differentiation is just another kind of simplification.\n\nThe symbolic integration programs SAINT and SIN are covered in [Slagle 1963](bibliography.md#bb1115) and [Moses 1967](bibliography.md#bb0870), respectively.\nThe mathematical solution to the problem of integration in closed term is addressed in [Risch 1969](bibliography.md#bb0985), but be warned; this paper is not for the mathematically naive, and it has no hints on programming the algorithm.\nA better reference is [Davenport et al.\n1988](bibliography.md#bb0270).\n\nIn this book, techniques for improving the efficiency of algebraic manipulation are covered in [sections 9.6](chapter9.md#s0035) and [10.4](chapter10.md#s0025).\n[Chapter 15](chapter15.md) presents a reimplementation that does not use pattern-matching, and is closer to the techniques used in MACSYMA.\n\n## 8.8 Exercises\n\n**Exercise 8.2 [s]** Some notations use the operator ** instead of ^ to indicate exponentiation.\nFix `infix->prefix` so that either notation is allowed.\n\n**Exercise 8.3 [m]** Can the system as is deal with imaginary numbers?\nWhat are some of the difficulties?\n\n**Exercise 8.4 [h]** There are some simple expressions involving sums that are not handled by the `integrate` function.\nThe function can integrate *ax*<sup>2</sup> + *bx* + *c* but not 5(*ax*<sup>2</sup> + *bx* + *c*).\nSimilarly, it can integrate *x*<sup>4</sup> + 2*x*<sup>3</sup> + *x*<sup>2</sup> but not (*x*<sup>2</sup> + *x*)<sup>2</sup>, and it can do *x*<sup>3</sup> + *x*<sup>2</sup> + *x* + 1 but not (*x*<sup>2</sup> + 1)(*x* + 1).\nModify `integrate` so that it expands out products (or small exponents) of sums.\nYou will probably want to try the usual techniques first, and do the expansion only when that fails.\n\n**Exercise 8.5 [d]** Another very general integration technique is called integration by parts.\nIt is based on the rule:\n\n&int;*udv=uv-&int;vdu*\n\nSo, for example, given\n\n&int;*xcos(x)dx*\n\nwe can take *u* = *x*, *dv = cos(x)dx*.\nThen we can determine *v* = *sin(x)* by integration, and come up with the solution:\n\n&int;*xcos(x)dx=xsin(x)*-&int;*sin(x)* * *1dx=xsin(x)+cos(x)*\n\nIt is easy to program an integration by parts routine.\nThe hard part is to program the control component.\nIntegration by parts involves a recursive call to `integrate`, and of all the possible ways of breaking up the original expression into a *u* and a *dv*, few, if any, will lead to a successful integration.\nOne simple control rule is to allow integration by parts only at the top level, not at the recursive level.\nImplement this approach.\n\n**Exercise 8.6 [d]** A more complicated approach is to try to decide which ways of breaking up the original expression are promising and which are not.\nDerive some heuristics for making this division, and reimplement `integrate` to include a search component, using the search tools of [chapter 6](chapter6.md).\n\nLook in a calculus textbook to see how &int;sin<sup>2</sup>*(x)dx* is evaluated by two integrations by parts and a division.\nImplement this technique as well.\n\n**Exercise 8.7 [m]** Write simplification rules for predicate calculus expressions.\nFor example,\n\n```lisp\n(true and x = x)\n(false and x = false)\n(true or x = true)\n(false or x = false)\n```\n\n**Exercise 8.8 [m]** The simplification rule `(x / 0 = undefined)` is necessary to avoid problems with division by zero, but the treatment of `undefined` is inadequate.\nFor example, the expression `((0 / 0) - (0 / 0))` will simplify to zero, when it should simplify to `undefined`.\nAdd rules to propagate `undefined` values and prevent them from being simplified away.\n\n**Exercise 8.9 [d]** Extend the method used to handle `undefined` to handle `+infinity` and `-infinity` as well.\n\n----------------------\n\n<a id=\"fn08-1\"></a><sup>[1](#tfn08-1)</sup>\nMACSYMA is the Project MAC SYMbolic MAthematics program.\nProject MAC is the MIT research organization that was the precursor of MIT's Laboratory for Computer Science.\nMAC stood either for Machine-Aided Cognition or Multiple-Access Computer, according to one of their annual reports.\nThe cynical have claimed that MAC really stood for Man Against Computer.\n\n<a id=\"fn08-2\"></a><sup>[2](#tfn08-2)</sup>\nThe term antiderivative is more correct, because of branch point problems.\n"
  },
  {
    "path": "docs/chapter9.md",
    "content": "# Chapter 9\n## Efficiency Issues\n\n> A Lisp programmer knows the value of everything, but the cost of nothing.\n\n> -Alan J.\nPerlis\n\n> Lisp is not inherently less efficient than other high-level languages.\n\n> -Richard J.\nFateman\n\nOne of the reasons Lisp has enjoyed a long history is because it is an ideal language for what is now called *rapid-prototyping*-developing a program quickly, with little regards for details.\nThat is what we have done so far in this book: concentrated on getting a working algorithm.\nUnfortunately, when a prototype is to be turned into a production-quality program, details can no longer be ignored.\nMost \"real\" AI programs deal with large amounts of data, and with large search spaces.\nThus, efficiency considerations become very important.\n\nHowever, this does not mean that writing an efficient program is fundamentally different from writing a working program.\nIdeally, developing an efficient program should be a three-step process.\nFirst, develop a working program, using proper abstractions so that the program will be easy to change if necessary.\nSecond, *instrument* the program to determine where it is spending most of the time.\nThird, replace the slow parts with faster versions, while maintaining the program's correctness.\n\nThe term *efficiency* will be used primarily to talk about the *speed* or run time of a program.\nTo a lesser extent, *efficiency* is also used to refer to the *space* or amount of storage consumed by a program.\nWe will also talk about the cost of a program.\nThis is partly a use of the metaphor \"time is money,\" and partly rooted in actual monetary costs-if a critical program runs unacceptably slowly, you may need to buy a more expensive computer.\n\nLisp has been saddled with a reputation as an \"inefficient language.\" Strictly speaking, it makes no sense to call a *language* efficient or inefficient.\nRather, it is only a particular *implementation* of the language executing a particular program that can be measured for efficiency.\nSo saying Lisp is inefficient is partly a historical claim: some past implementations *have* been inefficient.\nIt is also partly a prediction: there are some reasons why future implementations are expected to suffer from inefficiencies.\nThese reasons mainly stem from Lisp's flexibility.\nLisp allows many decisions to be delayed until run time, and that can make the run time take longer.\nIn the past decade, the \"efficiency gap\" between Lisp and \"conventional languages\" like FORTRAN or C has narrowed.\nHere are the reasons-some deserved, some not-behind Lisp's reputation for inefficiency:\n\n*   Early implementations were interpreted rather than compiled, which made them inherently inefficient.\nCommon Lisp implementations have compilers, so this is no longer a problem.\nWhile Lisp is (primarily) no longer an interpreted language, it is still an *interactive* language, so it retains its flexibility.\n\n*   Lisp has often been used to write interpreters for embedded languages, thereby compounding the problem.\nConsider this quote from [Cooper and Wogrin's (1988)](bibliography.md#bb0260) book on the rule-based programming language OPS5:\n\n> The efficiency of implementations that compile rules into executable code compares favorably to that of programs written in most sequential languages such as FORTRAN or Pascal Implementations that compile rules into data structures to be interpreted, as do many Lisp-based ones, could be noticeably slower.\n\nHere Lisp is guilty by association.\nThe fallacious chain of reasoning is: Lisp has been used to write interpreters; interpreters are slow; therefore Lisp is slow.\nWhile it is true that Lisp makes it very easy to write interpreters, it also makes it easy to write compilers.\nThis book is the first that concentrates on using Lisp as both the implementation and target language for compilers.\n\n*   Lisp encourages a style with lots of function calls, particularly recursive calls.\nIn some older systems, function calls were expensive.\nBut it is now understood that a function call can be compiled into a simple branch instruction, and that many recursive calls can be made no more expensive than an equivalent iterative loop (see [chapter 22](chapter22.md)).\nIt is also possible to instruct a Common Lisp compiler to compile certain functions inline, so there is no calling overhead at all.\nOn the other hand, many Lisp systems require two fetches instead of one to find the code for a function, and thus will be slower.\nThis extra level of indirection is the price paid for the freedom of being able to redefine functions without reloading the whole program.\n\n*   Run-time type-checking is slow.\nLisp provides a repertoire of generic functions.\nFor example, we can write `(+ x y)` without bothering to declare if `x` and `y` are integers, floating point, bignums, complex numbers, rationals, or some combination of the above.\nThis is very convenient, but it means that type checks must be made at run time, so the generic  +  will be slower than, say, a 16-bit integer addition with no check for overflow.\nIf efficiency is important, Common Lisp allows the programmer to include declarations that can eliminate run-time checks.\nIn fact, once the proper declarations are added, Lisp can be as fast or faster than conventional languages.\n[Fateman (1973)](bibliography.md#bb0375) compared the FORTRAN cube root routine on the PDP-10 to a MacLisp transliteration.\nThe MacLisp version produced almost identical numerical code, but was 18% faster overall, due to a superior function-calling sequence.<a id=\"tfn09-1\"></a><sup>[1](#fn09-1)</sup>\nThe epigraph at the beginning of this chapter is from this article.\n[Berlin and Weise (1990)](bibliography.md#bb0085) show that with a special compilation technique called *partial evaluation*, speeds 7 to 90 times faster than conventionally compiled code can be achieved.\nOf course, partial evaluation could be used in any language, but it is very easy to do in Lisp.\nThe fact remains that Lisp objects must somehow represent their type, and even with declarations, not all of this overhead can be eliminated.\nMost Lisp implementations optimize access to lists and fixnums but pay the price for the other, less commonly used data types.\n\n*   Lisp automatically manages storage, and so it must periodically stop and collect the unused storage, or *garbage*.\nIn early systems, this was done by periodically sweeping through all of memory, resulting in an appreciable pause.\nModern systems tend to use incremental garbage-collection techniques, so pauses are shorter and usually unnoticed by the user (although the pauses may still be too long for real-time applications such as controlling a laboratory instrument).\nThe problem with automatic garbage collection these days is not that it is slow-in fact, the automatic systems do about as well as handcrafted storage allocation.\nThe problem is that they make it convenient for the programmer to generate a lot of garbage in the first place.\nProgrammers in conventional languages, who have to clean up their own garbage, tend to be more careful and use static rather than dynamic storage more often.\nIf garbage becomes a problem, the Lisp programmer can just adopt these static techniques.\n\n*   Lisp systems are big and leave little room for other programs.\nMost Lisp systems are designed to be complete environments, within which the programmer does all program development and execution.\nFor this kind of operation, it makes sense to have a large language like Common Lisp with a huge set of tools.\nHowever, it is becoming more common to use Lisp as just one component in a computing environment that may include UNIX, X Windows, emacs, and other interacting programs.\nIn this kind of heterogeneous environment, it would be useful to be able to define and run small Lisp processes that do not include megabytes of unused tools.\nSome recent compilers support this option, but it is not widely available yet.\n\n*   Lisp is a complicated high-level language, and it can be difficult for the programmer to anticipate the costs of various operations.\nIn general, the problem is not that an efficient encoding is impossible but that it is difficult to arrive at that efficient encoding.\nIn a language like C, the experienced programmer has a pretty good idea how each statement will compile into assembly language instructions.\nBut in Lisp, very similar statements can compile into widely different assembly-level instructions, depending on subtle interactions between the declarations given and the capabilities of the compiler.\n[Page 318](chapter10.md#p318) gives an example where adding a declaration speeds up a trivial function by 40 times.\nNonexperts do not understand when such declarations are necessary and are frustrated by the seeming inconsistencies.\nWith experience, the expert Lisp programmer eventually develops a good \"efficiency model,\" and the need for such declarations becomes obvious.\nRecent compilers such as CMU's Python provide feedback that eases this learning process.\n\nIn summary, Lisp makes it possible to write programs in a wide variety of styles, some efficient, some less so.\nThe programmer who writes Lisp programs in the same style as C programs will probably find Lisp to be of comparable speed, perhaps slightly slower.\nThe programmer who uses some of the more dynamic features of Lisp typically finds that it is much easier to develop a working program.\nThen, if the resulting program is not efficient enough, there will be more time to go back and improve critical sections.\nDeciding which parts of the program use the most resources is called *instrumentation*.\nIt is foolhardy to try to improve the efficiency of a program without first checking if the improvement will make a real difference.\n\nOne route to efficiency is to use the Lisp prototype as a specification and reimplement that specification in a lower-level language, such as C or C++.\nSome commercial AI vendors are taking this route.\nAn alternative is to use Lisp as the language for both the prototype and the final implementation.\nBy adding declarations and making minor changes to the original program, it is possible to end up with a Lisp program that is similar in efficiency to a C program.\n\nThere are four very general and language-independent techniques for speeding up an algorithm:\n\n*   *Caching* the results of computations for later reuse.\n\n*   *Compiling* so that less work is done at run time.\n\n*   *Delaying* the computation of partial results that may never be needed.\n\n*   *Indexing* a data structure for quicker retrieval.\n\nThis chapter covers each of the four techniques in order.\nIt then addresses the important problem of *instrumentation*.\nThe chapter concludes with a case study of the simplify program.\nThe techniques outlined here result in a 130-fold speed-up in this program.\n\n[Chapter 10](chapter10.md) concentrates on lower-level \"tricks\" for improving efficiency further.\n\n## 9.1 Caching Results of Previous Computations: Memoization\n\nWe start with a simple mathematical function to demonstrate the advantages of caching techniques.\nLater we will demonstrate more complex examples.\n\nThe Fibonacci sequence is defined as the numbers 1, 1, 2, 3, 5, 8, ... where each number is the sum of the two previous numbers.\nThe most straightforward function to compute the nth number in this sequence is as follows:\n\n```lisp\n(defun fib (n)\n  \"Compute the nth number in the Fibonacci sequence.\"\n (if (<= n 1) 1\n   (+ (fib (- n 1)) (fib (- n 2)))))\n```\n\nThe problem with this function is that it computes the same thing over and over again.\nTo compute (`fib 5`) means computing (`fib 4`) and (`fib 3`), but (`fib 4`) also requires (`fib 3`), they both require (`fib 2`), and so on.\nThere are ways to rewrite the function to do less computation, but wouldn't it be nice to write the function as is, and have it automatically avoid redundant computation?\nAmazingly, there is a way to do just that.\nThe idea is to use the function `fib` to build a new function that remembers previously computed results and uses them, rather than recompute them.\nThis process is called *memoization*.\nThe function `memo` below is a higher-order function that takes a function as input and returns a new function that will compute the same results, but not do the same computation twice.\n\n```lisp\n(defun memo (fn &key (key #'first) (test #'eql) name)\n  \"Return a memo-function of fn.\"\n  (let ((table (make-hash-table :test test)))\n    (setf (get name 'memo) table)\n    #'(lambda (&rest args)\n        (let ((k (funcall key args)))\n          (multiple-value-bind (val found-p)\n              (gethash k table)\n            (if found-p val\n                (setf (gethash k table) (apply fn args))))))))\n```\n\nThe expression (`memo #'fib`) will produce a function that remembers its results between calls, so that, for example, if we apply it to 3 twice, the first call will do the computation of (`fib 3`), but the second will just look up the result in a hash table.\nWith `fib` traced, it would look like this:\n\n```lisp\n> (setf memo-fib (memo #'fib)) => #<CLOSURE -67300731>\n> (funcall memo-fib 3) =>\n(1 ENTER FIB: 3)\n  (2 ENTER FIB: 2)\n     (3 ENTER FIB: 1)\n     (3 EXIT FIB: 1)\n     (3 ENTER FIB: 0)\n     (3 EXIT FIB: 1)\n  (2 EXIT FIB: 2)\n  (2 ENTER FIB: 1)\n  (2 EXIT FIB: 1)\n(1 EXIT FIB: 3)\n3\n> (funcall memo-fib 3) = > 3\n```\n\nThe second time we call `memo-fib` with 3 as the argument, the answer is just retrieved rather than recomputed.\nBut the problem is that during the computation of (`fib 3`), we still compute (`fib 2`) multiple times.\nIt would be better if even the internal, recursive calls were memoized, but they are calls to fib, which is unchanged, not to `memo-fib`.\nWe can solve this problem easily enough with the function `memoize`:\n\n```lisp\n(defun memoize (fn-name &key (key #'first) (test #'eql))\n  \"Replace fn-name's global definition with a memoized version.\"\n  (setf (symbol-function fn-name) (memo (symbol-function fn-name))))\n```\n\nWhen passed a symbol that names a function, `memoize` changes the global definition of the function to a memo-function.\nThus, any recursive calls will go first to the memo-function, rather than to the original function.\nThis is just what we want.\nIn the following, we contrast the memoized and unmemoized versions of `fib`.\nFirst, a call to (`fib 5`) with `fib` traced:\n\n```lisp\n> (fib 5) =>\n(1 ENTER FIB: 5)\n   (2 ENTER FIB: 4)\n      (3 ENTER FIB: 3)\n         (4 ENTER FIB: 2)\n             (5 ENTER FIB: 1)\n             (5 EXIT FIB: 1)\n             (5 ENTER FIB: 0)\n             (5 EXIT FIB: 1)\n         (4 EXIT FIB: 2)\n         (4 ENTER FIB: 1)\n         (4 EXIT FIB: 1)\n      (3 EXIT FIB: 3)\n      (3 ENTER FIB: 2)\n         (4 ENTER FIB: 1)\n         (4 EXIT FIB: 1)\n         (4 ENTER FIB: 0)\n         (4 EXIT FIB: 1)\n      (3 EXIT FIB: 2)\n   (2 EXIT FIB: 5)\n   (2 ENTER FIB: 3)\n      (3 ENTER FIB: 2)\n         (4 ENTER FIB: 1)\n         (4 EXIT FIB: 1)\n         (4 ENTER FIB: 0)\n         (4 EXIT FIB: 1)\n      (3 EXIT FIB: 2)\n      (3 ENTER FIB: 1)\n      (3 EXIT FIB: 1)\n   (2 EXIT FIB: 3)\n(1 EXIT FIB: 8)\n8\n```\n\nWe see that `(fib 5)` and `(fib 4)` are each computed once, but `(fib 3)` is computed twice, `(fib 2)` three times, and `(fib 1)` five times.\nBelow we call `(memoize 'fib)` and repeat the calculation.\nThis time, each computation is done only once.\nFurthermore, when the computation of `(fib 5)` is repeated, the answer is returned immediately with no intermediate computation, and a further call to `(fib 6)` can make use of the value of `(fib 5)`.\n\n```lisp\n> (memoize 'fib) => #<CLOSURE 76626607>\n> (fib 5) =>\n(1 ENTER FIB: 5)\n  (2 ENTER FIB: 4)\n     (3 ENTER FIB: 3)\n        (4 ENTER FIB: 2)\n           (5 ENTER FIB: 1)\n           (5 EXIT FIB: 1)\n           (5 ENTER FIB: 0)\n           (5 EXIT FIB: 1)\n        (4 EXIT FIB: 2)\n     (3 EXIT FIB: 3)\n  (2 EXIT FIB: 5)\n(1 EXIT FIB: 8)\n8\n> (fib 5)   =>  8\n> (fib 6) =>\n(1 ENTER FIB: 6)\n(1 EXIT FIB: 13)\n13\n```\n\nUnderstanding why this works requires a clear understanding of the distinction between functions and function names.\nThe original `(defun fib ...)` form does two things: builds a function and stores it as the `symbol-function` value of `fib`.\nWithin that function there are two references to `fib`; these are compiled (or interpreted) as instructions to fetch the `symbol-function` of `fib` and apply it to the argument.\n\nWhat `memoize` does is fetch the original function and transform it with `memo` to a function that, when called, will first look in the table to see if the answer is already known.\nIf not, the original function is called, and a new value is placed in the table.\nThe trick is that `memoize` takes this new function and makes it the `symbol-function` value of the function name.\nThis means that all the references in the original function will now go to the new function, and the table will be properly checked on each recursive call.\nOne further complication to `memo:` the function `gethash` returns both the value found in the table and an indicator of whether the key was present or not.\nWe use `multiple-value-bind` to capture both values, so that we can distinguish the case when `nil` is the value of the function stored in the table from the case where there is no stored value.\n\nIf you make a change to a memoized function, you need to recompile the original definition, and then redo the call to memoize.\nIn developing your program, rather than saying `(memoize 'f)`, it might be easier to wrap appropriate definitions in a `memoize` form as follows:\n\n```lisp\n(memoize\n  (defun f (x) ...)\n  )\n```\n\nOr define a macro that combines `defun` and `memoize`:\n\n```lisp\n(defmacro defun-memo (fn args &body body)\n  \"Define a memoized function.\"\n  `(memoize (defun ,fn ,args . ,body)))\n\n(defun-memo f (x) ...)\n```\n\nBoth of these approaches rely on the fact that `defun` returns the name of the function defined.\n\n| []() |             |            |          |                |\n|------|-------------|------------|----------|----------------|\n| *n*  | `(fib` *n*) | unmemoized | memoized | memoized up to |\n| 25   | 121393      | 1.1        | .010     | 0              |\n| 26   | 196418      | 1.8        | .001     | 25             |\n| 27   | 317811      | 2.9        | .001     | 26             |\n| 28   | 514229      | 4.7        | .001     | 27             |\n| 29   | 832040      | 8.2        | .001     | 28             |\n| 30   | 1346269     | 12.4       | .001     | 29             |\n| 31   | 2178309     | 20.1       | .001     | 30             |\n| 32   | 3524578     | 32.4       | .001     | 31             |\n| 33   | 5702887     | 52.5       | .001     | 32             |\n| 34   | 9227465     | 81.5       | .001     | 33             |\n| 50   | 2.0e10      | -          | .014     | 34             |\n| 100  | 5.7e20      | -          | .031     | 50             |\n| 200  | 4.5e41      | -          | .096     | 100            |\n| 500  | 2.2e104     | -          | .270     | 200            |\n| 1000 | 7.0e208     | -          | .596     | 500            |\n| 1000 | 7.0e208     | -          | .001     | 1000           |\n| 1000 | 7.0e208     | -          | .876     | 0              |\n\nNow we show a table giving the values of `(fib` *n*) for certain *n*, and the time in seconds to compute the value, before and after `(memoize 'fib)`.\nFor larger values of *n*, approximations are shown in the table, although `fib` actually returns an exact integer.\nWith the unmemoized version, I stopped at *n*  =  34, because the times were getting too long.\nFor the memoized version, even *n*  =  1000 took under a second.\n\nNote there are three entries for (`fib 1000`).\nThe first entry represents the incremental computation when the table contains the memoized values up to 500, the second entry shows the time for a table lookup when (`fib 1000`) is already computed, and the third entry is the time for a complete computation starting with an empty table.\n\nIt should be noted that there are two general approaches to discussing the efficiency of an algorithm.\nOne is to time the algorithm on representative inputs, as we did in this table.\nThe other is to analyze the *asymptotic complexity* of the algorithm.\nFor the `fib` problem, an asymptotic analysis considers how long it takes to compute `(fib *n*)` as *n* approaches infinity.\nThe notation *O*(*f*(*n*)) is used to describe the complexity.\nFor example, the memoized version `fib` is an *O*(*n*) algorithm because the computation time is bounded by some constant times *n*, for any value of *n*.\nThe unmemoized version, it turns out, is *O*(1.7*<sup>n</sup>*), meaning computing `fib` of `n+1` can take up to 1.7 times as long as `fib` of *n*.\nIn simpler terms, the memoized version has *linear* complexity, while the unmemoized version has *exponential* complexity.\n[Exercise 9.4](chapter9.md#p4655) ([page 308](chapter9.md#p308)) describes where the 1.7 comes from, and gives a tighter bound on the complexity.\n\nThe version of `memo` presented above is inflexible in several ways.\nFirst, it only works for functions of one argument.\nSecond, it only returns a stored value for arguments that are `eql`, because that is how hash tables work by default.\nFor some applications we want to retrieve the stored value for arguments that are `equal`.\nThird, there is no way to delete entries from the hash table.\nIn many applications there are times when it would be good to clear the hash table, either because it has grown too large or because we have finished a set of related problems and are moving on to a new problem.\n\nThe versions of `memo` and `memoize` below handle these three problems.\nThey are compatible with the previous version but add three new keywords for the extensions.\nThe `name` keyword stores the hash table on the property list of that name, so it can be accessed by `clear-memoize`.\nThe `test` keyword tells what kind of hash table to create: `eq, eql, or equal`.\nFinally, the `key` keyword tells which arguments of the function to index under.\nThe default is the first argument (to be compatible with the previous version), but any combination of the arguments can be used.\nIf you want to use all the arguments, specify `identity` as the key.\nNote that if the key is a list of arguments, then you will have to use `equal` hash tables.\n\n```lisp\n(defun memo (fn &key (key #'first) (test #'eql) name)\n  \"Return a memo-function of fn.\"\n  (let ((table (make-hash-table :test test)))\n    (setf (get name 'memo) table)\n    #'(lambda (&rest args)\n        (let ((k (funcall key args)))\n          (multiple-value-bind (val found-p)\n              (gethash k table)\n            (if found-p val\n                (setf (gethash k table) (apply fn args))))))))\n```\n\n```lisp\n(defun memoize (fn-name &key (key #'first) (test #'eql))\n  \"Replace fn-name's global definition with a memoized version.\"\n  (clear-memoize fn-name)\n  (setf (symbol-function fn-name)\n        (memo (symbol-function fn-name)\n              :name fn-name :key key :test test)))\n```\n\n```lisp\n(defun clear-memoize (fn-name)\n  \"Clear the hash table from a memo function.\"\n  (let ((table (get fn-name 'memo)))\n    (when table (clrhash table))))\n```\n\n## 9.2 Compiling One Language into Another\n\nIn [chapter 2](chapter2.md) we defined a new language-the language of grammar rules-which was processed by an interpreter designed especially for that language.\nAn *interpreter* is a program that looks at some data structure representing a \"program\" or sequence of rules of some sort and interprets or evaluates those rules.\nThis is in contrast to a *compiler*, which translates some set of rules in one language into a program in another language.\n\nThe function `generate` was an interpreter for the \"language\" defined by the set of grammar rules.\nInterpreting these rules is straightforward, but the process is somewhat inefficient, in that generate must continually search through the `*grammar*` to find the appropriate rule, then count the length of the right-hand side, and so on.\n\nA compiler for this rule-language would take each rule and translate it into a function.\nThese functions could then call each other with no need to search through the `*grammar*`.\nWe implement this approach with the function `compile-rule`.\nIt makes use of the auxiliary functions `one-of` and `rule-lhs` and `rule-rhs` from [page 40](chapter2.md#p40), repeated here:\n\n```lisp\n(defun rule-lhs (rule)\n  \"The left-hand side of a rule.\"\n  (first rule))\n\n(defun rule-rhs (rule)\n  \"The right-hand side of a rule.\"\n  (rest (rest rule)))\n\n(defun one-of (set)\n  \"Pick one element of set, and make a list of it.\"\n  (list (random-elt set)))\n\n(defun random-elt (seq)\n  \"Pick a random element out of a sequence.\"\n  (elt seq (random (length seq))))\n```\n\nThe function `compile-rule` turns a rule into a function definition by building up Lisp code that implements all the actions that generate would take in interpreting the rule.\nThere are three cases.\nIf every element of the right-hand side is an atom, then the rule is a lexical rule, which compiles into a call to `one-of` to pick a word at random.\nIf there is only one element of the right-hand side, then `build-code` is called to generate code for it.\nUsually, this will be a call to append to build up a list.\nFinally, if there are several elements in the right-hand side, they are each turned into code by `build-code`; are given a number by `build-cases`; and then a `case` statement is constructed to choose one of the cases.\n\n```lisp\n(defun compile-rule (rule)\n \"Translate a grammar rule into a LISP function definition.\"\n (let ((rhs (rule-rhs rule)))\n   '(defun ,(rule-lhs rule) ()\n    ,(cond ((every #'atom rhs) '(one-of ',rhs))\n       ((length =l rhs) (build-code (first rhs)))\n       (t '(case (random .(length rhs))\n         ,@(build-cases 0 rhs)))))))\n\n(defun build-cases (number choices)\n \"Return a list of case-clauses\"\n (when choices\n   (cons (list number (build-code (first choices)))\n       (build-cases (+ number 1) (rest choices)))))\n\n(defun build-code (choice)\n \"Append together multiple constituents\"\n (cond ((null choice) nil)\n       ((atom choice) (list choice))\n       ((length=1 choice) choice)\n       (t '(append ,@(mapcar #'build-code choice)))))\n\n(defun length=1 (x)\n  \"Is x a list of length 1?\"\n  (and (consp x) (null (cdr x))))\n```\n\nThe Lisp code built by `compile-rule` must be compiled or interpreted to make it available to the Lisp system.\nWe can do that with one of the following forms.\nNormally we would want to call `compile`, but during debugging it may be easier not to.\n\n```lisp\n(dolist (rule *grammar*) (eval (compile-rule rule)))\n(dolist (rule *grammar*) (compile (eval (compile-rule rule))))\n```\n\nOne frequent way to use compilation is to define a macro that expands into the code generated by the compiler.\nThat way, we just type in calls to the macro and don't have to worry about making sure all the latest rules have been compiled.\nWe might implement this as follows:\n\n```lisp\n(defmacro defrule (&rest rule)\n  \"Define a grammar rule\"\n  (compile-rule rule))\n(defrule Sentence -> (NP VP))\n(defrule NP -> (Art Noun))\n(defrule VP -> (Verb NP))\n(defrule Art -> the a)\n(defrule Noun -> man ball woman table)\n(defrule Verb -> hit took saw liked)\n```\n\nActually, the choice of using one big list of rules (like `*grammar*`) versus using individual macros to define rules is independent of the choice of compiler versus interpreter.\nWe could just as easily define defrule simply to push the rule onto `*grammar*`.\nMacros like `defrule` are useful when you want to define rules in different places, perhaps in several separate files.\nThe `defparameter` method is appropriate when all the rules can be defined in one place.\n\nWe can see the Lisp code generated by `compile-rule` in two ways: by passing it a rule directly:\n\n```lisp\n> (compile-rule '(Sentence -> (NP VP)))\n(DEFUN SENTENCE ()\n   (APPEND (NP) (VP)))\n> (compile-rule '(Noun -> man ball woman table))\n(DEFUN NOUN ()\n   (ONE-OF '(MAN BALL WOMAN TABLE)))\n```\n\nor by macroexpanding a `defrule` expression.\nThe compiler was designed to produce the same code we were writing in our first approach to the generation problem (see [page 35](chapter2.md#p35)).\n\n```lisp\n> (macroexpand '(defrule Adj* -> () Adj (Adj Adj*)))\n(DEFUN ADJ* ()\n (CASE (RANDOM 3)\n   (0 NIL)\n   (1 (ADJ))\n   (2 (APPEND (ADJ) (ADJ*)))))\n```\n\nInterpreters are usually easier to write than compilers, although in this case, even the compiler was not too difficult.\nInterpreters are also inherently more flexible than compilers, because they put off making decisions until the last possible moment.\nFor example, our compiler considers the right-hand side of a rule to be a list of words only if every element is an atom.\nIn all other cases, the elements are treated as nonterminals.\nThis could cause problems if we extended the definition of `Noun` to include the compound noun \"chow chow\":\n\n```lisp\n(defrule Noun -> man ball woman table (chow chow))\n```\n\nThe rule would expand into the following code:\n\n```lisp\n(DEFUN NOUN ()\n (CASE (RANDOM 5)\n   (0 (MAN))\n   (1 (BALL))\n   (2 (WOMAN))\n   (3 (TABLE))\n   (4 (APPEND (CHOW) (CHOW)))))\n```\n\nThe problem is that `man` and `ball` and all the others are suddenly treated as functions, not as literal words.\nSo we would get a run-time error notifying us of undefined functions.\nThe equivalent rule would cause no trouble for the interpreter, which waits until it actually needs to generate a symbol to decide if it is a word or a nonterminal.\nThus, the semantics of rules are different for the interpreter and the compiler, and we as program implementors have to be very careful about how we specify the actual meaning of a rule.\nIn fact, this was probably a bug in the interpreter version, since it effectively prohibits words like \"noun\" and \"sentence\" from occurring as words if they are also the names of categories.\nOne possible resolution of the conflict is to say that an element of a right-hand side represents a word if it is an atom, and a list of categories if it is a list.\nIf we did indeed settle on that convention, then we could modify both the interpreter and the compiler to comply with the convention.\nAnother possibility would be to represent words as strings, and categories as symbols.\n\nThe flip side of losing run-time flexibility is gaining compile-time diagnostics.\nFor example, it turns out that on the Common Lisp system I am currently using, I get some useful error messages when I try to compile the buggy version of `Noun:`\n\n```lisp\n> (defrule Noun -> man ball woman table (chow chow))\nThe following functions were referenced but don't seem defined:\n CHOW referenced by NOUN\n TABLE referenced by NOUN\n WOMAN referenced by NOUN\n BALL referenced by NOUN\n MAN referenced by NOUN\nNOUN\n```\n\nAnother problem with the compilation scheme outlined here is the possibility of *name clashes*.\nUnder the interpretation scheme, the only names used were the function generate and the variable `*grammar*`.\nWith compilation, every left-hand side of a rule becomes the name of a function.\nThe grammar writer has to make sure he or she is not using the name of an existing Lisp function, and hence redefining it.\nEven worse, if more than one grammar is being developed at the same time, they cannot have any functions in common.\nIf they do, the user will have to recompile with every switch from one grammar to another.\nThis may make it difficult to compare grammars.\nThe best away around this problem is to use the Common Lisp idea of *packages*, but for small exercises name clashes can be avoided easily enough, so we will not explore packages until [section 24.1](chapter24.md#s0010).\n\nThe major advantage of a compiler is speed of execution, when that makes a difference.\nFor identical grammars running in one particular implementation of Common Lisp on one machine, our interpreter generates about 75 sentences per second, while the compiled approach turns out about 200.\nThus, it is more than twice as fast, but the difference is negligible unless we need to generate many thousands of sentences.\nIn [section 9.6](#s0035) we will see another compiler with an even greater speed-up.\n\nThe need to optimize the code produced by your macros and compilers ultimately depends on the quality of the underlying Lisp compiler.\nFor example, consider the following code:\n\n```lisp\n(defun f1 (n l)\n   (let ((l1 (first l))\n         (l2 (second l)))\n        (expt (* 1 (+ n 0))\n       (- 4 (length (list l1 l2))))))\nF1\n> (defun f2 (n l) (* n n)) =>F2\n> (disassemble 'fl)\n```\n\n| []()       |             |\n|------------|-------------|\n| `6 PUSH`   | `ARGIO ; N` |\n| `7 MOVEM`  | `PDL-PUSH`  |\n| `8 *`      | `PDL-POP`   |\n| `9 RETURN` | `PDL-POP`   |\n\n```lisp\nFl\n> (disassemble 'f2)\n```\n\n| []()       |            |\n|------------|------------|\n| `6 PUSH`   | `ARGO ; N` |\n| `7 MOVEM`  | `PDL-PUSH` |\n| `8 *`      | `PDL-POP`  |\n| `9 RETURN` | `PDL-POP`  |\n\n```lisp\nF2\n```\n\nThis particular Lisp compiler generates the exact same code for `f1` and `f2`.\nBoth functions square the argument `n`, and the four machine instructions say, \"Take the 0th argument, make a copy of it, multiply those two numbers, and return the result.\" It's clear the compiler has some knowledge of the basic Lisp functions.\nIn the case of `f1`, it was smart enough to get rid of the local variables `l1` and `l2` (and their initialization), as well as the calls to `first, second, length,` and `list` and most of the arithmetic.\nThe compiler could do this because it has knowledge about the functions `length` and `list` and the arithmetic functions.\nSome of this knowledge might be in the form of simplification rules.\n\nAs a user of this compiler, there's no need for me to write clever macros or compilers that generate streamlined code as seen in `f2`; I can blindly generate code with possible inefficiencies like those in `f1`, and assume that the Lisp compiler will cover up for my laziness.\nWith another compiler that didn't know about such optimizations, I would have to be more careful about the code I generate.\n\n## 9.3 Delaying Computation\n\nBack on [page 45](chapter2.md#p45), we saw a program to generate all strings derivable from a grammar.\nOne drawback of this program was that some grammars produce an infinite number of strings, so the program would not terminate on those grammars.\n\nIt turns out that we often want to deal with infinite sets.\nOf course, we can't enumerate all the elements of an infinite set, but we should be able to represent the set and pick elements out one at a time.\nIn other words, we want to be able to specify how a set (or other object) is constructed, but delay the actual construction, perhaps doing it incrementally over time.\nThis sounds like a job for closures: we can specify the set constructor as a function, and then call the function some time later.\nWe will implement this approach with the syntax used in Scheme-the macro `delay` builds a closure to be computed later, and the function `force` calls that function and caches away the value.\nWe use structures of type `delay` to implement this.\nA delay structure has two fields: the value and the function.\nInitially, the value field is undefined, and the function field holds the closure that will compute the value.\nThe first time the delay is forced, the function is called, and its result is stored in the value field.\nThe function field is then set to nil to indicate that there is no need to call the function again.\nThe function `force` checks if the function needs to be called, and returns the value.\nIf `force` is passed an argument that is not a delay, it just returns the argument.\n\n```lisp\n(defstruct delay value (computed? nil))\n\n(defmacro delay (&rest body)\n  \"A computation that can be executed later by FORCE.\"\n  `(make-delay :value #'(lambda () . ,body)))\n```\n\n```lisp\n(defun force (x)\n \"Find the value of x, by computing if it is a delay.\"\n (if (not (delay-p x))\n      x\n      (progn\n      (when (delay-function x)\n         (setf (delay-value x)\n             (funcall (delay-function x)))\n         (setf (delay-function x) nil))\n      (delay-value x))))\n```\n\nHere's an example of the use of `delay`.\nThe list `x` is constructed using a combination of normal evaluation and delayed evaluation.\nThus, the `1` is printed when `x` is created, `but` the `2` is not:\n\n```lisp\n(setf x (list (print 1) (delay (print 2)))) =>\n1\n(1 #S(DELAY .-FUNCTION (LAMBDA () (PRINT 2))))\n```\n\nThe second element is evaluated (and printed) when it is forced.\nBut then forcing it again just retrieves the cached value, rather than calling the function again:\n\n```lisp\n> (force (second x)) =>\n2\n2\n> x => (1 #S(DELAY : VALUE 2))\n> (force (second x)) => 2\n```\n\nNow let's see how delays can be used to build infinite sets.\nAn infinite set will be considered a special case of what we will call a *pipe*: a list with a `first` component that has been computed, and a `rest` component that is either a normal list or a delayed value.\nPipes have also been called delayed lists, generated lists, and (most commonly) streams.\nWe will use the term *pipe* because *stream* already has a meaning in Common Lisp.\nThe book *Artificial Intelligence Programming* ([Charniak et al.\n1987](bibliography.md#bb0180)) also calls these structures pipes, reserving streams for delayed structures that do not cache computed results.\n\nTo distinguish pipes from lists, we will use the accessors `head` and `tail` instead of `first` and `rest`.\nWe will also use `empty-pipe` instead of `nil, make-pipe` instead of `cons`, and `pipe-elt` instead of `elt`.\nNote that `make-pipe` is a macro that delays evaluation of the tail.\n\n```lisp\n(defmacro make-pipe (head tail)\n \"Create a pipe by evaluating head and delaying tail.\"\n '(cons ,head (delay ,tail)))\n(defconstant empty-pipe nil)\n(defun head (pipe) (first pipe))\n(defun tail (pipe)(force (rest pipe)))\n(defun pipe-elt (pipe i)\n \"The i-th element of a pipe, 0-based\"\n (if (= i 0)\n   (head pipe)\n   (pipe-elt (tail pipe) (- i 1))))\n```\n\nHere's a function that can be used to make a large or infinite sequence of integers with delayed evaluation:\n\n```lisp\n(defun integers (&optional (start 0) end)\n \"A pipe of integers from START to END.\n If END is nil, this is an infinite pipe.\"\n (if (or (null end) (<= start end))\n   (make-pipe start (integers (+ start 1) end))\n   nil))\n```\n\nAnd here is an example of its use.\nThe pipe `c` represents the numbers from 0 to infinity.\nWhen it is created, only the zeroth element, 0, is evaluated.\nThe computation of the other elements is delayed.\n\n```lisp\n> (setf c (integers 0)) => (0 . #S(DELAY :FUNCTION #<CLOSURE -77435477>))\n\n> (pipe-elt c 0) => 0\n```\n\nCalling `pipe-elt` to look at the third element causes the first through third elements to be evaluated.\nThe numbers 0 to 3 are cached in the correct positions, and further elements remain unevaluated.\nAnother call to `pipe-elt` with a larger index would force them by evaluating the delayed function.\n\n```lisp\n> (pipe-elt c 3) => 3\nc =>\n(0 . #S(DELAY\n        : VALUE\n        (1 . #S(DELAY\n                  : VALUE\n                  (2 . #S(DELAY\n                          : VALUE\n                          (3 . #S(DELAY\n                                   :FUNCTION\n                                   #<CLOSURE -77432724 >))))))))\n```\n\nWhile this seems to work fine, there is a heavy price to pay.\nEvery delayed value must be stored in a two-element structure, where one of the elements is a closure.\nThus, there is some storage wasted.\nThere is also some time wasted, as `tail` or `pipe-elt` must traverse the structures.\n\nAn alternate representation for pipes is as (*value . closure*) pairs, where the closure values are stored into the actual cons cells as they are computed.\nPreviously we needed structures of type delay to distinguish a delayed from a nondelayed object, but in a pipe we know the rest can be only one of three things: nil, a list, or a delayed value.\nThus, we can use the closures directly instead of using `delay` structures, if we have some way of distinguishing closures from lists.\nCompiled closures are atoms, so they can always be distinguished from lists.\nBut sometimes closures are implemented as lists beginning with `lambda` or some other implementation-dependent symbol.<a id=\"tfn09-2\"></a><sup>[2](#fn09-2)</sup>\nThe built-in function `functionp` is defined to be true of such lists, as well as of all symbols and all objects returned by `compile`.\nBut using `functionp` means that we cannot have a pipe that includes the symbol `lambda` as an element, because it will be confused for a closure:\n\n```lisp\n> (functionp (last '(theta iota kappa lambda))) => T\n```\n\nIf we consistently use compiled functions, then we could eliminate the problem by testing with the built-in predicate `compiled-function-p`.\nThe following definitions do not make this assumption:\n\n```lisp\n(defmacro make-pipe (head tai1)\n \"Create a pipe by evaluating head and delaying tail.\"\n '(cons ,head #'(lambda () ,tail)))\n(defun tail (pipe)\n \"Return tail of pipe or list, and destructively update\n the tail if it is a function.\"\n (if (functionp (rest pipe))\n   (setf (rest pipe) (funcall (rest pipe)))\n   (rest pipe)))\n```\n\nEverything else remains the same.\nIf we recompile `integers` (because it uses the macro `make-pipe`), we see the following behavior.\nFirst, creation of the infinite pipe `c` is similar:\n\n```lisp\n> (setf c (integers 0)) => (0 . #<CLOSURE 77350123>)\n\n> (pipe-elt c 0) => 0\n```\n\nAccessing an element of the pipe forces evaluation of all the intervening elements, and as before leaves subsequent elements unevaluated:\n\n```lisp\n> (pipe-elt c 5) => 5\n\n> c => (0 1 2 3 4 5 . #<CLOSURE 77351636>)\n```\n\nPipes can also be used for finite lists.\nHere we see a pipe of length 11:\n\n```lisp\n> (setf i (integers 0 10)) => (0 . #<CLOSURE 77375357>)\n\n> (pipe-elt i 10) => 10\n\n> (pipe-elt i 11) => NIL\n\n> i => (0 1 2 3 4 5 6 7 8 9 10)\n```\n\nClearly, this version wastes less space and is much neater about cleaning up after itself.\nIn fact, a completely evaluated pipe turns itself into a list!\nThis efficiency was gained at the sacrifice of a general principle of program design.\nUsually we strive to build more complicated abstractions, like pipes, out of simpler ones, like delays.\nBut in this case, part of the functionality that delays were providing was duplicated by the cons cells that make up pipes, so the more efficient implementation of pipes does not use delays at all.\n\nHere are some more utility functions on pipes:\n\n```lisp\n(defun enumerate (pipe &key count key (result pipe))\n \"Go through all (or count) elements of pipe,\n possibly applying the KEY function. (Try PRINT.)\"\n ;; Returns RESULT, which defaults to the pipe itself.\n (if (or (eq pipe empty-pipe) (eql count 0))\n       result\n       (progn\n       (unless (null key) (funcall key (head pipe)))\n       (enumerate (tail pipe) :count (if count (- count 1))\n                        : key key : result result))))\n(defun filter (pred pipe)\n \"Keep only items in pipe satisfying pred.\"\n (if (funcall pred (head pipe))\n   (make-pipe (head pipe)\n                     (filter pred (tail pipe)))\n   (filter pred (tail pipe))))\n```\n\nAnd here's an application of pipes: generating prime numbers using the sieve of Eratosthenes algorithm:\n\n```lisp\n(defun sieve (pipe)\n (make-pipe (head pipe)\n       (filter #'(lambda (x) (/= (mod x (head pipe)) 0))\n                (sieve (tail pipe)))))\n(defvar *primes* (sieve (integers 2)))\n> *primes* => (2 . #<CLOSURE 3075345>)\n> (enumerate *primes* :count 10) =>\n(2 3 5 7 11 13 17 19 23 29 31 . #<CLOSURE 5224472>)\n```\n\nFinally, let's return to the problem of generating all strings in a grammar.\nFirst we're going to need some more utility functions:\n\n```lisp\n(defun map-pipe (fn pipe)\n \"Map fn over pipe, delaying all but the first fn call.\"\n (if (eq pipe empty-pipe)\n      empty-pipe\n      (make-pipe (funcall fn (head pipe))\n              (map-pipe fn (tail pipe)))))\n(defun append-pipes (x y)\n \"Return a pipe that appends the elements of x and y.\"\n (if (eq x empty-pipe)\n       y\n       (make-pipe (head x)\n                  (append-pipes (tail x) y))))\n(defun mappend-pipe (fn pipe)\n \"Lazily map fn over pipe, appending results.\"\n (if (eq pipe empty-pipe)\n          empty-pipe\n          (let ((x (funcall fn (head pipe))))\n            (make-pipe (head x)\n                    (append-pipes (tail x)\n                                (mappend-pipe\n                                            fn (tail pipe)))))))\n```\n\nNow we can rewrite `generate-all` and `combine-all` to use pipes instead of lists.\n\nEverything else is the same as on [page 45](chapter2.md#p45).\n\n```lisp\n(defun generate-all (phrase)\n \"Generate a random sentence or phrase\"\n (if (listp phrase)\n   (if (null phrase)\n       (list nil)\n       (combine-all-pipes\n          (generate-all (first phrase))\n          (generate-all (rest phrase))))\n   (let ((choices (rule-rhs (assoc phrase *grammar*))))\n    (if choices\n          (mappend-pipe #'generate-all choices)\n          (list (list phrase))))))\n(defun combine-all-pipes (xpipe ypipe)\n \"Return a pipe of pipes formed by appending a y to an x\"\n ;; In other words, form the cartesian product.\n (mappend-pipe\n   #'(lambda (y)\n         (map-pipe #'(lambda (x) (append-pipes x y))\n                          xpipe))\n   ypipe))\n```\n\nWith these definitions, here's the pipe of all sentences from `*grammar2*` (from [page 43](chapter2.md#p43)):\n\n```lisp\n> (setf ss (generate-all 'sentence)) =>\n((THE . #<CLOSURE 27265720>) . #<CLOSURE 27266035>)\n> (enumerate ss :count 5) =>\n((THE . #<CLOSURE 27265720>)\n(A . #<CLOSURE 27273143>)\n(THE . #<CLOSURE 27402545>)\n(A . #<CLOSURE 27404344>)\n(THE . #<CLOSURE 27404527>)\n(A . #<CLOSURE 27405473>) . #<CLOSURE 27405600>)\n\n> (enumerate ss .-count 5 :key #'enumerate) =>\n((THE MAN HIT THE MAN)\n(A MAN HIT THE MAN)\n(THE BIG MAN HIT THE MAN)\n(A BIG MAN HIT THE MAN)\n(THE LITTLE MAN HIT THE MAN)\n(THE . #<CLOSURE 27423236>) . #<CLOSURE 27423343>)\n> (enumerate (pipe-elt ss 200)) =>\n(THE ADIABATIC GREEN BLUE MAN HIT THE MAN)\n```\n\nWhile we were able to represent the infinite set of sentences and enumerate instances of it, we still haven't solved all the problems.\nFor one, this enumeration will never get to a sentence that does not have \"hit the man\" as the verb phrase.\nWe will see longer and longer lists of adjectives, but no other change.\nAnother problem is that left-recursive rules will still cause infinite loops.\nFor example, if the expansion for `Adj*` had been `(Adj* -> (Adj* Adj) ())` instead of `(Adj* -> () (Adj Adj*))`, then the enumeration would never terminate, because pipes need to generate a first element.\n\nWe have used delays and pipes for two main purposes: to put off until later computations that may not be needed at all, and to have an explicit representation of large or infinite sets.\nIt should be mentioned that the language Prolog has a different solution to the first problem (but not the second).\nAs we shall see in [chapter 11](chapter11.md), Prolog generates solutions one at a time, automatically keeping track of possible backtrack points.\nWhere pipes allow us to represent an infinite number of alternatives in the data, Prolog allows us to represent those alternatives in the program itself.\n\n**Exercise 9.1 [h]** When given a function `f` and a pipe `p`, `mappend-pipe` returns a new pipe that will eventually enumerate all of `(f (first p))`, then all of `(f (second p))`, and so on.\nThis is deemed \"unfair\" if `(f (first p))` has an infinite number of elements.\nDefine a function that will fairly interleave elements, so that all of them are eventually enumerated.\nShow that the function works by changing `generate-all` to work with it.\n\n## 9.4 Indexing Data\n\nLisp makes it very easy to use lists as the universal data structure.\nA list can represent a set or an ordered sequence, and a list with sublists can represent a tree or graph.\nFor rapid prototyping, it is often easiest to represent data in lists, but for efficiency this is not always the best idea.\nTo find an element in a list of length *n* will take *n*/2 steps on average.\nThis is true for a simple list, an association list, or a property list.\nIf *n* can be large, it is worth looking at other data structures, such as hash tables, vectors, property lists, and trees.\n\nPicking the right data structure and algorithm is as important in Lisp as it is in any other programming language.\nEven though Lisp offers a wide variety of data structures, it is often worthwhile to spend some effort on building just the right data structure for frequently used data.\nFor example, Lisp's hash tables are very general and thus can be inefficient.\nYou may want to build your own hash tables if, for example, you never need to delete elements, thus making open hashing an attractive possibility.\nWe will see an example of efficient indexing in [section 9.6](#s0035) ([page 297](chapter9.md#p297)).\n\n## 9.5 Instrumentation: Deciding What to Optimize\n\nBecause Lisp is such a good rapid-prototyping language, we can expect to get a working implementation quickly.\nBefore we go about trying to improve the efficiency of the implementation, it is a good idea to see what parts are used most often.\nImproving little-used features is a waste of time.\n\nThe minimal support we need is to count the number of calls to selected functions, and then print out the totals.\nThis is called *profiling* the functions.<a id=\"tfn09-3\"></a><sup>[3](#fn09-3)</sup>\nFor each function to be profiled, we change the definition so that it increments a counter and then calls the original function.\n\nMost Lisp systems have some built-in profiling mechanism.\nIf your system has one, by all means use it.\nThe code in this section is provided for those who lack such a feature, and as an example of how functions can be manipulated.\nThe following is a simple profiling facility.\nFor each profiled function, it keeps a count of the number of times it is called under the `profile-count` property of the function's name.\n\n```lisp\n(defun profile1 (fn-name)\n \"Make the function count how often it is called\"\n ;; First save away the old, unprofiled function\n ;; Then make the name be a new function that increments\n ;; a counter and then calls the original function\n  (let ((fn (symbol-function fn-name)))\n     (setf (get fn-name 'unprofiled-fn) fn)\n   (setf (get fn-name 'profile-count) 0)\n   (setf (symbol-function fn-name)\n        (profiled-fn fn-name fn))\n   fn-name))\n(defun unprofile1 (fn-name)\n \"Make the function stop counting how often it is called.\"\n (setf (symbol-function fn-name) (get fn-name 'unprofiled-fn))\n fn-name)\n(defun profiled-fn (fn-name fn)\n \"Return a function that increments the count.\"\n #'(lambda (&rest args)\n   (incf (get fn-name 'profile-count))\n   (apply fn args)))\n(defun profile-count (fn-name) (get fn-name 'profile-count))\n (defun profile-report (fn-names &optional (key #'profile-count))\n \"Report profiling statistics on given functions.\"\n       (loop for name in (sort fn-names #'> :key key) do\n          (format t \"~& ~ 7D ~ A\" (profile-count name) name)))\n```\n\nThat's all we need for the bare-bones functionality.\nHowever, there are a few ways we could improve this.\nFirst, it would be nice to have macros that, like `trace` and `untrace`, allow the user to profile multiple functions at once and keep track of what has been profiled.\nSecond, it can be helpful to see the length of time spent in each function, as well as the number of calls.\n\nAlso, it is important to avoid profiling a function twice, since that would double the number of calls reported without alerting the user of any trouble.\nSuppose we entered the following sequence of commands:\n\n```lisp\n(defun f (x) (g x))\n(profile1 'f)\n(profile1 'f)\n```\n\nThen the definition of `f` would be roughly:\n\n```lisp\n(lambda (&rest args)\n   (incf (get 'f 'profile-count))\n   (apply #'(lambda (&rest args)\n      (incf (get 'f 'profile-count))\n      (apply #'(lambda (x) (g x))\n            args))\n        args))\n```\n\nThe result is that any call to `f` will eventually call the original `f`, but only after incrementing the count twice.\n\nAnother consideration is what happens when a profiled function is redefined by the user.\nThe only way we could ensure that a redefined function would continue profiling would be to change the definition of the macro defun to look for functions that should be profiled.\nChanging system functions like defun is a risky prospect, and in *Common Lisp the Language*, 2d edition, it is explicitly disallowed.\nInstead, we'll do the next best thing: ensure that the next call to `profile` will reprofile any functions that have been redefined.\nWe do this by keeping track of both the original unprofiled function and the profiled function.\nWe also keep a list of all functions that are currently profiled.\n\nIn addition, we will count the amount of time spent in each function.\nHowever, the user is cautioned not to trust the timing figures too much.\nFirst, they include the overhead cost of the profiling facility.\nThis can be significant, particularly because the facility conses, and thus can force garbage collections that would not otherwise have been done.\nSecond, the resolution of the system clock may not be fine enough to make accurate timings.\nFor functions that take about 1/10 of a second or more, the figures will be reliable, but for quick functions they may not be.\n\nHere is the basic code for `profile` and `unprofile:`\n\n```lisp\n(defvar *profiled-functions* nil\n \"Function names that are currently profiled\")\n\n(defmacro profile (&rest fn-names)\n \"Profile fn-names. With no args, list profiled functions.\"\n '(mapcar #'profile1\n       (setf *profiled-functions*\n      (union *profiled-functions* fn-names))))\n\n(defmacro unprofile (&rest fn-names)\n \"Stop profiling fn-names. With no args, stop all profiling.\"\n '(progn\n   (mapcar #'unprofile1\n         ,(if fn-names fn-names '*profiled-functions*))\n   (setf *profiled-functions*\n         ,(if (null fn-names)\n      nil\n         '(set-difference *profiled-functions*\n            ',fn-names)))))\n```\n\nThe idiom `'',fn-names` deserves comment, since it is common but can be confusing at first.\nIt may be easier to understand when written in the equivalent form `'(quote ,fn-names)`.\nAs always, the backquote builds a structure with both constant and evaluated components.\nIn this case, the `quote` is constant and the variable `fn-names` is evaluated.\nIn MacLisp, the function `kwote` was defined to serve this purpose:\n\n```lisp\n(defun kwote (x) (list 'quote x))\n```\n\nNow we need to change `profile1` and `unprofile1` to do the additional bookkeeping: For `profile1`, there are two cases.\nIf the user does a `profile1` on the same function name twice in a row, then on the second time we will notice that the current function is the same as the functioned stored under the `profiled-fn` property, so nothing more needs to be done.\nOtherwise, we create the profiled function, store it as the current definition of the name under the `profiled-fn` property, save the unprofiled function, and initialize the counts.\n\n```lisp\n(defun profile1 (fn-name)\n \"Make the function count how often it is called\"\n ;; First save away the old, unprofiled function\n ;; Then make the name be a new function that increments\n ;; a counter and then calls the original function\n (let ((fn (symbol-function fn-name)))\n   (unless (eq fn (get fn-name 'profiled-fn))\n       (let ((new-fn (profiled-fn fn-name fn)))\n         (setf (symbol-function fn-name) new-fn\n               (get fn-name 'profiled-fn) new-fn\n               (get fn-name 'unprofiled-fn) fn\n               (get fn-name 'profile-time) 0\n               (get fn-name 'profile-count) 0))))\n    fn-name)\n(defun unprofile1 (fn-name)\n \"Make the function stop counting how often it is called.\"\n (setf (get fn-name 'profile-time) 0)\n (setf (get fn-name 'profile-count) 0)\n (when (eq (symbol-function fn-name) (get fn-name 'profiled-fn))\n   ;; normal case: restore unprofiled version\n   (setf (symbol-function fn-name)\n        (get fn-name 'unprofiled-fn)))\n fn-name)\n```\n\nNow we look into the question of timing.\nThere is a built-in Common Lisp function, `get-internal-real-time`, that returns the elapsed time since the Lisp session started.\nBecause this can quickly become a bignum, some implementations provide another timing function that wraps around rather than increasing forever, but which may have a higher resolution than `get-internal-real-time`.\nFor example, on TI Explorer Lisp Machines, `get-internal-real-time` measures 1/60-second intervals, while `time:microsecond-time` measures 1/1,000,000-second intervals, but the value returned wraps around to zero every hour or so.\nThe function `time:microsecond-time-difference` is used to compare two of these numbers with compensation for wraparound, as long as no more than one wraparound has occurred.\n\nIn the code below, I use the conditional read macro characters `#+` and `#-` to define the right behavior on both Explorer and non-Explorer machines.\nWe have seen that `#` is a special character to the reader that takes different action depending on the following character.\nFor example, `#'fn` is read as `(function fn)`.\nThe character sequence `#+` is defined so that `#+`*feature expression* reads as *expression* if the *feature* is defined in the current implementation, and as nothing at all if it is not.\nThe sequence `#-` acts in just the opposite way.\nFor example, on a TI Explorer, we would get the following:\n\n```lisp\n>'(hi #+TI t #+Symbolics s #-Explorer e #-Mac m) => (HI T M)\n```\n\nThe conditional read macro characters are used in the following definitions:\n\n```lisp\n(defun get-fast-time ()\n \"Return the elapsed time. This may wrap around;\n use FAST-TIME-DIFFERENCE to compare.\"\n #+Explorer (time:microsecond-time) ; do this on an Explorer\n #-Explorer (get-internal-real-time)) ; do this on a non-Explorer\n(defun fast-time-difference (end start)\n \"Subtract two time points.\"\n #+Explorer (time:microsecond-time-difference end start)\n #-Explorer (- end start))\n(defun fast-time->seconds (time)\n \"Convert a fast-time interval into seconds.\"\n #+Explorer (/ time 1000000.0)\n #-Explorer (/ time internal-time-units-per-second))\n```\n\nThe next step is to update `profiled-fn` to keep track of the timing data.\nThe simplest way to do this would be to set a variable, say `start`, to the time when a function is entered, run the function, and then increment the function's time by the difference between the current time and `start`.\nThe problem with this approach is that every function in the call stack gets credit for the time of each called function.\nSuppose the function `f` calls itself recursively five times, with each call and return taking place a second apart, so that the whole computation takes nine seconds.\nThen `f` will be charged nine seconds for the outer call, seven seconds for the next call, and so on, for a total of 25 seconds, even though in reality it only took nine seconds for all of them together.\n\nA better algorithm would be to charge each function only for the time since the last call or return.\nThen `f` would only be charged the nine seconds.\nThe variable `*profile-call-stack*` is used to hold a stack of function name/entry time pairs.\nThis stack is manipulated by `profile-enter` and `profile-exit` to get the right timings.\n\nThe functions that are used on each call to a profiled function are declared `inline`.\nIn most cases, a call to a function compiles into machine instructions that set up the argument list and branch to the location of the function's definition.\nWith an `inline` function, the body of the function is compiled in line at the place of the function call.\nThus, there is no overhead for setting up the argument list and branching to the definition.\nAn `inline` declaration can appear anywhere any other declaration can appear.\nIn this case, the function `proclaim` is used to register a global declaration.\nInline declarations are discussed in more depth on [page 317](chapter10.md#p317).\n\n```lisp\n(proclaim '(inline profile-enter profile-exit inc-profile-time))\n(defun profiled-fn (fn-name fn)\n \"Return a function that increments the count, and times.\"\n #'(lambda (&rest args)\n     (profile-enter fn-name)\n     (multiple-value-progl\n        (apply fn args)\n        (profile-exit fn-name))))\n(defvar *profile-call-stack* nil)\n(defun profile-enter (fn-name)\n (incf (get fn-name 'profile-count))\n (unless (null *profile-call-stack*)\n   ;; Time charged against the calling function:\n   (inc-profile-time (first *profile-call-stack*)\n               (car (first *profile-call-stack*))))\n ;; Put a new entry on the stack\n (push (cons fn-name (get-fast-time))\n       *profile-call-stack*))\n(defun profile-exit (fn-name)\n ;; Time charged against the current function:\n (inc-profile-time (pop *profile-call-stack*)\n                     fn-name)\n ;; Change the top entry to reflect current time\n (unless (null *profile-call-stack*)\n   (setf (cdr (first *profile-call-stack*))\n       (get-fast-time))))\n(defun inc-profile-time (entry fn-name)\n (incf (get fn-name 'profile-time)\n            (fast-time-difference (get-fast-time) (cdr entry))))\n```\n\nFinally, we need to update `profile-report` to print the timing data as well as the counts.\nNote that the default `fn-names` is a copy of the global list.\nThat is because we pass `fn-names` to `sort`, which is a destructive function.\nWe don't want the global list to be modified as a result of this sort.\n\n```lisp\n(defun profile-report (&optional\n                      (fn-names (copy-list *profiled-functions*))\n                      (key #'profile-count))\n  \"Report profiling statistics on given functions.\"\n  (let ((total-time (reduce #' + (mapcar #'profile-time fn-names))))\n    (unless (null key)\n      (setf fn-names (sort fn-names #'> :key key)))\n    (format t \"~&Total elapsed time: ~d seconds.\"\n            (fast-time-> seconds total-time))\n    (format t Count Secs Time% Name\")\n    (loop for name in fn-names do\n         (format t \"~&~7D ~6,2F ~3d% ~A\"\n                (profile-count name)\n                (fast-time-> seconds (profile-time name))\n                (round (/ (profile-time name) total-time) .01)\n                name))))\n(defun profile-time (fn-name) (get fn-name 'profile-time))\n```\n\nThese functions can be used by calling `profile`, then doing some representative computation, then calling `profile-report`, and finally `unprofile`.\nIt can be convenient to provide a single macro for doing all of these at once:\n\n```lisp\n(defmacro with-profiling (fn-names &rest body)\n  '(progn\n        (unprofile . ,fn-names)\n        (profile . ,fn-names)\n        (setf *profile-call-stack* nil)\n        (unwind-protect\n                (progn . ,body)\n            (profile-report ',fn-names)\n            (unprofile . ,fn-names))))\n```\n\nNote the use of `unwind-protect` to produce the report and call `unprofile` even if the computation is aborted.\n`unwind-protect` is a special form that takes any number of arguments.\nIt evaluates the first argument, and if all goes well it then evaluates the other arguments and returns the first one, just like `progl`.\nBut if an error occurs during the evaluation of the first argument and computation is aborted, then the subsequent arguments (called cleanup forms) are evaluated anyway.\n\n## 9.6 A Case Study in Efficiency: The SIMPLIFY Program\n\nSuppose we wanted to speed up the `simplify` program of [chapter 8](chapter8.md).\nThis section shows how a combination of general techniques-memoizing, indexing, and compiling-can be used to speed up the program by a factor of 130.\n[Chapter 15](chapter15.md) will show another approach: replace the algorithm with an entirely different one.\n\nThe first step to a faster program is defining a *benchmark*, a test suite representing a typical work load.\nThe following is a short list of test problems (and their answers) that are typical of the `simplify` task.\n\n```lisp\n(defvar *test-data* (mapcar #'infix-> prefix\n  '((d (a * x ^ 2  +  b * x  +  c) / d x)\n      (d ((a * x ^ 2  +  b * x  +  c) / x) / d x)\n      (d((a*x ^ 3  +  b * x ^ 2  +  c * x  +  d)/x ^ 5)/dx)\n      ((sin (x  +  x)) * (sin (2 * x))  +  (cos (d (x ^ 2) / d x)) ^ 1)\n      (d (3 * x  +  (cos x) / x) / d x))))\n(defvar *answers* (mapcar #'simplify *test-data*))\n```\n\nThe function `test-it` runs through the test data, making sure that each answer is correct and optionally printing profiling data.\n\n```lisp\n(defun test-it (&optional (with-profiling t))\n  \"Time a test run. and make sure the answers are correct.\"\n  (let ((answers\n         (if with-profiling\n             (with-profiling (simplify simplify-exp pat-match\n                              match-variable variable-p)\n               (mapcar #'simplify *test-data*))\n             (time (mapcar #'simplify *test-data*)))))\n    (mapc #'assert-equal answers *answers*)\n    t))\n(defun assert-equal (x y)\n    \"If x is not equal to y, complain.\"\n    (assert (equal x y) (x y)\n                    \"Expected ~a to be equal to ~a\" x y))\n```\n\nHere are the results of (`test-it`) with and without profiling:\n\n```lisp\n> (test-it nil)\nEvaluation of (MAPCAR #'SIMPLIFY *TEST-DATA*) took 6.612 seconds.\n> (test-it t)\nTotal elapsed time: 22.819614 seconds\n```\n\n| []()    |         |         |                  |\n|---------|---------|---------|------------------|\n| `Count` | `Secs`  | `Time%` | `Name`           |\n| `51690` | `11.57` | `51%`   | `PAT-MATCH`      |\n| `37908` | `8.75`  | `38%`   | `VARIABLE-P`     |\n| `1393`  | `0.32`  | `1%`    | `MATCH-VARIABLE` |\n| `906`   | `0.20`  | `1%`    | `SIMPLIFY`       |\n| `274`   | `1.98`  | `9%`    | `SIMPLIFY-EXP`   |\n\nRunning the test takes 6.6 seconds normally, although the time triples when the profiling overhead is added in.\nIt should be clear that to speed things up, we have to either speed up or cut down on the number of calls to `pat-match` or `variable-p`, since together they account for 89% of the calls (and 89% of the time as well).\nWe will look at three methods for achieving both those goals.\n\n#### Memoization\n\nConsider the rule that transforms (`x + x`) into (`2 * x`).\nOnce this is done, we have to simplify the result, which involves resimplifying the components.\nIf `x` were some complex expression, this could be time-consuming, and it will certainly be wasteful, because `x` is already simplified and cannot change.\nWe have seen this type of problem before, and the solution is memoization: make `simplify` remember the work it has done, rather than repeating the work.\nWe can just say:\n\n```lisp\n(memoize 'simplify :test #'equal)\n```\n\nTwo questions are unclear: what kind of hash table to use, and whether we should clear the hash table between problems.\nThe simplifier was timed for all four combinations of `eq` or `equal` hash tables and resetting or nonresetting between problems.\nThe fastest result was `equal` hashing and nonresetting.\nNote that with `eq` hashing, the resetting version was faster, presumably because it couldn't take advantage of the common subexpressions between examples (since they aren't `eq`).\n\n| hashing | resetting | time |\n|---------|-----------|------|\n| none    | -         | 6.6  |\n| `equal` | yes       | 3.8  |\n| `equal` | no        | 3.0  |\n| `eq`    | yes       | 7.0  |\n| `eq`    | no        | 10.2 |\n\nThis approach makes the function `simplify` remember the work it has done, in a hash table.\nIf the overhead of hash table maintenance becomes too large, there is an alternative: make the data remember what `simplify` has done.\nThis approach was taken in MACSYMA: it represented operators as lists rather than as atoms.\nThus, instead of `(* 2 x)`, MACSYMA would use `((*) 2 x)`.\nThe simplification function would destructively insert a marker into the operator list.\nThus, the result of simplifying 2*x* would be `((* simp) 2 x)`.\nThen, when the simplifier was called recursively on this expression, it would notice the `simp` marker and return the expression as is.\n\nThe idea of associating memoization information with the data instead of with the function will be more efficient unless there are many functions that all want to place their marks on the same data.\nThe data-oriented approach has two drawbacks: it doesn't identify structures that are `equal` but not `eq`, and, because it requires explicitly altering the data, it requires every other operation that manipulates the data to know about the markers.\nThe beauty of the hash table approach is that it is transparent; no code needs to know that memoization is taking place.\n\n#### Indexing\n\nWe currently go through the entire list of rules one at a time, checking each rule.\nThis is inefficient because most of the rules could be trivially ruled out-if only they were indexed properly.\nThe simplest indexing scheme would be to have a separate list of rules indexed under each operator.\nInstead of having `simplify-exp` check each member of `*simplification-rules*`, it could look only at the smaller list of rules for the appropriate operator.\nHere's how:\n\n```lisp\n(defun simplify-exp (exp)\n  \"Simplify using a rule. or by doing arithmetic.\n  or by using the simp function supplied for this operator.\n  This version indexes simplification rules under the operator.\"\n  (cond ((simplify-by-fn exp))\n        ((rule-based-translator exp (rules-for (exp-op exp)) ;***\n           :rule-if #'exp-lhs :rule-then #'exp-rhs\n           :action #'(lambda (bindings response)\n                      (simplify (sublis bindings response)))))\n        ((evaluable exp) (eval exp))\n        (t exp)))\n(defvar *rules-for* (make-hash-table :test #'eq))\n(defun main-op (rule) (exp-op (exp-lhs rule)))\n(defun index-rules (rules)\n    \"Index all the rules under the main op.\"\n    (clrhash *rules-for*)\n    (dolist (rule rules)\n        ;; nconc instead of push to preserve the order of rules\n        (setf (gethash (main-op rule) *rules-for*)\n                    (nconc (gethash (main-op rule) *rules-for*)\n                                  (list rule)))))\n(defun rules-for (op) (gethash op *rules-for*))\n(index-rules *simplification-rules*)\n```\n\nTiming the memoized, indexed version gets us to .98 seconds, down from 6.6 seconds for the original code and 3 seconds for the memoized code.\nIf this hadn't helped, we could have considered more sophisticated indexing schemes.\nInstead, we move on to consider other means of gaining efficiency.\n\n**Exercise 9.2 [m]** The list of rules for each operator is stored in a hash table with the operator as key.\nAn alternative would be to store the rules on the property list of each operator, assuming operators must be symbols.\nImplement this alternative, and time it against the hash table approach.\nRemember that you need some way of clearing the old rules-trivial with a hash table, but not automatic with property lists.\n\n#### Compilation\n\nYou can look at `simplify-exp` as an interpreter for the simplification rule language.\nOne proven technique for improving efficiency is to replace the interpreter with a compiler.\nFor example, the rule `(x + x = 2 * x)` could be compiled into something like:\n\n```lisp\n(lambda (exp)\n    (if (and (eq (exp-op exp) '+) (equal (exp-lhs exp) (exp-rhs exp)))\n            (make-exp :op '* :lhs 2 :rhs (exp-rhs exp))))\n```\n\nThis eliminates the need for consing up and passing around variable bindings, and should be faster than the general matching procedure.\nWhen used in conjunction with indexing, the individual rules can be simpler, because we already know we have the right operator.\nFor example, with the above rule indexed under `+`, it could now be compiled as:\n\n```lisp\n(lambda (exp)\n    (if (equal (exp-lhs exp) (exp-rhs exp))\n            (make-exp :op '* :lhs 2 :rhs (exp-lhs exp))))\n```\n\nIt is important to note that when these functions return nil, it means that they have failed to simplify the expression, and we have to consider another means of simplification.\n\nAnother possibility is to compile a set of rules all at the same time, so that the indexing is in effect part of the compiled code.\nAs an example, I show here a small set of rules and a possible compilation of the rule set.\nThe generated function assumes that `x` is not an atom.\nThis is appropriate because we are replacing `simplify-exp`, not `simplify`.\nAlso, we will return nil to indicate that `x` is already simplified.\nI have chosen a slightly different format for the code; the main difference is the let to introduce variable names for subexpressions.\nThis is useful especially for deeply nested patterns.\nThe other difference is that I explicitly build up the answer with a call to `list`, rather than `make-exp`.\nThis is normally considered bad style, but since this is code generated by a compiler, I wanted it to be as efficient as possible.\nIf the representation of the `exp` data type changed, we could simply change the compiler; a much easier task than hunting down all the references spread throughout a human-written program.\nThe comments following were not generated by the compiler.\n\n```lisp\n(x * 1  =  x)\n(1 * x  =  x)\n(x * 0  =  0)\n(0 * x  =  0)\n(x * x  =  x ^ 2)\n\n(lambda (x)\n  (let ((xl (exp-lhs x))\n        (xr (exp-rhs x)))\n    (or (if (eql xr '1)          ; (x * 1  =  x)\n            xl)\n        (if (eql xl '1)          ; (1 * x  =  x)\n            xr)\n        (if (eql xr '0)          ; (x * 0  =  0)\n            '0)\n        (if (eql xl '0)          ; (0 * x  =  0)\n            '0)\n        (if (equal xr xl)        ; (x * x  =  x  ^  2)\n            (list '^ xl '2)))))\n```\n\nI chose this format for the code because I imagined (and later *show*) that it would be fairly easy to write the compiler for it.\n\n#### The Single-Rule Compiler\n\nHere I show the complete single-rule compiler, to be followed by the indexed-rule-set compiler.\nThe single-rule compiler works like this:\n\n```lisp\n> (compile-rule '(= (+ x x) (* 2 x)))\n(LAMBDA (X)\n  (IF (OP? X '+)\n    (LET ((XL (EXP-LHS X))\n          (XR (EXP-RHS X)))\n     (IF (EQUAL XR XL)\n         (SIMPLIFY-EXP (LIST '* '2 XL))))))\n```\n\nGiven a rule, it generates code that first tests the pattern and then builds the right- hand side of the rule if the pattern matches.\nAs the code is generated, correspondences are built between variables in the pattern, like `x`, and variables in the generated code, like `xl`.\nThese are kept in the association list `*bindings*`.\nThe matching can be broken down into four cases: variables that haven't been seen before, variables that have been seen before, atoms, and lists.\nFor example, the first time we run across `x` in the rule above, no test is generated, since anything can match `x`.\nBut the entry `(x.xl)` is added to the `*bindings*` list to mark the equivalence.\nWhen the second `x` is encountered, the test `(equal xr xl)` is generated.\n\nOrganizing the compiler is a little tricky, because we have to do three things at once: return the generated code, keep track of the `*bindings*`, and keep track of what to do \"next\"-that is, when a test succeeds, we need to generate more code, either to test further, or to build the result.\nThis code needs to know about the bindings, so it can't be done *before* the first part of the test, but it also needs to know where it should be placed in the overall code, so it would be messy to do it *after* the first part of the test.\nThe answer is to pass in a function that will tell us what code to generate later.\nThis way, it gets done at the right time, and ends up in the right place as well.\nSuch a function is often called a *continuation*, because it tells us where to continue computing.\nIn our compiler, the variable `consequent` is a continuation function.\n\nThe compiler is called `compile-rule`.\nIt takes a rule as an argument and returns a lambda expression that implements the rule.\n\n```lisp\n(defvar *bindings* nil\n  \"A list of bindings used by the rule compiler.\")\n(defun compile-rule (rule)\n  \"Compile a single rule.\"\n  (let ((*bindings* nil))\n    '(lambda (x)\n      ,(compile-exp 'x (exp-lhs rule) ; x is the lambda parameter\n                    (delay (build-exp (exp-rhs rule)\n                                               *bindings*))))))\n```\n\nAll the work is done by `compile-exp`, which takes three arguments: a variable that will represent the input in the generated code, a pattern that the input should be matched against, and a continuation for generating the code if the test passes.\nThere are five cases: (1) If the pattern is a variable in the list of bindings, then we generate an equality test.\n(2) If the pattern is a variable that we have not seen before, then we add it to the binding list, generate no test (because anything matches a variable) and then generate the consequent code.\n(3) If the pattern is an atom, then the match succeeds only if the input is `eql` to that atom.\n(4) If the pattern is a conditional like `(?is n numberp)`, then we generate the test `(numberp n)`.\nOther such patterns could be included here but have not been, since they have not been used.\nFinally, (5) if the pattern is a list, we check that it has the right operator and arguments.\n\n```lisp\n(defun compile-exp (var pattern consequent)\n  \"Compile code that tests the expression, and does consequent\n  if it matches. Assumes bindings in *bindings*.\"\n  (cond ((get-binding pattern *bindings*)\n         ;; Test a previously bound variable\n         '(if (equal .var .(lookup pattern *bindings*))\n              ,(force consequent)))\n        ((variable-p pattern)\n         ;; Add a new bindings; do type checking if needed.\n         (push (cons pattern var) *bindings*)\n         (force consequent))\n        ((atom pattern)\n         ;; Match a literal atom\n         '(if (eql ,var '.pattern)\n              ,(force consequent)))\n        ((starts-with pattern '?is)\n         (push (cons (second pattern) var) *bindings*)\n         '(if (,(third pattern) ,var)\n              ,(force consequent)))\n         ;; So. far, only the ?is pattern is covered, because\n         ;; it is the only one used in simplification rules.\n         ;; Other patterns could be compiled by adding code here.\n         ;; Or we could switch to a data-driven approach.\n         (t ;; Check the operator and arguments\n          '(if (op? ,var ',(exp-op pattern))\n              ,(compile-args var pattern consequent)))))\n```\n\nThe function `compile-args` is used to check the arguments to a pattern.\nIt generates a `let` form binding one or two new variables (for a unary or binary expression), and then calls `compile-exp` to generate code that actually makes the tests.\nIt just passes along the continuation, `consequent`, to `compile-exp`.\n\n```lisp\n(defun compile-args (var pattern consequent)\n  \"Compile code that checks the arg or args, and does consequent\n  if the arg(s) match.\"\n  ;; First make up variable names for the arg(s).\n  (let ((L (symbol var 'L))\n        (R (symbol var 'R)))\n    (if (exp-rhs pattern)\n        ;; two arg case\n        '(let ((,L (exp-lhs ,var))\n               (,R (exp-rhs ,var)))\n           ,(compile-exp L (exp-lhs pattern)\n                         (delay\n                           (compile-exp R (exp-rhs pattern)\n                                        consequent))))\n        ;; one arg case\n        '(let ((,L (exp-lhs ,var)))\n           ,(compile-exp L (exp-lhs pattern) consequent)))))\n```\n\nThe remaining functions are simpler.\n`build-exp` generates code to build the right- hand side of a `rule, op?` tests if its first argument is an expression with a given operator, and `symbol` constructs a new symbol.\nAlso given is `new-symbol`, although it is not used in this program.\n\n```lisp\n(defun build-exp (exp bindings)\n  \"Compile code that will build the exp, given the bindings.\"\n  (cond ((assoc exp bindings) (rest (assoc exp bindings)))\n        ((variable-p exp)\n         (error \"Variable ~ a occurred on right-hand side,~\n                but not left.\" exp))\n        ((atom exp) \",exp)\n        (t (let ((new-exp (mapcar #'(lambda (x)\n                                     (build-exp x bindings))\n                                   exp)))\n             '(simplify-exp (list .,new-exp))))))\n(defun op? (exp op)\n  \"Does the exp have the given op as its operator?\"\n  (and (exp-p exp) (eq (exp-op exp) op)))\n(defun symbol (&rest args)\n  \"Concatenate symbols or strings to form an interned symbol\"\n  (intern (format nil \"~{~a~}\" args)))\n(defun new-symbol (&rest args)\n  \"Concatenate symbols or strings to form an uninterned symbol\"\n  (make-symbol (format nil \"~{~a~}\" args)))\n```\n\nHere are some examples of the compiler:\n\n```lisp\n> (compile-rule '(= (log (^ e x)) x))\n(LAMBDA (X)\n  (IF (OP? X 'LOG)\n    (LET ((XL (EXP-LHS X)))\n      (IF (OP? XL '^\n          (LET ((XLL (EXP-LHS XL))\n                (XLR (EXP-RHS XL)))\n           (IF (EQL XLL 'E)\n                XLR))))))\n> (compile-rule (simp-rule '(n * (m * x) = (n * m) * x)))\n(LAMBDA (X)\n  (IF (OP? X '*)\n    (LET ((XL (EXP-LHS X))\n          (XR (EXP-RHS X)))\n      (IF (NUMBERP XL)\n          (IF (OP? XR '*)\n            (LET ((XRL (EXP-LHS XR))\n                  (XRR (EXP-RHS XR)))\n              (IF (NUMBERP XRL)\n                (SIMPLIFY-EXP\n                  (LIST '*\n                        (SIMPLIFY-EXP (LIST '* XL XRL))\n                        XRR)))))))))\n```\n\n#### The Rule-Set Compiler\n\nThe next step is to combine the code generated by this single-rule compiler to generate more compact code for sets of rules.\nWe'll divide up the complete set of rules into subsets based on the main operator (as we did with the `rules-for` function), and generate one big function for each operator.\nWe need to preserve the order of the rules, so only certain optimizations are possible, but if we make the assumption that no function has side effects (a safe assumption in this application), we can still do pretty well.\nWe'll use the `simp-fn` facility to install the one big function for each operator.\n\nThe function `compile-rule-set` takes an operator, finds all the rules for that operator, and compiles each rule individually.\n(It uses `compile-indexed-rule` rather than `compile-rule`, because it assumes we have already done the indexing for the main operator.)\nAfter each rule has been compiled, they are combined with `combine-rules`, which merges similar parts of rules and concatenates the different parts.\nThe result is wrapped in a `lambda` expression and compiled as the final simplification function for the operator.\n\n```lisp\n(defun compile-rule-set (op)\n  \"Compile all rules indexed under a given main op,\n  and make them into the simp-fn for that op.\"\n  (set-simp-fn op\n    (compile nil\n      '(lambda (x)\n        ,(reduce #'combine-rules\n                 (mapcar #'compile-indexed-rule\n                        (rules-for op)))))))\n(defun compile-indexed-rule (rule) .\n  \"Compile one rule into lambda-less code,\n  assuming indexing of main op.\"\n  (let ((*bindings* nil))\n    (compile-args\n      'x (exp-lhs rule)\n      (delay (build-exp (exp-rhs rule) *bindings*)))))\n```\n\nHere are two examples of what `compile-indexed-rule` generates:\n\n```lisp\n> (compile-indexed-rule '(= (log 1) 0))\n (LET ((XL (EXP-LHS X)))\n  (IF (EQL XL '1)\n      '0))\n> (compile-indexed-rule '(= (log (^ e x)) x))\n (LET ((XL (EXP-LHS X)))\n  (IF (OP? XL '^)\n      (LET ((XLL (EXP-LHS XL))\n            (XLR (EXP-RHS XL)))\n        (IF (EQL XLL 'E)\n             XLR))))\n```\n\nThe next step is to combine several of these rules into one.\nThe function `combine-rules` takes two rules and merges them together as much as possible.\n\n```lisp\n(defun combine-rules (a b)\n  \"Combine the code for two rules into one, maintaining order.\"\n  ;; In the default case, we generate the code (or a b),\n  ;; but we try to be cleverer and share common code,\n  ;; on the assumption that there are no side-effects.\n  (cond ((and (listp a) (listp b)\n              (= (length a) (length b) 3)\n              (equal (first a) (first b))\n              (equal (second a) (second b)))\n        ;; a = (f x y), b = (f x z) => (f x (combine-rules y z))\n        ;; This can apply when f=IF or f=LET\n        (list (first a) (second a)\n              (combine-rules (third a) (third b))))\n       ((matching-ifs a b)\n        (if ,(second a)\n            ,(combine-rules (third a) (third b))\n            ,(combine-rules (fourth a) (fourth b))))\n       ((starts-with a 'or)\n        ;;  a = (or ... (if p y)), b = (if p z) =>\n        ;;       (or ... (if p (combine-rules y z)))\n        ;; else\n        ;;  a = (or ...) b = > (or ... b)\n        (if (matching-ifs (lastl a) b)\n            (append (butlast a)\n                    (list (combine-rules (lastl a) b)))\n            (append a (list b))))\n        (t ; ; a. b = > (or a b)\n          '(or ,a ,b))))\n(defun matching-ifs (a b)\n  \"Are a and b if statements with the same predicate?\"\n  (and (starts-with a 'if) (starts-with b 'if)\n       (equal (second a) (second b))))\n(defun lastl (list)\n  \"Return the last element (not last cons cell) of list\"\n  (first (last list)))\n```\n\nHere is what `combine-rules` does with the two rules generated above:\n\n```lisp\n> (combine-rules\n    '(let ((xl (exp-lhs x))) (if (eql xl '1) '0))\n    '(let ((xl (exp-lhs x)))\n       (if (op? xl '^)\n           (let ((xl1 (exp-lhs xl))\n                (xlr (exp-rhs xl)))\n             (if (eql xll 'e) xlr)))))\n(LET ((XL (EXP-LHS X)))\n  (OR (IF (EQL XL '1) '0)\n      (IF (OP? XL '^)\n          (LET ((XLL (EXP-LHS XL))\n                (XLR (EXP-RHS XL)))\n            (IF (EQL XLL 'E) XLR)))))\n```\n\nNow we run the compiler by calling `compile-all-rules-indexed` and show the combined compiled simplification function for log.\nThe comments were entered by hand to show what simplification rules are compiled where.\n\n```lisp\n(defun compile-all-rules-indexed (rules)\n  \"Compile a separate fn for each operator, and store it\n  as the simp-fn of the operator.\"\n  (index-rules rules)\n  (let ((all-ops (delete-duplicates (mapcar #'main-op rules))))\n    (mapc #'compile-rule-set ail-ops)))\n> (compile-all-rules-indexed *simplification-rules*)\n(SIN COS LOG ^ * / - + D)\n> (simp-fn 'log)\n(LAMBDA (X)\n  (LET ((XL (EXP-LHS X)))\n    (OR (IF (EQL XL '1)\n            '0)                    ;*log 1 = 0*\n        (IF (EQL XL '0)\n            'UNDEFINED)            ;*log 0 = undefined*\n        (IF (EQL XL 'E)\n            '1)                    ;*log e = 1*\n        (IF (OP? XL '^)\n            (LET ((XLL (EXP-LHS XL))\n                  (XLR (EXP-RHS XL)))\n             (IF (EQL XLL 'E)\n                  XLR))))))       ;*log ex = x*\n```\n\nIf we want to bypass the rule-based simplifier altogether, we can change `simplify-exp` once again to eliminate the check for rules:\n\n```lisp\n(defun simplify-exp (exp)\n  \"Simplify by doing arithmetic, or by using the simp function\n  supplied for this operator. Do not use rules of any kind.\"\n  (cond ((simplify-by-fn exp))\n        ((evaluable exp) (eval exp))\n        (t exp)))\n```\n\nAt last, we are in a position to run the benchmark test on the new compiled code; the function `test-it` runs in about .15 seconds with memoization and .05 without.\nWhy would memoization, which helped before, now hurt us?\nProbably because there is a lot of overhead in accessing the hash table, and that overhead is only worth it when there is a lot of other computation to do.\n\nWe've seen a great improvement since the original code, as the following table summarizes.\nOverall, the various efficiency improvements have resulted in a 130-fold speed-up-we can do now in a minute what used to take two hours.\nOf course, one must keep in mind that the statistics are only good for this one particular set of test data on this one machine.\nIt is an open question what performance you will get on other problems and on other machines.\n\nThe following table summarizes the execution time and number of function calls on the test data:\n\n| []()            |          |       |              |             |      |\n|-----------------|----------|-------|--------------|-------------|------|\n|                 | original | memo  | memo + index | memo + comp | comp |\n| run time (secs) | 6.6      | 3.0   | .98          | .15         | .05  |\n| speed-up        | -        | 2     | 7            | 44          | 130  |\n| calls           |\n| pat-match       | 51690    | 20003 | 5159         | 0           | 0    |\n| variable-p      | 37908    | 14694 | 4798         | 0           | 0    |\n| match-variable  | 1393     | 551   | 551          | 0           | 0    |\n| simplify        | 906      | 408   | 408          | 545         | 906  |\n| simplify-exp    | 274      | 118   | 118          | 118         | 274  |\n\n## 9.7 History and References\n\nThe idea of memoization was introduced by Donald Michie 1968.\nHe proposed using a list of values rather than a hash table, so the savings was not as great.\nIn mathematics, the field of dynamic programming is really just the study of how to compute values in the proper order so that partial results will already be cached away when needed.\n\nA large part of academic computer science covers compilation; [Aho and Ullman 1972](bibliography.md#bb0015) is just one example.\nThe technique of compiling embedded languages (such as the language of pattern-matching rules) is one that has achieved much more attention in the Lisp community than in the rest of computer science.\nSee [Emanuelson and Haraldsson 1980](bibliography.md#bb0365), for an example.\n\nChoosing the right data structure, indexing it properly, and defining algorithms to operate on it is another important branch of computer science; [Sedgewick 1988](bibliography.md#bb1065) is one example, but there are many worthy texts.\n\nDelaying computation by packaging it up in a `lambda` expression is an idea that goes back to Algol's use of *thunks*-a mechanism to implement call-by-name parameters, essentially by passing functions of no arguments.\nThe name *thunk* comes from the fact that these functions can be compiled: the system does not have to think about them at run time, because the compiler has already thunk about them.\nPeter [Ingerman 1961](bibliography.md#bb0570) describes thunks in detail.\n[Abelson and Sussman 1985](bibliography.md#bb0010) cover delays nicely.\nThe idea of eliminating unneeded computation is so attractive that entire languages have built around the concept of *lazy evaluation*-don't evaluate an expression until its value is needed.\nSee [Hughes 1985](bibliography.md#bb0565) or [Field and Harrison 1988](bibliography.md#bb0400).\n\n## 9.8 Exercises\n\n**Exercise 9.3 [d]** In this chapter we presented a compiler for `simplify`.\nIt is not too much harder to extend this compiler to handle the full power of `pat-match`.\nInstead of looking at expressions only, allow trees with variables in any position.\nExtend and generalize the definitions of `compile-rule` and `compile-rule-set` so that they can be used as a general tool for any application program that uses `pat-match` and/or `rule-based-translator`.\nMake sure that the compiler is data-driven, so that the programmer who adds a new kind of pattern to `pat-match` can also instruct the compiler how to deal with it.\nOne hard part will be accounting for segment variables.\nIt is worth spending a considerable amount of effort at compile time to make this efficient at run time.\n\n**Exercise 9.4 [m]** Define the time to compute `(fib n)` without memoization as *T<sub>n</sub>*.\nWrite a formula to express *T<sub>n</sub>*.\nGiven that *T*<sub>25</sub> &asymp; 1.1 seconds, predict *T*<sub>100</sub>.\n\n**Exercise 9.5 [m]** Consider a version of the game of Nim played as follows: there is a pile of *n* tokens.\nTwo players alternate removing tokens from the pile; on each turn a player must take either one, two, or three tokens.\nWhoever takes the last token wins.\nWrite a program that, given *n*, returns the number of tokens to take to insure a win, if possible.\nAnalyze the execution times for your program, with and without memoization.\n\n**Exercise 9.6 [m]** A more complicated Nim-like game is known as Grundy's game.\nThe game starts with a single pile of *n* tokens.\nEach player must choose one pile and split it into two uneven piles.\nThe first player to be unable to move loses.\nWrite a program to play Grundy's game, and see how memoization helps.\n\n**Exercise 9.7 [h]** This exercise describes a more challenging one-person game.\nIn this game the player rolls a six-sided die eight times.\nThe player forms four two-digit decimal numbers such that the total of the four numbers is as high as possible, but not higher than 170.\nA total of 171 or more gets scored as zero.\n\nThe game would be deterministic and completely boring if not for the requirement that after each roll the player must immediately place the digit in either the ones or tens column of one of the four numbers.\n\nHere is a sample game.\nThe player first rolls a 3 and places it in the ones column of the first number, then rolls a 4 and places it in the tens column, and so on.\nOn the last roll the player rolls a 6 and ends up with a total of 180.\nSince this is over the limit of 170, the player's final score is 0.\n\n| []()     |    |    |    |    |    |    |     |    |\n|----------|----|----|----|----|----|----|-----|----|\n| roll     | 3  | 4  | 6  | 6  | 3  | 5  | 3   | 6  |\n| lst num. | -3 | 43 | 43 | 43 | 43 | 43 | 43  | 43 |\n| 2nd num. | -  | -  | -6 | -6 | 36 | 36 | 36  | 36 |\n| 3rd num. | -  | -  | -  | -6 | -6 | -6 | 36  | 36 |\n| 4th num. | -  | -  | -  | -  | -  | -5 | -5  | 65 |\n| total    | 03 | 43 | 49 | 55 | 85 | 90 | 120 | 0  |\n\nWrite a function that allows you to play a game or a series of games.\nThe function should take as argument a function representing a strategy for playing the game.\n\n**Exercise 9.8 [h]** Define a good strategy for the dice game described above.\n(Hint: my strategy scores an average of 143.7.)\n\n**Exercise 9.9 [m]** One problem with playing games involving random numbers is the possibility that a player can cheat by figuring out what `random` is going to do next.\nRead the definition of the function `random` and describe how a player could cheat.\nThen describe a countermeasure.\n\n**Exercise 9.10 [m]** On [page 292](chapter9.md#p292) we saw the use of the read-time conditionals, `#+` and `#-`, where `#+` is the read-time equivalent of when, and `#-` is the read-time equivalent of unless.\nUnfortunately, there is no read-time equivalent of case.\nImplement one.\n\n**Exercise 9.11 [h]** Write a compiler for ELIZA that compiles all the rules at once into a single function.\nHow much more efficient is the compiled version?\n\n**Exercise 9.12 [d]** Write some rules to simplify Lisp code.\nSome of the algebraic simplification rules will still be valid, but new ones will be needed to simplify nonalgebraic functions and special forms.\n(Since `nil` is a valid expression in this domain, you will have to deal with the semipredicate problem.) Here are some example rules (using prefix notation):\n\n```lisp\n(= (+ x 0) x)\n(= 'nil nil) (\n(= (car (cons x y)) x)\n(= (cdr (cons x y)) y)\n(= (if t x y) x)\n(= (if nil x y) y)\n(= (length nil) 0)\n(= (expt y (?if x numberp)) (expt (expt y (/ x 2)) 2))\n```\n\n**Exercise 9.13 [m]** Consider the following two versions of the sieve of Eratosthenes algorithm.\nThe second explicitly binds a local variable.\nIs this worth it?\n\n```lisp\n(defun sieve (pipe)\n  (make-pipe (head pipe)\n             (filter #'(lambda (x)(/= (mod x (headpipe)) 0))\n                    (sieve (tail pipe)))))\n(defun sieve (pipe)\n  (let ((first-num (head pipe)))\n    (make-pipe first-num\n               (filter #'(lambda (x) (/= (mod x first-num) 0))\n                      (sieve (tail pipe))))))\n```\n\n## 9.9 Answers\n\n**Answer 9.4** Let *F<sub>n</sub>* denote (`fib n`).\nThen the time to compute *F<sub>n</sub>*, *T<sub>n</sub>*, is a small constant for *n* &le; 1, and is roughly equal to *T<sub>n-1</sub>* plus *T<sub>n-2</sub>* for larger *n*.\nThus, *T<sub>n</sub>* is roughly proportional to *F<sub>n</sub>*:\n\n<img src=\"images/chapter9/si1_e.svg\"\nonerror=\"this.src='images/chapter9/si1_e.png'; this.onerror=null;\"\nalt=\"T_{n}=F_{n}\\frac{T_{i}}{F_{i}}\" />\n\nWe could use some small value of *T<sub>i</sub>* to calculate *T*<sub>100</sub> if we knew *F*<sub>100</sub>.\nFortunately, we can use the equation:\n\n<img src=\"images/chapter9/si2_e.svg\"\nonerror=\"this.src='images/chapter9/si2_e.png'; this.onerror=null;\"\nalt=\"F_{n} \\alpha \\phi^{n}\" />\n\nWhere &phi; = (1 + &radic;(5))/2 &asymp; 1.618.\nThis equation was derived by de Moivre in 1718 (see Knuth, Donald E.\n*Fundamental Algorithms*, pp.\n78-83), but the number *&phi;* has a long interesting history.\nEuclid called it the \"extreme and mean ratio,\" because the ratio of *A* to *B* is the ratio of *A* + *B* to *A* if *A*/*B* is *&phi;*.\nIn the Renaissance it was called the \"divine proportion,\" and in the last century it has been known as the \"golden ratio,\" because a rectangle with sides in this ratio can be divided into two smaller rectangles that both have the same ratio between sides.\nIt is said to be a pleasing proportion when employed in paintings and architecture.\nPutting history aside, given *T*<sub>25</sub> &asymp; 1.1 *sec* we can now calculate:\n\n<img src=\"images/chapter9/si3_e.svg\"\nonerror=\"this.src='images/chapter9/si3_e.png'; this.onerror=null;\"\nalt=\"T_{100} \\approx \\phi^{100}\\frac{1.1 \\text{sec}}{\\phi^{25}} \\approx 5 \\times 10^{15} \\text{sec}\" />\n\nwhich is roughly 150 million years.\nWe can also see that the timing data in the table fits the equation fairly well.\nHowever, we would expect some additional time for larger numbers because it takes longer to add and garbage collect bignums than fixnums.\n\n**Answer 9.5** First we'll define the notion of a forced win.\nThis occurs either when there are three or fewer tokens left or when you can make a move that gives your opponent a possible loss.\nA possible loss is any position that is not a forced win.\nIf you play perfectly, then a possible loss for your opponent will in fact be a win for you, since there are no ties.\nSee the functions `win` and `loss` below.\nNow your strategy should be to win the game outright if there are three or fewer tokens, or otherwise to choose the largest number resulting in a possible loss for your opponent.\nIf there is no such move available to you, take only one, on the grounds that your opponent is more likely to make a mistake with a larger pile to contend with.\nThis strategy is embodied in the function `nim` below.\n\n```lisp\n(defun win (n)\n  \"Is a pile of n tokens a win for the player to move?\"\n  (or (<= n 3)\n      (loss (- n 1))\n      (loss (- n 2))\n      (loss (- n 3))))\n(defun loss (n) (not (win n)))\n(defun nim (n)\n  \"Play Nim: a player must take 1-3; taking the last one wins.\n  (con ((<= n 3) n); an immediate win\n      ((loss (- n 3)) 3); an eventual win\n      ((loss (- n 2)) 2); an eventual win\n      ((loss (- n 1)) 1); an eventual win\n      (t 1))); a loss; the 1 is arbitrary\n(memoize 'loss)\n```\n\nFrom this we are able to produce a table of execution times (in seconds), with and without memoization.\nOnly `loss` need be memoized.\n(Why?) Do you have a good explanation of the times for the unmemoized version?\nWhat happens if you change the order of the loss clauses in `win` and/or `nim?`\n\n**Answer 9.6** We start by defining a function, `moves`, which generates all possible moves from a given position.\nThis is done by considering each pile of *n* tokens within a set of piles *s*.\nAny pile bigger than two tokens can be split.\nWe take care to eliminate duplicate positions by sorting each set of piles, and then removing the duplicates.\n\n```lisp\n(defun moves (s)\n  \"Return a list of all possible moves in Grundy's game\"\n  ;; S is a list of integers giving the sizes of the piles\n  (remove-duplicates\n    (loop for n in s append (make-moves n s))\n    :test #'equal))\n(defun make-moves (n s)\n  (when (> = n 2)\n    (let ((s/n (remove n s :count 1)))\n      (loop for i from 1 to (- (ceiling n 2) 1)\n            collect (sort* (list* i (- ni) s/n)\n                           #'>>))))\n(defun sort* (seq pred &key key)\n  \"Sort without altering the sequence\"\n  (sort (copy-seq seq) pred :key key))\n```\n\nThis time a loss is defined as a position from which you have no moves, or one from which your opponent can force a win no matter what you do.\nA winning position is one that is not a loss, and the strategy is to pick a move that is a loss for your opponent, or if you can't, just to play anything (here we arbitrarily pick the first move generated).\n\n```lisp\n(defun loss (s)\n  (let ((choices (moves s)))\n    (or (null choices)\n        (every #'win choices))))\n(defun win (s) (not (loss s)))\n(defun grundy (s)\n  (let ((choices (moves s)))\n    (or (find-if #'loss choices)\n        (first choices))))\n```\n\n**Answer 9.7** The answer assumes that a strategy function takes four arguments: the current die roll, the score so far, the number of remaining positions in the tens column, and the number of remaining positions in the ones column.\nThe strategy function should return 1 or 10.\n\n```lisp\n(defun play-games (&optional (n-games 10) (player 'make-move))\n  \"A driver for a simple dice game. In this game the player\n  rolls a six-sided die eight times. The player forms four\n  two-digit decimal numbers such that the total of the four\n  numbers is as high as possible, but not higher than 170.\n  A total of 171 or more gets scored as zero. After each die\n  is rolled, the player must decide where to put it.\n  This function returns the player's average score.\"\n  (/ (loop repeat n-games summing (play-game player 0 4 4))\n     (float n-games)))\n(defun play-game (player &optional (total 0) (tens 4) (ones 4))\n  (cond ((or (> total 170) (< tens 0) (< ones 0)) 0)\n        ((and (= tens 0) (= ones 0)) total)\n        (t (let ((die (roll-die)))\n            (case (funcall player die total tens ones)\n             (1 (play-game player (+ total die)\n                           tens (- ones 1)))\n             (10 (play-game player (+ total (* 10 die))\n                           (- tens 1) ones))\n             (t 0))))))\n(defun roll-die () (+ 1 (random 6)))\n```\n\nSo, the expression `(play-games 5 #'make-move)` would play five games with a strategy called `make-move`.\nThis returns only the average score of the games; if you want to see each move as it is played, use this function:\n\n```lisp\n(defun show (player)\n  \"Return a player that prints out each move it makes.\"\n  #'(lambda (die total tens ones)\n      (when (= total 0) (fresh-line))\n      (let ((move (funcall player die total tens ones)))\n        (incf total (* die move))\n        (format t \"~2d-> ~ 3d | ~ @[*~]\" (* move die) total (> total 170))\n         move)))\n```\n\nand call `(play-games 5 (show #'make-moves))`.\n\n**Answer 9.9** The expression `(random 6 (make-random-state))` returns the next number that `roll-die` will return.\nTo guard against this, we can make `roll-die` use a random state that is not accessible through a global variable:\n\n```lisp\n(let ((state (make-random-state t)))\n  (defun roll-die () (+ 1 (random 6 state))))\n```\n\n**Answer 9.10** Because this has to do with read-time evaluation, it must be implemented as a macro or read macro.\nHere's one way to do it:\n\n```lisp\n  (defmacro read-time-case (first-case &rest other-cases)\n    \"Do the first case, where normally cases are\n    specified with #+ or possibly #- marks.\"\n    (declare (ignore other-cases))\n    first-case)\n```\n\nA fanciful example, resurrecting a number of obsolete Lisps, follows:\n\n```lisp\n(defun get-fast-time ()\n    (read-time-case\n```\n\n| []()             |                              |\n|------------------|------------------------------|\n| `#+Explorer`     | `(time :microsecond-time)`   |\n| `#+Franz`        | `(sys:time)`                 |\n| `#+(or PSL UCI)` | `(time)`                     |\n| `#+YKT`          | `(currenttime)`              |\n| `#+MTS`          | `(status 39)`                |\n| `#+Interlisp`    | `(clock 1)`                  |\n| `#+Lispl.5`      | `(tempus-fugit)`             |\n| `;; otherwise`   |                              |\n|                  | `(get-internal-real-time)))` |\n\n**Answer 9.13** Yes.\nComputing (`head pipe`) may be a trivial computation, but it will be done many times.\nBinding the local variable makes sure that it is only done once.\nIn general, things that you expect to be done multiple times should be moved out of delayed functions, while things that may not be done at all should be moved inside a delay.\n\n----------------------\n\n<a id=\"fn09-1\"></a><sup>[1](#tfn09-1)</sup>\nOne could say that the FORTRAN compiler was \"broken.\" This underscores the problem of defining the efficiency of a language-do we judge by the most popular compiler, by the best compiler available, or by the best compiler imaginable?\n\n<a id=\"fn09-2\"></a><sup>[2](#tfn09-2)</sup>\nIn KCL, the symbol `lambda-closure` is used, and in Allegro, it is `excl:.\nlexical-closure`\n\n<a id=\"fn09-3\"></a><sup>[3](#tfn09-3)</sup>\nThe terms *metering* and *monitoring* are sometimes used instead of profiling.\n\n"
  },
  {
    "path": "docs/code.md",
    "content": "## Code highlighting\n\n\nHere I'm testing the code highlighing functionality\n\n```lisp\n;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File gps.lisp: Final version of GPS\n\n(requires \"gps1\")\n\n;;; ==============================\n\n(defun executing-p (x)\n  \"Is x of the form: (executing ...) ?\"\n  (starts-with x 'executing))\n\n(defun starts-with (list x)\n  \"Is this a list whose first element is x?\"\n  (and (consp list) (eql (first list) x)))\n\n(defun convert-op (op)\n  \"Make op conform to the (EXECUTING op) convention.\"\n  (unless (some #'executing-p (op-add-list op))\n    (push (list 'executing (op-action op)) (op-add-list op)))\n  op)\n\n(defun op (action &key preconds add-list del-list)\n  \"Make a new operator that obeys the (EXECUTING op) convention.\"\n  (convert-op\n    (make-op :action action :preconds preconds\n             :add-list add-list :del-list del-list)))\n\n;;; ==============================\n\n(mapc #'convert-op *school-ops*)\n\n;;; ==============================\n\n(defvar *ops* nil \"A list of available operators.\")\n\n(defstruct op \"An operation\"\n  (action nil) (preconds nil) (add-list nil) (del-list nil))\n\n(defun GPS (state goals &optional (*ops* *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (remove-if #'atom (achieve-all (cons '(start) state) goals nil)))\n\n;;; ==============================\n\n(defun achieve-all (state goals goal-stack)\n  \"Achieve each goal, and make sure they still hold at the end.\"\n  (let ((current-state state))\n    (if (and (every #'(lambda (g)\n                        (setf current-state\n                              (achieve current-state g goal-stack)))\n                    goals)\n             (subsetp goals current-state :test #'equal))\n        current-state)))\n\n(defun achieve (state goal goal-stack)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Goal: ~a\" goal)\n  (cond ((member-equal goal state) state)\n        ((member-equal goal goal-stack) nil)\n        (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n                 (find-all goal *ops* :test #'appropriate-p)))))\n\n;;; ==============================\n\n(defun member-equal (item list)\n  (member item list :test #'equal))\n\n;;; ==============================\n\n(defun apply-op (state goal op goal-stack)\n  \"Return a new, transformed state if op is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Consider: ~a\" (op-action op))\n  (let ((state2 (achieve-all state (op-preconds op) \n                             (cons goal goal-stack))))\n    (unless (null state2)\n      ;; Return an updated state\n      (dbg-indent :gps (length goal-stack) \"Action: ~a\" (op-action op))\n      (append (remove-if #'(lambda (x) \n                             (member-equal x (op-del-list op)))\n                         state2)\n              (op-add-list op)))))\n\n(defun appropriate-p (goal op)\n  \"An op is appropriate to a goal if it is in its add list.\"\n  (member-equal goal (op-add-list op)))\n\n;;; ==============================\n\n(defun use (oplist)\n  \"Use oplist as the default list of operators.\"\n  ;; Return something useful, but not too verbose: \n  ;; the number of operators.\n  (length (setf *ops* oplist)))\n\n;;; ==============================\n\n(defparameter *banana-ops*\n  (list\n    (op 'climb-on-chair\n        :preconds '(chair-at-middle-room at-middle-room on-floor)\n        :add-list '(at-bananas on-chair)\n        :del-list '(at-middle-room on-floor))\n    (op 'push-chair-from-door-to-middle-room\n        :preconds '(chair-at-door at-door)\n        :add-list '(chair-at-middle-room at-middle-room)\n        :del-list '(chair-at-door at-door))\n    (op 'walk-from-door-to-middle-room\n        :preconds '(at-door on-floor)\n        :add-list '(at-middle-room)\n        :del-list '(at-door))\n    (op 'grasp-bananas\n        :preconds '(at-bananas empty-handed)\n        :add-list '(has-bananas)\n        :del-list '(empty-handed))\n    (op 'drop-ball\n        :preconds '(has-ball)\n        :add-list '(empty-handed)\n        :del-list '(has-ball))\n    (op 'eat-bananas\n        :preconds '(has-bananas)\n        :add-list '(empty-handed not-hungry)\n        :del-list '(has-bananas hungry))))\n\n;;; ==============================\n\n(defun make-maze-ops (pair)\n  \"Make maze ops in both directions\"\n  (list (make-maze-op (first pair) (second pair))\n        (make-maze-op (second pair) (first pair))))\n\n(defun make-maze-op (here there)\n  \"Make an operator to move between two places\"\n  (op `(move from ,here to ,there)\n      :preconds `((at ,here))\n      :add-list `((at ,there))\n      :del-list `((at ,here))))\n\n(defparameter *maze-ops*\n  (mappend #'make-maze-ops\n     '((1 2) (2 3) (3 4) (4 9) (9 14) (9 8) (8 7) (7 12) (12 13)\n       (12 11) (11 6) (11 16) (16 17) (17 22) (21 22) (22 23)\n       (23 18) (23 24) (24 19) (19 20) (20 15) (15 10) (10 5) (20 25))))\n\n;;; ==============================\n\n(defun GPS (state goals &optional (*ops* *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (find-all-if #'action-p\n               (achieve-all (cons '(start) state) goals nil)))\n\n(defun action-p (x)\n  \"Is x something that is (start) or (executing ...)?\"\n  (or (equal x '(start)) (executing-p x)))\n\n;;; ==============================\n\n(defun find-path (start end)\n  \"Search a maze for a path from start to end.\"\n  (let ((results (GPS `((at ,start)) `((at ,end)))))\n    (unless (null results)\n      (cons start (mapcar #'destination\n                          (remove '(start) results\n                                  :test #'equal))))))\n\n(defun destination (action)\n  \"Find the Y in (executing (move from X to Y))\"\n  (fifth (second action)))\n\n;;; ==============================\n\n(defun make-block-ops (blocks)\n  (let ((ops nil))\n    (dolist (a blocks)\n      (dolist (b blocks)\n        (unless (equal a b)\n          (dolist (c blocks)\n            (unless (or (equal c a) (equal c b))\n              (push (move-op a b c) ops)))\n          (push (move-op a 'table b) ops)\n          (push (move-op a b 'table) ops))))\n    ops))\n\n(defun move-op (a b c)\n  \"Make an operator to move A from B to C.\"\n  (op `(move ,a from ,b to ,c)\n      :preconds `((space on ,a) (space on ,c) (,a on ,b))\n      :add-list (move-ons a b c)\n      :del-list (move-ons a c b)))\n\n(defun move-ons (a b c)\n  (if (eq b 'table)\n      `((,a on ,c))\n      `((,a on ,c) (space on ,b))))\n\n\n;;; ==============================\n\n(defun achieve-all (state goals goal-stack)\n  \"Achieve each goal, trying several orderings.\"\n  (some #'(lambda (goals) (achieve-each state goals goal-stack))\n        (orderings goals)))\n\n(defun achieve-each (state goals goal-stack)\n  \"Achieve each goal, and make sure they still hold at the end.\"\n  (let ((current-state state))\n    (if (and (every #'(lambda (g)\n                        (setf current-state\n                              (achieve current-state g goal-stack)))\n                    goals)\n             (subsetp goals current-state :test #'equal))\n        current-state)))\n\n(defun orderings (l) \n  (if (> (length l) 1)\n      (list l (reverse l))\n      (list l)))\n\n;;; ==============================\n\n(defun achieve (state goal goal-stack)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Goal: ~a\" goal)\n  (cond ((member-equal goal state) state)\n        ((member-equal goal goal-stack) nil)\n        (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n                 (appropriate-ops goal state))))) ;***\n\n(defun appropriate-ops (goal state)\n  \"Return a list of appropriate operators, \n  sorted by the number of unfulfilled preconditions.\"\n  (sort (copy-list (find-all goal *ops* :test #'appropriate-p)) #'<\n        :key #'(lambda (op) \n                 (count-if #'(lambda (precond)\n                               (not (member-equal precond state)))\n                           (op-preconds op)))))\n\n;;; ==============================\n\n(defun permutations (bag)\n  \"Return a list of all the permutations of the input.\"\n  ;; If the input is nil, there is only one permutation:\n  ;; nil itself\n  (if (null bag)\n      '(())\n      ;; Otherwise, take an element, e, out of the bag.\n      ;; Generate all permutations of the remaining elements,\n      ;; And add e to the front of each of these.\n      ;; Do this for all possible e to generate all permutations.\n      (mapcan #'(lambda (e)\n                  (mapcar #'(lambda (p) (cons e p))\n                          (permutations\n                            (remove e bag :count 1 :test #'eq))))\n              bag)))\n\n;;; ==============================\n```\n"
  },
  {
    "path": "docs/css/github.css",
    "content": "/**\n * Inspired by github's default code highlighting\n */\npre { white-space: pre; background-color: #f8f8f8; border: 1px solid #ccc; font-size: 13px; line-height: 19px; overflow: auto; padding: 6px 10px; border-radius: 3px; }\npre code.hl-highlighted {white-space: pre; margin: 0; padding: 0; background: none; border: none; overflow-x: auto; font-size: 13px;}\ncode.hl-highlighted {margin: 0 2px; padding: 0 5px; white-space: nowrap; font-family: Consolas, \"Liberation Mono\", Courier, monospace; background: #f8f8f8; border: 1px solid #eaeaea; border-radius: 3px;}\n\ncode.hl-highlighted {color: #008080;}\ncode.hl-highlighted .function {color: #008080;}\ncode.hl-highlighted .function.known {color: #800603;}\ncode.hl-highlighted .function.known.special {color: #2d2d2d; font-weight: bold;}\ncode.hl-highlighted .keyword {color: #990073;}\ncode.hl-highlighted .keyword.known {color: #990073;}\ncode.hl-highlighted .symbol {color: #75a;}\ncode.hl-highlighted .lambda-list {color: #966;}\ncode.hl-highlighted .number {color: #800;}\ncode.hl-highlighted .variable.known {color: #c3c;}\ncode.hl-highlighted .variable.global {color: #939;}\ncode.hl-highlighted .variable.constant {color: #229;}\ncode.hl-highlighted .nil {color: #f00;}\ncode.hl-highlighted .list {color: #222;}\n\ncode.hl-highlighted .string, code.hl-highlighted .string * {color: #d14 !important;}\ncode.hl-highlighted .comment,\ncode.hl-highlighted .comment *,\ncode.hl-highlighted .comment .string\ncode.hl-highlighted .comment .string * {color: #777777 !important;}\ncode.hl-highlighted .string .comment {color: #d14 !important;}\n\ncode.hl-highlighted .list.active {display: inline-block; background: #aefff7;}\n\n"
  },
  {
    "path": "docs/frontmatter.md",
    "content": "\n\n# Paradigms of Artificial Intelligence Programming\n## CASE STUDIES IN COMMON LISP\n## *Peter Norvig*\n\n<span align=\"center\">MORGAN KAUFMANN PUBLISHERS ⬦ SAN FRANCISCO, CALIFORNIA</span>\n\nSponsoring Editor *Michael B. Morgan* \\\nProduction Manager *Yonie Overton* \\\nCover Designer *Sandra Popovich* \\\nText Design/Composition *SuperScript Typography* \\\nCopyeditor *Barbara Beidler Kendrick* \\\nProofreaders *Lynn Meinhardt, Shanlyn Hovind, Gary Morris* \\\nPrinter *Malloy Lithographing*\n\nMorgan Kaufmann Publishers, Inc. \\\n*Editorial and Sales Office:* \\\n340 Pine Street, Sixth Floor \\\nSan Francisco, CA 94104-3205 \\\nUSA \\\nTelephone 415/392-2665 \\\nFacsimile 415/982-2665 \\\nInternet mkp@mkp.com \\\nWeb site http://mkp.com\n\n© 1992 Morgan Kaufmann Publishers, Inc. \\\nAll rights reserved\n\nPrinted in the United States of America\n\n03 02 01 8 7 6 \\\nNo part of this publication may be reproduced, stored in a retrieval system, or transmitted in any form or by any means-electronic, photocopying, recording, or otherwise—without the prior written permission of the publisher.\n\nLibrary of Congress Cataloging-in-Publication Data\n\nNorvig, Peter. \\\nParadigms of artificial intelligence programming: case studies in common Lisp / Peter Norvig.\n\np. cm. \\\nIncludes bibliographical references and index. \\\nISBN 1-55860-191-0: \\\n1\\. Electronic digital computers-Programming. 2. COMMON LISP\n(Computer program language) 3. Artificial intelligence. I. Title. \\\nQA76.6.N6871991 \\\n006.3-dc20 91-39187 \\\nCIP\n\n*To my family...*\n\n"
  },
  {
    "path": "docs/images/chapter14/diagram-14-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T08:46:41.027Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"ad7y3_2--HlLkMJdQWqe\" version=\"16.5.2\" type=\"device\"><diagram id=\"RnjeL9D_0V7jKk0gnuU0\" name=\"Page-1\">7ZdLb5wwFIV/DctKPDLT6TIw01SquoimapWlgx2wYnyJx1OY/vpex2bAAdRm0Q6KukHm8+Pa55gjESRZ1d4oUpdfgDIRxCFtg2QbxPFq8x6fBpwciNYWFIpTi6Ie7PlP5mDo6JFTdvAGagChee3DHKRkufYYUQoaf9gDCL9qTQo2AvuciDH9zqkuLY1XYc8/MV6UrnLHK9INdeBQEgrNACW7IMkUgLatqs2YMMp1qth5H2d6z9tSTOo/mUDvyLW83V3Rx8/3356A3d59Td6t7Co/iDi647rN6lN3/kLBsXbDmNKsnVKd3HfDw/G+ovNp8Y4wqJhWJxzS+j6f/Nem13rtUDmQuatDnLvFed1eAmw4FV6hSPR7RVAQSZlZJAyStCm5Zvua5Ka3wU8AWakrLLqNsPkAUrtLHaEK6aySQ8XmvRrLeCmh4gmh1gKrphwbhX4+qwVGA/PpWY2QPh3NrU9viCIVSNqTbua2m4pbs7P9FREPqrzwB5XVvgkHreCRZSBAIZEgmdkVF+IFIoIXEl9zdIIhT41PHLPg2nVUnFJTZtJ1/168WeOjKef/cWhsFhYayWJTw7q1oNtzNZsbr4+JUeLspgNiJkveeG4szvrN5YMjWi0sOT4sNzk2y7o+3cJ/Jzmy/8lxCevxtf8Feu4b/EUmu18=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter14/fig-14-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-25T06:00:27.213Z\" agent=\"5.0 (Macintosh)\" etag=\"_r8HvNJs5grNyQO9Y-UF\" version=\"17.2.1\" type=\"device\"><diagram id=\"U145w6UBikSHUpAzq8nc\" name=\"Page-1\">7Vxbb6M4FP41kaYPrbjm8pik7Xa1XamjSjsz+7KiwUnYJXGGOA2ZX78GbIiNAZMScJW8tPjgC5zznZuPSc+crsLfAmez/BO6wO8Zmhv2zPueYdiGjv9GhENCMEdmQlgEnpuQ9Izw6v0ChKgR6s5zwZbpiCD0kbdhiTO4XoMZYmhOEMA9220OfXbVjbMAOcLrzPHz1G+ei5bktWwtoz8Bb7EkK9saubFyaF9C2C4dF+6PSOZDz5wGEKLkahVOgR+xjrIlGfdYcDd9rgCskcyAyfb3x+f9/bfnp/nX6fMv/8UCs1sii3fH35H3JQ+LDpQBiwDuNvnFyPrvIEAgFEnCeaMzZG+LQQLgCqDggPuFrKAPbHOfMXtISMsjPluE5hDxLtJ5MxbgC8KFGhzRqzmyX3oIvG6cWdTeY9T3zMkSrfAy9zq+dLabBIhzLwR4qckcrhEBtt7H7TwzS2XDczjPySNeWW3yyviEvApZnnTFOksBxTPV0jxbGTRZBSxWR/P6n5BXimjeoHvNM2y1NG+oDJoGBSxWR/NGn5BXimieIRFbgbU7jqJ23FrDNWA5h9Vy7UYsu9cEbMPcCg7fSde48YP0jBv3IdM60FbooXQQvv5xdJ0NiRp0RD3xbOEumIFq5UNOsABl8xHgAZfJV0oVwxZIl9IC4DvIe2ezHJHIyQov0MOvm5qsdB46JHlP0us4DaEDQ3Z9Oo/GzZPwITdPDLj0LT8Q3mvqmf9R1ymPOjlPKh51HYCuTtZTg1uKuABdgQ0HS1dM/SRywbYApf6eg65OmliDW4qoH+XVZURgVD5dh0yc8A9iIcsGUMOWA6ZBHiGYn6+kCQO0hAu4dvyHjMrBJOvzDOGGSPdfgNCBgMfZIcjiTIQJ7c4uRUWKPo1BXzKqBH/V2k9EXRnKE2WqDOVtSVxKA+5jFnXYiYQ7l1ZfUlpDtaQ16lIfMx2sttKZhDOhyviD5iQsm1rTBKg5EcdDsRt1DkcdNpGN3hY7CGPAeogBV9Cr1R1fJOs36g1oMVMygJj5znbrzWrFECdY/tMRQpM5RUKE3O5I/8Qggc9xdL3dqMEQ5Xl9HxGBM4Dp/9xBeuN2G0NhjDvoxibMbuKrBfkfz/JGCS+Ugp/zLdcr4Cm4V/IAlMyBFwfyiIXrFgXwPzCFPgyykHju+T5HcnxvscZNH8yjGaKkwJs5/piQV57rxrZYlJyUq0QhvOUTDw5Xw3weMhCg2jhbHmJ/Fid2LAujOGypcGkfMFCSLsyUNWTNJjFDQ8qs1PWEpnCH5ryeTVRSTWyG670Xmp9xmfnBNGas4rbGaMbW6APFjI2o4lst2clVslWSTdudibaTZEias5XWvfGNALE55eU2kgsG61ptXVzXKopRC57qrFaeusnG49IvOA7VotuTm3zwmd6clt3smY9FtydlY6ObXx7jHmXTx13uyDo313hYpBAVdiw9Mde4ITOL86UjP1MKsiLXVDzL9Kb+mGOQyo9isHf1oYwP1eSwx+8ENAc9UUFNLMoiMyQNiLKJeRMmnuwKmrgtabDOZ6+6qQo1UDNoJGCrTMdpzqFI0cAUnfDk8h1smsUZz2WomMmfhu/nVawvULGz5TZmN4WezlWMbslXb3mpVZijO2NHOlYU/1yoRgk2glrVKEt0zpGzghdtA9M8iJafjK4llk/XT055L1aIgkNnrcaKltmpI7vV7jSbPYBwZ/etCn8Wt15A4GEegKB5Jydb16E2S7GjCYapc7g4w2adJToYK7dLf6GqLkgL27XX+b0EZs/qMsViCr7va7VMYhXXNlOdmV4V6UhidteKlK9ZVhcR6PbchcpMshjZRJwze/861qx/nsLR/O1vY/nX4Wf/D3pUo+0whz+tjymPXvTk8ZRbHGGg/HG8mEy66ak8uCDjtNDGGjYRoOQjEKtARVs60WZdt9DqaqTVefqY/1ibK2RdqGAEKWGrgqG6e55jxPE5vUrTe+pOZ6E8qnM5S2hmOztsLD4/XvussWmw8+iSlrl2DmoJn7fweDzvMLQWzpfY9X7i4CzALgSoorg79ZcEcgEgXyJvCnc1P8v4IEz7zcJUGKp2siMnGYpWRbRFnxXpUna7kRDXNiUtfvJpd+OxsMVXVvhvSRtCfm6dNj4xsouPQl03K2Kp8L8e1XWl2s7v0wqqNBcqnBaLnkJTL4g/1PzSpiH30KCZb8t68ztSJ+9k4Gb2e7JJ9+w3ec2H/wE=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter14/si1_e.tex",
    "content": "(b_{0}=0) \\wedge (b_{1}=0) \\wedge (b_{2}=1) ... \\wedge (b_{n}=0)"
  },
  {
    "path": "docs/images/chapter14/si2_e.tex",
    "content": "\\sqrt{x} = y \\Rightarrow y \\times y = x"
  },
  {
    "path": "docs/images/chapter15/si1_e.tex",
    "content": "5 \\times x^{3} +b \\times x^{2} +c \\times x + 1"
  },
  {
    "path": "docs/images/chapter15/si2_e.tex",
    "content": "\\int ax^{2} + bx\\, dx = \\frac {ax^{3}}{3} + \\frac {bx^{2}}{2} + c."
  },
  {
    "path": "docs/images/chapter15/si3_e.tex",
    "content": "\\int_{a}^{b} y\\, dx"
  },
  {
    "path": "docs/images/chapter15/si4_e.tex",
    "content": "( a + b ) ^{n} = \\sum_{i=0}^{n} \\frac {n!}{i! (n-i)!)} a^{i} b^{n-i}"
  },
  {
    "path": "docs/images/chapter15/si5_e.tex",
    "content": "(a+b)^{3} = b^{3} + 3ab^{2} + 3a^{2}b + a^{3}"
  },
  {
    "path": "docs/images/chapter15/si7_e.tex",
    "content": "\\sin{(x)},\n\\cos{\\left (x - \\frac {\\pi}{2} \\right ) },\n\\frac {e^{ix} - e^{-ix}} {2i}"
  },
  {
    "path": "docs/images/chapter16/fig-16-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-26T02:25:53.661Z\" agent=\"5.0 (Macintosh)\" etag=\"vHTPlASUrTs7OEF9AyXM\" version=\"17.2.2\" type=\"device\"><diagram id=\"6C9LwMfbPLOwd58eGg--\" name=\"Page-1\">7Vlbk5owGP01PLYD4vXR+3Zmt91ZdrfdvqUQIW0gTIwK/fX9kCBgsNqZFanji5Pv5H7Od0hAzRz70Zyj0HtgDqZaS3cizZxorVbX6MNvAsQp0O61U8DlxEkhIwcs8htLUJfoijh4WWooGKOChGXQZkGAbVHCEOdsU262YLQ8a4hcrACWjaiKfiWO8OQudD3H7zBxPTlzqyMrfJS1lcDSQw7bFCBzqpljzphIS340xjShLqMl7Tc7ULtbF8eBOKXDHX110fPssc/8RXcazMMx/v5BarFGdCX3Kxcr4owAl7NVKJthLnBURTv6kTXX1XUZu91CkmDmY8FjaCIHynrI/DB6Mt7kbBsZ216BaVNiSArs7kbOSYCC5OEfODGPcwKUBA5OBtE1c7TxiMBWiOykdgMuAMwTPkw6MaB4kLsiR4fVUYm7GDOGwsyXp/nw8yfrIasqcAS7FWUiloKzX3jMKOOABCyAlqMFoXQPQpS4AYQ2sIMBHyXcEbDkUFb4xHGSaSqZL2tzPeR3Lm9Vo9s0r3Yb49VOw9KlV8FMlyaOdMgaim5S3Nl3VwlzFeqvztRNU6nfAFPre6bWVVMP6uRk0BhP949mS63EZFfiAjPjl/vnl6fpFR6/TeP+hFvh2W/K7eNOrflCeML7Q01eTQVq0KPdUC9smVtVkv53tzaP/RNOkbOfrHt+NSvs2q6VlKpL4YXsOjieMPVyo17FHpEg210MAbdiuiYICjOytD1w2tVZuGmK7D6cHUpOxoXHXBYges9YKEn/iYWI5WdEtBKsLAlQwONvSf+PnSx8k8Ntg0lUiuIsiogodIPoLRsRynmnJIhLUmBH+b649/yAHbIVt/EJySkQd/FfRdSrReSYQjKvyyt5f8XUa2iyfUuGMt1vIh4T8cBbak0iqmfCTUTlHey4iBfV0Lxp+A4a9s6jIYT53z7busJfZ+b0Dw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter16/si1_e.tex",
    "content": "\\begin{tabular}{ll}\nA+B$-$AB; & A,B $>$ 0 \\\\\nA+B+AB;   & A,B $<$ 0 \\\\\n$\\dfrac {A + B} {1 - \\textup{min}( \\lvert A \\rvert, \\lvert B \\rvert )}$; & otherwise \\\\\n\\end{tabular}\n"
  },
  {
    "path": "docs/images/chapter17/fig-17-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T09:02:00.240Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"yrwx6Hix5KTUjcVb1UjG\" version=\"16.5.2\" type=\"device\"><diagram id=\"_c-jluAhfx_kgPv7KN8i\" name=\"Page-1\">7Znfb5swEMf/mjxWApM06WNCk/ZlU6tomraXycIXsGYwcpxA9tfPDPPT7ZpkYiiSXyLua3OH73O2iZl4fpw/CZxGnzgBNkEOySfe4wSh2WKufgvhpAX3vhRCQUkpuY2wpb9Ai45WD5TAvtNRcs4kTbtiwJMEAtnRsBA863bbcdaNmuIQDGEbYGaqXymRUamqcTT6M9Aw0pHRXDfEuOqrB7KPMOFZS/LWE88XnMvyKs59YEXqqrSU923eaa2fS0Aiz7nhx8vda+J7ryfkfInELP/OP3+7016OmB30ePXDylOVAEjIssijshKeKHEVyZgpy1WXgh8SAkUER1k7nsgNjikrWD8DO4KkAdYNGq2rBr4qgwAxUt8Mxq1TpCoLeAxSnFSXrGEw04mNWumvNAEMS3rsuse6FMLaXR3hhVMVGDm6aqfaja7ZhdN1sOcHEYC+p53ynhsXdf1Me34kFiFIw4+6aI25kf4AvQAusnDPoVLbl+JFzt/LZGC8nsV7DZUbmbxTS3fQyfvBEj8w3Zmlew5dY9JduzTX9n/ie2/5Dsp3Oi7eucV7DZXbWJsXFu6gc/fDLXxgvg+W71Vb5o38LaoOjlp81wZgCbnsUt1LwX+CzxkXDfUdZawnYUbDRJmBogZKXx1BFMTZUjfElJAizCqLqIRtioMiZiZw+q+1U0SC/NLqqW5w+3hLs1Vc6I3i6s/Ndh11yF2MyTx6WllMqLc2zsemhAxKS0vp/S1sNE7mYdCT5dSfTe7D2JjMU51Hi8ncm6ZjczLPZ3zLyXizG313Mo9ZNhaTgWnAZU+ZzRfM8g2++QrsrX8D</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T09:07:41.606Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"lSc749RVqkKKeggf-Scj\" version=\"16.5.2\" type=\"device\"><diagram id=\"_c-jluAhfx_kgPv7KN8i\" name=\"Page-1\">7Vpbc+IgFP41PrqTq8ZHb21n9jLtut1u92WHJmiYxeAQvPXXL2mICSFatYnabl4cOMIhnO/7DpDQMPvT1TUFM/8r8SBuGJq3apiDhmHYTpv/Roa1MOit2DChyItNemoYoWcojJqwzpEHQ6khIwQzNJONLgkC6DLJBiglS7nZmGB51BmYQMUwcgFWrQ/IY35s5fNI7TcQTXwxstEWf0xB0lZMJPSBR5YZkzlsmH1KCItL01Uf4ih0SVjifldb/t08F4UB26fDn9vmXdA379aGdu9Te/WbfHtsCi8LgOdivuJh2ToJAAy8bhRHXgtIwI09n00xr+m8SMk88GA0gsZrYxKwKzBFOML6BuIFZMgF4g8Brc4n3lOfXTwI9CQ0xEyuIZlCRte8wTLFwBaB9TPhT2wUYsDQQsYQCCpMNu42I9wSxJ/E0ARrLeFGcNbRZAchmVMXij7ZkOfc6Ibsx8r5YYBOIFP88EJmzqnpBdADwDVqcPdBZVM/FF5D202T8uAd/bgNfj7grjv04Hdi3HvPn5+brQJ4eyrCPOhfwBNPyhK2AKNJwMsuBwlSblhAGuGJu+KPKfK8yEePwhA9g6cXfxEPZtF8XmZo9xr2oBDwnXTkA8GVhJ3I3WIQKT9K/BC9mtonrf02KgjEOnIHMh6HsBIpmrUUj1HQO0m0Vo1upYn2leW44jxrv7M8m7CxlDyr6ZYU+ySLvzHxNp1TZd4i9GptKtpUUuaxm6BN/UTqdBR8mxeszYSNb9ZmtAVyWqVoUc/1qE6LRTvWWovladE6rxQ770qKCRnLkKJlmfIqqZejTONUymzXyjxGUBe3gS0EV10ia3DLTLuvnnMqzrtF4r3kA0rCxzIyr+PocuzLocbJtkTqmllrs7HHqeLy3tEWf1/RFHyHCsBcBUxGNWSU/IV9gglNUR8jjHOm/cW79BGDoxlwozGXFMwq4I4i6K3C1fU8vHE1Qy6jgFz5vJrlkYTcwTCp38HUBPr/wZRb19rnRslQUOrWKG3ffpwNJ/Vrx3WNU15NeufcMKmfLQY1TOraZJ0bJ/UVdr/GSdnZnX11Ut9uXtUwKTCdMu0VnpYPu/LkYhCGyN116IIrxH5F5U+2qD2KdlF5sMo0G6xFZWtg43PNLpqJuFzIQa2TS5adHGx7v0NpyY5aOT8Vv0JRd5YlkULPUCIlSOmkuKzTe1mkcM7KicPu7BySKE7DCftDckJZT6q761PIisPu+hydKYzKaGF+SFpYVbGCV9M72nHz9J67OfwH</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-03.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T10:21:28.582Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"ZgYBGrJYyBVX3bYxWpOR\" version=\"16.5.2\" type=\"device\"><diagram id=\"fVXPQx1yfp7bDnNjsJ13\" name=\"Page-1\">7V1Zb9s4EP41BnYfXIjUZT02SfcAWmDRLFDkUbWVWFjHMmTl6q9fOZYU85AoyrxE+aFozFh0zG+Ob4bD4cy9fnz9M49362/ZKtnMoLN6nbk3MwgBCL3yv8PIWzXiuPA48pCnq2rsY+A2/ZXUb6xGn9JVskfeWGTZpkh36OAy226TZYGMxXmevaBvu8826Kfu4oeEGLhdxhty9Ee6KtbH0dBxPsb/StKHdYH94jGu31sN7NfxKns5GXK/zNzrPMuK40+Pr9fJ5rB49bIcn/uj5bfN35Un26LPA+7dnX+V/n3362axdt6+O9+/FtdzsIiO8zzHm6fqG1d/bvFWL0GePW1XyWEaZ+ZevazTIrndxcvDb19K1MuxdfG4KV+B8sf7dLO5zjZZXr7eZtvyTVfVJyR5kby2/vGgWZJSlpLsMSnyt/Itr6g0VFLkBdXrlw9I/Hrl1ydwwHowrsTgoZn6Y6nKH6rV4lk59rol29XngwR+rMTJOqGLenw2WRGyyFwgZAXIBajH8mQTF+kzOj1tUapP+CdLyw9uW/8IW9V99pQvk+qZUxnsngZg0xRx/pAUxDTv+DRfeThk8AIZP2RR9zSSIXOnBZkrSM1crXrmXUAbABpLYSWD5k8KtGaec0HztWpacAFtAGguQ2Nlm0eHgtoVCVyJw9f4ZxlPIZDFm/RhW/68LDFJSpJ9deDVaRmvfK5+8ZiuVoc5rvJkn/6Kf77Pd4B3d/hC71/Rv5r5N13EvAqmqodnTQxzKgrtAtnK4p1PIfRRfTlPMKpZ5hH6RHZ/v0+kYBdOSuHcUJDChXr5CC1Ws0ThQobCBZjC1Yz6TMkIVSnc4qJwAxTOY3hKyQrXI6dkEWgeI0TuDVqk10qSYdvcDhsZMWwkTkrqAHaoXMi3ioBGIS8axtIwn2FeJWsYmFbOOBCUgcTnUWwXAbygNgQ1vYljj0yNWOLNjvLYRfmRdT/Tl9UuMUCfkOfa3GkZSQ/LRTUuijvGxvTN99UqXL2tPxXcQsZy92b9LAGQ7d4WpMI922EpXaalDIIQWfwz05G1KqJzQmWmc1q7pcJMJzGRYobp8m2YLjfxfp8uxwydnHIS1R6Pb8vUAthEheF6S0r49nAsgI1VDjK0rES1vvHtBVgI3GA7qTfv5fLtB1gAHKssZGh5iWKN8/hiOguAE7YBp7eYy+OLBCwAjpXa781NNNcGTY5TytolUGwq64/rAu6hRGZXvW1YmoPrkASoC81OgFxQgMTDZnFHJJTnIzqg0ZalQEGBvOKtKg1Iy0FQaqT0wdVk7SBqLwgZlwjmYigd6BaCFmyVVhQor/82X1cH5xMHoS2uyoBmdi0pdzyKaatxmDuf0IR+febrXL1HH5CohtQaERK8ckELebjFT0W2P57EPUy9L/LsvwQ71Dn0nOcQm48Rm6b86cQqQIpVwBVPGLHxe+xRyyZ7eGqgec1ge7gLE8f2lFd9dmCj3IPw+ggcBtlHX3uEJ/aCQ/fL55I5ZcxcSWjJhVdtg0iTE1Dgw7OfAgNM4VsC+xLNoupC4Ta+r+78cI7sVzhqS0mbGniK3x2wFsNgHBbLhyoMFlcurMnrM9gRvsLCTBXsQRlVOGBokAPmFuc3LeIMqHTfkoCaoUZlQO02ObYz0Z+jobmyI4S1pk1a9Rao6uEqNDC1hWuwdE2kQWmLJrbIR5P3dl0PqywVIhnocQFldf7QkM2hUTtETRGpT2JnyeGao1R2KGHohajCzMVooboOFiZsVOMFibp3qkMz2Hlo0u6XsQkDyla1JdYn7FYb5xPEdrfE2B7s9LsyChCaQcz1ap3akgJxSkjWC9iihCwe7gB05c8Tg3ozQpnSmcG7jXJ1Yy30sPaMe9hNw+eHvlYyPKE6Ft5j40p1BYF+Fm5GBcERG0NMk7ksnDxGZ4vxYfWLwtJwgmzPAp3UV2WKahWftNaNk4VTWjdMDzoruFzUQwll8wGiS6tuPhCZId6RSaGKqXwgghesRupFIjMyAkap2Ti9CICkFlpCyiNmRiAUIgd4rarMHq49TKZsn0/0HNbt84FjhjWq0DHEHJnq9YFDOzY6ObTG6fcBtHYPp5LLTncho5YK3UlVtpEKHDNO75plNEfK4YCZZ1r0tuVpKxjixdbFe2QobhMCOE9JTgJdvK8gGFoHSUyk+JQl4DxmOQl0W9OK3LqLo6tadznP8EwCXbzR2WDdxZvwqkdXeM+08aOLd0Mb3MgQnwiovnoF8gWqk0R3sO76ulkV7HERquqidv0NOaDy2yq70FEu5Ya35ABQ+d2GRsEz8qYcSloA8QFmSlcO8W2DZXZ00Bv6mprYF99B2FoMx3Jq06P5G+tby7GsZcsRXF2t5QDskSBU3DxFP5OtqbV2qtRSGjxxJqv+zj6j4Bk5k+1TyG+dU+iu8TfNKfS5XFF1ebABXsGQUqG2ewan7hUMqQ3SBM/IvUIP8GTlNxj3durPbwi/pEVmbNxSCTX1/EaPHYMLhohymW6yxN/HacEWXwtn4669YMwjHVsz1VUrtpEgbNt4vTJTfCmJY1ayNQWQ55bEuY5idPtcjDY1dPGiqeGlyniba+XoKgkT+AovtPf6Br4h5fi+Vt441m7fhlTN6AXPkn7RZnQUGrkiaornAhpzsKTZdyWZrT7NgkbDIFBSIsXX40w/N6gb1+k2SYFeBjxObhBY2/i8kstWRbLhIhAQGLIjpVf37KB2gb2H14Puw+u23QQCAr7krqVqOVaWTguXbWHpQXftqBUs/dJugEyaY2lVb+ixR4Bl3z3VzSSCy94KCQq24eUN3VsBvl50Oc+0CvCbJjlIX1DXJV/1ngnl2hNgh7+ELOK6cOuazdG06aM0ybooWQ/bCBkTSdcyMnv8bImW+Z1aduhtFgHsoigxWjdHe9SrS9xQ7mejaKGFYNKwhOdhWRciKzOgyqN7vewSo/w+dwlsC7tUzVPUd4/QG/O5jOUeGvMRAiAbN+VtJczSt6G1VLpxA5Sb2ci4YLwH8RhFXHgsXfNFbWfuQjK6JhXJVjggTt8d7XCQcRjJ522Fo9U26YODZHXudOGgHIVVCkefphEW+Xz8yMJgruZq5tjq+1poxQ3vvjw4u0RMpDqHS7k0jzR/o0xIHEWyK7v0kcQVlJGo61LQSV30eZnZJTLSnQ7xbgoNzCHeZAA7HaaHWzYD4CC5xXTiINczDY4FnLCx8gLDiDdYkEmb6cRBeM/2pg+0PjimnLTBL0ho+nvrg4NM2vxW+nLna/mv/C4O/L0HOH1XsD+IL+u0SG538fLwmS95vGuJpM5DA6vnpKRsIgoYeDGSQDDIlM07GHc1GOU/12JA8BSzAYiQgcc7Iv9OBBE8j0NDhHY6SyIiZOzxjsiPiSCCuxCJiJQv8ywrTmP58kutv2WrQ8Lky/8=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-04.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T09:20:42.857Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"DvB0yIw1-98XU86LuDKZ\" version=\"16.5.2\" type=\"device\"><diagram id=\"_c-jluAhfx_kgPv7KN8i\" name=\"Page-1\">7V1dk6I4FP01PtrFh4A++tFt7+5sV091Tc3svmwxEpUaJBbi1/z6DU1Qw41C02AE0w9dEiVAzj03NyfH7pY+XOzGgb2c/40d5LU0xdm19FFL04yuRX5HDXvaoJpxwyxwnbhJPTa8ub8RbVRo69p10Ir5YIixF7pLtnGCfR9NQqbNDgK8ZT82xR571aU9Q6DhbWJ7sPW764TzuNVSlGP7M3Jnc3plzTLiNxZ28ln6ydXcdvD2pEl/bOnDAOMwfrXYDZEXDV0yLPF5T2fePdxXgPwwzwn/vba/+kP9615Tvs0DY/cvfvmnTXvZ2N6aPi+92XCfDADynX40juTIxz5pHMzDhUeOVPIywGvfQdEVFHI0xX74ZC9cL8L6GXkbFLoTm75BoVXJgw/gvdMbQQ6DBn2SMcILFAZ78oHtEQODDuz8ZPiTtgB5duhuWAxtGgqzQ3eHK7xil9yJptCo7dBuaMx2FbaDFV4HE0TPOR3yVDeqxvbTSfUT2sEMhaAf8uLkmY9N74B+AFxNgpsHlcPxR+HVlMthUjG8uoS3CCo1IW9HolspeTNSfMXoGhLdPOgC0hVNzYfj8vH17b+M3fOL3t/9+WtsjAf9l43TNiB92xBhMuhf7J+kXmawtT135pPXEwISCkjDBgURnl6fvrFwHSfqYxCglfvb/vneXxQHy+hx3h/QGLSMERfwi+FILoR2DHa0rKYXaZ2Wrkx80LPayoPZ03rM2Cd1yCdjw2KzMXs6nk5XqBKmmpKplTK1I5iosIq6ZaIm0VgKURW1w459KZGR1KW0U/NaRLUkUYvwqx71UleCW2kWziyrq07DPK1icMOJOAnIMhKxpetsziwpEXeZTttXK5l6kqyF1iQ10Z0SZf4E30cAMGFFyKK6CgP8Cw2xh4Mj6lPX81JN+cm8nbshelvak+ia28BeVhA7gOBniayqaXjjw5Pg0jjBlU60p3HEIPdhmKC2DxPq/cGUmugs0SjBia8vUTpfjwjDCa4TxxKnNJvUnmiYoO42kjDBuakjGicogA8lTqCyEz47QfXzScIEYLpm2vN/BLsf/ekfr18Wg95+11t8G+7E2jhSyyvO2ApbcVksTkW3gnWD7ae6rWAuujxtRKILUCm+Faxfaz3Nh/fGtK/cmhYbC+dD95L2ZSSVQKJSqaXERqre6bHnlyJ9cZ9XqCfndqmaxbCaJGKhnpzbRbe0RJw1X1cMr1BTTn3gLb7Vn8oCVe718/CFixmBW/1lzrJG1ixbX08O93mFbvXfAVHTefjaRIW7/Q0hqpVJ1Np6crjPK3Qn+HaJmsmvmhRMnJ1giW+ZiTizsq4aYJ6w2BBpQm2yL4f/xJqka6F1SU2ERM4edUOMORze54ieJIkCC2x8KGyzBspIDTHmfAomLTXXXXHvkw8TlIMa4sz5HJvOlSTCcIKyTkOcOaXSSfweNVRtRhInODtd0ZrDxwmqLw2x5nwKp3RtJ3x6gtpKQ6w5pcIkPO0lHWcsoSFSZa6e7XWIV3SgPxAEZaS3NB5aVzAe+SSNe8FDND1MqUlwpQSjpL9iYnTZfvTeQ+/0JyU+Vb0DK/0xuVAq7KAwTeVBOflRLwZR1Wjz/DINUY/jSL6kHjfM2WZKd0wJjKtp2hb6R1BuF/vS0nbWbF+136LJidq8mKgjbxSbprVSQoN1Rl1vj8+U3qhcVC28JX8531/d0thYq5SZ7ZVqlqnRhIKeZG6ZzE1PstfmaqIYN5CrvUyuNsvXaMkvXBajWE0KYkuT+Fabi7NWTlUDzBMiG7LiiYP3UjZumrHRkl/MK2OtUkuR2YK6pDQ9kggCXzGID0Xt81lQQpSmRzJ/puZB0a4SC8pH0vR4oVwRhhPUfaTpEdJJuPvHgqLOSOIEZyfRpsckbqTpkcGJVHo3NT11oe4iTY8QJuFpr8vTT+7HZGek8RBteuzmkzvuBY/q6EEOj//RMV7iHv8rpv74Pw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-07.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-26T02:17:40.335Z\" agent=\"5.0 (Macintosh)\" etag=\"oYByhiXs8627J6bAunMJ\" version=\"17.2.2\" type=\"device\"><diagram id=\"_c-jluAhfx_kgPv7KN8i\" name=\"Page-1\">7V3bcptIEP0aP8rFHenRlh0ntUnKXm8267ykiBhb7CJQIWzL/voFA7KYGXEZzQUm8+ISY8TtnO7p7jm0Tsz5anuVeOvll9gH4Ymh+dsT8+LEMBx9mv3NB16KAcu1ioGHJPCLIf194DZ4BeWgVo4+Bj7Y1HZM4zhMg3V9cBFHEViktTEvSeLn+m73cVg/69p7AMjA7cIL0dHvgZ8ui1Fb097HP4LgYVme2an+sfKqfcuBzdLz4+e9IfPyxJwncZwWn1bbOQjzR1c9luJ7Hw78d3ddCYjSLl/4eT25iebmzYuhfVsm9vZH/PVuUh7lyQsfy/udlFebvlRPAET+Wf4gs60ojrLB82W6CrMtPfuYxI+RD/JTaNnWfRylH7xVEOZgfwThE0iDhVf+o8RWz+78HL348kqAX4OjvJUrEK9AmrxkO5S80k7LL5S0mhVbz/sQFUPLPXSqsQSEXho81SH2SqY87E62O/91HGTXuTu5pdXOPdXqB9jEj8kClN/ZRwQ6jG7Uj2NBx0m95AGkDcepdozv7zegtk/2Ye+pvQ+9caIHPwyEHwOnBx8CwMjttvtSwNCaqXSAAgTw3v51Hf39PTxbXPrgz9j45r/+8TpxMPCeowhnD/2z9yvz6zVsvTB4iLLPiwwkkGQDTyDJ8QzPyn+sAt/Pj3GegE3w6v16O17Og3V+P293aJ+f2BdYwBvpmJ0IbGvYle6/PEnNxeLcx0Q71dzjqFB3POxN0VSmSGJBjJ0xLXQthS5TR9syZTP2s/bI/GzFRip+VtOt2rOvvPiRjncy5eV5cegp20RsE3GZpEHQbpuT78VFQQpfevhaYuF1FbwkqAxuZv00u7M/X2r/WslS8z69giQ5iybuFEEXU8HgNbF2njA7zMFu68RqU+HBRIcQYzeRolgpS6TpaFujZcZhLs7TDjnMrfh4dJibGeN0Wi9I6nSoAX2DnW3OlG0SxabDq/ThC/0agu8lAnBmBWkd1U2axP+BeRzGyTvq90EYQkPdjfd5GaTgdu0t8nM+J96aAXcQgz5ouLoOw1ts7pHLwJAL9qv7PKoh1xsmdEEGdaC/H0zQvOaKRslAUDpTKB0OP4ThhNbMrxROsDXpM9EwocXvCwUTOjdZonFCC6FzhRMS2QmfndB65gcFEwITT7eHzZbRUA9BaS/jWoTeZhMsmpIusA3Sf/LPp3a5dVful3++2O7tdvFSbhx8sEVe00Sz8rkMJFGbQc5yBsHWuYbi1A/kQMdhXELpt8rfhxR7lHgnCHVS2FKSAvEd7NQB2Cp3P1dBuTgDYYkhhrDijFuHhVT7Ydr143BGF80mFboYVMi1H6bQJSqh0p7hwtuGykiM10UL5+NbgDzM26Ylj2oBcgS6HuwNCtX1DNcwqfndtumZtWUqeLvASy7rgRw4Q10PFl+hK5a/Ab6w+fLGF7MWpgDugstI/DNmFU3hS9OAWydy1gDjilkC9UA0g+OCvJIIgvB3qPJWsrBnJGWJ6nTyJa56c+b69u4flLrSMc5Z/aAWN1NFM1lJxF0YWnRwBNX8h0jci00OC354mNCFWUnEXUfBZEBhCsf1czxMaOFAEnXXcdZ0KJoUhhP6OoEk6i6q5sRT54DHCS3UXCic0NmJo7wLvwyJBoSSyLuOwgkO00VPTwZaFpNE3kUVJuFuz2Am5akUXd2lPO3ZdF3b0xC+CquKwS/JkWp5TEhWy07ghadFv1VHYloY/HgxlYIXcDWct8bLENqGYMD1tjosJq2XY03Oy1mGWo/uhgupEAgWaSJMYQ0w7vV2SZY7jPZuBMNtp4a/IyUfILOisfjbKh9QADPyt20TM2t8cfIQSdxtwd1Gdzumrmr4ezSUfXaxT5tWxwmLc6ZrKgEBW4AtwfiqhJUIlrHMrypfZWu+rYEYa4AlzlfN5nxVAnmeqfJXsqhnLOWk6nRK1NXcFaXymqLW+SxpW3YdJ0OBrMcUDROabipVV0MQIgwnaXt20TQnyxYNk7Q9u6jOTrvkQBhO0vbsOtKchjY9Sdu0iypO4v1ev6oI065dVNQ71oGlBiENmmwbwo20a5cJE4B1stavtf3wxX7WkPp2EdNiKpgV/Wo0TLu50WGFLQMrkEmFszKhum55JKBF0jZ2XsALN7xpofpd4M0VEuYSK5LgN9h4K5JstASlAMbhQqxIMluYwhpgiRteFORtlCSNTAFqK30KmRWNxt+qBn9s/W3rzMwa4IH9fjlVf3sg1ZJJAmoriVEnAyVXCEKunLdE0Jbh1zkbqNskMHKnDhVz5CcpspWkiK05wvMlb3OsTiehOc7azNGqhAXVLHek4G/XBYeXdTqqPERmVGOJZh1VHmLrflvzHtYAS1wecprLQxIIrh1VLiLLMcZSvXVUF81OfcpEK0Qd1UazS98/4ZI2R/XR7NJHU7ji2lF9NLvYk3DpoaP6aHaZn4RLrqs0UkmuGxs0Cp+fXLSgoiTXmHhetN9z+9VFhi+5doSqKOGGicRyORPS3fFW17qyNVh1BtVglZwXumBe9CvUDF917Qp9RYMaL5CJhbMcyJWu864zqM675Hp8eAWHNzH6NTIiDjA0Brz4eT25iebmzYuhfVsm9vZH/PXu4A8g8eEF3EfZJaQF9PIOEmCyZgW7N/2YTyN4VggNL2ixAn7TjzctpmjWOBpaNPyehLBJxKLECzgb4c4LTlkqi0mk4Wd7xs8LuF8Qb14wy1IF8cISGlzADTYs0pcToOjC4v3rm7IlqZbQ6IIaLeDwgh4vss0kjtP93RNvvfwS+7nS5/J/</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-08.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-25T07:02:18.535Z\" agent=\"5.0 (Macintosh)\" etag=\"EjCUPBOif3cAYP1BI_4w\" version=\"17.2.1\" type=\"device\"><diagram id=\"-bKK5X63ZEeCfPXSaYzh\" name=\"Page-1\">5Ztbc6IwFIB/jY/thGv1sWprt7ud7Uwftn3MSCqZInFjrLC/foMEgaSVqtwKvkgOcILnO5fkqANjsgxmFK7cB+Igb6ADJxgY04HOX2DI3yJJGEtMWwgWFDuxSEsFT/gfEkIgpBvsoHXuQkaIx/AqL5wT30dzlpNBSsk2f9kr8fKzruACKYKnOfRU6R/sMDeWDgFI5XcIL1wxs52cWMLkWiFYu9Ah24zIuBkYE0oIi4+WwQR5ke0Ss8T33X5ydv9cFPnsKzeE4cvv56n715yOhsPZPcCPfnAhtLxDbyM+r3hYFiYGQL5zHdmRj3zic+HYZUuPjzR+SMnGd1A0A+Aj9ZGEfuTkjCwecIbIEjEa8gu2qWktYS83Y9VERpEHGX7Po4GC8GKvbj/DI8H8SXQgvPFCM2yhSXijltBJlKzJhs6RuC9rTUUV94GcqqGkiUG6QEzRxA8ynzwV7WgdQU7vGTnZ3Jp9OjlQ4AQVozN6hq7CoFO8oGJ0Zs/QFSW57xN0VqnkODAaPotTu8FLdObSSobTIHvlNDySOF/k7MxxqADo7Ypq/fSollXVHNR2z4K6RHJyfqgb3VU1UQ1yUV1jTLcs3Ss4z6jUoF7PGNbhGbXme9Cwb4DysgZoNN+Pepbvy4zqIieoGF3SFSorrAPM9qs4fpwJaj5KYzoaFIZ0bMVDEWy3zDFM2TFOX94Xrimqdoy+dbJKTMdAUmXUzU5vd60uLM0GaJtzSIFtnp7xgaTKqLlYa+V2y0rfuBev29qW9Ut0DrmA1O4cfe/HWfKu6oysXze7cjtyvWJn2Q2z61vLrNDgZ7Cre7VVbs+s/ex43F2OwCh9lRWFhxUrZbVqruV2vNrPtbCAfaMdkNqSulHgMRSwPLE1o+QNTYhHaEr0FXueJIIeXvh8OOcsEZeP3xFleA69a3FiiR0nmma8dTFDTyu462NsKVx93S8inSg46Blp5Iw+bgBmXEf/wHVkKlkvySE5+scUaltp0mn7y1/Gak0DUNs3150G8NnvGBoDoPZgxl0GYMgAGo8Atc8x6zSAq0/6l40BUHsJ0y4DkGtw80VYbQjcdhqA1rYIUHf1d10GYMndy8ZrgLo1/9UrAFbTANQ99H2XAcg1wDSbBqBuhH/2CcC+G9UUgOSrzAyAH10GoHR+mq4BhroTfugVgOpqAB+mf7eKW3fpf9aMm/8=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-09.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-25T07:15:21.767Z\" agent=\"5.0 (Macintosh)\" etag=\"u0zKqg2RZKcDchkyCD_N\" version=\"17.2.1\" type=\"device\"><diagram id=\"R1HJJvlgUmHN-uVhw20P\" name=\"Page-1\">7VxLk6I6FP41Lu0K4aEuu+2enntn5tZU9WIeO0bSSl00FtCtzq+fIOGRBEUxhIjTiy5yxAN85zuP5AQH5nS5fQ7d9eIL9lAwgMDbDszHAYQOGJP/iWCXCiyHCuah76UioxC8+L8RFQIqffM9FDEnxhgHsb9mhTO8WqFZzMjcMMQb9rRXHLBXXbtzJAheZm4gSr/5Xrygj2WDQv4R+fMFvbKdfbB0s3OpIFq4Ht6URObTwJyGGMfp0XI7RUECXQZL+r0PBz7N7ytEq/iUL2yjxQbvsPUz+DSM/pu+D7+i6ZBqeXeDN/q89GbjXQYAWnn3CY5ktMIrInxYxMuAjAxyGOK3lYeSKwAyEm+J6kceAzK9wWeElygOd+SETQFtBuCijCqVhShwY/+dNY1LLTzP1eVX+Ip9cicQUDLmtqBcNCzAqojwWzhD9FtlLDlFJuAUAU5R7IZzFAuKyEHpsQvR3lRnmA3elNkEtMdNzTausX/LZhs5FXZ7EE1HYP/s/iJxlDGaG/jzFTmeETOhkAjeURj7JFLd0w+WvuclOh5CFPm/3V97fYmB18kD7R/RfhjYj5UmP8ozciG0rQq39CJMSGMYQr81BHfAYLDPQs+F3BgagFPLqcCvrxFqxZrmTTlhe7GT9+a2ndC+MifMeHaxExIftKVwYdyVy1k35XK1Vca15L0qj+uv2fhICZtGytqQe8BsBEh3VzqNRp7TbxgwMwlykGqUygmxFBp2Q4qiQuELFBp4r4w1fNSAJ+bXQlH7cXwkNSAQk4e77+XBj/LgccuMdmcyBoIUsGNlslZpQjB448rMUVyZgQpa6FyZZTSWUZlBmzWiFGoM2UpNWZ02lurfzWO7IgccywrdHddpE81ycscpWV5grSOIBinZqAq+F+TkrR9/p58kx/uMfGfTUZGSk0FtRk5xPpaAHa0CgsERx2w6castClsOCNnM/m8gP89uNqfIVG03KNeZqwvs1J2blNi1FbUJ9CIG59BW00xg85FB8eKnU7WCpnOJnTNZTgtixBYUknoQI0ZpnkoVJG25PYjczw1Vfq5Z4pbm50IFoNrPq2ZgWvu5tC7H3s8Ni3VJ8zJ6ZGrGyhz7tjsdNpRVeKn2O7HVUTGF1sfrMppJWMEywNhhsZdCDVanuiUs47aaVtI8EHbsgGJrQWsHzFgmYwmZdRVpG2wgoza7YwUeWLVbqr8eWOc4TR1Q9dKD3N6e9labTO7ABOR/BtvGaR5Gj+sVJiZth9Vr27loyOzNydk1lbVXFETO2+q/1Rb9V7NsKzbgngTDETrHrLWiOMT/oykOcFhY89UPAk50uhtuFn6MXtbuvumyCd316ZwQHO6gY8EJi3YGfok0sII0fEQt84MxyNmb6sUO2LS/6Au9ZrNr+MVe032P4T+0C7oz+KEAv5jfewM/5OHvnP3iSv5zj+Hn3trIG62dwS+utz72GH4u83afesXFtg/9hd8c6cZ+cXb3sYfwZ1V957FeXCL53GO4R13DLc6G/+0h3Adiu+V0Db84qf10O/DnC4BdwZ8FuxL8//QXfmEFp+tYb4qz2i83BH/Xsd8RZ7UC+qWV0FngRpE/O7YYqnhjMy0VNFlp5Vctcvte2qRS/KaRc96+uTNoAZTQQvPtsY1pIcQP1bwQa5XrChe6badkrdl0O73BvwYxUUuLkZjEL6TFQRPrYjm+O8A7YuNX2lSbTnoBoLvp2vv5AdWmay9J5wH4Ryk0yw7GWTdXE14Ie9vNpi5tcbzgq/e2eXHe3mj9kjTsJy+g0zEvztt51jhegLZ4YWvNi8ZFvcW/VSktj5Bh8fuZ6enFb5CaT38A</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-10.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T11:11:46.495Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"4osfu43u_mmgiIWG8bG0\" version=\"16.5.2\" type=\"device\"><diagram id=\"MuLa8kP81w_iLAAzEJXq\" name=\"Page-1\">5Vpbb5swGP01edwEJiHpY25NdulULdLaPlUWuMGawZnjJGS/fqaYAPbStBG3kBeED+azfc7B9mfRscZ+OGNw5d1RF5EOMNywY006APQGfXGNgL0ETDsGlgy7MWSmwAL/RRI0JLrBLlrnKnJKCcerPOjQIEAOz2GQMbrLV3uhJN/qCi6RBiwcSHT0Abvci1HLMFJ8jvDSky13kwc+TOpKYO1Bl+4ykDXtWGNGKY/v/HCMSERdQkv83u2Rp4d+MRTw97zgsGcT/IGDu/EDCx7nP+9/OT8+yShbSDZyvLKzfJ8QgAJ3GPEoSgENBDjyuE9EyRS3jG4CF0UtGKKEQswf5ZPo/inCP/dkaRJmqk32sqAPQ/ZpTTfMQW/0PamI3JyCcvQzRH3E2V5U2KW69aQYXkayBGOIQI63ed2htM/yEO7Qwj3FosvACBPl4zekz7tJOYkQj0e+lNXpRBwlDIdsibgWRtxkxpxCryb4gCFAKYZITfCU9UDRhgCNMsRAEdI+0xBKnEG1hrAu2RBWowxhgoKmCDVQxZbolr9olGWIbrMMYRdlCLtWQ/QueY7oNcoSwCho1VADVWwJuxxLVLOxtJtliaJ2ljVvLfuFWuKovA1R7QTXF6LZ4Ko0O7Wvuowd+811aXZi63Mh62Vy3HUlqimzmgWK+dKsiqdHE1yVauo3otF97qqm6V+2bsWeajRdt1NfybnnDpXLVuzJQ9NlU5e2s2fJk99t2brpBwRDTTiOQp5Xa80Z/Y3GlFCWqvmCCVEgSPAyEEVH6IgEPtoixrEDyVA+8LHrRs2Mdh7maLGCr+nfjsHV+z0RxUThm644sJ0jOylmPAP+4xlV26w9cnp8mHw9FR+1mPxuw9jXs95xe9lXJiy7bvL19HXSXvLV1bl29vVEdNpi9rvNYj8JnGH/tr3sqzuc2tnXf6yYtZn9HPmWWTf7elr+rb3s949s7mtjX0+u5+1l3zQV+uvecQI9Sf7SYvqPnSTVRr+e635vMf03TZt89Gz3a3vp185Ry1t5RTH9VzU+GEr/97Wm/wA=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-11.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-25T07:20:44.922Z\" agent=\"5.0 (Macintosh)\" etag=\"hZo2cTFzl_uUeQSZQeDI\" version=\"17.2.1\" type=\"device\"><diagram id=\"-bKK5X63ZEeCfPXSaYzh\" name=\"Page-1\">5V1be9o4EP01PKafsY2Bx4Sk6SXdpqVNm33zYgW8ayPWUQL011cEXzUmSlxZMlJegsZGNufMRTMeQc+ZxJvLxF8tPuEART3bCjY957xn233XGtF/O8l2L3G9VDBPwiA9qRBMw18oFVqp9CEM0H3lRIJxRMJVVTjDyyWakYrMTxK8rp52h6PqVVf+HAHBdOZHUPojDMhiLx1ZViF/h8L5Ir2ylx2I/ezcVHC/8AO8Lomci54zSTAm+1fxZoKiHXYZLPv3vT1wNL+vBC3JS97w701if55dX/0/mpOTDRqd/BN/PElnefSjh/TzpjdLthkAaBmc7nCkoyVeUuHZgsQRHfXpywQ/LAO0u4JFR/CW0vlRUAE5vcFLhGNEki09YV1AO0jxWpRQzWQJinwSPlap8VOG5/l0+RWucUjvxLZSbTwZeOlE21w9q3Pc44dkhtK3lcFkZ3JHzEwWMxPxkzkiYCb6ovTBC9ETWa8gzjaLOAD3qDFxFkcFWibOMYu4Fi2OVYGWiXPNIo7r4I7G4gZCiaN8Jduf6aGnwe3uyJtBNjzflM88376ScLq8eYLjOd9vd8qk7cYmzc4k2aI9syxaHG+sb5BN3LAdi7YqFi3Rnrvl6QGbzUO0LVcvRjL0Qqqnt9RqhiXMY1hKPf3YLE8v0KJ5GtAycVkVSJRJb0KSr93o65JB01Fhz7sB15z3ID5nvV631MJj1MJpvKTnLiXaVgvD6lbiHLHNzOTIZs7udozmhmSna6rBGLXb2NfbrHuQHKT7YktjwhN1/mqtY/5enGqAyCFbNQwvvg3YRKq5v5fNnNjqm0HMDT3FzBlWHuPi3Zw52WsssfWxzjNHbe7N2BoXf0NBJsiZGMTTtnkVW9/qPK/c2HU8WQ8sQF0A6gjakCpf9yTB/6EJjnBS8HkXRhEj8qNwvqTDGWUSUfnZI0pIOPOj0/RAHAbB7jJn60VI0HTlP9Ut1om/erlW7OZEm2f1IrebcX21r6Q3do3esHZaVpEKI69uloBVpInO8LMPXB3V+MNyzanO+B/qVFCGPyy6nGmM/4DFX7n+w8rGpc74Dw9UK5XhD8sH5xrjz4Zf9fEXFgHe6ox/v2v6D1P5dxrjP2Srlcr9P0zIr0zCf6gaf5h+fdAYf9b/u55i/DP7K+H/0SD88wKUMvxh/vVeY/xBtUe1/3dg/vXJJPwl+v8RDhbj6dV3cncaD2+syWM8T0zb5eQyzx/y9egft3+57dVNa4mDdqM3cTy4mxPX3va0WuIM2+XEhfvFxDnynvrWEmdao4XLgftoLM6wPguunTS3OMkxzrA2C9ZOnMZP51UTZ1iXhTiLAyrgySXOsDaK9mKcbOJM28bDg7s5ce1tzKtPwA3LwLmh6eVBzlbMnNiEINuAVWy6ui0d+YMNWPXlA7tjasGQ2bwwo1wtDEs3BMZQdibJq1bT2rq5eB9PEDUs4RBYxmbDsSOZOdMyDh7ex+MtDUs5HPabA8bHukKp6fnWmjlxNsfVgbaZg8niZ0CdPk/L2W5BV2K34LNZUwn/a43xzw2FfXCjDH/48PSLxvizuyXyQKEMf1jy+Kox/iBQ91XjD/Ocqc74s936qrulbJitfNMYfzb+Osr9P8w5vmuMP6iVq9b/mm7lG43xB4mDcvzh+v+HzvgfKnEowx+u///WGf9D3w2gDH+4/v9LZ/zZb6lSHX8duP6/1Rn/Q42LyvCH6/+fGuN/sFdAPP50WPzezL5cV/xoj3PxGw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter17/fig-17-12.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T06:55:01.992Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"jCi1gvFMbCVNbo1q6imz\" version=\"16.5.2\" type=\"device\"><diagram id=\"g-EARZ6RgGrlnJ_yPWPj\" name=\"Page-1\">7Z1td5owFMc/jS93DiSA+rLap23t1s1tXftmhyOp0iHxxFi1n344QSC3LisHjCZ902OucJHfPw/3XqJt4f5kecH86fiaBiRqIStYtvBpC6F220v+rg2rjcFzU8OIhcHGZOeGQfhMUqOVWudhQGalAzmlEQ+nZeOQxjEZ8pLNZ4wuyoc90Kh81ak/IsAwGPoRtN6GAR+nd2FZuf2ShKMxF96Y+NmxqWE29gO6KJjwWQv3GaV882qy7JNojS7DsjnvfMe728/FSMz/54RVu3szR93bx7v7h2d8fvXL8R7fpV6e/Gie3m/6YfkqA0Di4GTNMWnFNE6MvTGfREnLTl4yOo8Dsr6ClbQ255IAEM0/o72986TDEDohnK2SQxY5WjflNS5QzWyMRD4Pn8ru/VTh0dbd9go3NEwujKy0Mzqpm1W5mTmY0TkbkvScIknRDfq3H+6zEeHAT/KicM+56a9Or9AMGaWZbZVh215V1ZSKht9EqyRaR+KoYdkco2ST0j6SGdI1SjVxsCGrnhmys1/RvDfR6pghgaOGZWsbJZtkiBxHLNIxSrLaRpo0qGlYtq5RsknntWMJIbNChiG6eWXaGFWUTfBji36aVs2syogtBuxVayMy+ZuWDb3JVmltQ5LZtmndDKuPeHXp5inWzawCSX3jTdYBmtbNrBIJFnFXjUpER3sfb2ZVSRyrJt1ER3vXzawySW3jTdoBmtbNrFqJsLzhqstbW+KnadXMKpWIUYlbVTaZ/E0/2DarUiLGgJVHG8aKdTOrViKuSZV1cxzFuiGjdAPDpOrTbWl007RuZhVL6tNNcLTvJACZVSxxnZrCEuXzpFnFktrCSWkHaFo3s4olQLequxPENGDPG4GQWbWS2mQDw23fupldK6lrtO17kjS8VlJVNukq2fSGcrOKJdLJ7ViCEgyLJSdAOE6WvKzWjDP6m/RpRFmu5kMYRYLJj8JRnDSHiWwksfeeCOPh0I9O0jcmYRCsL9NbjENOBlN/uL7mgvnTHX1i7YAsX9srXp7csmahz6AX+oyYTxe7R0mPV8NHAH5PX/jiLnzl9GH+e6YvfQF+WzV8mMT29YUP9uo6qvHDXPRcX/zCGmsrn3lgSnmqMX1xx7Pyzg8zwwt98Xd3VJmV0YcZ3qW+9G1b6PwdxfizwVfA/15j/O6h4Yf51gd98WN0aPhhxvVRY/wH1/vho+IrjfF3Dw0/zHiv9cUP4s6uavww5/2kMX7hQYKtmj5MeT/rS1+MOx3VSZcDc94bjfHv+kKNMvww5/1iDn6sHD9Mer/qix9skcOK8WdxcAH/QGP8wty/TQOU4YdJ7zeN8Ys/p6K63OzCpPe7vvh3fkdLGX6Y9P7QGL8Y9yvHD5PeWw3xH8xSC5PcnxrjVv0c3YVZ7Z2GuHftclM+ucCs9l5j/EJg6aouaLowq7X1xS9+jVn5VA+TWqQvfbBTUzX+rMZRwI8Nwt/cyps089/B32y0zf+XAD77Aw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/diagram-18-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T07:24:57.841Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"vRghccSsgJUCDrzDkxBL\" version=\"16.5.2\" type=\"device\"><diagram id=\"nvVFWxn3Xte6PcbaY4gH\" name=\"Page-1\">3ZhNc9owEIZ/jY90wAa7HAMk7aFtDnQmTW6KLWwlstYjy8Hur+8KS9iOoUmTtni4MNpXq6/n1Q4Ix1um5SdJsuQrRJQ77jgqHW/luG4Q+PiphaoW/JkRYsmiWpo0wpr9pEYcG7VgEc07iQqAK5Z1xRCEoKHqaERK2HbTNsC7q2Ykpj1hHRLeV29YpBK7u3Gjf6YsTuzKM9OREptrhDwhEWxbknfpeEsJoOpWWi4p1+gslnrc1ZHe/b4kFeo1Ax6+XRMo41GVX989jpZ3NyUrR2aWJ8ILc16zWVVZALGEIjNpVCpaHsJO7m36uL+vyf60eEkopFTJClPMRHZE9YzstqFtU5IWaKsR42+8n7hhgA2D4Q+QuC8j2SZM0XVGQh1v8do73iJRKS6zmmCT5Fl9EzespLjU4ii9NqXj/vTRnYqN12Mz68HBM6ouj1xJeKRL4CBRESAwc7FhnD+TCGexwDBEJhT1hSbGsBQvTEfKokgvszhkAF5TEWncq/E5IZ++tkIRKQi1NvL0KID3V6w/sIqdDalip8O6Pv4BNj7XBVpgI9aNuVVwgb14dmU9MF+C03/xTrtl7J64ij8OqYqDYd2WeY/N/OwKdGDI7fujRZhG+DIwoUHXPTxIlUAMgvAvAJlx4YEqVZl3DSkUdD2iJVM/9PAP+FOqDm9bXavSTL0LKhsIPGE9KpjZ+Lbd2YzbRc3A6EK/ibTZnOQ5C78nTNQdV4zbTdUn18c9aqGRcihkSF++uYrImP7Ofe+w+5JyothTdx9/3+vJf/Y6eJPX7pl47f8brzFsXtO7vtY/Et7lLw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/diagram-18-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T07:29:18.146Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"isLnqB-gkNUuGjHj5vIs\" version=\"16.5.2\" type=\"device\"><diagram id=\"_yVxQxZ9vVd97eACBopI\" name=\"Page-1\">7VxRd5owFP41PnYHiEh5rNpuD9tZz/GcrXvMJAU2JA5j1f76hSWIEKi01HCnvHjIhSTyfd8NucmFAZosth8TvAy+UI9EA8vwtgM0HViW44z4b2rYCcPIlgY/CT1hMnPDLHwm0mhI6zr0yKpwIaM0YuGyaJzTOCZzVrDhJKGb4mWPNCr2usQ+UQyzOY5U6/fQY4GwItvI7Z9I6AeyZ2TIEwucXSsNqwB7dHNgQrcDNEkoZeJosZ2QKIUug0XUu6s5u/9fCYlZkwrDm6dvV1+f0dS7D55XM8SR2VzJVp5wtJb3K/8s22UA+AldL+VlJGFkWwU7/pldbqj/y9zfLRcJoQvCkh2/ZFskWurDypDd5GhnjQYHQGc2LPn19w3nGPADCcMrILGOQ7IJQkZmSzxPyxsu+wEaB2zBu5ma/BCvlkKJj+GW8K7GtegdolTPjwpdV9igCmxGEe91vOYHfnqQ0ilMvIe9VYGQI8GKqK1YQn+TCY1owi0xjfmV48cwikomHIV+zItzjhzh9nGKa8gd9kaeWISel3YzrqKJizn2UlKmxjkRM+zej21gfmxD8uMhLLmMFGzss/NQYJA73XuoC8xDryF5qANLLq6CjXl+LgoM82wm2ulsGAFzUrNBiKBxPmxUo9cZOlXRQmlGbF3IjBgaNVXBim5vdqB5c4NAQaM3I2CSqYoZSt7sXoYzQ2NGjVi0OzO4lSqzQUyh0ZlHwCSjhhfX5+en0EBX4xb9fgptJSprGIifurAkY1UFGOUpNLqMpy40aqqiG83eXIqH9zPqzjBpEFboc2bROSDFqPFFNms6Iz8Fh3qDvY6Th7omNEdtEDJodFQbmGSqYgfxiF0tcVyAafRnnSYpCJe6Wgm4btK7Tkh+tnK5S7R1po9rcJw22FA5+TDgQhsGGkQkGoeBa1iSyWZX7z8MuBczCkCjFEBOl+UAGwVQg0hG3yiAgGUPofq8rraTAXQpwwA0TodIgbh4qzRhAfVpjKPPlC4l5r8IYzuZhIvXjBYZIduQPcjq6fGP9PiDY8vidHtwbrrLCjG/nYeshbQgqll2Vs7r/SvlFb2bNIE3Z5pb7sIUhgOuiKfk7x4dpRISYRY+FetVMSCr3tOQt5jPcZQFxmILK7pO5kRWymlU2ilNldxSMwwnPmFKM//UsL+ZFgIZKgJJsZzJooT83TRjvkkzxtloRtkJfptmyuthukWjJiGdUjQZ41I3ZkPRSHntdaNJNJYh0H9psliTldhSXY5dnG6ZRiN1vZsqRppV4bxJFRZYVdQkwrVUxXXHqnD6saKNKlBNQlVLVVioY1mou/D9YPEaWdSk5rSVxbBjWbj9aPGCLAT6R2cWTfTTUj7tXspRNwN75z8FyzV5QZpYNntfbsWy05DlmnwRTSyrS6i9L5+CZfGSQWc0qwuJvTO/guZsweY4zTXbyZpo1rsceHbe3Jzmmv1CTTT3C3jtaEYNaW69jtyOZgjvS0B739gG9b6EDSx131azh0z10f+/b9OCQ11d9uifsa0HX7vTZyzq6tMjL4/HpR1It+uUnK4+/3DkqVXeYO0YpmFX798fyfMs5UCYJ4OJF/OPpInV5vxDc+j2Lw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/diagram-18-03.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T07:31:15.506Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"0OhhGT6In8EoH2jPE2uB\" version=\"16.5.2\" type=\"device\"><diagram id=\"_yVxQxZ9vVd97eACBopI\" name=\"Page-1\">7VzLcpswFP0aL9MBZIxZxnHTdqbP8fS5U4wCpBi5WI5xvr4iSCYgqOXEgKBsPOiCJHPOueJeSTACV6v4TQTX3gfsoGBkaE48AvORYVjWhP4mhn1qmJjM4Ea+k5r0zLDwHxAzasy69R20yV1IMA6Iv84blzgM0ZLkbDCK8C5/2S0O8r2uoYsEw2IJA9H63XeIl1qBqWX2t8h3PdYz0NiJFeTXMsPGgw7ePTGB1yNwFWFM0qNVfIWCBDoOS1rvuuLs4X9FKCQyFcaX998uPj2AufPZe9gsAEVmd8FauYfBlt0v+7NkzwFwI7xdi53xmigiKC5jAt7wFrK7pSJBeIVItKfXxXmimT4MjuwuQ5tD6D0Bmtsg49c9NJxhQA8YDCdAYhyHZOf5BC3WcJmUd1T2IzDzyIp2M9fpIdysUyXe+jGiXc1E9P5JRhFSEbq2sAEl2EwC2utsSw/c5CChMzXRHg5WAUJ6hySP2oZE+De6wgGOqCXEIb1ydusHQcEEA98NaXFJwUTUPkvw8qnDXrITK99xkm5mZTRRMYdOQspc6xMx4/b92FTMj83W/HhcAak6cpkI2Jjd9lD1Ibfa91BbMQ+dtuahVgWk6sjFFrDRO+6i6mPOI9FWo2GgmJPqEilCXfGwVoGqQpIpyxYKEbHRx4i4A9SUJStNe7OlmjdLJAp1eTOoQFUhyZTlDAVvtnvozB1gRsxYGndm5WaqdImcoi5nnlSgqpBkxPRi2nE/7QDoYt7SvJ+qNhPFG27DT+0KVNWRjFGWYBRDaNDDp24HqCnLbhr25kI+fIioW8NEIq2oyZkPdCismLL84j9YIeoCNRILIrXnw7pq3iyRV9TlzWYFqgpJpizBSF13s4ZhDqbJn22ykyF1qYtNCtdlAkSEsrOlc2JpW70YBjrAqcSqS+3DgK3aMCCRttQ1DEwrUFVHMjwEO/8wIDu71sehogO8K7A7zLAUGyqARE5U01ABqlBVSDLVO8ReGjGAXg4DHeB0DASI87eKI+JhF4cweI/xmmF+hwjZs+28cEtwnhEU++QHq54c/0yOX1kmK87jJ+fme14I6e384C0khbSaYfJyVu+xlFV0LpOtwBnT1HLtJzBUcMVYQU5uc7DISYQCSPx7lKtVxgCr+hn7tIssEBKmKvMtbPA2WiJWKaNRaKcQT9mFZgiMXESEZh7VcLiZFwhkLAgkAW7Bigzys2lGf5ZmtN5oRlhTfp5mijNrTYtG3M5Up2g440w3uqRomLwOuqlLNCnY/woXx82oyzLz4ZauSanrbKqYNKwK61mqMFRRhdWMKqYtq8IaxooTVMEH9rpVYYCWZSGu5w+DxfHcrHZZjFuWhT2MFhlvKdgSkcVx/ZxbPi97vUcbnL8OlidqsawPvnwKy5Yky7ZaLItTqIMvn4Fl/naCKjSLE4mDMx8P44/TbKpFc7PTgV33Znmap2rRPEzgnUQzkKT5/PPIL6NZhTcvVHtz2WzvzQtT/ZcATHGLkS4++ju1TNsF1MVpj+EZe+rga6r1jAWNfMREfgsCXyQqrBy2vSWnkQ9JnIySsMDaMkzjRt7kPxmm4h4IvTmYph+/f7mxbOMujKc3v959+rr/Qko/1HKWHUx21zcwdckDSqkVQ1ldnEXuDfqNjdK0mH3GMF3FyT4FCV7/BQ==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/diagram-18-04.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T07:32:40.601Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"4aR4lWGscuLuZKJ7SEdj\" version=\"16.5.2\" type=\"device\"><diagram id=\"_yVxQxZ9vVd97eACBopI\" name=\"Page-1\">7VzLcpswFP0aL9MBZIxZ+tG0nWmbdtw0bXfEKECDkYvlGOfrK4pkAoJYTgwIyiaDLkgK55x7rasHAzBbRe9Ca+1+Qjb0B5piRwMwH2iaYYzI39iwTwwjnRqc0LMTk5oaFt4jpEaFWreeDTeZBzFCPvbWWeMSBQFc4ozNCkO0yz52h/xsr2vLgZxhsbR83nrj2dhNrEBXUvt76Dku7Rko9MbKYs9Sw8a1bLR7YgJvB2AWIoSTq1U0g34MHYMlqXdZcvfwf4UwwCIVhpOH7xdXj2Buf3EfNwtAkNld0FYeLH9L35f+s3jPAHBCtF3znbGaMMQwKmLCumUtpG9LRALRCuJwT56LskRTfWgM2V2KNoPQfQI0s1mUX+fQcIoBuaAwnACJdhySnethuFhby7i8I7IfgKmLV6SbuUourc06UeKdF0HS1ZRH71ky8pDy0DWFDSjAZuSTXqdbcuHEFzGdiYn0cLByEJI3xFnUNjhE93CGfBQSS4AC8uT0zvP9nMnyPScgxSUBExL7NMbLIw47oTdWnm3H3UyLaCJiDuyYlLnSJWKGzfuxLpkf64358bAEUnnkMuKw0dvtofJDbjTvoaZkHjpuzEONEkjlkYvJYaO23EXlx5yNRBsdDQPJnFQVSBGqGg8rJahKJJmibCE3Ita6OCJuATVFyUrd3mzI5s0CiUJV3gxKUJVIMkU5Q86bzQ46cwuY4TOW2p1ZupkqVSCnqMqZRyWoSiQZPr0Yt9xPWwA6n7fU76eyzUSxhpvwU7MEVXkkoxUlGPkhNOjgr24LqCnKbmr25lw+fBhRN4aJQFpRkTMf6JBYMUX5xX+wQtQGagQWRCrPh1XZvFkgr6jKm/USVCWSTFGCkbjuZm0FGZhGf7bxTobEpS42CVyTGIgQpncL58SStjoRBlrAqcCqS+VhwJQtDAikLVWFgXEJqvJIhg3Bzh8GRGfXuhgqWsC7BLvDNEOyUAEEcqKKQgUoQ1UiyZTvEHvtiAF0Mgy0gNMh4CDOvioKsYscFFj+R4TWFPPfEOM93c5rbTHKMgIjD/+g1ePrn/H1G0OnxXn05N58zwoBeZ0frIW4kFTTdFZO6/0rpRXtSbwVOGWaWC69GIYSrigr0M5sDuY5CaFvYe8BZmoVMUCrfkEe6SIdCHFTldkWNmgbLiGtlNLItZMbT5m5ZrAVOhBzzfxTw+FlXiGQISeQGLgFLVLIz6YZ9UWaUTqjGW5N+WWayc+s1S0afjtTlaJhjFPdqIKiofI66KYq0SRgPzdcHNajLkPPDrdURUhdZ1PFqGZVGC9ShSaLKox6VDFuWBVGHytOUAUL7FWrQgMNy4Jfz++DxfHcrHJZDBuWhdlHi5S3BGyBkcVx/ZxbPq873qP0zl8FyyO5WFZ7Xz6FZUOQZVMulvkp1N6Xz8AyO50gC838RGLvzMeH8cdp1uWiud7pwLZ7szjNY7lo7ifwTqIZCNJ8/nnk19Esw8kL2U4u682dvNDlPwSg81uMVP6nv1XLtG1AnZ/26H9jTw2+uly/saCWj5iIb0Fgi0S5lcOmt+TU8iGJk1HiFlgbhmlYy0n+k2HK74FQ64Np/Pnm661har+DaHz768PV9f4rLvxQy1l2MJlt38DUJg8opLZoKNutwyktCuV+dHN//+ubMvlwfTVD18h8B7YF3yNk4aCL4NcX+kgx/dJkstCWfq0TvP0L</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/diagram-18-05.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T08:04:51.086Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"_g-qrK1zZqJ2olm4-ILS\" version=\"16.5.2\" type=\"device\"><diagram id=\"_yVxQxZ9vVd97eACBopI\" name=\"Page-1\">7Vxdc5s4FP01fvQOIGPMoz+abma6mzZuNm1fdohRMAlGXixinF+/UhDGIGHjxIBwPdNJ0QUJc8654l5xoQPGi+hzYC3nfyEbeh1NsaMOmHQ0TQc6+UsNm9jQ07XY4ASuHZvU1DB1XyEzKswaujZcZQ7ECHnYXWaNM+T7cIYzNisI0Dp72CPysmddWg7kDNOZ5fHWe9fGc3YVipLa/4SuM2dnBsmOhZUcy0ZYzS0brWPT2zHgUweMA4RwvLWIxtCj0CWwxANdFezd/q4A+rhMh+trPYxuJ6vbvhVeDaa9p1vte3cQj/JieSG7XvZj8SYBIEChb0M6iNIBo/XcxXC6tGZ075owTmxzvPBISyWbbDgYYBgV/k51e/VENBAtIA425JCkQ4IgE4xqsPZ6F/7YNN9Bnl2+YjHCne3IKShkg+Eixqg3fPmne/MKJvbX+etqCoh61l3NEIDUo//0sQNVnTXyuBEEcBacFQ7QMxwjDwXE4iOfHDl6dD0vZ7I81/FJc0YQg8Q+oni6RJJDtmPh2jY9jZCNLF8F6As4kpIQoWiBfKLdXizDyKwPosHf998eDFN78qPBw6/rm7vNN9zdI1kPmueu2AbZEM4gqoCNHPYOAWFZ/tK39zvrIRlB2QuJmkVE03lItFon1cOQHPBaa7WM7/ePbkTFIxDOXjIOq6kpbETzW9+jrhmSDYduUDpjEznD1toaj24pMb3m/ViXzI/1xvy4VwCpPHLpc9jo7fZQ+SEXxT01e6gpmYeWSPEq8lCjAFJ55GJy2Kgtd1H5MU8i0UajYSCZk6olUoSq4mGlAFWJJCPKFuLwd7W0/AxM/f9CuqI2ol7bZQ44JEd48BGne9OImWXFdLkOBXbHGHXAVceY/Eu2VPJ/kipvg+34hGcRb7eA+BJLPZXPFYZsc0WJNKSquQIUoCqRZEQZSS57Ns8weW4BM3w+VLszS7cOppbIWKpy5n4BqhJJhk9eBi330xaAzmdF9fupbOtcycBN+KlZgKo8ktFE6Uv1Abp25gF6C4gXZWY1zxW5XF70eLpeTEokLRVNFVs6JFaMKHv5DZ5utYGaEkvFlWfbpmzeXCIaqsqbBwWoyiMZIAqLDtz439DqrmK46J1/GUDRjb9c0n6G9/0W8N4DHMTZS0UBCdcc5FveF4SWDPMniPGGlXhaIUZZRmDk4h+sO93+Sbf/MHTWnEQ7+yabpOGTy/mRjEAbcTdNT9ppv7dW2tEe0vLQlGliuXIpDPvLkKCdKRjlOQmgZ2H3BWZ6iRhgXb8il5winQG51Cc7wgqFwQyyTimN3Di5idTMDYOtwIGYG+ZNDduL+YBA+PIyCtyUNRnkJ9OM+i7N7MrkZ0Yl1WpGU2L0Y1NxAd/ptcWtZb9PW/mYu25x8Q9pqxRXIhOmL7WsuIx6xLWrpb0hd9Uzl6FnQzdVKaWuk6miX7MqjHepoqYp57AqjHpUMWhYFcZlrjhCFcnEXrUqNNCwLPjnCJfJYo8sQE2y6DUsC/MyW6S8xWCXiCwO6+fU8vlY0bJycf4qWO7LxbJ68eVjWDZKsmzKxTK/HHvx5ROwnNRcykIzv+B4cebDYfxhmnW5aK532bDt3lye5oFcNF8W8I6iGZSk+fTPKD5GswwVn7K9j6U3V/Gpy198qItqEKqvJAPnXUnWBuL5lZfLbf7Y+V+X6zYPank7/OjPg+Qeggq+DlJvLUUt7/4d/9mfXB2CWh9MwifioljivOoGWyRkL7p/fv71XRle392M0R0yP4NQ8JkblV9oPRvwG/QP4VexjnxXsnRkLYCpONjOKbLO6k0xKNphUE7/rbA9/MgTcAGRXvaEyL2dELklPr3fT5qIhUkz/eJj/NAy/Wom+PQ/</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/fig-18-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T07:03:28.952Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"PAYRXYMA8VsgvsMA29Vf\" version=\"16.5.2\" type=\"device\"><diagram id=\"6eYZ95Ioyt_LsSiEXXUj\" name=\"Page-1\">7Z1dc9o4FIZ/DZfdwZ+Qy4Wk7cX2JtmZnemdggXWVFgeWwmkv34lsPmSU3zaGBif08l0sGIc/J7H9tGDQwbBdLn+UrA8/aYSLgf+MFkPgvuB749GsfnfDrxtB+KoGlgUItkOefuBJ/GTV4PDavRFJLw8WlErJbXIjwdnKsv4TB+NsaJQq+PV5koe/9ScLbgz8DRj0h39TyQ63Y6Gw+F+/CsXi1SffGPJ6nWrgTJliVodDAUPg2BaKKW3j5brKZc2ujqW7fM+v/Pd3esqeKbbPOGV55Mfk0nK7x9nn7zk+8Pr9+xTtZVXJl+q/a1erH6rAzCvO7cPNXu2Q5NSs0JXdRqaZRO8ZiLjhVn2NstSsrwUm7W3a6RCJv+wN/Wi6+3US5Pq5/NC8/W7O+bt4jKUcbXkungzq6zryLfPeDteXO2rFdQ1SA8qtRtkFSGL3Zb3KZoHVZCAUH1gqI8Wi0mqCvHTZimr2E6DLldiKVlmcGPJydBEbQ4vO6RVXj2SfK6rh89Ka7WsFooqg2FjsZJC5f+yYsHrVeZCyqmSytY3U5lFIFci05vUoon5MjlOh39Fg8js2dQse/tl82VXL/RUZaUuDCd2s5yVesXL1vV/H10XinNlD7uqetC+6mbftGDy0ZyvWLbYHFWpXsrqAFqlQvOnnM3sqitzUt0eZPbsxvZ1UiazudycUFKRJDxrLhUMh01hefHwyrf19f6oQv7ZCoXAAlUb2wcH3hqTZv8yps0h85IlpVP13ev8fRBCAqEdCCfn775zEREXIC7GSLiIiQsQF56PBIwRgQEDI0YCxpjAAIHhD5GAcUdgwMDA0nvWNo3IaEsGlu7TgypAslUfaKuAzrIzeeUBnCWS84N3XjD284RAIrMtCsgElkdmE0gGmiaC3CaQDDQSyyO9CUUDi8bySHAC0UAjsjxSnFA00HShJDmhaGBpQ+ueilzWFV1WA2yXdVk+wGgiOUEc3HCKymXVlScUzqKAzGX5ZDmBZKBpIshyAslA47J80pxQNLC4LJ80JxANNC7LJ80JRQNNF0qaE4oGmjYUoDnJZXXkspo62wv/ViHduNl8ZOCTWQF5zbYoIJNZAWlOIBlYuoiANCeQDDQyKyDPCUUDi8wKyHMC0UAjswLynFA00HSh5DmhaKBpQwGek2RWVzKroX25sMyiWzebjwx8Mqv+kYTCWRSQyayQNCeQDCxdREiaE0gGGpkVkueEooFFZoXkOYFooJFZIXlOKBpoulDynFA00LShAM9JMqsjmdV0jbqszArp3s3mIwOhzCKv2RYFZDIrIs0JJANLFxGR5gSSgUZmReQ5oWhgkVkReU4gGmhkVkSeE4oGmi6UPCcUDTRtKMBzkszqSmY1nIguK7Miunez+cjAJ7Mi8pptUcAms0hzAsnA0kXU028ioy0ZaGRWTJ4TigYWmRWT5wSigUZmxeQ5oWhg6UJj8pxQNNC0oQDPSTKrK5l19Q+Aj+nezeYjA5/MislrtkUBmcyKSXMCyUDTRZDmBJKBRmaNyHNC0cAis0bkOYFooJFZI/KcUDSwdKEj8pxQNLC0oSPXczKHDZOuPuag1IX6wU/q2VBiJsXCVP9+xm3tzICtlZgx+Xf1jaXhYwNZE1mF3W1ey7BWxf7136isA64/q6pdkYNfFPmPFNLINYnP/Q1/fGPhu/5u1t/wd5OnW0nfVWZJj9OPbyx9V0vx/qa/mwLcSvqu+pn3OP0bu+jWl6GD9Bc9Tv/GrrpjV2Ck/U0/uLGr7th1BF5/0/eOw2/69YdLvmE8dmfh7jS8r+E3vV1/0fDdeW6AJvzGPzB20fTdiW6IJ/2mT8S+aPruTDdCk37jRzhdNH13phvjSf/qF113pjvCk/7Vr7ruTHeMJv3g2lfduxb3EZjNiLx8L6KDmrAy5zP7iudibUP7GC0WnVwpo1aJdTY/umvx9vpVE/OHx4ntlq+WmDuj/MDEDo/5gdmJzb9ukrw+ey3epP39JBNRmAGh7FmxVC92D7tM9/TI7pBTs1gopQ/fFjVxpN9Uwu0a/wM=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/fig-18-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T07:13:33.961Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"e_MVBuFQByn4bvLMkMIH\" version=\"16.5.2\" type=\"device\"><diagram id=\"6eYZ95Ioyt_LsSiEXXUj\" name=\"Page-1\">7Z1dc5s4FIZ/jS93x+LTvtyk3d2L3Zt2Zzqzd9QQmyk2HiBNsr9+hQ3YRrTlqBFSeNXpdGLFdcyrB+noMSgL937//EcRHXd/53GSLZxl/Lxw3y0cJwwD/m/d8HJuCPymYVuk8bmJXRo+pv8lTeOyaX1M46S8eWKV51mVHm8bN/nhkGyqm7aoKPKn26c95NntTz1G20Ro+LiJMrH1UxpXu3Prarm8tP+ZpNtd85O99hv7qH1u01Duojh/umpy3y/c+yLPq/NX++f7JKuja2M5/7/fv/Hd7n0VyaEa8x++Jse7L3d3u+Tdh80vLP73/dd/D780r/I1yh6b423ebPXSBsDf97H+soo+1013ZRUVVdNPS/6YB19F6SEp+GN2epxl0bFMT88+P2OXZvFf0Uv+WLWv0z66E4+ifUtJUSXPV03NUf2R5PukKl74U57byM//4+X24dOlt9y2D3ZXPdU1Rg0h2+6VLynyL5ogCaE6xFA/1Fjc7fIi/a/OMmti6wddPqX7LDpw3KK413SXn06vuqnKj81XWfJQNV9+zqsq3zcPiiaD5WBnxUV+/Ccqtkn7lIc0y+7zLK/795AfagSOeXqoTqn5d/wvz/F++au/8PmR3fPH7PKY/62fXlT3+aGsCs5J/bJJVFZPSTnc/9/l9MdQ/KjbPVW97o7vdX64VRplH/h4FR22p7NqV+2z5gR62qVV8vEYbeqnPvFB9XyS1aNbdOmnnGfxkJ0GlF0ax8lhuKtoOJw6Ninef03O/cvG95Aj00MesYOaF7sER361KOPHd4gqfso8HuJS6PXufcqD4FkQpMbvuXPhWy5IXKxAuAgsFyQumAMCRmjBoIERgICxsmCQwHCWIGCsLRg0MFBqz9amWTLGkoFSfTKqArS26hVtFdFZKpNXjOAs5zg+MCnBOM8BAVxkElAAE1gM3GzSyYApIsDdJp0MGInFwPWmBBooGouBC046GjAii4ErTgk0YKpQcMkpgQZKGdrWVNZlaXRZA7BN67IcgtGc4wDRnQXWZbU9b1GwLquXDLjlpJMBU0SAW046GTAuywHXnBJooLgsB1xz0tGAcVkOuOaUQAOmCgXXnBJowJShBM1pXZYilzVU2U58VyH6hZvr0X029xHBRfea41EAk1kuuuYkk4FSRbjompNMBozMctE9Jx0NFJnlontOMhowMstF95x0NGCqUHTPSUcDpgwleE4rs1TJrIHyZWKZBX7pZncaWJnV/kiLgpVZPTLANSedDJQqwgPXnHQyYGSWB+45JdBAkVkeuOekowEjszxwzymBBkwVCu45JdCAKUMJntPKLEUya2iOmlZmeeDXbnangZVZHrjXJKAAJrN8cM1JJwOlivDBNSedDBiZ5YN7Tgk0UGSWD+456WjAyCwf3HNKoAFThYJ7Tgk0YMpQgue0MkuVzBoYiKaVWT74tZvdaWBllg/uNQkooMkscM1JJwOlimiX35YMK7P6aIB7Tgk0UGRWAO456WjAyKwA3HNKoIFShQbgnlMCDZgylOA5rcxSJbO0bwAfgF+72Z0GVmYF4F6TgAKYzArANSedDJgqAlxz0smAkVkhuOeUQANFZoXgnpOOBozMCsE9pwQaKFVoCO45JdBAKUND0XNGAhs8tOqWg7Iq8i9Jrz8HujjK0i3v/XebpO473lB3QbqJst+ab+w5HyfIhsgq6sNOWhkmdjb5d1S2Abd7VY3rZPc7nfxTCikUTeLn+Ya/Mix80d9t5ht+t3gyJX1RmcUzTj8wLH1RSyXzTb9bApiSvqh+HmacvmGTbjsNXaW/nXH6hs26K1Fg7OabvmvYrLsSHQGbb/rsNvyh2x+m/MB4Ja7CxWX4XMMf+rh+0vDFda4LE/7gLxibNH1xoevhpD+0I/ak6YsrXR8m/cEtnCZNX1zpBjjpa590xZVuiJO+9llXXOmuYNJ3dc+66xHXEfCXSY/ltyK66pOoPCab+h0/pM91aE0nfWqOzXktUeb35k5/VIbKVkzrER+4G5ahs7zNsHusLUNx1fmKGV6PCwt+EKc/apLUT+OID3Llk4zTgjekeT1ylvljfYQq0+2f646nO90R93wYyakwajq6kxxxi4Rho2aXmTEZjri/wPQMtY+XIy7MNzxD/bP3iEvYDctwZVqEI671NixCYXLWnSFbvr3VjFCJ665w2FLpckZlKe4Zx+NbXdWse5N0KCbJBpJk6pJUuqqZMElXe5JKa0aFSfq9s5tpT1Jp5Thhkr72JJXWjypX1a5xUSqtI1VGGfaiXOuOkimtJlUWQsy4KN9sTWncWMlG1JQ3W4ssxG1ENvUeI+mh/jzslKi4Bchml2bxX9FL/li1r9M+epWbLHoXfI7ddrZrVJAr4QYou2WLgMAPYCVtADLtJi2Mge/jdEHfbtPC2IiPJSwMkBu1MAa+nZMEGyj3yDIGvr+TBBswm7UwBr7FkwwcKNu1MAa+y5MEHDAbtnRDpIXDbtkiwgG+05MMHDAFacuC9Vl6fBbRbKrTWw74zk6XM8HqLeagu04CDGh6y0FXn3Q2cKoJdPVJZwNHbzno7lMCDhi95aC7TzocQHoL3X1KwAFTj7bX5Vs4rN4S4SC4T6u3lOkt7b9ii7kEzznLUcIdf/Xl/EcFdNdJgAFNb7no6pPOBk41ga4+6Wzg6C0X3X1KwAGjt1x090mHA0dvuejuUwIOnHoU3X1KwAFTkLY/0+otrXprcFf0af2Wh36RZ3cqWL/FPHTZSYABzW956O6TzgZOOYHuPuls4PgtD11+SsAB47c8dPlJhwPHb3no8lMCDpx6FF1+SsCBU5AS5Kf1W+r81tDvnZvWb/noV3l2p4L1W8yHl53jYUDzWz68+ySzAVNO+PDuk8wGjt/y4eUnHQ4Yv+XDy08yHDh+y4eXn3Q4cOpRePlJhwOnICXIT+u3lPmtoalqar+FfplndypYv9WV1RYG67cENtDdJ50NmHIiQHefdDZw/FaALj8l4IDxWwG6/KTDgeO3AnT5KQEHTj2KLj8l4MApSAny0/otdX5rYDSa2G8F6Jd5dqeC9VssQJedBBjQ/FaI7j7pbMCUEyG6+6SzgeO3QnT5KQEHjN8K0eUnHQ4cvxWiy08JOHDqUXT5KQEHTkFKkJ/Wb6nzW/r3lw/RL/PsTgXrt1iILjsJMMD5LXT3SWcDppxoD9SyYf2WCAe6/JSAA8ZvrdDlJx0OHL+1QpefEnDA1KMrdPkpAQdOQSrKz0igg6dW3ZJQVkX+Jen16EAnR1m65f3/bpPUvccb6j5IN1H2W/ONPSfkhNkQW0V93Enrx8Tupv+Oszbidturcd3sfqebf04qrUS9+HnG8a9Mi190epv5xu87psUvWrR4xvEHpsUviqpkvvEHS8PiX4su6GHG8Zs29a5F27KdcfymTb1r0Wfs5ht/aNrUuxaNAZtv/B67jX/obolJP0xei2tycVE+2/iHPsyfNn5x1evixD/4y8ymzV9c9npA+Q9ttj1t/uK618fJf3AzqGnzFxe+AVD++qdfceUbAuWve/7tTsCr/Fc4+bu6519nKS6+hPj566TH8lshXfVKVB6TTf2WH9LnOrammz41B+e8lr7xe4O4PypEZUsoZzniQ1f5EK+xXvCjOP1RE2W3/Ye+KEd8RCkfZZwWvCHN6zO/zB/rQ1QZrx/0SPW0xzviDgcjSe1HyRztUY64H8CwkdN3jAtxxBWyhoXorUybfphYQ5keojAy6g9xxCWXhoUoFELap5fudp63Nr0EnnE8Ki2EFEbprXuTjCtGyQaiZOqifKtFj+f3qGTao1Ra9EwZpa89yhF3ERoZpe8aF+WIe/DMjDLsRbnWHqXSglzlDM5Mi9JRWparjNK4sdJRWpxPqS20C7Y2ubcXZV9e6I/yrWrfvsIwIMq3utrpU6lw4cgfFnleXd/2wQ9993ceJ/Uz/gc=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter18/fig-18-04.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-17T07:22:56.393Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"xGAb2ozbJGSwOJ0eM6Gz\" version=\"16.5.2\" type=\"device\"><diagram id=\"6eYZ95Ioyt_LsSiEXXUj\" name=\"Page-1\">7Z1dc5s4GIV/jS+zY8yHncvayaY7bXqRdLed3OwoRjGkGHmxEif99StssGOkrRHB4OVoJtOCjIk550i8egCnZ0/mL1cJWQTXzKdRb9D3X3r2RW8wGA498W/a8Lpp8NysYZaE/qbJ2jXchj9p1tjPWp9Cny73NuSMRTxc7DdOWRzTKd9rI0nCVvubPbBo/7cuyIxKDbdTEsmt30KfB5tWp9/ftX+k4SzghRfmJN82a1gGxGerN032Zc+eJIzxzdL8ZUKjVLpcls37fv+PV7efK6ExL/OGZ7oY/xiPA3pxMz2z/LvL57v4LNvLM4mesuPNPix/zQUQn3uRLnJynzaNl5wkPPOpL9aF8JyEMU3EurVejyKyWIbrrTdbBGHkfyav7Inn+8nXxvJR5B+JJpy+vGnKjuqKsjnlyavY5CWXfPOO1/3V1c4tO/cgeOPUtpFkCZlt97xTUSxkQmqIOtAU9SaNxThgSfgz1TLKZCsKvVyF84jEIm7ELzSN2bp7pU2cLbKliD7wbPGecc7m2UqSadBXmuUnbPGVJDOab/IQRtGERSz1N2ZxGoEFC2O+Vs0dix+h46T/m9tzxZFNxLq1Wxc/6eYJn7B4yRORk3S3lCz5ii7V/v8yp4dDcch251iu2+VdF4fLQxLdiPGKxLN1rwr4PMo60CoIOb1dkGm66UoMqptOlo5uZOcTE1o8ROsBJQh9n8Zqq/TisDaWJpfPdOOvVd6hQRWHHE2Dsp3thNPeG4nE8cWEiy7zFPtLyfXt56weBMcEodL43fVcuCYXWrkYgeTCM7nQyoU1AAnG0ARDLxgeSDBGJhhawRj0QYJxboKhFwyU2jOnaSYZZZOBUn1augjQ0KoaaZUmszwavLI0mGUXxwerEmDs5oAADjI1ogAGsCxwsqmfDJgiApxt6icDBmJZ4HizQjRQMJYFDjj1owEDsixwxFkhGjBVKDjkrBANlDI0r6kMy2qRZSnC1izLGmgQzS4OENteYFhW7ryJgmFZBWXAKad+MmCKCHDKqZ8MGJY1AMecFaKBwrIG4JhTPxowLGsAjjkrRAOmCgXHnBWiAVOGamBOw7KOxLJUlW3DTxWi37h5Xtqzro8INjrXLB8FMJhlo2NO7WSgVBE2OubUTgYMzLLROad+NFBglo3OObWjAQOzbHTOqR8NmCoUnXPqRwOmDNXgnAZmHQtmKcqXhmEW+K2b225gYFb+K00UDMwqJAMcc+onA6WKcMAxp34yYGCWA845K0QDBWY54JxTPxowMMsB55wVogFThYJzzgrRgClDNTingVlHglmqc1SzMMsBv3dz2w0MzHLAuaZGFMBglguOOfWTgVJFuOCYUz8ZMDDLBeecFaKBArNccM6pHw0YmOWCc84K0YCpQsE5Z4VowJShGpzTwKxjwSzFQNQszHLB793cdgMDs1xwrqkRBTSYBY459ZOBUkXk02+TDAOzitEA55wVooECszxwzqkfDRiY5YFzzgrRQKlCPXDOWSEaMGWoBuc0MOtYMKv1L4D3wO/d3HYDA7M8cK6pEQUwmOWBY079ZMBUEeCYUz8ZMDBrCM45K0QDBWYNwTmnfjRgYNYQnHNWiAZKFToE55wVooFShg5lzkmkbAjR+H4OljxhP2jBT4XFJApnwv2LKU29Ew2pBeGURB+yF+YiH+uQqZKVpIdNcxgmm639NypzgfPvqipnsv0Lk9+FkIYySbzvrvijExNf5nfT7oq/nTydivoyMvM7rL53YurLWIp2V/3tFOBU1JfRz0OH1T+xk25+Gnqj/qzD6p/YWXckA4ygu+rbJ3bWHcmMwOqu+ta++KrHH5q8YDySZ+HyNLyr4qsu1zcqvjzPtWHEV/6BsUbVlye6Do76qm/EblR9eabrwqiv/AqnRtWXZ7oejvqtn3Tlme4QR/3Wz7ryTHcEo77d4Fn34zWdz+Lwy9930+e/vt4/fjsPLs/kqVZv4EWp1g9MHORbE7x/nlj+wtlyfU/qB7GBNVq87F4US7P0/0m+G/GpNnvatHfX2dHBmYTuxaF3GSvP4oyx1Yx1Ds5SGjVWdZ3WGFvF2FPrsqrHSYyzVZwtMrW2+6zqaRDjbA2DcevOqh7wMM7WUD+pKuNGnVU9r2GcreM827q1qgcujLV1nGhbH49VT0zsW7t5mHJnniP7+AHOx+KtP22XwjkmMT5qDrXOifl4mC8ZH0vchNr2GdM6jJOMj2Vu7mjdyMP4yBhZYt7Z+sB6GBYZH8sUrK0beZgNGSNLVKytTyqtwyjIGFmiZG3SyNtP1qMdfB6Pl+fPs9cvn/784/6xxCXREj6O/48+SqYprC39/EKDA6vSxloqVjwbiw9CtG1jLfUqno3FCWQNX37wLhtrKVfhbazjiwreZWMtxSqejRIGaLs71lKrGh9b74+HL1IaH0vUqq3POQ5fkTQ+lihWW/exlsuP3+F8LNwg0OBFZDUBqOXqI56NJ+djLSgHz8eCje37WAvLwfOxQSPFasJSubevXYmDCq6ZT9Mt/gU=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter2/fig-02-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T06:33:09.104Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"ZzK_DkKH8b283yS7PXpY\" version=\"16.5.2\" type=\"device\"><diagram id=\"_zHYkpfvwAWn_asyx_K_\" name=\"Page-1\">7ZrLcpswFIafxst2QBhClolz6aLtZMbTNlnKRgE1IDlCjnGeviJI5qJgk8QTNJRNJjq6IP6j70gca+LMkuyawVX0gwYongAryCbOxQQAz52Kv7lhWximjlUYQoaDwmSXhjl+RtKomq1xgNJaQ05pzPGqblxSQtCS12yQMbqpN7uncf2pKxgizTBfwli3/sEBjworsKzS/g3hMFJPVhUJVG2lIY1gQDcVk3M5cWaMUl78l2QzFOfSKVmKflcttbt5MUR4lw7e4687DMhjihG20wXObp/vv0jnpHyr3pfRNQlQ3seaOOeU8YiGlMD4O6UrYbSF8S/ifCs9BdecClPEk1jWogzz27z7V1eW7io1F5kc+aWwVQXC2bbSKS/eVevKbi+lsl9wlvtYFAklqLBc4TiW9bpGUraUrtkS7RFGLTXIQsT3tANFOxTUVpH0wDWiCRLzFQ0YiiHHT/VFBeXaDHftSv+Jf6QL3+BOOe4TjNfySal4c0TEqzb9zFHG645LOaMPaEZjyko974WYDROMcUhEcZkPLeznT4hxLIg5kxUJDoL8MeebCHM0X8EXpTciPAhbfX21OigfE2V7JVW1irhNiacnTVGFTBV3ji/6qSZuvhzmsihVG7mq8nKQK/vEKLCABtbvmwEjpfasbR2nCmHTzyQMOD0SZr2LMLs3wryuhNlGEeZphMEBAiaB2uHTF1EnmtobmkAyQMWzurqmOMDXHCC+ah6Gq79vmP6n/0W4adnPe1cfnIwbevdPUavrju4ataOreVcYW8C822Ax80zDzNbEHjE7dB4+jJlnFmZ60gcyPkDKJFW23zdVYKSqO1WdEz5mUQX0zPiY1Puwk81K6qlpVyInEQ4dYOh8/SO4/0hqaVqPkbR1tTodIQNGQQbcMZAe38e+UT5W064EUhGUFsMNpL5pgdQbIesO2bQjZKdGQQb6/Jn50Ga531fv3Uw/wcfH/51Zdr2hWEy6NTe0K6shipnKXo2lspvGB0L0VAvRw8wStKS8+w/RvsH4GnfWdXvD92MHIVejbNhflFpY6xszW79H8HPAN3WaUQ70Lb9+sWDI8tvNjErv+uu7zHjqf9OF3uPnoVsOhI2l0zwPFi+knQf1cdz6OP6xzpWiWF5OL5qXF/ydy38=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter3/fig-03-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-11T11:22:18.536Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"D5m9HwRjp_pRQqV42t-S\" version=\"16.5.6\" type=\"device\"><diagram id=\"IgVY7a_BC9MwR5xifWp8\" name=\"Page-1\">7Vtdk5owFP01zrQP7vCtPq6uu8523G273W7blx0KUTOLxAlx1f76BkkUCCpYBLS8OOSS3MA954ZDuDbU3nR5h83ZZIhs4DQUyV421JuGohi6Rn99wyowaKoUGMYY2oFJ3hqe4B/AjLzbHNrAi3QkCDkEzqJGC7kusEjEZmKMFtFuI+REZ52ZYyAYnizTEa0v0CaTwKpK0tY+AHA8YTMr/MTU5H2ZwZuYNlqETGq/ofYwQiQ4mi57wPFDx8MSjLvdcXZzXRi4JM2AX9+7r/D2cWjcz77oD+po+DrsN7mbd9OZsxv+8PjQp5ZvL4/+7+Brv/+R3QBZ8aAQsKRzdidk6lCDTA89gtEb6CEHYWpxkUt7dkfQcWIm04FjlzYdMPI9vANMIA32NTNPoW37k3QXE0jA08y0/BkXlFnUhtHctYF/OxJtiffP74X6BMuQicXjDqApIHhFu7CzGoNmsQVW5nBNQqByypqMS+ONp2286QELeZbwK0L4hVgD1772eUxblmN6HrSikY9GhQYDr374jSudN3+Gz90sI60Vby0hCYbJRou11+OuOpv2dqjfCI/8DDCkEQH4EDYemmMLpCAksCNpKUIYwkxPgIzbMHBMAt+jyZyEI5vhM4L0kjcMMZibVZQw3EFwO2xMOPf2u2nF3BATjwER3KwptbnlVCx7e0byAK7ujbtps/vJMgdAf25qh0k2piyapc+ozXJr/uYepGSYYpnGAtAWE6+dAKKRQ94lRkRc9falHVu6duacGLd9MBxkNgtZ08/gcNBk1RCidgrqpyb3AfrS8JmrULeZ38HbnWualDxNMoV29U48TQ+Cq0l23VSMiO9mO0Y8NBp54CS5me0B8J8xMYZ81lU3Pi4nnrb387SdjqdpWF1d2qqZaJtCt+TM3GKIqUTBU47kacxN/Kl3YnVgCFCuXwByV/wWRdYXiBXR/Hwp03RhKdMSGJPHK0Bi+Funz6RqSWpZjSEgHZk2snHA0YkTp30YuVPLarkVDUHZurqTicw5qZl2SnqXrWZqXV2gQOHbhzUVa2F9VrzNtjWRn7JOS91aWafHUny5X++qX6q0jquR0rW1XMBrarXEdXyn+WhxrXTKFddyBTatNx/5KqKuZT0TnXPSNByJyouaWl8XqVPEbaOai7XAPgPiFrDh9m/crRV2ejDFPbh1xYqA6MVo7LgmKV1jcwKUWl0QU71lC7WEqqoCHo4cico/HGuhVmSBgVJzsRZqZyjUlLJqDFJztxZq6cEUt3Muu8ogvg9XukwT39dZofdVY13sfblF3oaoBk9W5Z0c+9xfOc+oynsvGyuyxGpq4iMyuxpodWIypuBKbyVFTcplffDQY8+1oz94CI5SSrvcoBNrZy76Y6Fe3EYGbW7/ZhXgtf2rmtr/Cw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter3/fig-03-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-07-14T14:24:16.276Z\" agent=\"5.0 (X11)\" etag=\"E-nha_KSy34UWql-ehKJ\" version=\"20.1.1\" type=\"device\"><diagram id=\"IgVY7a_BC9MwR5xifWp8\" name=\"Page-1\">5VpbU+IwGP01zOrD7vRCCz4KojvOIDrsrLovTqYNNLNpw6TBwv76TW3S0gTGiggRn2hO0i/pOfkuDW25/XhxRcEsGpIQ4pZjhYuWe9FyHLttd/lPjiwLpNNtF8CUolAMqoAx+gcFaAl0jkKY1gYyQjBDszoYkCSBAathgFKS1YdNCK7POgNTqAHjAGAdvUchiwrU8awK/wnRNBIzu7IjBnKsANIIhCRbgdxBy+1TQlhxFS/6EOfcSVqK+y439JbrojBhTW6Is97wdjR+vL6zZg+jjp/0Mf0urDwDPBfPKxbLlpIASuZJCHMjVsvtZRFicDwDQd6bcck5FrEY85bNL/VFyRkgZXCxAolFXkESQ0aXfIjolXyJ/dIVzawivy2gaIV3iQEh97S0W1HCLwQr6xn687v3hC5HQ/96dufduJPh03BgIkO+WQw55jFke2ZR5BpI0ZlZFLVfpwgm4Xke0XkrIQmsU1LnbyNBMKyFe52elef31jy/xCjEgKHnepJYR4qY4ZYgvpKN7NuOwmtK5jSA4q7VqK4Yctz1Mko7DNApZJqdF4nKp95eNe9NqgUYpCkKPrVwtiKctaVwdvsVQx+sXNe8kKRk/nJrHyoknZlHkW8YRdIbTOJITf6HJ8nAGlJNQIcnqUEZecQFgNPZUQFQtveUR+wGte1xlwCl3feWAJqhj5ZOr7lHNwNNPR5RWF2vlFHyF/YJJrRyxQnCWIEARtMkF50rCTney+MTCgA+Fx0xCsN8mrUBr+GuaB7zFE+xfT3k+Wu2jepQuwt5evX86350vPzbvmkC+LuOXZwcunzIGz882Xxc7btY1FrL19gtQkADJzYkOKoSq9o1jo1KkN3ze63dOYKd4Rm1M7Qjj223Rlexo1ZOH701Grw576jg+eTO72x7qKUqvGfnl8v+QiVt92w3yqmGSqffl3T6q/ZJCtnkZYWO9e0kL4y4Y2Xk9FTT9P2FFoYTdvAySzlGs/Uiq0yue6mypPcYnEsNcUMlfqpnLU2dUDGz5/zo6AcC0gWXX9QF3cP74Nv+XjuClOZvkOCdzrS7FxHerD7+KIZXX9C4g/8=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter3/fig-03-03.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-11T11:21:24.138Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"wwrSu2L-KgqisEbDd3db\" version=\"16.5.6\" type=\"device\"><diagram id=\"OJfH5U2ScXOQNmsXuO6G\" name=\"Page-1\">5Vtbb9owFP41aNsDFY65lMdC2apJvWit1nYvU0ZcyBZiZAwk/fVzGickNjSGJnZKX1p8Ehz7O9fvODTgcBZ8I/Z8eokd5DWslhM04HnDsrqdNvsbCcJY0IatWDAhrhOLwEZw6z4jLkxuW7oOWuRupBh71J3nhWPs+2hMczKbELzO3/aEvfxT5/YESYLbse3J0nvXoVO+i1ZrI79A7mTKnww7/MLMTu7lgsXUdvA6I4KjBhwSjGn8aRYMkRdBl8ASf+/rjqvpugjyqcoXwvb30A7uLi/+/vz90HteN69WwyafZWV7S77fzwzIBRN9ekYEs//BF758GiaQUBSwJw6mdOYxAWAfF5Tgf2iIPUyYxMc+u3Pw5HqeILI9d+Kz4ZitGTH5YIUIdRnYZ/zCzHWc6DGD9dSl6HZuj6NnrpllMRnBS99B0XZabMRXziZAwU5IQAo0s0+EZ4iSMNpU3sbC/HC90XOfi6ZZFXOZzS1rks67QZ994ArYQxlQUoYEPfKds8ioIww9e7Fwx3lF5CFCgUsfos8nEEI+fozuPGl1e3x8HmRuPg8zgxtEXLaxSE8ZwJEj+YsAN1swXpIxKjI7WS0Z4DtbgE9kBHk2dVf5ZWzTBn/CDXbZAjdat/JqTz00mSJePv9W1qOEidr5eXrCNNQmE0SlaV5MI9304dbSKbaWCTOH+U4/4RHT/pPcnoY0Vf8RgDyV/ed0ixrbVfmPVYxI3j+2BZmMMylFmN26edW+2zqBadcdGMGhTOHUk3D6Nfpxfbz5T/Bf0FXDv7IEeFp6AvTZsuIM2EmGj9lrm+z3Mgob+6a6OMgX2ZSpVCdkKCBqTjXTgZ4wkeZc1y/bMFQVbKxGkUrTQzUnmoA4UcWaS/aRUV1wvAEVdES0zQZUIPO7t0bUlFJ0soTiVTKhHk2LiUNrO/56vNIS1HswcxDjqeZwChQq5aq5g+gqpskDUGDfmorkWD31oQ+gPvxhFzQ1IRBAJuXXV6MPlO9MMwjQLT3hmacQoLidUGUpKtb+h5II2BIm0p31ZHr/RttQ1bGxeqWo+FdVnSXagG4WUX5noMI61pS6RQcT09yhjqrbTxXYfuWd7dM8BKar02QHdSjB+oU2rrXmshQ4rmFoalKdWgpHRpkoykvO4soI7FMXpYG3zLD7ahwpbCooF2Jmw3szra6TLHxogG+K7cW+3gif2F3GEO/uj/mcRcgmxmmSVf6rBuZpklXcNtFYfB1Mk9IXpAzRJEvu9nwmaPGywiN+F0jyUdlFt1lPdS6q0MnQ3aNNd2usDFag8JpqvVg/NSqDFSiyYWjqUgZ/uNNksQ+UzvvWPpA0UcW5KYk/dWoNGA+KsD4EGBYfz2p1dSgTjbpBU5OgCPdjBO+9N5D4bGFvILGgQvYBjbKP4+kNQIXD5mqy87s7iSvt9RPdFBNqO6UFBRGnRNuwjAYAsf1wuG2I5Y3moz744U5pRW+EoCS3TstQXaqTKWgo6e5oGkZicwRW97InG25+Jxhra/NbSzj6Dw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter3/fig-03-04.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-11T11:40:00.697Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"6vT5c3aywo5LcfKhZ7iC\" version=\"16.5.6\" type=\"device\"><diagram id=\"6tWrPLTI28i2UeIAHrzu\" name=\"Page-1\">7Vxtb5swEP41kboPk2LANP24Zt2bNO2lmrZ+dMFNrJE4I25D9utnCiZgh9mhAVzSLxEc5gjPnZ+7sy8ZudNF8j5Gq/lnGuJo5IzDZOS+HTmODz3+mQq2mcBzx5lgFpMwE4Gd4Jr8xblQDLsnIV5XBjJKI0ZWVWFAl0scsIoMxTHdVIfd0aj61BWaYUVwHaBIlf4kIZuL1xrv5B8wmc3zJ3vj/MICibG5YD1HId2URO7VyJ3GlLLsaJFMcZRCJ2DJ7ntXc7X4XjFeMpMbvqNvH8i3H/GNTz5dT7/8+Lj447zOtTyg6D5/37MzxAW3r/jH2VnAP189Hob8A6eHj6/CtgIehhP+9Ms5W0RcAPjhmsX0N57SiMZcsqRLPvLyjkSRJEIRmS35acC/P+byywccM8KBf5NfWJAwTB9zuZkThq9XKEifueFexmUxvV+GOH21MT/L34IrwEktPKAAnfsqpgvM4i0fklT9bVs93exsDoRp5yV7C29GuZvNCsU7U/CD3BoHWMZTLKNgP+MgrGpfPZ8Q6FYMHz8RkokKyWQPIl5biDh6RPZ5Ssk10XqVUcQdSVLfMfObevOoyJWw8brExn0G2CRVDPqC6lwPFV6Gb9LQkbJThNZrElSx2kc+OFTiiHaelSCAeyAQshhHiJGHqvp9uORP+EoJf3ABuFudxjKwa3ofBzi/pxw//q/mXFLDUDzDTFHzaKLilZtbbWIdHYLznvnwwqY5P7GLD4WtrAbHEkIEahJ4WowI5CSuISUCv1tOBAYZ0aANV5D4Ew1XfL2uDKema0ix3FArqwJsDd+1VlkBG0orz7JkAkCbAiawrLwC/nNAx5J8wjssn8hJqzYmcSzi7a/80uPJTfnK26RythVnCWG/Ssc3QgE/3t2Snog7DGLff+kkiz0GTpQFF+3AvmIsgFVqapocOeOqntdysG47yJ5coQ8kxMFFQ9MBObGVFbVtOoPSdmCm86UkqWlmqyjqOLUV37tkulvFdsNJbb0atPvKbR2D3HZYM8e5ONLMURR1PXMMMvC2y5JiVdeWLR+r8u7MQvZUJY5BhtM/OpZUJY7BDsKwmbHxMqeiqON1Ttc5ddO54Eimc+X51bbpDDam2w5qnlwW9b3W5hokad3xdmYie6Kaa9VKZB06lkQ11yBBGhY1ek51NjfO9xVFHef7widOx3QQHsl0iqKuTWeQkHRdqvUe1Ty7etAcu6KaZ1XMr0PHkqjmGaQAA9pBEnSi3UESTqTdQfL0+6cvO0h6NzRIrrqmecfvm+atWnTy9Ful3TKXwSpT/+jYQvOHbfM9e5r3TWl+Ykrz+q7bF5rXuqF4DZvWqPreeIEGPTzd8VhmIXtYHhrUf/2jYwnLQ4O6cEAsL9hEy/LCibQsD/Wl7AvL693Qgq5fKPdV9b1mA61aa4eWdf1Cq7oP6tCxheYPa7d89jRv2vULTbt+4UvX7zFo/uTaPJSu33FT0/kaRS2bzldrjkCx3WBaR+WFPdeQwFtrHfXVoiYcLvxywd17566vlkl4uPDLmXD/8J9c47Tc/9C4PVBR1HF7oH/YbuEQTCc3ZDb9oQ+UTdfxD338k2tfcnVJlvFP2GUfOFq2xk93/0qWDd/9s5t79Q8=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter4/diagram-04-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-11T11:59:07.788Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"QYIg99UJNksNRJ3U6ATr\" version=\"16.5.6\" type=\"device\"><diagram id=\"VG0u8cqzUguId8PNqFFr\" name=\"Page-1\">7ZvLUtswFIafJsvOWL4QWJJA2+kU6DSLwlLEIlbrWBlFIXafvjKW4stJgA4BGU42GetYluXz/ZHyS/EgGM/zL5IukgsRs3Tge3E+CM4Gvn8UhfqzDBRVIAy8KjCTPK5CpA5M+F9mgrbaisds2aqohEgVX7SDU5FlbKpaMSqlWLer3Ym0fdcFnTEQmExpCqO/eKwSEx1Gdfwr47NEdU7Mqa1rHmSZ0FisG6HgfBCMpRCqOprnY5aWqbNpqa77vOPspl+SZeo5FywvvuVXvy8nl/Lqp0dvv1/cnRWfTCv3NF21n3epCpsBxXJ9g1Gi5qkOEH24VFL8YWORCqkjmch0zdEdT9NOiKZ8luniVHeR6fjonknFdW5PzYk5j+PyNqN1whWbLOi0vOdaC0nHpFhlMSt775XNi0wZdZBjXTYd1w2yfGdGyCbPWp5MzJmSha6StyVWtIvrGrPVatIgbGPUCGu2abdOvj4w+f8PFj5g4eNhEfaLRQBYBHhYDPvFIgQsQjwsiNcvGBGAESGCEfQLxhGAcYQIRptF6JjFELAY4mER9ovFMWBxjIfFsF8sTgCLEzwsurO3axh2zGz6PQ8RjqBnOLbYb7z+e+iaBjTgNoSBRtgzGtCCE7we3DkNaMIJYhfuHAe04QSxD3eOAxpxgteJb74sznBAL07wmnH3OKAdJ3j9uHsc0JETxJbcOQ+7P9zc90Psyd3zgKYc86Z44BoHdOU2hAFHdzJ3jgPacsxb485xQF+OenfcOQ9ozFFvkDvnAZ05oMGy+LT8o2Cd5QaYx1Om0yKLa3PyoXDTLJzlrVJhSzlX143jm8ZxfUlZsFdUfWYx+KtiB4x+LrGSU/ZIRkxCFJUzph6pd7IddANktAWkjUmWUsXv293dRtfc4Yfg+kE2Ogo632vf6wikekxzVa0R2FDUEWTUaajKA2joQWybx36B/uBSxKvoj7wb/Vlv86QAw4MA9yFAuPiCfAC0S4FPCrDxL+2DAl+gQLje9PoKJH1WoP2FfpiD30SA9sdlL4dA4mQI9J8pQHKYhPeiQLikiH0IjJ47CUcHBe5DgX6Px0A3CrQvEz6pQP+gwH0oEC4c71WBLufTDyKRXTvVb6UQuJb9YRRCdqybvjOF7HjP48UC0cX6Reiqev0yeXD+Dw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter4/diagram-04-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-24T09:23:39.974Z\" agent=\"5.0 (Macintosh)\" etag=\"apGPE0G1fcG2nx0sVERq\" version=\"17.1.5\" type=\"device\"><diagram id=\"r8ogiY8uB4qGxXzg6cRb\" name=\"Page-1\">7Vldb5swFP01eYwENkmTx4R23cukTdE0aS+Thx2wZjAzJiH99TPFfDiQhKhdId1eEvvYXNvnnHtlkgl0w+xRoDj4xDFhE2DhbALvJwDMgK0+c+BQAHAJC8AXFBeQXQMb+kQ0aGk0pZgkxkTJOZM0NkGPRxHxpIEhIfjenLblzFw1Rj5pARsPsTb6jWIZFKhjwxr/SKgf6JVnCz0QonKuPkgSIMz3DQg+TKArOJdFK8xcwnLqSlqK5z6cGK32JUgk+zzgHnicTH+s7aev7vJLCiP+nU11lB1iqT6v3qw8lASQCK9yHlUv4pEC14EMmerZqil4GmGSr2CpXntLOj7BBsl6g4+Eh0SKg5qwr6mdab6CJqsaE4QhSXemNEgr7FfhqhU+c6p2AqzM9JS2ol1KU0ZIeCo8oh9qUnkcZ3khkETCJ7IVSDUap66hZ6WuUG3ZUi1RK8qWdJJk0tQrkYL/Ii5nXNR6biljRxBi1I9U11NKEoWvd0RIqrJipQdCinG+zHofUEk2MfLyNfeqBPR3RR6TZGd9oUfvTvDdsM28wzbQOu0QQ5NrBSiN9Ep5s+WR1JUP3EIeVWS/NJGgM2wi2V31b86k1sQQdP475eXANHlWa6Um2CDO6kHV8vNvnyNWRlI7K4IVQyPN0t4e7J+1YHE5bZ03Tdu7y2nrK1ri/oevLh7oZxnBOkvKkeMX/Shx/hYl8DIjXd5pmBUlcXHv2tIsd1OHc86LcdlPQ5HTZZfrqoPioaM6rG6rNLwfQe3F8AWgqoIjqQDOcBVgcYLT8Rimyy+vUQHW77MCjF9Qu/3u9OYV4Phe5AxcAcqCNEQJWJ4gdTyOAS9/R/inbgE3oCgYXw0Y+hYAhnsRqOQYsWO6Lkn/7wGjVFR16x/Vix+K6j8m4MMf</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter4/diagram-04-03.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T07:03:52.229Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"53lOOylO5Lx337QGhmBm\" version=\"16.5.2\" type=\"device\"><diagram id=\"r8ogiY8uB4qGxXzg6cRb\" name=\"Page-1\">7VndbpswGH2aXGbiLyS9TFjXaVOlTdHUaTeTBwbcGcyMSUiffibYAQIh0KYNiXqT2Mfmsznn+MOYkW4F6R0FkX9PHIhHmuKkI/3jSNPMicF/M2CTA4au5IBHkZNDagEs0RMUoOyWIAfGlY6MEMxQVAVtEobQZhUMUErW1W4uwdVRI+DBGrC0Aa6jD8hhfo7qilLgnyHyfDnyRDQEQPYVQOwDh6xLkH470i1KCMtLQWpBnFEnacmv+3SgdTcvCkPW5QJrQ6J4/HuhPv2wbr4nekh+4bGIsgI4EfcrJss2kgAYOvOMR14LScjBhc8CzGsqL1KShA7MRlB4rT4lER86FZLFBO8gCSCjG95hXVArCfRLrEqMQgwYWlWlAUJhbxduN8I3gvhMNCWtekpYUZXSyAgxSagNxUVlKvfjHAvEAPUgqwXihdJdF9BWqR6q3dRUi/mIrCYdgymr6hUzSv5Ci2BCCz1dhPEeBDDyQl61uZKQ44sVpAzxVTEXDQFynGyYxdpHDC4jYGdjrnkK6O6KLCZMW30hWo0DfJdsYzTYRlcOO6SiSV8B1KZ1Y+KMbJdsnVKoYP5LiGwYx9v8NucdVC1Ki0Ze8rJ/jwAsI/GZ5cHypoGqm01RZG3tRGprytDkri+4mhoepyXqfvO7Bxb4IyMovUiZdePEeC1OpCZtnDS5p2RXEEf5E9tFaeanBu+0y3HcUWdj5+UJghPRkCDml5UdrkhRbXg5wDh3DtDPlgN2cgzYMcYr5YDFVeaAYSn61X18xF98/HDvW7OfWjChAerytpSnAE60fNvrtyfqnRKMs2WERoY6JMmXJ4RWbYbrnqZk+b4luFw9m9L7G28I9lb/G74TNDIyOdvqNw4wOhy3mO+bgR6rf/h6To97/ZpOTqcnOjrVjgU63dFpo2wdTnL41i3Kii6GqdBvUZLSxiCOkd2mZnVhOdAFyXaJ8ijyG4I6y+vi6Mz4YE4vwQZaVb3pM12gmu1xnm0CXi2+qOTdi69S+u1/</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter4/diagram-04-04.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-24T09:54:20.912Z\" agent=\"5.0 (Macintosh)\" etag=\"g5ymVWzsFlM_boXNuZB2\" version=\"17.2.1\" type=\"device\"><diagram id=\"r8ogiY8uB4qGxXzg6cRb\" name=\"Page-1\">7Vpbk5owGP01Pm6Hm7dHZe223dmZ7ux0tu1LJ4UA2QbChqC4v75Bwk0QsauCTl80+QJfwjknhyQ6UHU3uqPAdx6ICfFAkcxooN4OFGWoyPwzDqyTgDpVk4BNkZmE5DzwhN6gCEoiGiITBqULGSGYIb8cNIjnQYOVYoBSsipfZhFc7tUHNqwEngyAq9FnZDJHPIUk5fFPENmO6FlJG1yQXisCgQNMsiqE1MVA1SkhLCm5kQ5xDF0KS3Lfxx2t2bgo9FibG/Q18YObX3P57Zs+fQxVj/zENyLLEuBQPK8YLFunAEDPnMU48ppHPB6cO8zFvCbzIiWhZ8K4B4nXqkMS+aFZAlkM8A4SFzK65hescmiHAi+ngGoaoxADhpZlaoBg2M7SZT18JYiPRJGisqaEFOWRVM4QkJAaUNxUhHI7z75EDFAbskoiXig8dR7aMHUAa9MKawHvkVWoYzBiZb4CRskfqBNMaM6nhTDeCgGMbI9XDc4k5PH5ElKG+KyYiQYXmWbczXzlIAaffGDEfa64BbRXRZwTRo26EK3aDrwLstFqZKNKuxVS4uRQAuS6eTPCMdgW2SglZ2H0GpK04SbY+NuMXyArfpQ38pIdf9sE4DQTH1mSLGnqKbvxEIVrK0diO/PQ3tBdnXAVNmwOi9/+4bMXFvidZpAOA0VpB4p2KlDS/ptAqZNPQa8g8JNXtoWiWFA14mnmY7+kOkPn/Q7BgahxiNll2cMVMar0zwQmXXuA2pkHZHT0WDHaiTxgfpUe0C9G762XF/zFwc8Pjj75rrhD6qI226XEAjjQ6XbvsEXRwZagdeYItQi1MMn3G0IjN/1VT51Z/reDy+Wzzt7PvCDY3hifcVNQC8mws+mv7YC0P3IZnWj661c5/fvP53i/1q/p7HR8pMNTZV+i4x2e1tLW4iyHr938uGhhGAn+5gUqDQyCABlNbJYnlgktEG6mKM+S/oogT5K6ODzTPozGlyADZYs9+R9lkNG+K9HxZKBNbm02ftWCR/fz8n6qOwvwo/1S/ny7ee18L+9aSM6ydm8koxdmXzvCU63dL/7lfaF8tl67d7aT79oNzrKUb+Smv+o51VL+4g/3e8cnr+Z/sUjWDvnfVNTFXw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter4/diagram-04-05.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T07:09:41.842Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"ktEi6yiEI_JgyoBN_dom\" version=\"16.5.2\" type=\"device\"><diagram id=\"r8ogiY8uB4qGxXzg6cRb\" name=\"Page-1\">7Vpdb5swFP01eezEZz4eE9p1W1VpVTV13cvkgQPuDKbGJKS/fiaYgIFSojaBRHtJ8LW5Nufce3xxMtItP7mmIPRuiQPxSFOcZKRfjjRtbBr8MzVsMoOhK5nBpcjJTGphuEcvUBjzYTFyYCQNZIRghkLZaJMggDaTbIBSspaHLQmWZw2BC2uGexvguvUBOczLrKapFPYvELlePrNmZh0+yMeKkZEHHLIumfSrkW5RQlh25ScWxCl0OSzZfZ9f6d2ti8KAdbnB2pAwuvi9UF9+WLO7WA/IL3whvKwAjsXzisWyTQ4ADJx5iiNvBSTgxoXHfMxbKr+kJA4cmM6g8FZ9ScI/dCSQxQKvIfEhoxs+YF2CVuDllVDNbRRiwNBKpgYIht2du90M3wniK9GURI4pEYozRXYQkZjaUNxTRrLqZtbuhwHqQlbzwy9Kz1yYtjztwdmsxlnEZ2Q14hhMmMxWxCj5Cy2CCS3YXCKMKyaAkRvwps15hNy+WEHKEM+JuejwkeOk0yzWHmLwPgR2OueaC0D3mEh9wqQ1KkTvtBnuUswYDTGjK6+Hh0TJvvirTUkzxinWS7KNk4KE8XNM8o6LaCtucz5A1cKk6ORXbvrtEoBzT3xlmbOsa6DkpksUkq19ENn6ZGBs19OtRobLUQm7P/tuswJ/cg9KKyZaBROzGybGoTDJt7Q2TJqCpxStIAqz3XqJkjScGkKnnY63A6o3dN6vDxyIBn2Yn5Y4nBGjWv8aUNXF3jVA700DdnQMOGKMA2nA4iw1YFiM3iyfnvA3Dz/cetb0p+ab1Edd3pQyCeBA5296+5VEe0uCqvUmCY0QdVDJ9ytCKznDDZ8mtfyvB6fLZ5O+H7kiMOTsV3vOfrO37DdeQXQ40TI+UPZbZ5n9w+dz8nasn9Gx6c7PO89NTb3dz8edmzaS1uEgh1duYXq5xDAR7C1KRNoYRBGy27iU08qBSxBvE5R7yX8+UKdZWxycGZ/Gk1MIAkUmr5pbXYOgum1V/XxcEBjTS5dNno3ozv+6uplZ3hV47F7GH3Df7u9NvhGSo5TtrWQMQugbV3iosv3kN+4T5bNz2X68t3hjWGpwlDK+lZvhRs+hyviTP9gfHJ+8WfyzIqsdin+n6Ff/AA==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter4/diagram-04-06.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-24T10:04:20.430Z\" agent=\"5.0 (Macintosh)\" etag=\"sdzarpRykyzf9gcCF3a9\" version=\"17.2.1\" type=\"device\"><diagram id=\"r8ogiY8uB4qGxXzg6cRb\" name=\"Page-1\">7Vpdb5swFP01eezEV9LkMaFZt1WVVlVT171MHhhwZzA1JiH99TPBBBxcStQmIdFeEnxtrs05515fnAxMO8yuKYiDW+JCPDA0NxuYVwPDGBo6/8wNq8JgmVZh8ClyC5NeGe7RCxRGTVhT5MJEGsgIwQzFstEhUQQdJtkApWQpD/MIlmeNgQ8bhnsH4Kb1AbksEI811Cr7F4j8oJzZGBYdISjHipFJAFyyrJnM+cC0KSGsuAozG+IcuhKW4r7Pr/Ru1kVhxLrcYK9InFz8nukvP+zJXWpG5Be+EF4WAKfiecVi2aoEAEbuNMeRtyISceMsYCHmLZ1fUpJGLsxn0HiruSThH7oSyGKB15CEkNEVH7CsQSvwCmqoljYKMWBoIVMDBMP+xt1mhu8E8ZUYWiZrSkhxoskOEpJSB4p76khuu5m0+2GA+pA1/PCL2jNXpjVPO3A2aXCW8BlZgzgGMyazlTBK/kKbYEIrNj2E8ZYJYORHvOlwHiG3zxaQMsRjYio6QuS6+TSzZYAYvI+Bk8+55AmguyZynzBrVYXoHavhrmnGUmjG1F6Xh0TJrvjrqqAZ4Rxrj6x1UpEwek5J2XGRrJPblA/QjTirOvmVn3/7BODSE19Z4azo6im5+RJFyjY+iGzT6BnbzXBrkOFzVOLuz77ZrMCf0oPWisl2BOjdMLH2hUlJURsmKvHU1AqSuNitPZTlclJIp52OtwV1NHTenx84EIr8MD2t5HBGjBr9ywHDY+cA82g5YENHjxVj7SkHzM4yB/SL0Rvv6Ql/C/DDbWCPfxrhkIaoy5tSkQI40OWb3m4l0c4pQTeOlhKUEHXIku/PCK3k9Fc+qmz5Px+cLp+q/H7gisCSo/+ALwVKRIZHi37rFUT7o5bRnqLfPsvo7z+fl29r/YyOTTd+3nluapntfj7u3FRJWoeDHF65xfmlh2Em2JvViHQwSBLktHEph5ULPZCuA5R7KX8+0MdFWxycWZ9Gl6cgAk0mbzu2uopge9va9vNxIrDGVz67fLaSu/Dr4mZiB3Pw2L2M39++bY6OVrYrITlI2d5KRi8SvXKF+yrbT37jPlE+O5fth3uLt/qVDQ5Sxrdy01/17KuMP/mD/d7xyZvVPyuK2qH6d4o5/wc=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter4/diagram-04-09.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-24T10:30:56.397Z\" agent=\"5.0 (Macintosh)\" etag=\"VCByfXIIONK_C_gv-lhh\" version=\"17.2.1\" type=\"device\"><diagram id=\"r8ogiY8uB4qGxXzg6cRb\" name=\"Page-1\">7Vpbk5owGP01Pm6Hm7dHZe223dmZ7jidbfvSSSFAtoGwISjur2+QIFcR6w2dvij5Al/COSeHj2hP1d3ogQLfeSImxD1FMqOeet9TlL4i8884sEoCmqolAZsiMwnJWWCO3qEISiIaIhMGhRMZIZghvxg0iOdBgxVigFKyLJ5mEVwc1Qc2rATmBsDV6AsymSPuQpKy+CeIbEeMrKQdLkjPFYHAASZZ5kLqrKfqlBCWHLmRDnEMXQpLct3HLb2beVHosTYX6CviB3e/pvL7N338HKoe+YnvRJYFwKG4XzFZtkoBgJ45iXHkLY94PDh1mIt5S+aHlISeCeMRJN6qTknkh2YBZDHBB0hcyOiKn7DMoO0LvJwcqmmMQgwYWhSpAYJhe5NuM8JXgvhMFCkqakpIUR5IxQwBCakBxUV5KMt5xjsSMUBtyCqJ+EHurrPQmqk9WBtXWAv4iKxCHYMRK/IVMEr+QJ1gQjM+LYRxKQQwsj3eNDiTkMenC0gZ4qtiIjpcZJrxMNOlgxic+8CIx1xyC2ivijgnjBp1IXpHW/Be5ldkVTaqtF0hBU72JUCuWzcDHINtkbVSMhYGbyFJO+6Ctb9N+Amy4kdZJz+y42+bAJxm4jNLkiVdHWU3nqJwbeVIbHeP7uqCq7Bhc1j89je/eWCB32kGqREUWSmBorQDRTsVKOn4TaDUySenVxD4ySPbQlEsqBrxNPOxW1IXQ+dwh+BA1DjE5Lrs4YYYVS5vAlrXPEC9mAds6OiwYrQTecD0Jj2gW4w+Wq+v+IuDX54cffRdcfvURW1elxIL4ECnr3v7FUV7W0K5WBqdzxJqIWrhkoc7QiM53ZVPnVv+94Pr5bPO389cEVTelc5YEtRi0r/Y+te2YNodvQxOtP71m1z/3edzuFvrN7R7uslz6PapuivR8bZPa2lrsZvDqzc/PrQwjAR/0xyVBgZBgIwmNosLy4QWCNdLlGdJf0eQR0lbbJ9pHwbDa5CBVGJP/kcZVN5my4mOJwNtdG+z4ZsWPLufF49j3ZmBH+2L+dM9vcubemcs3mshOUvx3khGJ8y+doanKt6v/uF9pXy2Lt4v9y6vXdgOzlLLN5LTXfmcqpa/+v39zvHJm9m/LJLiIfunijr7Cw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter6/diagram-06-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T07:58:50.038Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"TLgAopzbzdcw9ocLYHqu\" version=\"16.5.2\" type=\"device\"><diagram id=\"UnORSrFGrbqB2hR2rCz-\" name=\"Page-1\">7Vxdc5s4FP01fsyO+bYf7TjZdiY7O23a2fapozUyqIuRF+QY99dXFMkYC8c0Y6wrj18SdAEhzrnncq8QHjj3y+LPDK3iv2iIk4E9DIuBMxvYtmeP+d/SsK0Mrj+qDFFGwspk1YZn8gML41BY1yTEeeNARmnCyKppnNM0xXPWsKEso5vmYQuaNK+6QhFWDM9zlKjWf0jI4srq2F5tf4dJFIsrO0Mx7iWSxwpDHqOQbvZMzsPAuc8oZdXWsrjHSQmdhKU67/HI3t24MpyyLic8fZ6M8sVHd7nJvk+/PhXkw/u/7/yqlxeUrMX9isGyrQQgyuh6pV5MXP8FZwwXbUygf2UP9d1yJ8F0iVm25ccVTaKFf9ieaG9qtCWE8R7Q0oYEv9Gu4xoDviFg+A1I3NOQbGLC8PMKzcv2hrv9wJnGbMkvM7P4JspXlScuSIH5paYqeq+ScQipCp0ubDwFm5ECDh87a+KRs4z+h+9pQjNuSWnKj5wuSJIcmFBCopQ35xwmzO3TEgnCpTgRO5YkDMvLTNsI4G6ahiXcs+E1QR7oV6gHTKEjbQoNjkAKx13GCjZjsxUKH3L5ANMp0TEwiVrWaUx60uiODsAeYyvoyFGbKlMTUHf069RyoAlVX7q74wOwy6gJr4xsxgrVANQhVKUBNKF2KAT6Eir8KslSawJLxccsocJHXXasU6jg5o9sfanvjg/ALtOS+jpmC9UE1AGkvuCmkWx9qa8NPwmzW1Jf13ChGoA6gNT3oETdZcLaMNGX+doG5GBq5mu6TOGD7qhZzMVlalnAdOp0SDJ60umOD8Au05Zt+Ekpy3yF0gZM/v/rclVAJam7vIJrUgKR4Xov34rK/57sh4+r6qqymx0FTKBUTZEuHwXG0KJAhwymryjgHUEVkMu05TJniQL+dUYBAyjtsByh99o6gBYF1HUIF4sCoyOownEZt23e9CxRILjOKGAApR1mffuOAgdBYKw5BrgdiqSeYoB7DFNADqNWSyo8RqnUBNA7TPn2/qx2gMm0QxXTl0zdI6AC8hi1nDH8dZUJoANY9GwdvK6ydMtU36pnF/4aXFetNwxfp2UA6FIhexA3b5VmLKYRTVHyROlKYP4dM7YV33mhNaNNRnBB2Bdxern9tdz+I/BEc1bs7ZttZSPlt/NF9lA2qtNsT7br83616hPDSfmNWEltgvKczD/FJK12PJJEDupomMnpOpvjDn7JUBbhV+kWTxUcNj5HU8nOcIIYeWk6+fmpVdVTjuxZNIUszsa29Sa2h+ay7cNiW01p+mRbUiUItzqyLfxiR7h2tp2ObMtXtFDYVt8P98t28Ca2bUPZli/6oLDt3bT9Brb9rmwHsNj2b9rukW05cQ+F7eCm7d9nWz6OT7LtwSJb/dT+Ju3zkT0GRbavltY3ZZ8kW6ZeJ8mW3wZBYfuy1faVSLs727ACua9O3N60fZrtoCvbsKpt/9JzK9eh7a5s28Ai+aXnVq5C27KsOs22tki+CInz8HH6efJ++O2dNXnEQy+4E76ndTWBxl9+acXkIh8BvMoGiBdmrSNUV59Y6uwc1LeUhmKuAmzYs/a8YfU1v+w9qvJm/XuXv/bt/Wao8/AT</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter6/fig-06-01.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-26T03:54:02.344Z\" agent=\"5.0 (Macintosh)\" etag=\"P97z9yYVQUf-OvFriKdF\" version=\"17.2.2\" type=\"device\"><diagram id=\"rPxaSJdkIvPcn3-rQgUL\" name=\"Page-1\">7V1dd9o4EP01ecweLNkGHvPRpt0mbXazbbZPe1xwwK2Dcxyngf76lYttsGSDCJY0o9CHnkhgY2buHc1IM8MRPbufX6TBw/QqGYfxEemN50f0/IiQAfXY//nEYjnh9wbLiUkajZdTzmriJvoVFpO9YvYpGoePtTdmSRJn0UN9cpTMZuEoq80FaZo81992l8T1T30IJqEwcTMKYnH2Nhpn0+Ws2+ut5t+F0WRafDItX7gPyvcWE4/TYJw8r03RN0f0LE2SbPnX/fwsjHPRlWJZXve25dXqudJwlslccB2fX559+n754/N/0cmHi+fM/3Z7TJZ3+RnET8X3LR42W5QCYHdhsmaD0+dplIU3D8Eof+WZaZvNTbP7mI0c9uddFMdnSZykv69jgsj/sfmEXRFlufqdfCg+d/FVfoZpFs7XporvcREm92GWLthb5nVsLOrD55V+yqnpmmrKuaBAxKS670pq7I9CcDsI0fNFoY0ZiIrhLJnl0kuTp9k4zO/zWyhpNk0mySyIL5PkoZDg9zDLFgUFgqcsqcuXyStd/Jtf/4dXDr/Wh+fz4vbL0aIajU9yKqwehs28jfJv+fv1xyxNflTwJuX112EaMQmFaXmbeZStfT4bfa2NVp+eDxZrA/5OrRh4TJ7SUbhB1qUSsyCdhNl2ZOeK2AipNIyDLPpZZ3vnECkfGzfRhqaJ5ohCs5xorkGqlcvtNqo5FBTXPO/VoQQBRnqwMNK3DyOdwaERbTow4nWNkeLS6yRiD12tan3OffS9+h2W36i4iANa9RR7+ALlMozLF/B5qZl2BuiBwtooTGQp7MAy867FGHEZA5CiBJYzUD43MoNM6gaZ9AwbZHeoh2wvM5Iv87lfSOoWb71DqlFZqrmgqOY1MEuJQTa89HaHGx0Y6XyvrNnvppzB4i3R8kHV+d0UpZnnopVqbMzM2+xTQfO7XVkK+6DMvKtrC86cpvdXqmpzS0otVJaD2+dQbG9dC4/F8BuKzvfY9vMHe5owcvAHd8AIrE2c8rmR+W0Ot2FKPNOO2+HMQ5899nA6buVzY+PakDucMB4k6Tqc2JUxjwyRGXfNHjAf6HFlKe/KunpdWW8AVJ063BTX72t2VHxZ4znUAz/iGj4x9lFaZX7Dz/iRsSvmjxl0d5qOHDbzH66708fp7ri67LrhVLFWzYLJydm6WaXaxPZxmlgX2OmAp+kQeGdetApbue86qCPbkdyG3d0JVkwRH+xenaYdtu01B0QTpF6IBOFGLuVu5OmNq3xdCf0oz4k0RTcuv4b4es/l/YaVFgYIwNiVzvPlXrhUSdsVn7sRVWZXPn25Ov0ek9vL44/0mnx+fzwm5Bh+BUhThhhqK7UdxMBOlYrnRubw04G5ne5Gquky3geqVcsAYKo1QgTqWYiFZ/zyEDG2EdcIEQfqAUurKlT7Yh5Xe10VX++6beDy5W4udyPF2wYlJJEttC5f70bFhZY0LLRE1UKrKZtOV3VFtyujJlJqDJUbMQA/g8ceZ0s6OAe2kkLdgIekVKiLd1d2ohKI5YZCB737pui98bmxeVP8tkVDKohWb8qBepjVKmzlNovzbaikb7O7k6Q64CA4KcKXRzbki2uliC5H4uBsHhPZUl1irJy72Yq+Ej8DF0aMlXg1+6K6VtoDRnbACKw8TIKzNN/rcUv2QN+SvXF5wCZHzvWhpl0fp0FsB5ulyGbJlsqZ8302Pjc2rnFto2hDU1+9XIPfx88erslWVpHOcw/3wwj8njOvECOdF3/uF2cc1myAGAG2e46zkNLjcxFM+8fkYI/1cU22tpIYa8PfjJFDEjZAjMDaPybwW4S9QozAahFGcFbmesOWU1BjcfbBHuvj2kCWa7DibHLYiwGIEWAx1AClPfb5Hj6mYyjn4Pvo45pskWJ5EAWFaziLFH2+5ISY5tohcV4b10oKAd4/3vjcyLmmcVlrbqklI0YB2Guiq7MQJsYdWZdsTQtegxbKuX2bZ3HZ1dWPUO/at8F0n00Hp29J+YxnVySh1qJ8mSIBENnuXa+YEGyDdPdS4M1zRTND+fYwyhL7G1Etk9y218piHxhLEXXXYkjPikb53VPeX5HuRMSH/TxmFVfiySxogDDbirTuTh/1AOilRUhby6KcgV4ADSXW8glDyYO8H0N6o2Q2C0dZ8K28Q2+jfwPuLGPQ5b5I8PjAZMEGd9E8Z1rNcRyHd8FTzF49ZTLLgmi2gSqb9bfdmzRW6CWGbLeCONnDZ3W5LY1RKajCdK3LrpgK4mgyY8MRE1QuvdNcFNEoiE+KF+6j8ThuU1TdAFqsBIl0YuU8h1bPQLusdlbMc69FC0Yg1ixNIkjzxDKeg1JC8yNKpCCq5jm4/flhlzkeinnut2gBEMTEoOPUMp4jUIKEi6qa5+B6mDk90dUES/RhixrgYMzpif7RmWVMx6AF0a/STnVCuL3ZspO/Oal0WdOtluorDUJGmbj9fW4X13GoAUKcXqP6wDjTu6yqUs10+BGi0xOjoTe2MR2DGiTOblQzvVrG+bNbc1LBs/W+0iBglDliRPTWNrJjUAOAYzaH//kd3zTZyz44GMjuwD/jcRwxJrqwjOwo1CCRSaQ8YOd/es882btsaKSa7G6LHiChTAyL3tlGdgxqkDhbUr4RD679daeZ1qrJ3m/RAySUiWHRe9vIjkANRIymtJMdYDdLPGk0Kw1CRpkYFv1pGdlRqEHihEk12WkfWszeaQ9g1WSnLXqAhDIxLPpgG9kxqAFC3hy0kL3T3kiquQ4/Z8tp6G1yaRvXMagBQu4ctJ/jcTptUKCa7AjSthqKC65sIzsGNYjBlP6FHVxzKIooe67SIGSUiVHRR8vIjkINALLnKH/yRk278RRRAh1FkLlFxbDok21kx6AGAAl04FrnOxRRAh1FkLnV0HDs2jayY1ADgAQ6g73wWoQiEdtA4brbpgZIIBOjor8s4zoKNQDIn/Og1bu5iNLnXAR5W64YFP1tG9cxqEE6fS6XShZkUZJLb7hba80XFMbU6T80Tn9ECXUugkwuVwyTbmyjPwI1eGJ0pX+pJ3W33vxP1nqIEuoqDUJGmRgn/WMZ2VGoAUCOTX1dN72qe4gSbDwEmR2e6CV9sY3oJtXAhmmSZGuvXbDvNr1KxmH+jv8B</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter6/fig-06-02.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-03-26T03:58:05.698Z\" agent=\"5.0 (Macintosh)\" etag=\"s1-DpJLCAGxHsPcD4mhS\" version=\"17.2.2\" type=\"device\"><diagram id=\"rPxaSJdkIvPcn3-rQgUL\" name=\"Page-1\">7V1bV9s4EP41PLIntiwneeTS0m5hyy7bsn3a48YmcWsijhEl2V+/cmMnsWQHEWxpRoUHTiTHjjIz31ykT8oBObldnOXR3eyCxUl24A/ixQE5PfD9EaHif9GxXHWEg9GqY5qn8arL23Rcpf8lZeeg7H1I4+S+9kbOWMbTu3rnhM3nyYTX+qI8Z4/1t92wrP6pd9E0UTquJlGm9l6nMZ+teoPBYNP/Lkmns/KTSXXhNqreW3bcz6KYPW51kTcH5CRnjK9e3S5OkqwQXSWW1X1vW66ux5Unc65zw2V2en7y8dv590//pkcfzh55+PX60F895UeUPZTftxwsX1YCEE8RshaN48dZypOru2hSXHkU2hZ9M36biZYnXt6kWXbCMpb/vE8IovgT/UzckfJC/V7RVMddfpUfSc6TxVZX+T3OEnab8Hwp3rKo28ay3nzc6Kfqmm2ppuqLSouYrp+7kZp4UQruGUKkoSq0WBhR2ZyzeSG9nD3M46R4zk+h5HzGpmweZeeM3ZUS/JZwviwhED1wVpevkFe+/Ke4/zdaNb/Um6eL8vGr1nLdio8KKGwGI3repsW3/Hn9nufs+9q8/er+yyRPhYSSvHrMIuVbny9aX2qtzacXjeVWQ35Sqw3cs4d8kuyQdaVEHuXThD9t2YUidppUnmQRT3/U0d65iVTDxg20sW2gearQHAdaYBFqVbh9CmoeAYU1Sn85K0FgIwNQNlKNG5k/DqXEJ7TtkIl7UOsMVY2gfQHUfF2oebCghrPG8OtQ8weWoRaMzUBtP/PfL6LtCemWWNgh1Igu1AJQUKMNyOrFHVt2qt3ZjQkb6bwSLW+9ZKkY9NphEclhyZ5oNdDyJsnQ1qN4gZsnKN38UJLa0LabN1W82IPwCzDXubtthpJfaWFtFdQolgIHJxTBptWBrh+noGJ9NW5k/taTSlif2na4w1esGcMa1cVaCAtrFCfWxtJ0kfXkxtR00XMRcy8skkv3vMDMR2bSFCKnKYHZNKVCKTJYyJWS9VnUQF3WshhvmuZqduMJbrwZ4ow3wci9nORZmrWQjO9ZCa5ssD8XO8TpYgNg0yrU0Oz5s3HRKuzek4dR3bI9zTmO52chPUOkit7gVGtqqvppKpSpGeg9LUF5UECkB1GziW1oimeEchJ2bMaaAjmGhGYXNMKGSAvDCMD4lc45PXuGKm2/EkoPIoYL5jHKbI6M7M0jffx8cfwt86/PD/8gl/6n94ex7x+aQma3FAWU3r7C+NPOwBrrqNFEoM40OsiE0DcRWLMs1biReeNAJoES1Rv7Dd7Y78sbG1qsNkVM69Z9GqrmDSbLjTYAfxHVnYisnZ5bc7eNJuJBnYKDpNS+/QSVdnStt3QZqoDW4Q5ZzJUroIYlw75i7s4pPWxylEmqDewfo7mLKZ/0GrcOfV3CtG+NVN8ct+BvOv0FbQQWGdPHSX6nA8kdj2yHNZykViqFNWI7rHkNYnv1WT35LF1Sq724tnPc2LAmbcwkDYdSmMVa8Io1Y1gLdbHWOQX3ZVjDyZSl8lSz7bjmv2LNHNZ0ybO+teNfmm0E/vEvv6CNAMt9cNJq6bhllcda7vOKNXNYG+lirXOC3suwNkKJtTAAlvt48DeFu4O1sSbWqokfKFjDSTAMpVM4PN/yPGSlVuRyNOiydm6ERSZGIpNpAlWORvmuOmJU/OyW6OpBATKjXLeU3NIEbdBE1dc3q0qXeE7lZGIkPahnetZYg3YxFVZyp4+e9Ynr0dfqCYNmXUEtXkZdBsvo/m51+vxNuiiQVnNXcXITPWTi6rGQGY/S+Q6o7Nbf0z7MGpNCDZnXijjF4HldbitnVAmqdF3bsiu7oiydzkVzIgRVSO+4EEU6ibKj8sJtGsdZm6LqDtBhJWis6fSOc2iLyqRLzlnPOKctWrBiYs3S9BVpHjmGc1BKaB6ixnpS3zi3WbQ1C6XLSd2ecR62aAGQialFx7FjOEegBI0UtW+cg9tv5A3UVBMs0MctaoBjY95AzY9OHEM6Bi2oeZVxqPu+tD++OnfDnlS6JNb2C/WNBiFbmUqwPXUL6zjUAKFOr0F9ZB3pXVLk+kY6/ArRG6jV0BvXkI5BDRprN30jfR3G5XO57EkFz9T7RoOArazh5yXfugZ2DGoAsMzmyYdlhbbB3ukPgPUMdg/+Go/X8Es7Z46BHYUaNPYq9l6wywdl2gd7l7vK+gZ70KIHSFamlkXvXAM7BjVorC31PhFv8RCSFql0ye/rG+zDFj1AsjK1LHrvGtgRqMFXqynjYAd4pAAeGs1Gg5CtTC2LfncM7CjUoLHC1DfYyRBazd7pQSx9g5206AGSlall0QfXwI5BDRB4c9BK9k43Q/eNdficLa9hw+u5a1jHoAYI3Dlo5116ne5s7BvsCGhbDZsLLlwDOwY1qMWU+cAO7sQAgog9t9YgZCtTq6I/HAM7CjUAYM8ReeWN2E7jCSICHUHA3CJqWfTRNbBjUAMAAh24cxA9gohARxAwt6rUbUuel66BHYMaABDoLB6i0yIUjdoGCtaDNjVAMjK1KvrTMayjUAMA/hyFtt8tQESfCxDwtgK1KPrLNaxjUIM2fa6QCo94ygrpjZ93oNseG2Pq8B9bhz8iQl2AgMkVqGXSlWvwR6AGqlZX5kO9X0/r7f9uCEVEqFtrELKVqXXS346BHYUaAHBs6nHddlSniAg2FAGzg6pZ0mfXgG5TDaKZM8a3rp2J7za7YHFSvON/</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter6/fig-06-03.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T07:38:13.449Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"nyB1iqM8ueEHaoxAX9RR\" version=\"16.5.2\" type=\"device\"><diagram id=\"l3nq_wCWnY9jHQWyh2ix\" name=\"Page-1\">7VrdbpswGH2aXHYCTEi4TNNuk7ZKVStt0u48cMGagzPj/PXpZ4qB2BCVJQislF6kcDCf4Rw4HydkApar/RcG1/EDDRGZOFa4n4C7ieO43kx8ZsAhBxx/ngMRw2EO2RXwjF+RBC2JbnCIUmUgp5RwvFbBgCYJCriCQcboTh32Qok66xpGqAY8B5DU0Z845LFEp1aFf0U4iuXMTrFhBYuxEkhjGNLdEQTuJ2DJKOX50mq/RCSjrqAl3+/zia3lcTGU8DY7fEMPm6enH7++B5jf3mxfHxdscTPNq2wh2cjzlQfLDwUBEaObtRyGGEf7Jtrh72K4VT8uuzxbcZEgukKcHcSQvSr0QV3dVWS7EoqPeC4wKOWNyroVBWJBsvAfjNjvMyIISUKUFbEm4HYXY46e1zDItu7EPSCwmK/EpHe2WHyhCZdX9VysniTymLDTUtVZHIonp4Enj3B5xgph3t8NLTbcpG9cLMQA21nvq41iKcr+20UZcVR5pRyvqSAI5CrVKWf0D1pSQplAEpqgbFJMiAZBgqNErAaCcCTw20wOLG75hdywwmGYTdOoraq+Ji8VYzHPLmVnelVqe+/fFigJF5nhZswSmKY4UOU5SZztlFShsObG7/rIESfTBk4KjCECOd6q5ZuIkjM8Uvx2HUvhPNWmgMZ0SjcsQHKfYxfWyvhqGcf/NJ2rlThkEeK1Sm+ylWd9gZLzj64kUCXwzlRSK+Nb/crom9C5zWrdhSLm9e5cLXPsHDQ95XTRvZ2xexupd9PT2ocyfdvpxvX1Oj3bPgAm2L7m+kPbvmuq7edqGWQDTXG/C9sHo+0bqfeY2jSvcs60fS222bbIbTO/+us3w4HZR9dVC1/l17EXhjh73nM7bxHG+09xQ/fzFtF2oH4+N8vfi8Kd93N37OdG6t3i5cR1+74ev842/lqhnp3fbZHI+w5y/sDG77YIt8MYf66WQUbQFHm7MP7paPxG6t3iPf11G78W5ErvuvT9mzVokHNbBPTen/8HbwMt0u1AbcAzzBaa4mMXbcAb24CRerdIxtfdBjT7PvctjtZNen6JU3AxynhpitO/3u0sxInV6peZ+fDq163g/h8=</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter6/fig-06-04.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T07:55:29.447Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"z3lJR5FKxpSg_7UW-Xe0\" version=\"16.5.2\" type=\"device\"><diagram id=\"UnORSrFGrbqB2hR2rCz-\" name=\"Page-1\">7VzbctowEP0aHtPBNxweQ0jazqTTadNOk0cVC1upsagsgunXV64kwAg3DhPkjcNLYq180zl71ruyTM+7nBXvGZonn2iE057bj4qeN+65bhiE4m9pWElDMBxIQ8xIJE3OxnBL/mBl7CvrgkQ4r+zIKU05mVeNE5pleMIrNsQYXVZ3m9K0etU5irFhuJ2g1LT+IBFPpNXr9zf2D5jECd/pmCG9rzLkCYrocsvkXfW8S0Ypl1uz4hKnJXQaFnncdU3v+r4YzniTA26+X5zn06/+bMkeRvc3Bfny8fOZ4uIRpQs1XnWzfKUBiBldzNVumHFc7IMd/dS79837ctajFU6C6QxzthK7FFWilX+4gWovN2jrkyZbQGsbUvzG6xNvMBAbCoZnQOI/DckyIRzfztGkbC+F2/e8UcJn4jJjR2yifC49cUoKLC41qkVvG6V6fkzo2sImMLDxDXDEGHkVj5wz+gtf0pQyYcloJvYcTUma7phQSuJMNCcCEyzsoxIxIqR4oTpmJIrKy4z2ESDcNItKuMf9LkEetq/QAJhCzyEpNITlLkMDm6BzCgUGuX6AtSnRITCJOg4kjTr9/eC1ho77BlQKDnSvfZk6HjSdgsp2JUWAXMbMdwfd0yk00CHUpCE0nTYoAyzqFFiN5JgVQQefp8BA1yduU6fgJo9cUHnv1jwjDJcx897uPU/BgQ4g7wU3heSCyntdYCmY+xbyXnCgA8h7d8rTdRrcGiag0l4XWgZmpr1e92QKDHTPzGGsy9RxgOnUa5Bj2NOppAiQy+xLNgZpKct8jrIKTIPfi3JBgJTUWS7huihHzfCmV2zF5X9fn0fclzyVtHcuCoCj1MyQ7EeBIbQo0CCDsRgFAmAusy+XOUWBV01pg5UIRy+tQ2hRwFyC0GYUOIflMv6+WdMXiQLBm4kC0ChtMOd77CiwEwSGLccAv0GRZC8G+DXYtYaOWS2Z8Lx2lYIDvcGM79Gf1R4wmTaoYizK1AfmMWY5073pNXCgA1jv7Oy8rXLalimoBc8+sOW3vllvON2TKTDQtUK2IK4OlTKe0JhmKL2hdK4wf8Ccr9QnXmjBaZURXBB+pw4vt+/L7XdhoJrjYqtvvNKNTAznTp+hbMjD3EC3N8f9a20OjC7Kz8NKalOU52TyLSGZ7Lgmqb4pOUwcGR+J7QQTAQVdsAlu4KgcsRj/l+yaN5MMp4iTx+qdvDy1pnrK4d+qppLFi7HtHMR2v0Ns17zgssS2mdIck21NlSLcaci28os14fDY9hqy7dZMXlhi2/xc77hshwex7XaFba8mu7bEtrkI9qTtA9geNGW7JkmzxLa5ROuk7SOy7des87TEdnjS9guwrZdQPcl2zZtHS2Sfn6Rtk+xhm2QPzNL6pOznk60XXT1JtvwYtzW27VbbXZV2c7ZbDeQDc+L2pO0D2A6bst1qtT2wPbfSUW03ZdttN5Lbnlvpprb1Aqmn2T5SJBfNzY+y/evb+mE77+ov</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter6/fig-06-05.drawio",
    "content": "<mxfile host=\"app.diagrams.net\" modified=\"2022-02-15T08:15:14.672Z\" agent=\"5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.3 Safari/605.1.15\" etag=\"ex4sNlfpPyisxALDlJxB\" version=\"16.5.2\" type=\"device\"><diagram id=\"myoUr3GNk_nKLyKWxfPX\" name=\"Page-1\">7V1bc6M2GP01fkwHIS7mMZdepjPbbmen080jtbU2U2JcQjZOf31FkLAtkUBMQIdYL4kRGJvvfBx0dKTPM3p9t/s5j7frT9mSpTPXWe5m9Gbmuv485H/LhqeqgTgkqFpWebIUbfuGL8l/TB4oWh+SJbs/OrDIsrRItseNi2yzYYviqC3O8+zx+LBvWXr8qdt4xbSGL4s41Vv/SpbFWlxX4Ozbf2HJai0+2XfEjrtYHisa7tfxMns8aKI/zuh1nmVF9epud83SMnYyLNX7fnphb/29crYpurzhtvi82V6vfv3thv3x/fdF8WdByQWtzvI9Th/E9YovWzzJAKzy7GErDmN5wXZNYY//loc7+vci9dXyLGHZHSvyJ37I7hhokSAXkdh+3EfbE03rg0DLtljgu6pPvI8BfyHC8IaQkPaQ8Ihslqw8iTOjV4/rpGBftvGi3PvI7wLeti7u+IfeEP7yxdAdhuhlcPS4mQqM2xCYIOWfevUt49dxGKHg34dM7ri4f76nL/kBJNju9jv5q1X5/1qehn+r6kxVuxZ2HsDiOLb3RZ79w66zNMt5yybbsPJDkzRVmuI0WW345oIHnPH2qxKOhN/kl2LHXbJclh/TCOYx3B8GT+Lh3fyEmr77fZjbv8IHKF+CgQjg6lwIAA7REJABQtMMMMdhgBAsX6KBGODybBgADFF5vxplAKpQgGkF4OJIgAOliJEvVgT0ZAA4RBGGAFQGMC4D3A7aaCwKAJONbpNCsjJgyog2CbuRKSBC6wN0kEZjEUAAli5NAsmqgCkj2qTrlJizzfKytFPK4KXx/X2yeA57nBd68wEwxyErURUWDwn4NtslxVexr3x9W77+wRdbN7uDXTdPcmPDL/mrOP3zxsG7ys392563no7gYkvN7lEoil919pAvWIc7gF/9ir0KdCvOfgPOsi1naVwk34+/bxP44hM+Z8nz7Sez0VN7VY6SQNWFirftc0g7U6CcKFTOU8VBO89zLtaXfXp6ys4gVBe1HrgyddNSHJVKwTQNtSq1r1WFhiiASlW7qDVPGwsKjkilYJKGWpHalwHQEAUUqeb7ADgqlYJpGmpVal8GQEO0g0odmwE80wwgT4zAABFWvnhNAsmqgCkj2qTrDDMANT1fxesgjUZigAofoHxpEkhWBUwZ0Q7TM0dnANNmtddBGo3FAD5YvjQJJKsCpoxoh+mZw3pVtT91Ozuwp173qg7sqdvZgXU1glclGLPVq6LtVD+qWaWaTF3NKqKN0rjKmQa2qzxjbuqJ2XZKZr9jhtKuGeq1T561GdolQ2VETPaitG6U8Yn/Po6h6oPZb36T8LZDKVNGFMBQrZkZhwJwHFUfzH/zraPalwLQEAVwVPGW//k4lqoPZsD51lLtSwFoiJqe+EtmJ0z8rTdGn/grJxa2StXqVsGRqpGSQadLVTUXB5aqcuoxRIaSV/PzHfPMbR90HTJ91PneJ08c1x/v/sjp00HTj97HcU0vbgqa5LyZPk7wQuyMhaZJF9uRjikjilDmKISjAJw6RwFYVZzA1jnqSwFoiALUOdJ6AcanjQQ4hY4CsLI4gS101JcCwBCVD2AoCjA+ezzEsTxDMIMsbNJIVghMGVEEy1OjANNCIMSxPEMwgyy0lmdfCkBDFNHy9EyvIw9xLM8QzCALreXZlwLQEDVteU5s/rjftdZR0M71Y1qeruo0nWx5UtX9GtizmhuzPKc5f1wO1rRmaCXpTGWoq1aQoirHTSdDAZQU1QpymVZScxwlNQfrd8+HUlJnM5gChyiCktImJxmnABwlNQfrd8+HUlJnM5gChyhAPR68xfjyCyFQAFj5lmiogjxnM5gCh6jbnuww88dn7yg5jY51uNpYh7p+uPP8XK0HNXJp56iDZrJjHfpC3NaxjjnWAoTpjsZFABWH9LKDpoVOhFNyKAIrUBMNVXLobMY64BDtMFFyfAowPXcs6iD/xqKA9ofdqKGp10vZwY6PAynCSjKNBExPHSFOBwU41q/lOmArj4gz1GKysxnwAMTUmGI1qzyjdiCGHPJQlyTTU4c8qLYOZ+QhD+IAKEpPW5Ns/kmCIykFREisY0Vl7ycJHKYAslLnAdOykjg4ulJABJQzEh0rLD8QpgDKkmoFCozzAAFSlgRNhRCrLPvyAB6mAIVKNB4gpufTEIJTqURAhJQzQ9UqOR9dgIcpQLUSTReYNpwJwalWIhBCSpmh6pWcjyyAw1TetFDdAeM04HYQS2PRQBVPpJRpkkxWFUwb0w5r7T7iFNtqpqMpv6m2l2oddOpiTV1RqbWYh/abXNOOpc2gEvd3S6DR8wfRrzT+s7vEBfIrO9QLHzk41q/s3ROBwxTRrzS+3o+4QH6li+ZtSXTswMQHwhTAr9R4wPh0eCJ/GwaBByiat0WtX9mXB/AwtWs336RH60l8rYs3xWPTmHRVf5eznn37Vu3qOWp3jShnGlq8UgTxqv3UsfFOKwUSrxRN6FArXns/rOAwRRCvcD95TiiQeKVoQkee2YrXD4QpgnhVecC4q+4BaVcPTed4Vrv2pQE8TM/UExUzxUwpS0+rC3SqsFQp9N0WcfLNPCtv0/3h/GZYf8qWrDzifw==</diagram></mxfile>"
  },
  {
    "path": "docs/images/chapter9/si1_e.tex",
    "content": "T_{n}=F_{n}\\frac{T_{i}}{F_{i}}"
  },
  {
    "path": "docs/images/chapter9/si2_e.tex",
    "content": "F_{n} \\alpha \\phi^{n}"
  },
  {
    "path": "docs/images/chapter9/si3_e.tex",
    "content": "T_{100} \\approx \\phi^{100}\\frac{1.1 \\text{sec}}{\\phi^{25}} \\approx 5 \\times 10^{15} \\text{sec}\n"
  },
  {
    "path": "docs/index.html",
    "content": "<!DOCTYPE html>\n<html lang=\"en\">\n<head>\n  <meta charset=\"UTF-8\">\n  <title>Document</title>\n  <meta http-equiv=\"X-UA-Compatible\" content=\"IE=edge,chrome=1\" />\n  <meta name=\"description\" content=\"Description\">\n  <meta name=\"viewport\" content=\"width=device-width, user-scalable=no, initial-scale=1.0, maximum-scale=1.0, minimum-scale=1.0\">\n  <link rel=\"stylesheet\" href=\"//unpkg.com/docsify/lib/themes/vue.css\">\n  <link rel=\"stylesheet\" href=\"./css/github.css\">\n</head>\n<body>\n  <nav>\n      <a href=\"https://github.com/norvig/paip-lisp\">Github</a>\n    </nav>\n  <div id=\"app\"></div>\n  <script>\n    window.$docsify = {\n      loadSidebar: true,\n      subMaxLevel: 3,\n      coverpage: true,\n      plugins: [\n        function (hook, vm) {\n          hook.doneEach(function() {\n            HighlightLisp.highlight_auto({className: 'lang-lisp'});\n          })\n        }\n      ]\n    }\n  </script>\n  <script src=\"//unpkg.com/docsify/lib/docsify.min.js\"></script>\n  <script type=\"text/javascript\" src=\"./js/highlight-lisp.js\"></script>\n</body>\n</html>\n"
  },
  {
    "path": "docs/js/highlight-lisp.js",
    "content": "/**\n * Common Lisp syntax highlighter\n *\n * @version 0.1.1\n * @author Andrew \"Danger\" Lyon\n * @copyright Lyon Bros. Enterprises, LLC\n * @licence MIT\n */\nvar highlight_lisp = function() {\n\t// all of the following functions were pulled straight from my syntax/lisp.vim\n\t// file in my vim directory.\n\tvar funcs =\n\t\t'\\\\* find-method pprint-indent find-package pprint-linear find-restart ' +\n\t\t'pprint-logical-block \\\\+ find-symbol pprint-newline finish-output ' +\n\t\t'pprint-pop first pprint-tab - fixnum pprint-tabular / flet prin1 // float ' +\n\t\t'prin1-to-string /// float-digits princ /= float-precision princ-to-string 1\\\\+ ' +\n\t\t'float-radix print 1- float-sign print-not-readable < floating-point-inexact ' +\n\t\t'print-not-readable-object <= floating-point-invalid-operation print-object = ' +\n\t\t'floating-point-overflow print-unreadable-object > floating-point-underflow ' +\n\t\t'probe-file >= floatp proclaim abort floor prog abs fmakunbound prog\\\\* access ' +\n\t\t'force-output prog1 acons format prog2 acos formatter progn acosh fourth ' +\n\t\t'program-error add-method fresh-line progv adjoin fround provide adjust-array ' +\n\t\t'ftruncate psetf adjustable-array-p ftype psetq allocate-instance funcall push ' +\n\t\t'alpha-char-p function pushnew alphanumericp function-keywords putprop and ' +\n\t\t'function-lambda-expression quote append functionp random apply gbitp ' +\n\t\t'random-state applyhook gcd random-state-p apropos generic-function rassoc ' +\n\t\t'apropos-list gensym rassoc-if aref gentemp rassoc-if-not arithmetic-error get ' +\n\t\t'ratio arithmetic-error-operands get-decoded-time rational ' +\n\t\t'arithmetic-error-operation get-dispatch-macro-character rationalize array ' +\n\t\t'get-internal-real-time rationalp array-dimension get-internal-run-time read ' +\n\t\t'array-dimension-limit get-macro-character read-byte array-dimensions ' +\n\t\t'get-output-stream-string read-char array-displacement get-properties ' +\n\t\t'read-char-no-hang array-element-type get-setf-expansion read-delimited-list ' +\n\t\t'array-has-fill-pointer-p get-setf-method read-eval-print array-in-bounds-p ' +\n\t\t'get-universal-time read-from-string array-rank getf read-line array-rank-limit ' +\n\t\t'gethash read-preserving-whitespace array-row-major-index go read-sequence ' +\n\t\t'array-total-size graphic-char-p reader-error array-total-size-limit handler-bind ' +\n\t\t'readtable arrayp handler-case readtable-case ash hash-table readtablep asin ' +\n\t\t'hash-table-count real asinh hash-table-p realp assert hash-table-rehash-size ' +\n\t\t'realpart assoc hash-table-rehash-threshold reduce assoc-if hash-table-size ' +\n\t\t'reinitialize-instance assoc-if-not hash-table-test rem atan host-namestring ' +\n\t\t'remf atanh identity remhash atom if remove base-char if-exists ' +\n\t\t'remove-duplicates base-string ignorable remove-if bignum ignore remove-if-not ' +\n\t\t'bit ignore-errors remove-method bit-and imagpart remprop bit-andc1 import ' +\n\t\t'rename-file bit-andc2 in-package rename-package bit-eqv in-package replace ' +\n\t\t'bit-ior incf require bit-nand initialize-instance rest bit-nor inline restart ' +\n\t\t'bit-not input-stream-p restart-bind bit-orc1 inspect restart-case bit-orc2 ' +\n\t\t'int-char restart-name bit-vector integer return bit-vector-p ' +\n\t\t'integer-decode-float return-from bit-xor integer-length revappend block ' +\n\t\t'integerp reverse boole interactive-stream-p room boole-1 intern rotatef ' +\n\t\t'boole-2 round boole-and intersection ' +\n\t\t'row-major-aref boole-andc1 invalid-method-error rplaca boole-andc2 ' +\n\t\t'invoke-debugger rplacd boole-c1 invoke-restart safety boole-c2 ' +\n\t\t'invoke-restart-interactively satisfies boole-clr isqrt sbit boole-eqv keyword ' +\n\t\t'scale-float boole-ior keywordp schar boole-nand labels search boole-nor ' +\n\t\t'second boole-orc1 lambda-list-keywords sequence boole-orc2 ' +\n\t\t'lambda-parameters-limit serious-condition boole-set last set boole-xor lcm ' +\n\t\t'set-char-bit boolean ldb set-difference both-case-p ldb-test ' +\n\t\t'set-dispatch-macro-character boundp ldiff set-exclusive-or break ' +\n\t\t'least-negative-double-float set-macro-character broadcast-stream ' +\n\t\t'least-negative-long-float set-pprint-dispatch broadcast-stream-streams ' +\n\t\t'least-negative-normalized-double-float set-syntax-from-char built-in-class ' +\n\t\t'least-negative-normalized-long-float setf butlast ' +\n\t\t'least-negative-normalized-short-float setq byte ' +\n\t\t'least-negative-normalized-single-float seventh byte-position ' +\n\t\t'least-negative-short-float shadow byte-size least-negative-single-float ' +\n\t\t'shadowing-import call-arguments-limit least-positive-double-float ' +\n\t\t'shared-initialize call-method least-positive-long-float shiftf ' +\n\t\t'call-next-method least-positive-normalized-double-float short-float capitalize ' +\n\t\t'least-positive-normalized-long-float short-float-epsilon car ' +\n\t\t'least-positive-normalized-short-float short-float-negative-epsilon case ' +\n\t\t'least-positive-normalized-single-float short-site-name catch ' +\n\t\t'least-positive-short-float signal ccase least-positive-single-float ' +\n\t\t'signed-byte cdr length signum ceiling simple-condition cell-error ' +\n\t\t'simple-array cell-error-name lisp simple-base-string cerror ' +\n\t\t'lisp-implementation-type simple-bit-vector change-class ' +\n\t\t'lisp-implementation-version simple-bit-vector-p char list ' +\n\t\t'simple-condition-format-arguments char-bit list\\\\* ' +\n\t\t'simple-condition-format-control char-bits list-all-packages simple-error ' +\n\t\t'char-bits-limit list-length simple-string char-code listen simple-string-p ' +\n\t\t'char-code-limit listp simple-type-error char-control-bit load simple-vector ' +\n\t\t'char-downcase load-logical-pathname-translations simple-vector-p char-equal ' +\n\t\t'load-time-value simple-warning char-font locally sin char-font-limit log ' +\n\t\t'single-flaot-epsilon char-greaterp logand single-float char-hyper-bit logandc1 ' +\n\t\t'single-float-epsilon char-int logandc2 single-float-negative-epsilon ' +\n\t\t'char-lessp logbitp sinh char-meta-bit logcount sixth char-name logeqv sleep ' +\n\t\t'char-not-equal logical-pathname slot-boundp char-not-greaterp ' +\n\t\t'logical-pathname-translations slot-exists-p char-not-lessp logior ' +\n\t\t'slot-makunbound char-super-bit lognand slot-missing char-upcase lognor ' +\n\t\t'slot-unbound char/= lognot slot-value char< logorc1 software-type char<= ' +\n\t\t'logorc2 software-version char= logtest some char> logxor sort char>= ' +\n\t\t'long-float space character long-float-epsilon special characterp ' +\n\t\t'long-float-negative-epsilon special-form-p check-type long-site-name ' +\n\t\t'special-operator-p cis loop speed class loop-finish sqrt class-name ' +\n\t\t'lower-case-p stable-sort class-of machine-instance standard clear-input ' +\n\t\t'machine-type standard-char clear-output machine-version standard-char-p close ' +\n\t\t'macro-function standard-class clrhash macroexpand standard-generic-function ' +\n\t\t'code-char macroexpand-1 standard-method coerce macroexpand-l standard-object ' +\n\t\t'commonp macrolet step compilation-speed make-array storage-condition compile ' +\n\t\t'make-array store-value compile-file make-broadcast-stream stream ' +\n\t\t'compile-file-pathname make-char stream-element-type compiled-function ' +\n\t\t'make-concatenated-stream stream-error compiled-function-p make-condition ' +\n\t\t'stream-error-stream compiler-let make-dispatch-macro-character ' +\n\t\t'stream-external-format compiler-macro make-echo-stream streamp ' +\n\t\t'compiler-macro-function make-hash-table streamup complement make-instance ' +\n\t\t'string complex make-instances-obsolete string-capitalize complexp make-list ' +\n\t\t'string-char compute-applicable-methods make-load-form string-char-p ' +\n\t\t'compute-restarts make-load-form-saving-slots string-downcase concatenate ' +\n\t\t'make-method string-equal concatenated-stream make-package string-greaterp ' +\n\t\t'concatenated-stream-streams make-pathname string-left-trim cond ' +\n\t\t'make-random-state string-lessp condition make-sequence string-not-equal ' +\n\t\t'conjugate make-string string-not-greaterp cons make-string-input-stream ' +\n\t\t'string-not-lessp consp make-string-output-stream string-right-strim constantly ' +\n\t\t'make-symbol string-right-trim constantp make-synonym-stream string-stream ' +\n\t\t'continue make-two-way-stream string-trim control-error makunbound ' +\n\t\t'string-upcase copy-alist map string/= copy-list map-into string< ' +\n\t\t'copy-pprint-dispatch mapc string<= copy-readtable mapcan string= copy-seq ' +\n\t\t'mapcar string> copy-structure mapcon string>= copy-symbol maphash stringp ' +\n\t\t'copy-tree mapl structure cos maplist structure-class cosh mask-field ' +\n\t\t'structure-object count max style-warning count-if member sublim count-if-not ' +\n\t\t'member-if sublis ctypecase member-if-not subseq debug merge subsetp decf ' +\n\t\t'merge-pathname subst declaim merge-pathnames subst-if declaration method ' +\n\t\t'subst-if-not declare method-combination substitute decode-float ' +\n\t\t'method-combination-error substitute-if decode-universal-time method-qualifiers ' +\n\t\t'substitute-if-not defclass min subtypep defconstant minusp svref defgeneric ' +\n\t\t'mismatch sxhash define-compiler-macro mod symbol define-condition ' +\n\t\t'most-negative-double-float symbol-function define-method-combination ' +\n\t\t'most-negative-fixnum symbol-macrolet define-modify-macro ' +\n\t\t'most-negative-long-float symbol-name define-setf-expander ' +\n\t\t'most-negative-short-float symbol-package define-setf-method ' +\n\t\t'most-negative-single-float symbol-plist define-symbol-macro ' +\n\t\t'most-positive-double-float symbol-value defmacro most-positive-fixnum symbolp ' +\n\t\t'defmethod most-positive-long-float synonym-stream defpackage ' +\n\t\t'most-positive-short-float synonym-stream-symbol defparameter ' +\n\t\t'most-positive-single-float sys defsetf muffle-warning system defstruct ' +\n\t\t'multiple-value-bind deftype multiple-value-call tagbody defun ' +\n\t\t'multiple-value-list tailp defvar multiple-value-prog1 tan delete ' +\n\t\t'multiple-value-seteq tanh delete-duplicates multiple-value-setq tenth ' +\n\t\t'delete-file multiple-values-limit terpri delete-if name-char the delete-if-not ' +\n\t\t'namestring third delete-package nbutlast throw denominator nconc time ' +\n\t\t'deposit-field next-method-p trace describe translate-logical-pathname ' +\n\t\t'describe-object nintersection translate-pathname destructuring-bind ninth ' +\n\t\t'tree-equal digit-char no-applicable-method truename digit-char-p ' +\n\t\t'no-next-method truncase directory not truncate directory-namestring notany ' +\n\t\t'two-way-stream disassemble notevery two-way-stream-input-stream ' +\n\t\t'division-by-zero notinline two-way-stream-output-stream do nreconc type do\\\\* ' +\n\t\t'nreverse type-error do-all-symbols nset-difference type-error-datum ' +\n\t\t'do-exeternal-symbols nset-exclusive-or type-error-expected-type ' +\n\t\t'do-external-symbols nstring type-of do-symbols nstring-capitalize typecase ' +\n\t\t'documentation nstring-downcase typep dolist nstring-upcase unbound-slot ' +\n\t\t'dotimes nsublis unbound-slot-instance double-float nsubst unbound-variable ' +\n\t\t'double-float-epsilon nsubst-if undefined-function ' +\n\t\t'double-float-negative-epsilon nsubst-if-not unexport dpb nsubstitute unintern ' +\n\t\t'dribble nsubstitute-if union dynamic-extent nsubstitute-if-not unless ecase ' +\n\t\t'nth unread echo-stream nth-value unread-char echo-stream-input-stream nthcdr ' +\n\t\t'unsigned-byte echo-stream-output-stream null untrace ed number unuse-package ' +\n\t\t'eighth numberp unwind-protect elt numerator ' +\n\t\t'update-instance-for-different-class encode-universal-time nunion ' +\n\t\t'update-instance-for-redefined-class end-of-file oddp ' +\n\t\t'upgraded-array-element-type endp open upgraded-complex-part-type ' +\n\t\t'enough-namestring open-stream-p upper-case-p ensure-directories-exist optimize ' +\n\t\t'use-package ensure-generic-function or use-value eq otherwise user eql ' +\n\t\t'output-stream-p user-homedir-pathname equal package values equalp ' +\n\t\t'package-error values-list error package-error-package vector etypecase ' +\n\t\t'package-name vector-pop eval package-nicknames vector-push eval-when ' +\n\t\t'package-shadowing-symbols vector-push-extend evalhook package-use-list vectorp ' +\n\t\t'evenp package-used-by-list warn every packagep warning exp pairlis when export ' +\n\t\t'parse-error wild-pathname-p expt parse-integer with-accessors extended-char ' +\n\t\t'parse-namestring with-compilation-unit fboundp pathname ' +\n\t\t'with-condition-restarts fceiling pathname-device with-hash-table-iterator ' +\n\t\t'fdefinition pathname-directory with-input-from-string ffloor pathname-host ' +\n\t\t'with-open-file fifth pathname-match-p with-open-stream file-author ' +\n\t\t'pathname-name with-output-to-string file-error pathname-type ' +\n\t\t'with-package-iterator file-error-pathname pathname-version with-simple-restart ' +\n\t\t'file-length pathnamep with-slots file-namestring peek-char ' +\n\t\t'with-standard-io-syntax file-position phase write file-stream write-byte ' +\n\t\t'file-string-length plusp write-char file-write-date pop write-line fill ' +\n\t\t'position write-sequence fill-pointer position-if write-string find ' +\n\t\t'position-if-not write-to-string find-all-symbols pprint y-or-n-p find-class ' +\n\t\t'pprint-dispatch yes-or-no-p find-if pprint-exit-if-list-exhausted zerop ' +\n\t\t'find-if-not pprint-fill';\n\n\t// common lisp global variables. also from lisp.vim\n\tvar standard_vars =\n\t\t'\\\\*applyhook\\\\* \\\\*load-pathname\\\\* \\\\*print-pprint-dispatch\\\\* \\\\*break-on-signals\\\\* ' +\n\t\t'\\\\*load-print\\\\* \\\\*print-pprint-dispatch\\\\* \\\\*break-on-signals\\\\* \\\\*load-truename\\\\* ' +\n\t\t'\\\\*print-pretty\\\\* \\\\*break-on-warnings\\\\* \\\\*load-verbose\\\\* \\\\*print-radix\\\\* ' +\n\t\t'\\\\*compile-file-pathname\\\\* \\\\*macroexpand-hook\\\\* \\\\*print-readably\\\\* ' +\n\t\t'\\\\*compile-file-pathname\\\\* \\\\*modules\\\\* \\\\*print-right-margin\\\\* \\\\*compile-file-truename\\\\* ' +\n\t\t'\\\\*package\\\\* \\\\*print-right-margin\\\\* \\\\*compile-file-truename\\\\* \\\\*print-array\\\\* ' +\n\t\t'\\\\*query-io\\\\* \\\\*compile-print\\\\* \\\\*print-base\\\\* \\\\*random-state\\\\* \\\\*compile-verbose\\\\* ' +\n\t\t'\\\\*print-case\\\\* \\\\*read-base\\\\* \\\\*compile-verbose\\\\* \\\\*print-circle\\\\* ' +\n\t\t'\\\\*read-default-float-format\\\\* \\\\*debug-io\\\\* \\\\*print-escape\\\\* \\\\*read-eval\\\\* ' +\n\t\t'\\\\*debugger-hook\\\\* \\\\*print-gensym\\\\* \\\\*read-suppress\\\\* \\\\*default-pathname-defaults\\\\* ' +\n\t\t'\\\\*print-length\\\\* \\\\*readtable\\\\* \\\\*error-output\\\\* \\\\*print-level\\\\* \\\\*standard-input\\\\* ' +\n\t\t'\\\\*evalhook\\\\* \\\\*print-lines\\\\* \\\\*standard-output\\\\* \\\\*features\\\\* \\\\*print-miser-width\\\\* ' +\n\t\t'\\\\*terminal-io\\\\* \\\\*gensym-counter\\\\* \\\\*print-miser-width\\\\* \\\\*trace-output\\\\* ' +\n\t\t'pi internal-time-units-per-second';\n\n\t// common lisp known keywords\n\tvar keywords =\n\t\t':abort :from-end :overwrite :adjustable :gensym :predicate :append :host ' +\n\t\t':preserve-whitespace :array :if-does-not-exist :pretty :base :if-exists :print ' +\n\t\t':case :include :print-function :circle :index :probe :conc-name :inherited ' +\n\t\t':radix :constructor :initial-contents :read-only :copier :initial-element ' +\n\t\t':rehash-size :count :initial-offset :rehash-threshold :create :initial-value ' +\n\t\t':rename :default :input :rename-and-delete :defaults :internal :size :device ' +\n\t\t':io :start :direction :junk-allowed :start1 :directory :key :start2 ' +\n\t\t':displaced-index-offset :length :stream :displaced-to :level :supersede ' +\n\t\t':element-type :name :test :end :named :test-not :end1 :new-version :type :end2 ' +\n\t\t':nicknames :use :error :output :verbose :escape :output-file :version ' +\n\t\t':external :documentation :shadowing-import-from :modern :export ' +\n\t\t':case-sensitive :case-inverted :shadow :import-from :intern :fill-pointer ' +\n\t\t':upcase :downcase :preserve :invert :load-toplevel :compile-toplevel :execute ' +\n\t\t':while :until :for :do :if :then :else :when :unless :in :across :finally ' +\n\t\t':collect :nconc :maximize :minimize :sum :and :with :initially :append :into ' +\n\t\t':count :end :repeat :always :never :thereis :from :to :upto :downto :below ' +\n\t\t':above :by :on :being :each :the :hash-key :hash-keys :hash-value :hash-values ' +\n\t\t':using :of-type :upfrom :downfrom :arguments :return-type :library :full ' +\n\t\t':malloc-free :none :alloca :in :out :in-out :stdc-stdcall :stdc :c :language ' +\n\t\t':built-in :typedef :external :fini :init-once :init-always';\n\n\tvar lambda = '&allow-other-keys &aux &body &environment &key &optional &rest &whole';\n\n\tvar special = 'let let\\\\* lambda';\n\n\t/**\n\t * Given a list of items in a string: 'item1 item2 item2 ...'\n\t *\n\t * return a regex *string*: '(item1|item2|item2|...)'\n\t */\n\tvar list_to_regex = function(list)\n\t{\n\t\tvar items = list.replace(/(^ | $)/gm, '').split(/ /g);\n\t\treturn '('+items.join('|')+')';\n\t};\n\n\tvar is_in_list = function(item, list)\n\t{\n\t\tvar items = list.replace(/(^ | $)/gm, '').split(/ /g);\n\t\tfor(var i = 0, n = items.length; i < n; i++)\n\t\t{\n\t\t\tif(items[i] == item) return true;\n\t\t}\n\t\treturn false;\n\t};\n\n\t/**\n\t * Collections of search and replaces to make.\n\t */\n\tvar replace = [\n\t\t// ---------------------------------------------------------------------\n\t\t// strings (should !!ALWAYS!! be first, lest our <span> tags be destroyed...)\n\t\t// ---------------------------------------------------------------------\n\t\t{regex: /\"([\\s\\S]*?)\"/gm, replace: '<span class=\"string\">\"$1\"</span>'},\n\n\t\t// ---------------------------------------------------------------------\n\t\t// comments\n\t\t// ---------------------------------------------------------------------\n\t\t{regex: /(;.*)(\\n|$)/gm, replace: '<span class=\"comment\">$1</span>$2'},\n\n\t\t// ---------------------------------------------------------------------\n\t\t// \"special\" (let/lambda)\n\t\t// ---------------------------------------------------------------------\n\t\t{\n\t\t\tregex: new RegExp('.'+list_to_regex(special)+'(?=[\\\\s()])', 'g'),\n\t\t\treplace: function(fullmatch, fnname) {\n\t\t\t\tif(fullmatch[0] == '(')\n\t\t\t\t{\n\t\t\t\t\treturn '(<span class=\"function special known\">' + fnname + '</span>';\n\t\t\t\t}\n\t\t\t\telse\n\t\t\t\t{\n\t\t\t\t\treturn fullmatch;\n\t\t\t\t}\n\t\t\t}\n\t\t},\n\n\n\t\t// ---------------------------------------------------------------------\n\t\t// function matches\n\t\t// ---------------------------------------------------------------------\n\t\t// known functions\n\t\t{\n\t\t\tregex: new RegExp('.'+list_to_regex(funcs)+'(?=[\\\\s()])', 'g'),\n\t\t\treplace: function(fullmatch, fnname) {\n\t\t\t\tif(fullmatch[0] == '(')\n\t\t\t\t{\n\t\t\t\t\treturn '(<span class=\"function known\">' + fnname + '</span>';\n\t\t\t\t}\n\t\t\t\telse\n\t\t\t\t{\n\t\t\t\t\treturn fullmatch;\n\t\t\t\t}\n\t\t\t}\n\t\t},\n\t\t// symbol functions (#'my-fn)\n\t\t{\n\t\t\tregex: /([\\s()])(#'(\\w[\\w_-]*))(?=[\\s()])/g,\n\t\t\treplace: function(fullmatch, delim1, symfun, sym)\n\t\t\t{\n\t\t\t\tvar known = false;\n\t\t\t\tif(is_in_list(sym, funcs))\n\t\t\t\t{\n\t\t\t\t\tknown = true;\n\t\t\t\t}\n\t\t\t\treturn delim1 +'<span class=\"function symbol'+ (known ? ' known' : '') +'\">'+ symfun +'</span>';\n\t\t\t}\n\t\t},\n\n\t\t// ---------------------------------------------------------------------\n\t\t// lambda keywords\n\t\t// ---------------------------------------------------------------------\n\t\t{regex: new RegExp('([\\\\s()])'+list_to_regex(lambda)+'(?=[\\\\s()])', 'g'), replace: '$1<span class=\"lambda-list\">$2</span>'},\n\n\t\t// ---------------------------------------------------------------------\n\t\t// symbols/keywords/variables\n\t\t// ---------------------------------------------------------------------\n\t\t// generic symbols\n\t\t{regex: /([\\s()])('\\w[\\w_-]*)(?=[\\s()])/g, replace: '$1<span class=\"symbol\">$2</span>'},\n\t\t// known keywords\n\t\t{\n\t\t\tregex: new RegExp('([\\\\s()])'+list_to_regex(keywords)+'([\\\\s()])', 'g'),\n\t\t\treplace: function(fullmatch, whitespace, keyword, whitespace2) {\n\t\t\t\treturn whitespace + '<span class=\"keyword known\">'+ keyword +'</span>'+ whitespace2;\n\t\t\t}\n\t\t},\n\t\t// generic keywords\n\t\t{\n\t\t\tregex: /([\\s()])(:\\w[\\w_-]*)/g,\n\t\t\treplace: function(fullmatch, delim, keyword) {\n\t\t\t\tif(fullmatch[0].match(/[\\s()]/gm))\n\t\t\t\t{\n\t\t\t\t\treturn delim + '<span class=\"keyword\">'+ keyword +'</span>';\n\t\t\t\t}\n\t\t\t\treturn fullmatch;\n\t\t\t}\n\t\t},\n\t\t// known variables\n\t\t{\n\t\t\tregex: new RegExp('([\\\\s()])'+list_to_regex(standard_vars)+'([\\\\s()])', 'g'),\n\t\t\treplace: function(fullmatch, whitespace, varname, whitespace2) {\n\t\t\t\treturn whitespace + '<span class=\"variable known\">'+ varname +'</span>'+ whitespace2;\n\t\t\t}\n\t\t},\n\t\t// globals/constants\n\t\t{regex: /([\\s()])(\\*\\w[\\w_-]*\\*)(?=[\\s()])/g, replace: '$1<span class=\"variable global\">$2</span>'},\n\t\t{regex: /([\\s()])(\\+\\w[\\w_-]*\\+)(?=[\\s()])/g, replace: '$1<span class=\"variable constant\">$2</span>'},\n\n\t\t// ---------------------------------------------------------------------\n\t\t// numbers\n\t\t// ---------------------------------------------------------------------\n\t\t// binary\n\t\t{regex: /([\\s()])(#b[01]+)(?=[\\s()])/ig, replace: '$1<span class=\"number binary\">$2</span>'},\n\t\t// hex\n\t\t{regex: /([\\s()])(#x[\\da-f]+)(?=[\\s()])/ig, replace: '$1<span class=\"number hex\">$2</span>'},\n\t\t// float\n\t\t{regex: /([\\s()])([+-]?(?:\\d+\\.\\d+|\\d+\\.|\\.\\d+))(?=[\\s()])/g, replace: '$1<span class=\"number float\">$2</span>'},\n\t\t// ratio\n\t\t{regex: /([\\s()])([+-]?\\d+(?:\\/\\d+)?)(?=[\\s()])/g, replace: '$1<span class=\"number ratio\">$2</span>'},\n\t\t// integers\n\t\t{regex: /([\\s()])([+-]?\\d+)(?=[\\s()])/g, replace: '$1<span class=\"number integer\">$2</span>'},\n\n\t\t// ---------------------------------------------------------------------\n\t\t// misc parsers\n\t\t// ---------------------------------------------------------------------\n\t\t// t/nil\n\t\t{regex: /([\\s()])(nil|t)(?=[\\s()])/g, replace: '$1<span class=\"nil\">$2</span>'},\n\n\t\t// generic \"maybe a function\" forms. best second to last\n\t\t{regex: /\\((\\w[\\w_:-]*)(?=[\\s()])/g, replace: '(<span class=\"function\">$1</span>'},\n\n\t\t// ()'s (should most probably be last, unless there's a good reason)\n\t\t{regex: /([()])/g, replace: '<span class=\"list\">$1</span>'}\n\t];\n\n\t/**\n\t * Main highlight function.\n\t */\n\tthis.highlight_element = function(code_el)\n\t{\n\t\tcode_el.className += ' hl-highlighted';\n\t\tvar html = code_el.innerHTML;\n\t\t// can't have &...;'s running wild like a pack of animals...\n\t\thtml = html.replace(/&amp;/g, '&');\n\t\thtml = html.replace(/&lt;/g, '<');\n\t\thtml = html.replace(/&gt;/g, '>');\n\t\t// pad the HTML string (makes regexs much simpler)\n\t\thtml = \"\\n\" + html + \"\\n\";\n\t\tfor(var i = 0, n = replace.length; i < n; i++)\n\t\t{\n\t\t\tvar rep = replace[i];\n\t\t\thtml = html.replace(rep.regex, rep.replace);\n\t\t}\n\t\t// unpad HTML string\n\t\thtml = html.replace(/(^\\n|\\n$)/g, '');\n\t\thtml = html.replace(/<(?!\\/?span)/g, '&lt;');\n\t\t// Re-encode stray &s to conform with XHTML\n\t\t//html = html.replace(/&/g, '&amp;');\n\t\t\n\t\tcode_el.innerHTML = html;\n\t},\n\n\t/**\n\t * Automatically highlight all <code class=\"lisp\"> blocks\n\t *\n\t * Takes an options arg, which can be used to specify the classname of the\n\t * <code> tags you wish to highlight.\n\t */\n\tthis.highlight_auto = function(options)\n\t{\n\t\toptions || (options = {});\n\t\tvar classname = options.className ? options.className : 'lisp';\n\t\tvar codes = document.getElementsByTagName('code');\n\t\tfor(var i = 0, n = codes.length; i < n; i++)\n\t\t{\n\t\t\tvar code = codes[i];\n\t\t\tif(code.className.match(classname))\n\t\t\t{\n\t\t\t\tthis.highlight_element(code);\n\t\t\t}\n\t\t}\n\t},\n\n\t/**\n\t * If called, enables paren matching (hovering over a paren will add the\n\t * \"active\" class to both the highlighted and the matching paren)\n\t */\n\tthis.paren_match = function(options)\n\t{\n\t\toptions || (options = {});\n\n\t\tif(!('querySelector' in document))\n\t\t{\n\t\t\tconsole.error('HighlightLisp.paren_match: browser does not support querySelector/matches');\n\t\t\treturn;\n\t\t}\n\n\t\tvar matches = function(element, selector)\n\t\t{\n\t\t\tif(!element) return;\n\t\t\tvar domatch;\n\t\t\tvar tests = ['matches', 'msMatchesSelector', 'mozMatchesSelector', 'webkitMatchesSelector'];\n\t\t\tfor(var i = 0; i < tests.length; i++)\n\t\t\t{\n\t\t\t\tif(!(tests[i] in element)) continue;\n\t\t\t\tdomatch = element[tests[i]];\n\t\t\t\tbreak;\n\t\t\t}\n\n\t\t\treturn domatch.call(element, selector);\n\t\t};\n\n\t\tvar is_paren = function(el)\n\t\t{\n\t\t\treturn matches(el, 'code > .list, code span:not(.comment):not(.string) .list');\n\t\t};\n\n\t\tvar find_match = function(paren)\n\t\t{\n\t\t\t// grab all non-commented/stringed parens\n\t\t\tvar children = paren.parentElement.querySelectorAll('code > span.list, code span:not(.comment):not(.string) .list');\n\t\t\t// turn them into a real array\n\t\t\tchildren = Array.prototype.slice.call(children);\n\n\t\t\tvar is_opening = function(el) { return el.innerHTML == '('; };\n\n\t\t\t// tracks when to start counting parens\n\t\t\tvar count = false;\n\t\t\t// tests if this is an opening or closing paren\n\t\t\tvar opening = is_opening(paren);\n\t\t\t// if this is a closing paren, reverse the children so we can search\n\t\t\t// backwards just by going forwards\n\t\t\tif(!opening) children.reverse();\n\n\t\t\tfor(var i = 0; i < children.length; i++)\n\t\t\t{\n\t\t\t\tvar child = children[i];\n\t\t\t\tvar open = is_opening(child);\n\t\t\t\t// mark the first occurrence of the paren, and start counting\n\t\t\t\t// from there\n\t\t\t\tif(child === paren)\n\t\t\t\t{\n\t\t\t\t\tcount = 1;\n\t\t\t\t\tcontinue;\n\t\t\t\t}\n\t\t\t\tif(count === false) continue;\n\t\t\t\tif(opening == open) count++;\n\t\t\t\telse count--;\n\t\t\t\tif(count === 0) return child;\n\t\t\t}\n\t\t};\n\n\t\tvar add_class = function(el, classname, add)\n\t\t{\n\t\t\tif(!el) return;\n\t\t\tel.className = el.className.replace(new RegExp(classname, 'g'), '');\n\t\t\tif(add) el.className += ' '+classname;\n\t\t};\n\n\t\tvar codes = document.getElementsByClassName('hl-highlighted');\n\t\tfor(var i = 0; i < codes.length; i++)\n\t\t{\n\t\t\tvar code = codes[i];\n\t\t\tvar listener = function(add, e)\n\t\t\t{\n\t\t\t\tvar hovered = e.target;\n\t\t\t\tif(!is_paren(hovered)) return;\n\t\t\t\tvar match = find_match(hovered);\n\t\t\t\tadd_class(hovered, 'active', add);\n\t\t\t\tadd_class(match, 'active', add);\n\t\t\t};\n\t\t\tcode.addEventListener('mouseover', listener.bind(this, true));\n\t\t\tcode.addEventListener('mouseout', listener.bind(this, false));\n\t\t}\n\t}\n};\n\nvar HighlightLisp = new highlight_lisp();\n"
  },
  {
    "path": "docs/markdown-help.md",
    "content": "\n## Markdown help\n\n## Style guide\nTry to use Markdown instead of HTML. \nTry to do minimal changes from the text - don't put a paragraph in one line, or remove trailing space separately, as they make diffs hard to follow. \n\nExample sections in chapters: \n\n```\n# Chapter 1\n## Introduction to Lisp\n## 3.1 A Guide to Lisp Style \n### Answer 1.2\n```\n\nTo mark a block of code, use: \n\n```\n  ```lisp\n```\nThat will give syntax highlighting. Leave out `lisp` if it's something else, like assembly. \n\n`>` to blockquote - to indent. You only need one at the start of a paragraph. \n\nUse `*italics*` for *italics*, and `**bold**` for **bold**.\n\n## Line breaks\nNon-paragraph line breaks can be tricky, like in the quotes at the start of chapters. \nIt looks like two trailing spaces do the trick in both Github Flavored Markdown and Docsify: \n\n\n> *Cerium quod factum.*  \n> (One is certain of only what one builds.) \n> \n> -Giovanni Battista Vico (1668-1744)  \n> Italian royal historiographer \n\n\n## Special symbols\nThere are a lot of special symbols, with special ways of calling them; there's [a Wikipedia page with a list.](https://en.wikipedia.org/wiki/List_of_XML_and_HTML_character_entity_references) Here are some of the common ones: \n\n\n| symbol   | entity     |\n|----------|------------|\n| &times;  | `&times;`  |\n| &pi;     | `&pi;`     |\n| &int;    | `&int;`    |\n| &phi;    | `&phi;`    |\n| &asymp;  | `&asymp;`  |\n| &ouml;   | `&ouml;`   |\n| &plusmn; | `&plusmn;` |\n| &eacute; | `&eacute;` |\n| &rArr;   | `&rArr;`   |\n| &lambda; | `&lambda;` |\n| 0&#x0338;| `0&#x0338;`|\n\nNote that these will not work in code blocks. \n\n\n## Markdown variants\n\nWe're largely targeting [Github Flavored Markdown,](https://github.github.com/gfm/) but the online version uses [docsify,](https://docsify.js.org/) which uses [marked.](https://github.com/markedjs/marked) \n\nIf you'd like to test the docsify parsing, you can run a local server; look at `scripts/httpd` - there are Ruby and Python variants. \n"
  },
  {
    "path": "docs/preface.md",
    "content": "# Preface\n\n> **paradigm** *n* **1** an example or pattern; *esp* an outstandingly clear or typical example.  \n> -*Longman's Dictionary of the English Language*, 1984\n\nThis book is concerned with three related topics: the field of artificial intelligence, or AI; the skill of computer programming; and the programming language Common Lisp.\nCareful readers of this book can expect to come away with an appreciation of the major questions and techniques of AI, an understanding of some important AI programs, and an ability to read, modify, and create programs using Common Lisp.\nThe examples in this book are designed to be clear examples of good programming style-paradigms of programming.\nThey are also paradigms of AI research-historically significant programs that use widely applicable techniques to solve important problems.\n\n<a id=\"tfnpreface-1\"></a>\nJust as a liberal arts education includes a course in \"the great books\" of a culture, so this book is, at one level, a course in \"the great programs\" that define the AI culture.<sup>[1](#fnpreface-1)</sup>\n\nAt another level, this book is a highly technical compendium of the knowledge you will need to progress from being an intermediate Lisp programmer to being an expert.\nParts I and II are designed to help the novice get up to speed, but the complete beginner may have a hard time even with this material.\nFortunately, there are at least five good texts available for the beginner; see [page xiii](#page-xiii) for my recommendations.\n\nAll too often, the teaching of computer programming consists of explaining the syntax of the chosen language, showing the student a 10-line program, and then asking the student to write programs.\nIn this book, we take the approach that the best way to learn to write is to read (and conversely, a good way to improve reading skills is to write).\nAfter the briefest of introductions to Lisp, we start right off with complex programs and ask the reader to understand and make small modifications to these programs.\n\nThe premise of this book is that you can only write something useful and interesting when you both understand what makes good writing and have something interesting to say.\nThis holds for writing programs as well as for writing prose.\nAs Kernighan and Plauger put it on the cover of *Software Tools in Pascal:*\n\n> Good programming is not learned from generalities, but by seeing how significant programs can be made clean, easy to read, easy to maintain and modify, human-engineered, efficient, and reliable, by the application of common sense and good programming practices.\nCareful study and imitation of good programs leads to better writing.\n\nThe proud craftsman is often tempted to display only the finished work, without any indication of the false starts and mistakes that are an unfortunate but unavoidable part of the creative process.\nUnfortunately, this reluctance to unveil the process is a barrier to learning; a student of mathematics who sees a beautiful 10-line proof in a textbook can marvel at its conciseness but does not learn how to construct such a proof.\nThis book attempts to show the complete programming process, \"warts and all.\" Each chapter starts with a simple version of a program, one that works on some examples but fails on others.\nEach chapter shows how these failures can be analyzed to build increasingly sophisticated versions of the basic program.\nThus, the reader can not only appreciate the final result but also see how to learn from mistakes and refine an initially incomplete design.\nFurthermore, the reader who finds a particular chapter is becoming too difficult can skip to the next chapter, having gained some appreciation of the problem area, and without being overwhelmed by the details.\n\nThis book presents a body of knowledge loosely known as \"AI programming techniques,\" but it must be recognized that there are no clear-cut boundaries on this body of knowledge.\nTo be sure, no one can be a good AI programmer without first being a good programmer.\nThus, this book presents topics (especially in parts III and V) that are not AI per se, but are essential background for any AI practitioner.\n\n## Why Lisp? Why Common Lisp?\n\nLisp is one of the oldest programming languages still in widespread use today.\nThere have been many versions of Lisp, each sharing basic features but differing in detail.\nIn this book we use the version called Common Lisp, which is the most widely accepted standard.\nLisp has been chosen for three reasons.\n\nFirst, Lisp is the most popular language for AI programming, particularly in the United States.\nIf you're going to learn a language, it might as well be one with a growing literature, rather than a dead tongue.\n\nSecond, Lisp makes it easy to capture relevant generalizations in defining new objects.\nIn particular, Lisp makes it easy to define new languages especially targeted to the problem at hand.\nThis is especially handy in AI applications, which often manipulate complex information that is most easily represented in some novel form.\nLisp is one of the few languages that allows full flexibility in defining and manipulating programs as well as data.\nAll programming languages, by definition, provide a means of defining programs, but many other languages limit the ways in which a program can be used, or limit the range of programs that can be defined, or require the programmer to explicitly state irrelevant details.\n\nThird, Lisp makes it very easy to develop a working program fast.\nLisp programs are concise and are uncluttered by low-level detail.\nCommon Lisp offers an unusually large number of useful predefined objects, including over 700 functions.\nThe programming environment (such as debugging tools, incremental compilers, integrated editors, and interfaces to window systems) that surround Lisp systems are usually very good.\nAnd the dynamic, interactive nature of Lisp makes it easy to experiment and change a program while it is being developed.\n\nIt must be mentioned that in Europe and Japan, Prolog has been as popular as Lisp for AI work.\nProlog shares most of Lisp's advantages in terms of flexibility and conciseness.\nRecently, Lisp has gained popularity worldwide, and Prolog is becoming more well known in the United States.\nAs a result, the average AI worker today is likely to be bilingual.\nThis book presents the key ideas behind Prolog in [chapters 11](chapter11.md) and [12](chapter12.md), and uses these ideas in subsequent chapters, particularly [20](chapter20.md) and [21](chapter21.md).\n\nThe dialect of Lisp known as Scheme is also gaining in popularity, but primarily for teaching and experimenting with programming language design and techniques, and not so much for writing large AI programs.\nScheme is presented in [chapters 22](chapter22.md) and [23](chapter23.md).\nOther dialects of Lisp such as Franz Lisp, MacLisp, InterLisp, ZetaLisp, and Standard Lisp are now considered obsolete.\nThe only new dialect of Lisp to be proposed recently is EuLisp, the European Lisp.\nA few dialects of Lisp live on as embedded extension languages.\nFor example, the Gnu Emacs text editor uses elisp, and the AutoCad computer-aided design package uses AutoLisp, a derivative of Xlisp.\nIn the future, it is likely that Scheme will become a popular extension language, since it is small but powerful and has an officially sanctioned standard definition.\n\nThere is a myth that Lisp (and Prolog) are \"special-purpose\" languages, while languages like Pascal and C are \"general purpose.\" Actually, just the reverse is true.\nPascal and C are special-purpose languages for manipulating the registers and memory of a von Neumann-style computer.\nThe majority of their syntax is devoted to arithmetic and Boolean expressions, and while they provide some facilities for forming data structures, they have poor mechanisms for procedural abstraction or control abstraction.\nIn addition, they are designed for the state-oriented style of programming: computing a result by changing the value of variables through assignment statements.\n\nLisp, on the other hand, has no special syntax for arithmetic.\nAddition and multiplication are no more or less basic than list operations like appending, or string operations like converting to upper case.\nBut Lisp provides all you will need for programming in general: defining data structures, functions, and the means for combining them.\n\nThe assignment-dominated, state-oriented style of programming is possible in Lisp, but in addition object-oriented, rule-based, and functional styles are all supported within Lisp.\nThis flexibility derives from two key features of Lisp: First, Lisp has a powerful *macro* facility, which can be used to extend the basic language.\nWhen new styles of programming were invented, other languages died out; Lisp simply incorporated the new styles by defining some new macros.\nThe macro facility is possible because Lisp programs are composed of a simple data structure: the list.\nIn the early days, when Lisp was interpreted, most manipulation of programs was done through this data structure.\nNowadays, Lisp is more often compiled than interpreted, and programmers rely more on Lisp's second great flexible feature: the *function*.\nOf course, other languages have functions, but Lisp is rare in allowing the creation of new functions while a program is running.\n\nLisp's flexibility allows it to adapt as programming styles change, but more importantly, Lisp can adapt to your particular programming problem.\nIn other languages you fit your problem to the language; with Lisp you extend the language to fit your problem.\n\nBecause of its flexibility, Lisp has been successful as a high-level language for rapid prototyping in areas such as AI, graphics, and user interfaces.\nLisp has also been the dominant language for exploratory programming, where the problems are so complex that no clear solution is available at the start of the project.\nMuch of AI falls under this heading.\n\nThe size of Common Lisp can be either an advantage or a disadvantage, depending on your outlook.\nIn David Touretzky's (1989) fine book for beginning programmers, the emphasis is on simplicity.\nHe chooses to write some programs slightly less concisely, rather than introduce an esoteric new feature (he cites `pushnew` as an example).\nThat approach is entirely appropriate for beginners, but this book goes well past the level of beginner.\nThis means exposing the reader to new features of the language whenever they are appropriate.\nMost of the time, new features are described as they are introduced, but sometimes explaining the details of a low-level function would detract from the explanation of the workings of a program.\nIn accepting the privilege of being treated as an \"adult,\" the reader also accepts a responsibility-to look up unfamiliar terms in an appropriate reference source.\n\n## Outline of the Book\n\nThis book is organized into five parts.\n\n**Part I** introduces the Common Lisp programming language.\n\n[Chapter 1](chapter1.md) gives a quick introduction by way of small examples that demonstrate the novel features of Lisp.\nIt can be safely skipped or skimmed by the experienced programmer.\n\n[Chapter 2](chapter2.md) is a more extended example showing how the Lisp primitives can be put together to form a program.\nIt should be studied carefully by the novice, and even the experienced programmer will want to look through it to get a feel for my programming style.\n\n[Chapter 3](chapter3.md) provides an overview of the Lisp primitives.\nIt can be skimmed on first reading and used as a reference whenever an unfamiliar function is mentioned in the text.\n\nPart I has been kept intentionally brief, so that there is more room for presenting actual AI programs.\nUnfortunately, that means that another text or reference book (or online help) may be needed to clarify some of the more esoteric features of the language.\nMy recommendations for texts are on page xiii.\n\nThe reader may also want to refer to [chapter 25](chapter25.md), which offers some debugging and troubleshooting hints.\n\n**Part II** covers four early AI programs that all use rule-based pattern-matching techniques.\nBy starting with relatively simple versions of the programs and then improving them and moving on to more complex programs, the reader is able to gradually acquire increasingly advanced programming skills.\n\n[Chapter 4](chapter4.md) presents a reconstruction of GPS, the General Problem Solver.\nThe implementation follows the STRIPS approach.\n\n[Chapter 5](chapter5.md) describes ELIZA, a program that mimics human dialogue.\nThis is followed by a chapter that generalizes some of the techniques used in GPS and ELIZA and makes them available as tools for use in subsequent programs.\n\n[Chapter 7](chapter7.md) covers STUDENT, a program that solves high-school-level algebra word problems.\n\n[Chapter 8](chapter8.md) develops a small subset of the MACSYMA program for doing symbolic algebra, including differential and integral calculus.\nIt may be skipped by those who shy away from heavy mathematics.\n\n**Part III** detours from AI for a moment to present some general tools for more efficient programming.\nThe reader who masters the material in this part can be considered an advanced Lisp programmer.\n\n[Chapter 9](chapter9.md) is a detailed study of efficiency techniques, concentrating on caching, indexing, compilation, and delaying computation.\n[Chapter 10](chapter10.md) covers lower-level efficiency issues such as using declarations, avoiding garbage generation, and choosing the right data structure.\n\n[Chapter 11](chapter11.md) presents the Prolog language.\nThe aim is two-fold: to show how to write an interpreter for another language, and to introduce the important features of Prolog, so that they can be used where appropriate.\n[Chapter 12](chapter12.md) shows how a compiler for Prolog can be 20 to 200 times faster than the interpreter.\n\n[Chapter 13](chapter13.md) introduces object-oriented programming in general, then explores the Common Lisp Object System (CLOS).\n\n[Chapter 14](chapter14.md) discusses the advantages and limitations of both logic-oriented and object-oriented programming, and develops a knowledge representation formalism using all the techniques of part III.\n\n**Part IV** covers some advanced AI programs.\n\n[Chapter 15](chapter15.md) uses the techniques of part III to come up with a much more efficient implementation of MACSYMA. It uses the idea of a canonical form, and replaces the very general rewrite rule approach with a series of more specific functions.\n\n[Chapter 16](chapter16.md) covers the EMYCIN expert system shell, a backward chaining rule-based system based on certainty factors.\nThe MYCIN medical expert system is also covered briefly.\n\n[Chapter 17](chapter17.md) covers the Waltz line-labeling algorithm for polyhedra (using Huffman-Clowes labels).\nDifferent approaches to constraint propagation and backtracking are discussed.\n\n[Chapter 18](chapter18.md) presents a program that plays an excellent game of Othello.\nThe technique used, alpha-beta searching, is appropriate to a wide variety of two-person games.\n\n[Chapter 19](chapter19.md) is an introduction to natural language processing.\nIt covers context-free grammar, top-down and bottom-up parsing, chart parsing, and some semantic interpretation and preferences.\n\n[Chapter 20](chapter20.md) extends the linguistic coverage of the previous chapter and introduces logic grammars, using the Prolog compiler developed in [chapter 11](chapter11.md).\n\n[Chapter 21](chapter21.md) is a fairly comprehensive grammar of English using the logic grammar formalism.\nThe problems of going from a simple idea to a realistic, comprehensive program are discussed.\n\n**Part V** includes material that is peripheral to AI but important for any serious Lisp programmer.\n\n[Chapter 22](chapter22.md) presents the Scheme dialect of Lisp.\nA simple Scheme interpreter is developed, then a properly tail-recursive interpreter, then an interpreter that explicitly manipulates continuations and supports `call/cc`.\n[Chapter 23](chapter23.md) presents a Scheme compiler.\n\n[Chapter 24](chapter24.md) presents the features that are unique to American National Standards Institute (ANSI) Common Lisp.\nThis includes the `loop` macro, as well as error handling, pretty printing, series and sequences, and the package facility.\n\n[Chapter 25](chapter25.md) is a guide to troubleshooting and debugging Lisp programs.\n\nThe bibliography lists over 200 sources, and there is a comprehensive index.\nIn addition, the appendix provides a directory of publicly available Lisp programs.\n\n## How to Use This Book\n\nThe intended audience for this book is broad: anyone who wants to become an advanced Lisp programmer, and anyone who wants to be an advanced AI practitioner.\nThere are several recommended paths through the book:\n\n*   *In an Introductory AI Course:* Concentrate on parts I and II, and at least one example from part IV.\n\n*   *In an Advanced AI Programming Course:* Concentrate on parts I, II and IV, skipping chapters that are of less interest and adding as much of part III as time permits.\n\n*   *In an Advanced Programming Languages Course:* Concentrate on parts I and V, with selections from part III.\nCover [chapters 11](chapter11.md) and [13](chapter13.md) if similar material is not presented with another text.\n\n*   *For the Professional Lisp Programmer:* Read as much of the book as possible, and refer back to it often.\nPart III and [chapter 25](chapter25.md) are particularly important.\n\n## Supplementary Texts and Reference Books\n<a name=\"page-xiii\"></a>\n\nThe definitive reference source is [Steele](https://en.wikipedia.org/wiki/Guy_L._Steele_Jr.)'s [*Common Lisp the Language*](https://www.cs.cmu.edu/Groups/AI/html/cltl/cltl2.html).\nFrom 1984 to 1990, this unambiguously defined the language Common Lisp.\nHowever, in 1990 the picture became more complicated by the publication of [*Common Lisp the Language*, 2d edition](https://www.cs.cmu.edu/Groups/AI/html/cltl/cltl2.html).\nThis book, also by Steele, contains the recommendations of ANSI subcommittee X3J13, whose charter is to define a standard for Lisp.\nThese recommendations include many minor changes and clarifications, as well as brand new material on object-oriented programming, error condition handling, and the loop macro.\nThe new material doubles the size of the book from 465 to 1029 pages.\n\nUntil the ANSI recommendations are formally accepted, Common Lisp users are in the unfortunate situation of having two distinct and incompatible standards: \"original\" Common Lisp and ANSI Common Lisp.\nMost of the code in this book is compliant with both standards.\nThe most significant use of an ANSI function is the `loop` macro.\nThe ANSI `map-into`, `complement`, and `reduce` functions are also used, although rarely.\nDefinitions for all these functions are included, so even those using an \"original\" Common Lisp system can still run all the code in the book.\n\nWhile *Common Lisp the Language* is the definitive standard, it is sometimes terse and can be difficult for a beginner.\n[*Common Lisp: the Reference*](https://archive.org/details/commonlisprefere00fran), published by Franz Inc., offers complete coverage of the language with many helpful examples.\n[*Common LISPcraft*](https://www.amazon.com/Common-LISPcraft-Robert-Wilensky/dp/0393955443), by [the late] [Robert Wilensky](https://www2.eecs.berkeley.edu/Faculty/Homepages/wilensky.html), and *Artificial Intelligence Programming*, by Charniak et al., also include brief summaries of the Common Lisp functions.\nThey are not as comprehensive, but that can be a blessing, because it can lead the reader more directly to the functions that are important (at least in the eyes of the author).\n\nIt is a good idea to read this book with a computer at hand, to try out the examples and experiment with examples of your own.\nA computer is also handy because Lisp is self-documenting, through the functions `apropos`, `describe`, and `documentation`.\nMany implementations also provide more extensive documentation through some kind of 'help' command or menu.\n\nThe five introductory Lisp textbooks I recommend are listed below.\nThe first is more elementary than the others.\n\n*   [*Common Lisp: A Gentle Introduction to Symbolic Computation*](https://www.cs.cmu.edu/~dst/LispBook/book.pdf) by [David Touretzky](http://www.cs.cmu.edu/~dst/).\nMost appropriate for beginners, including those who are not computer scientists.\n\n*   *A Programmer's Guide to Common Lisp* by Deborah G. Tatar.\nAppropriate for those with experience in another programming language, but none in Lisp.\n\n*   *Common LISPcraft* by Robert Wilensky.\nMore comprehensive and faster paced, but still useful as an introduction as well as a reference.\n\n*   *Common Lisp* by Wade L. Hennessey.\nSomewhat hit-and-miss in terms of the topics it covers, but with an enlightened discussion of implementation and efficiency issues that do not appear in the other texts.\n\n*   *LISP* (3d edition) by Patrick H. Winston and Bertold Horn.\nCovers the most ground in terms of programming advice, but not as comprehensive as a reference.\nMay be difficult for beginners.\nIncludes some AI examples.\n\nWhile it may be distracting for the beginner to be continually looking at some reference source, the alternative-to have this book explain every new function in complete detail as it is introduced-would be even more distracting.\nIt would interrupt the description of the AI programs, which is what this book is all about.\n\nThere are a few texts that show how to write AI programs and tools, but none that go into the depth of this book.\nNevertheless, the expert AI programmer will want to be familiar with all the following texts, listed in rough order of increasing sophistication:\n\n*   *LISP* (3d edition).\n(See above.)\n\n*   *Programming Paradigms in Lisp* by Rajeev Sangal.\nPresents the different styles of programming that Lisp accommodates, illustrating them with some useful AI tools.\n\n*   *Programming for Artificial Intelligence* by Wolfgang Kreutzer and Bruce McKenzie.\nCovers some of the basics of rule-based and pattern-matching systems well, but covers Lisp, Prolog, and Smalltalk, and thus has no time left for details in any of the languages.\n\n*   *Artificial Intelligence Programming* (2d edition) by Eugene Charniak, Christopher Riesbeck, Drew McDermott, and James Meehan.\nContains 150 pages of Lisp overview, followed by an advanced discussion of AI tools, but no actual AI programs.\n\n*   *AI in Practice: Examples in Pop-11* by Allan Ramsey and Rosalind Barrett.\nAdvanced, high-quality implementations of five AI programs, unfortunately using a language that has not gained popularity.\n\nThe current text combines the virtues of the last two entries: it presents both actual AI programs and the tools necessary to build them.\nFurthermore, the presentation is in an incremental fashion, with simple versions presented first for clarity, followed by more sophisticated versions for completeness.\n\n## A Note on Exercises\n\nSample exercises are provided throughout.\nReaders can test their level of understanding by faithfully doing the exercises.\nThe exercises are graded on the scale [s], [m], [h], [d], which can be interpreted either as a level of difficulty or as an expected time it will take to do the exercise:\n\n| Code | Difficulty | Time to Do |\n|------|------------|------------|\n| [s]  | Simple     | Seconds    |\n| [m]  | Medium     | Minutes    |\n| [h]  | Hard       | Hours      |\n| [d]  | Difficult  | Days       |\n\nThe time to do the exercise is measured from the point that the concepts have been well understood.\nIf the reader is unclear on the underlying concepts, it might take hours of review to understand a [m] problem.\nAnswers to the exercises can be found in a separate section at the end of each chapter.\n\n## Acknowledgments\n\nA great many people contributed to this book.\nFirst of all I would like to thank my students at USC and Berkeley, as well as James Martin's students at Colorado and Michael Pazzani's students at Irvine, who course-tested earlier versions of this book.\nUseful suggestions, corrections, and additions were made by:\n\nNina Amenta (Berkeley), Ray S.\nBabcock and John Paxton (Montana State), Bryan A.\nBentz (BBN), Mary P.\nBoelk (Johnson Controls), Michael Braverman (Berkeley), R.\nChandrasekar and M.\nSasikumar (National Centre for Software Technology, Bombay), Mike Clancy (Berkeley), Michael Covington (Georgia), Bruce D'Ambrosio (Oregon State), Piew Datta (Irvine), Shawn Dettrey (USC), J.\nA.\nDurieux (AI Engineering BV, Amsterdam), Joseph Faletti (ETS), Paul Fuqua (Texas Instruments), Robert Goldman (Tulane), Marty Hall (Johns Hopkins), Marti Hearst (Berkeley), Jim Hendler (Maryland), Phil Laird (NASA), Raymond Lang (Tulane), David D.\nLoeffler (MCC), George Luger (New Mexico), Rob MacLachlan (CMU), Barry Margolin (Thinking Machines), James Mayfield (UMBC), Sanjay Manchandi (Arizona), Robert McCartney (Connecticut), James Meehan (DEC), Andrew L.\nRessler, Robert S.\nRist (University of Technology, Sydney), Paul Snively (Apple), Peter Van Roy (Berkeley), David Gumby Wallace (Cygnus), and Jeff Wu (Colorado).\n\nSam Dooley and Eric Wefald both wrote Othello-playing programs without which I would not have written [chapter 18](chapter18.md).\nEric also showed me Aristotle's quotes on means-ends analysis.\nTragically, Eric died in August 1989.\nHe is sorely missed by his friends and colleagues.\nRichard Fateman made suggestions for [chapter 8](chapter8.md), convinced me to write [chapter 15](chapter15.md), and, with help from Peter Klier, wrote a substantial program from which I adapted some code for that chapter.\nCharley Cox (Franz Inc.), Jamie Zawinski (Lucid Inc.), and Paul Fuqua (Texas Instruments) explained the inner workings of their respective companies' compilers.\nMike Harrison, Paul Hilfinger, Marc Luria, Ethan Munson, and Stephan Slade helped with LATEX.\nNarciso Jarimillo tested all the code and separated it into the files that are available to the reader (see page 897).\n\nDuring the writing of this book I was supported by a grant from the Defense Advanced Research Projects Agency (DoD), Arpa Order No.\n4871, monitored by Space and Naval Warfare Systems Command under Contract N00039-84-C-0089.\nSpecial thanks to DARPA and to Robert Wilensky and the rest of my colleagues and students at Berkeley for providing a stimulating environment for research, programming, and writing.\n\nFinally, thanks to Mike Morgan and Yonie Overton for overseeing the production of the book and encouraging me to finish on time.\n\n----------------------\n\n<a id=\"fnpreface-1\"></a>\n<sup>[1](#tfnpreface-1)</sup> This does not imply that the programs chosen are the best of all AI programs-just that they are representative.\n"
  },
  {
    "path": "lisp/auxfns.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;; Code from Paradigms of AI Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;; File auxfns.lisp: Auxiliary functions used by all other programs\n;;; Load this file before running any other programs.\n\n;;;; Implementation-Specific Details\n\n(eval-when (eval compile load)\n  ;; Make it ok to place a function definition on a built-in LISP symbol.\n  #+(or Allegro EXCL)\n  (dolist (pkg '(excl common-lisp common-lisp-user))\n    (setf (excl:package-definition-lock (find-package pkg)) nil))\n\n  ;; Don't warn if a function is defined in multiple files --\n  ;; this happens often since we refine several programs.\n  #+Lispworks\n  (setq *PACKAGES-FOR-WARN-ON-REDEFINITION* nil)\n\n  #+LCL\n   (compiler-options :warnings nil)\n  #+sbcl\n  (progn\n    (sb-ext:unlock-package '#:common-lisp)\n    (sb-ext:unlock-package '#:common-lisp-user)))\n\n;;;; REQUIRES\n\n;;; The function REQUIRES is used in subsequent files to state dependencies\n;;; between files.  The current definition just loads the required files when it has not yet\n;;; been loaded, assumming they match the pathname specified in *PAIP-DIRECTORY*.\n;;; You should change that to match where you have stored the files.\n;;; A more sophisticated REQUIRES would search in different directories if needed.\n\n(defvar *paip-modules* '())\n\n(defvar *paip-files*\n  `(\"auxfns\" \"tutor\" \"examples\"\n    \"intro\" \"simple\" \"overview\" \"gps1\" \"gps\" \"eliza1\" \"eliza\" \"patmatch\"\n    \"eliza-pm\" \"search\" \"gps-srch\" \"student\" \"macsyma\" \"macsymar\" \"unify\"\n    \"prolog1\" \"prolog\" \"prologc1\" \"prologc2\" \"prologc\" \"prologcp\"\n    \"clos\" \"krep1\" \"krep2\" \"krep\" \"cmacsyma\" \"mycin\" \"mycin-r\" \"waltz\"\n    \"othello\" \"othello2\" \"syntax1\" \"syntax2\" \"syntax3\" \"unifgram\"\n    \"grammar\" \"lexicon\" \"interp1\" \"interp2\" \"interp3\"\n    \"compile1\" \"compile2\" \"compile3\" \"compopt\"))\n\n(defun requires (&rest files)\n  \"The arguments are files that are required to run an application.\"\n  (loop for file in files\n     for name = (string-downcase file)\n     unless (find name *paip-modules* :test 'equal)\n     collect (progn\n               (push name *paip-modules*)\n               (load-paip-file name))))\n\n(defparameter *paip-directory*\n  (make-pathname :name nil :type nil\n\t\t :defaults (or #.(and (boundp '*compile-file-truename*) *compile-file-truename*)\n\t\t\t       (and (boundp '*load-truename*) *load-truename*)\n\t\t\t       (truename \"\"))) ;;??? Maybe Change this\n  \"The location of the source files for this book.  If things don't work,\n  change it to reflect the location of the files on your computer.\")\n\n(defparameter *paip-source*\n  (make-pathname :name nil :type \"lisp\" ;;???  Maybe Change this\n\t\t :defaults *paip-directory*))\n\n(defparameter *paip-binary*\n  (make-pathname\n   :name nil\n   :type (first (list #+LCL (first *load-binary-pathname-types*)\n\t\t      #+Lispworks system::*binary-file-type*\n\t\t      #+MCL \"fasl\"\n\t\t      #+Allegro excl:*fasl-default-type*\n\t\t      #+(or AKCL KCL) \"o\"\n\t\t      #+CMU \"sparcf\"\n\t\t      #+CLISP \"fas\"\n\t\t      \"bin\"))  ;;???  Maybe Change this\n   :directory (append (pathname-directory *paip-source*) '(\"bin\"))\n   :defaults *paip-directory*))\n\n(defun paip-pathname (name &optional (type :lisp))\n  (make-pathname :name name\n\t\t :defaults (ecase type\n\t\t\t     ((:lisp :source) *paip-source*)\n\t\t\t     ((:binary :bin) *paip-binary*))))\n\n(defun compile-all-paip-files ()\n  (mapc #'compile-paip-file *paip-files*))\n\n(defun compile-paip-file (name)\n  (let ((path (paip-pathname name :lisp)))\n    (load path)\n    (compile-file path :output-file (ensure-directories-exist (paip-pathname name :binary)))))\n\n(defun load-paip-file (file)\n  \"Load the binary file if it exists and is newer, else load the source.\"\n  (let* ((src (paip-pathname file :lisp))\n\t (src-date (file-write-date src))\n\t (bin (paip-pathname file :binary))\n\t (bin-date (ignore-errors (file-write-date bin)))\n\t (*package* (or (find-package :paip)\n                        *package*)))\n    (load (if (and (probe-file bin) src-date bin-date (>= bin-date src-date))\n\t      bin\n              src))))\n\n;;;; Macros (formerly in auxmacs.lisp: that file no longer needed)\n\n(eval-when (load eval compile)\n  (defmacro once-only (variables &rest body)\n    \"Returns the code built by BODY.  If any of VARIABLES\n  might have side effects, they are evaluated once and stored\n  in temporary variables that are then passed to BODY.\"\n    (assert (every #'symbolp variables))\n    (let ((temps nil))\n      (dotimes (i (length variables)) (push (gensym) temps))\n      `(if (every #'side-effect-free? (list .,variables))\n\t(progn .,body)\n\t(list 'let\n\t ,`(list ,@(mapcar #'(lambda (tmp var)\n\t\t\t       `(list ',tmp ,var))\n\t\t\t   temps variables))\n\t (let ,(mapcar #'(lambda (var tmp) `(,var ',tmp))\n\t\t       variables temps)\n\t   .,body)))))\n\n  (defun side-effect-free? (exp)\n    \"Is exp a constant, variable, or function,\n  or of the form (THE type x) where x is side-effect-free?\"\n    (or (atom exp) (constantp exp)\n\t(starts-with exp 'function)\n\t(and (starts-with exp 'the)\n\t     (side-effect-free? (third exp)))))\n\n  (defmacro funcall-if (fn arg)\n    (once-only (fn)\n\t       `(if ,fn (funcall ,fn ,arg) ,arg)))\n\n  (defmacro read-time-case (first-case &rest other-cases)\n    \"Do the first case, where normally cases are\n  specified with #+ or possibly #- marks.\"\n    (declare (ignore other-cases))\n    first-case)\n\n  (defun rest2 (x)\n    \"The rest of a list after the first TWO elements.\"\n    (rest (rest x)))\n\n  (defun find-anywhere (item tree)\n    \"Does item occur anywhere in tree?\"\n    (if (atom tree)\n\t(if (eql item tree) tree)\n\t(or (find-anywhere item (first tree))\n\t    (find-anywhere item (rest tree)))))\n\n  (defun starts-with (list x)\n    \"Is x a list whose first element is x?\"\n    (and (consp list) (eql (first list) x)))\n  )\n\n;;;; Auxiliary Functions\n\n(setf (symbol-function 'find-all-if) #'remove-if-not)\n\n(defun find-all (item sequence &rest keyword-args\n                 &key (test #'eql) test-not &allow-other-keys)\n  \"Find all those elements of sequence that match item,\n  according to the keywords.  Doesn't alter sequence.\"\n  (if test-not\n      (apply #'remove item sequence\n             :test-not (complement test-not) keyword-args)\n      (apply #'remove item sequence\n             :test (complement test) keyword-args)))\n\n(defun partition-if (pred list)\n  \"Return 2 values: elements of list that satisfy pred,\n  and elements that don't.\"\n  (let ((yes-list nil)\n        (no-list nil))\n    (dolist (item list)\n      (if (funcall pred item)\n          (push item yes-list)\n          (push item no-list)))\n    (values (nreverse yes-list) (nreverse no-list))))\n\n(defun maybe-add (op exps &optional if-nil)\n  \"For example, (maybe-add 'and exps t) returns\n  t if exps is nil, exps if there is only one,\n  and (and exp1 exp2...) if there are several exps.\"\n  (cond ((null exps) if-nil)\n        ((length=1 exps) (first exps))\n        (t (cons op exps))))\n\n;;; ==============================\n\n(defun seq-ref (seq index)\n  \"Return code that indexes into a sequence, using\n  the pop-lists/aref-vectors strategy.\"\n  `(if (listp ,seq)\n       (prog1 (first ,seq)\n              (setq ,seq (the list (rest ,seq))))\n       (aref ,seq ,index)))\n\n(defun maybe-set-fill-pointer (array new-length)\n  \"If this is an array with a fill pointer, set it to\n  new-length, if that is longer than the current length.\"\n  (if (and (arrayp array)\n           (array-has-fill-pointer-p array))\n      (setf (fill-pointer array)\n            (max (fill-pointer array) new-length))))\n\n;;; ==============================\n\n;;; NOTE: In ANSI Common Lisp, the effects of adding a definition (or most\n;;; anything else) to a symbol in the common-lisp package is undefined.\n;;; Therefore, it would be best to rename the function SYMBOL to something\n;;; else.  This has not been done (for compatibility with the book).\n\n(defun symbol (&rest args)\n  \"Concatenate symbols or strings to form an interned symbol\"\n  (intern (format nil \"~{~a~}\" args)))\n\n(defun new-symbol (&rest args)\n  \"Concatenate symbols or strings to form an uninterned symbol\"\n  (make-symbol (format nil \"~{~a~}\" args)))\n\n(defun last1 (list)\n  \"Return the last element (not last cons cell) of list\"\n  (first (last list)))\n\n;;; ==============================\n\n(defun mappend (fn list)\n  \"Append the results of calling fn on each element of list.\n  Like mapcon, but uses append instead of nconc.\"\n  (apply #'append (mapcar fn list)))\n\n(defun mklist (x)\n  \"If x is a list return it, otherwise return the list of x\"\n  (if (listp x) x (list x)))\n\n(defun flatten (exp)\n  \"Get rid of imbedded lists (to one level only).\"\n  (mappend #'mklist exp))\n\n(defun random-elt (seq)\n  \"Pick a random element out of a sequence.\"\n  (elt seq (random (length seq))))\n\n;;; ==============================\n\n(defun member-equal (item list)\n  (member item list :test #'equal))\n\n;;; ==============================\n\n(defun compose (&rest functions)\n  #'(lambda (x)\n      (reduce #'funcall functions :from-end t :initial-value x)))\n\n;;;; The Debugging Output Facility:\n\n(defvar *dbg-ids* nil \"Identifiers used by dbg\")\n\n(defun dbg (id format-string &rest args)\n  \"Print debugging info if (DEBUG ID) has been specified.\"\n  (when (member id *dbg-ids*)\n    (fresh-line *debug-io*)\n    (apply #'format *debug-io* format-string args)))\n\n(defun debug (&rest ids)\n  \"Start dbg output on the given ids.\"\n  (setf *dbg-ids* (union ids *dbg-ids*)))\n\n(defun undebug (&rest ids)\n  \"Stop dbg on the ids.  With no ids, stop dbg altogether.\"\n  (setf *dbg-ids* (if (null ids) nil\n                      (set-difference *dbg-ids* ids))))\n\n;;; ==============================\n\n(defun dbg-indent (id indent format-string &rest args)\n  \"Print indented debugging info if (DEBUG ID) has been specified.\"\n  (when (member id *dbg-ids*)\n    (fresh-line *debug-io*)\n    (dotimes (i indent) (princ \"  \" *debug-io*))\n    (apply #'format *debug-io* format-string args)))\n\n;;;; PATTERN MATCHING FACILITY\n\n(defconstant fail nil)\n(defconstant no-bindings '((t . t)))\n\n(defun pat-match (pattern input &optional (bindings no-bindings))\n  \"Match pattern against input in the context of the bindings\"\n  (cond ((eq bindings fail) fail)\n        ((variable-p pattern) (match-variable pattern input bindings))\n        ((eql pattern input) bindings)\n        ((and (consp pattern) (consp input))\n         (pat-match (rest pattern) (rest input)\n                    (pat-match (first pattern) (first input) bindings)))\n        (t fail)))\n\n(defun match-variable (var input bindings)\n  \"Does VAR match input?  Uses (or updates) and returns bindings.\"\n  (let ((binding (get-binding var bindings)))\n    (cond ((not binding) (extend-bindings var input bindings))\n          ((equal input (binding-val binding)) bindings)\n          (t fail))))\n\n(defun make-binding (var val) (cons var val))\n\n(defun binding-var (binding)\n  \"Get the variable part of a single binding.\"\n  (car binding))\n\n(defun binding-val (binding)\n  \"Get the value part of a single binding.\"\n  (cdr binding))\n\n(defun get-binding (var bindings)\n  \"Find a (variable . value) pair in a binding list.\"\n  (assoc var bindings))\n\n(defun lookup (var bindings)\n  \"Get the value part (for var) from a binding list.\"\n  (binding-val (get-binding var bindings)))\n\n(defun extend-bindings (var val bindings)\n  \"Add a (var . value) pair to a binding list.\"\n  (cons (cons var val)\n        ;; Once we add a \"real\" binding,\n        ;; we can get rid of the dummy no-bindings\n        (if (eq bindings no-bindings)\n            nil\n            bindings)))\n\n(defun variable-p (x)\n  \"Is x a variable (a symbol beginning with `?')?\"\n  (and (symbolp x) (equal (elt (symbol-name x) 0) #\\?)))\n\n;;; ==============================\n\n;;;; The Memoization facility:\n\n(defmacro defun-memo (fn args &body body)\n  \"Define a memoized function.\"\n  `(memoize (defun ,fn ,args . ,body)))\n\n(defun memo (fn &key (key #'first) (test #'eql) name)\n  \"Return a memo-function of fn.\"\n  (let ((table (make-hash-table :test test)))\n    (setf (get name 'memo) table)\n    #'(lambda (&rest args)\n        (let ((k (funcall key args)))\n          (multiple-value-bind (val found-p)\n              (gethash k table)\n            (if found-p val\n                (setf (gethash k table) (apply fn args))))))))\n\n(defun memoize (fn-name &key (key #'first) (test #'eql))\n  \"Replace fn-name's global definition with a memoized version.\"\n  (clear-memoize fn-name)\n  (setf (symbol-function fn-name)\n        (memo (symbol-function fn-name)\n              :name fn-name :key key :test test)))\n\n(defun clear-memoize (fn-name)\n  \"Clear the hash table from a memo function.\"\n  (let ((table (get fn-name 'memo)))\n    (when table (clrhash table))))\n\n;;;; Delayed computation:\n\n(defstruct delay value (computed? nil))\n\n(defmacro delay (&rest body)\n  \"A computation that can be executed later by FORCE.\"\n  `(make-delay :value #'(lambda () . ,body)))\n\n(defun force (delay)\n  \"Do a delayed computation, or fetch its previously-computed value.\"\n  (if (delay-computed? delay)\n      (delay-value delay)\n      (prog1 (setf (delay-value delay) (funcall (delay-value delay)))\n             (setf (delay-computed? delay) t))))\n\n;;;; Defresource:\n\n(defmacro defresource (name &key constructor (initial-copies 0)\n                       (size (max initial-copies 10)))\n  (let ((resource (symbol '* (symbol name '-resource*)))\n        (deallocate (symbol 'deallocate- name))\n        (allocate (symbol 'allocate- name)))\n    `(progn\n       (defparameter ,resource (make-array ,size :fill-pointer 0))\n       (defun ,allocate ()\n         \"Get an element from the resource pool, or make one.\"\n         (if (= (fill-pointer ,resource) 0)\n             ,constructor\n             (vector-pop ,resource)))\n       (defun ,deallocate (,name)\n         \"Place a no-longer-needed element back in the pool.\"\n         (vector-push-extend ,name ,resource))\n       ,(if (> initial-copies 0)\n            `(mapc #',deallocate (loop repeat ,initial-copies\n                                       collect (,allocate))))\n       ',name)))\n\n(defmacro with-resource ((var resource &optional protect) &rest body)\n  \"Execute body with VAR bound to an instance of RESOURCE.\"\n  (let ((allocate (symbol 'allocate- resource))\n        (deallocate (symbol 'deallocate- resource)))\n    (if protect\n        `(let ((,var nil))\n           (unwind-protect (progn (setf ,var (,allocate)) ,@body)\n             (unless (null ,var) (,deallocate ,var))))\n        `(let ((,var (,allocate)))\n           ,@body\n           (,deallocate var)))))\n\n;;;; Queues:\n\n;;; A queue is a (last . contents) pair\n\n(defun queue-contents (q) (cdr q))\n\n(defun make-queue ()\n  \"Build a new queue, with no elements.\"\n  (let ((q (cons nil nil)))\n    (setf (car q) q)))\n\n(defun enqueue (item q)\n  \"Insert item at the end of the queue.\"\n  (setf (car q)\n        (setf (rest (car q))\n              (cons item nil)))\n  q)\n\n(defun dequeue (q)\n  \"Remove an item from the front of the queue.\"\n  (pop (cdr q))\n  (if (null (cdr q)) (setf (car q) q))\n  q)\n\n(defun front (q) (first (queue-contents q)))\n\n(defun empty-queue-p (q) (null (queue-contents q)))\n\n(defun queue-nconc (q list)\n  \"Add the elements of LIST to the end of the queue.\"\n  (setf (car q)\n        (last (setf (rest (car q)) list))))\n\n;;;; Other:\n\n(defun sort* (seq pred &key key)\n  \"Sort without altering the sequence\"\n  (sort (copy-seq seq) pred :key key))\n\n(defun reuse-cons (x y x-y)\n  \"Return (cons x y), or reuse x-y if it is equal to (cons x y)\"\n  (if (and (eql x (car x-y)) (eql y (cdr x-y)))\n      x-y\n      (cons x y)))\n\n;;; ==============================\n\n(defun length=1 (x)\n  \"Is x a list of length 1?\"\n  (and (consp x) (null (cdr x))))\n\n(defun rest3 (list)\n  \"The rest of a list after the first THREE elements.\"\n  (cdddr list))\n\n;;; ==============================\n\n(defun unique-find-if-anywhere (predicate tree\n                                &optional found-so-far)\n  \"Return a list of leaves of tree satisfying predicate,\n  with duplicates removed.\"\n  (if (atom tree)\n      (if (funcall predicate tree)\n          (adjoin tree found-so-far)\n          found-so-far)\n      (unique-find-if-anywhere\n        predicate\n        (first tree)\n        (unique-find-if-anywhere predicate (rest tree)\n                                 found-so-far))))\n\n(defun find-if-anywhere (predicate tree)\n  \"Does predicate apply to any atom in the tree?\"\n  (if (atom tree)\n      (funcall predicate tree)\n      (or (find-if-anywhere predicate (first tree))\n          (find-if-anywhere predicate (rest tree)))))\n\n;;; ==============================\n\n(defmacro define-enumerated-type (type &rest elements)\n  \"Represent an enumerated type with integers 0-n.\"\n  `(progn\n     (deftype ,type () '(integer 0 ,(- (length elements) 1)))\n     (defun ,(symbol type '->symbol) (,type)\n       (elt ',elements ,type))\n     (defun ,(symbol 'symbol-> type) (symbol)\n       (position symbol ',elements))\n     ,@(loop for element in elements\n             for i from 0\n             collect `(defconstant ,element ,i))))\n\n;;; ==============================\n\n(defun not-null (x) (not (null x)))\n\n(defun first-or-nil (x)\n  \"The first element of x if it is a list; else nil.\"\n  (if (consp x) (first x) nil))\n\n(defun first-or-self (x)\n  \"The first element of x, if it is a list; else x itself.\"\n  (if (consp x) (first x) x))\n\n;;; ==============================\n\n;;;; CLtL2 and ANSI CL Compatibility\n\n(unless (fboundp 'defmethod)\n(defmacro defmethod (name args &rest body)\n  `(defun ',name ',args ,@body))\n)\n\n(unless (fboundp 'map-into)\n(defun map-into (result-sequence function &rest sequences)\n  \"Destructively set elements of RESULT-SEQUENCE to the results\n  of applying FUNCTION to respective elements of SEQUENCES.\"\n  (let ((arglist (make-list (length sequences)))\n        (n (if (listp result-sequence)\n               most-positive-fixnum\n               (array-dimension result-sequence 0))))\n    ;; arglist is made into a list of args for each call\n    ;; n is the length of the longest vector\n    (when sequences\n      (setf n (min n (loop for seq in sequences\n                           minimize (length seq)))))\n    ;; Define some shared functions:\n    (flet\n      ((do-one-call (i)\n         (loop for seq on sequences\n               for arg on arglist\n               do (if (listp (first seq))\n                      (setf (first arg)\n                            (pop (first seq)))\n                      (setf (first arg)\n                            (aref (first seq) i))))\n         (apply function arglist))\n       (do-result (i)\n         (if (and (vectorp result-sequence)\n                  (array-has-fill-pointer-p result-sequence))\n             (setf (fill-pointer result-sequence)\n                   (max i (fill-pointer result-sequence))))))\n      (declare (inline do-one-call))\n      ;; Decide if the result is a list or vector,\n      ;; and loop through each element\n      (if (listp result-sequence)\n          (loop for i from 0 to (- n 1)\n                for r on result-sequence\n                do (setf (first r)\n                         (do-one-call i))\n                finally (do-result i))\n          (loop for i from 0 to (- n 1)\n                do (setf (aref result-sequence i)\n                         (do-one-call i))\n                finally (do-result i))))\n      result-sequence))\n\n)\n\n(unless (fboundp 'complement)\n(defun complement (fn)\n  \"If FN returns y, then (complement FN) returns (not y).\"\n  #'(lambda (&rest args) (not (apply fn args))))\n)\n\n(unless (fboundp 'with-compilation-unit)\n(defmacro with-compilation-unit (options &body body)\n  \"Do the body, but delay compiler warnings until the end.\"\n  ;; That way, undefined function warnings that are really\n  ;; just forward references will not be printed at all.\n  ;; This is defined in Common Lisp the Language, 2nd ed.\n  (declare (ignore options))\n  `(,(read-time-case\n       #+Lispm 'compiler:compiler-warnings-context-bind\n       #+Lucid 'with-deferred-warnings\n               'progn)\n    .,body))\n)\n\n;;;; Reduce\n\n(when nil ;; Change this to T if you need REDUCE with :key keyword.\n\n(defun reduce* (fn seq from-end start end key init init-p)\n  (funcall (if (listp seq) #'reduce-list #'reduce-vect)\n           fn seq from-end (or start 0) end key init init-p))\n\n(defun reduce (function sequence &key from-end start end key\n               (initial-value nil initial-value-p))\n  (reduce* function sequence from-end start end\n           key initial-value initial-value-p))\n\n(defun reduce-vect (fn seq from-end start end key init init-p)\n  (if (null end) (setf end (length seq)))\n  (assert (<= 0 start end (length seq)) (start end)\n          \"Illegal subsequence of ~a --- :start ~d :end ~d\"\n          seq start end)\n  (case (- end start)\n    (1 (if init-p\n           (funcall fn init (funcall-if key (aref seq start)))\n           (funcall-if key (aref seq start))))\n    (0 (if init-p init (funcall fn)))\n    (t (if (not from-end)\n           (let ((result\n                   (if init-p\n                       (funcall\n                         fn init\n                         (funcall-if key (aref seq start)))\n                       (funcall\n                         fn\n                         (funcall-if key (aref seq start))\n                         (funcall-if key (aref seq (+ start 1)))))))\n             (loop for i from (+ start (if init-p 1 2))\n                   to (- end 1)\n                   do (setf result\n                            (funcall\n                              fn result\n                              (funcall-if key (aref seq i)))))\n             result)\n           (let ((result\n                   (if init-p\n                       (funcall\n                         fn\n                         (funcall-if key (aref seq (- end 1)))\n                         init)\n                       (funcall\n                         fn\n                         (funcall-if key (aref seq (- end 2)))\n                         (funcall-if key (aref seq (- end 1)))))))\n             (loop for i from (- end (if init-p 2 3)) downto start\n                   do (setf result\n                            (funcall\n                              fn\n                              (funcall-if key (aref seq i))\n                              result)))\n             result)))))\n\n(defun reduce-list (fn seq from-end start end key init init-p)\n  (if (null end) (setf end (length seq)))\n  (cond ((> start 0)\n         (reduce-list fn (nthcdr start seq) from-end 0\n                      (- end start) key init init-p))\n        ((or (null seq) (eql start end))\n         (if init-p init (funcall fn)))\n        ((= (- end start) 1)\n         (if init-p\n             (funcall fn init (funcall-if key (first seq)))\n             (funcall-if key (first seq))))\n        (from-end\n         (reduce-vect fn (coerce seq 'vector) t start end\n                      key init init-p))\n        ((null (rest seq))\n         (if init-p\n             (funcall fn init (funcall-if key (first seq)))\n             (funcall-if key (first seq))))\n        (t (let ((result\n                   (if init-p\n                       (funcall\n                         fn init\n                         (funcall-if key (pop seq)))\n                       (funcall\n                         fn\n                         (funcall-if key (pop seq))\n                         (funcall-if key (pop seq))))))\n             (if end\n                 (loop repeat (- end (if init-p 1 2)) while seq\n                    do (setf result\n                             (funcall\n                               fn result\n                               (funcall-if key (pop seq)))))\n                 (loop while seq\n                    do (setf result\n                             (funcall\n                               fn result\n                               (funcall-if key (pop seq))))))\n             result))))\n)\n\n(pushnew \"auxfns\" *paip-modules* :test 'equal)\n"
  },
  {
    "path": "lisp/clos.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp;  -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File clos.lisp: Object-oriented programming examples\n\n(defstruct account\n  (name \"\") (balance 0.00) (interest-rate .06))\n\n(defun account-withdraw (account amt)\n  \"Make a withdrawal from this account.\"\n  (if (<= amt (account-balance account))\n      (decf (account-balance account) amt)\n      'insufficient-funds))\n\n(defun account-deposit (account amt)\n  \"Make a deposit to this account.\"\n  (incf (account-balance account) amt))\n\n(defun account-interest (account)\n  \"Accumulate interest in this account.\"\n  (incf (account-balance account)\n        (* (account-interest-rate account)\n           (account-balance account))))\n\n;;; ==============================\n\n(defun new-account (name &optional (balance 0.00)\n                    (interest-rate .06))\n  \"Create a new account that knows the following messages:\"\n  #'(lambda (message)\n      (case message\n        (withdraw #'(lambda (amt)\n                      (if (<= amt balance)\n                          (decf balance amt)\n                          'insufficient-funds)))\n        (deposit  #'(lambda (amt) (incf balance amt)))\n        (balance  #'(lambda () balance))\n        (name     #'(lambda () name))\n        (interest #'(lambda ()\n                      (incf balance\n                            (* interest-rate balance)))))))\n\n;;; ==============================\n\n(defun get-method (object message)\n  \"Return the method that implements message for this object.\"\n  (funcall object message))\n\n(defun send (object message &rest args)\n  \"Get the function to implement the message,\n  and apply the function to the args.\"\n  (apply (get-method object message) args))\n\n;;; ==============================\n\n(defun withdraw (object &rest args)\n  \"Define withdraw as a generic function on objects.\"\n  (apply (get-method object 'withdraw) args))\n\n;;; ==============================\n\n(defmacro define-class (class inst-vars class-vars &body methods)\n  \"Define a class for object-oriented programming.\"\n  ;; Define constructor and generic functions for methods\n  `(let ,class-vars\n     (mapcar #'ensure-generic-fn ',(mapcar #'first methods))\n     (defun ,class ,inst-vars\n       #'(lambda (message)\n           (case message\n             ,@(mapcar #'make-clause methods))))))\n\n(defun make-clause (clause)\n  \"Translate a message from define-class into a case clause.\"\n  `(,(first clause) #'(lambda ,(second clause) .,(rest2 clause))))\n\n(defun ensure-generic-fn (message)\n  \"Define an object-oriented dispatch function for a message,\n  unless it has already been defined as one.\"\n  (unless (generic-fn-p message)\n    (let ((fn #'(lambda (object &rest args)\n                  (apply (get-method object message) args))))\n      (setf (symbol-function message) fn)\n      (setf (get message 'generic-fn) fn))))\n\n(defun generic-fn-p (fn-name)\n  \"Is this a generic function?\"\n  (and (fboundp fn-name)\n       (eq (get fn-name 'generic-fn) (symbol-function fn-name))))\n\n;;; ==============================\n\n"
  },
  {
    "path": "lisp/cmacsyma.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File cmacsyma.lisp: Canonical Form version of Macsyma.\n\n;;; Bug Fix by dst, Dave_Touretzky@CS.CMU.EDU\n\n(requires \"macsyma\") ; Only for the infix parser\n\n;;;; rule and expression definitions from \"student.lisp\"\n\n(defstruct (rule (:type list)) pattern response)\n(defstruct (exp (:type list)\n                (:constructor mkexp (lhs op rhs)))\n  op lhs rhs)\n\n(defun exp-p (x) (consp x))\n(defun exp-args (x) (rest x))\n\n(defun binary-exp-p (x)\n  (and (exp-p x) (= (length (exp-args x)) 2)))\n\n(proclaim '(inline main-var degree coef\n                   var= var> poly make-poly))\n\n(deftype polynomial () 'simple-vector)\n\n(defsetf main-var (p) (val)\n  `(setf (svref (the polynomial ,p) 0) ,val))\n\n(defsetf coef (p i) (val)\n  `(setf (svref (the polynomial ,p) (+ ,i 1)) ,val))\n\n(defun main-var (p) (svref (the polynomial p) 0))\n(defun coef (p i)   (svref (the polynomial p) (+ i 1)))\n(defun degree (p)   (- (length (the polynomial p)) 2))\n\n(defun poly (x &rest coefs)\n  \"Make a polynomial with main variable x\n  and coefficients in increasing order.\"\n  (apply #'vector x coefs))\n\n(defun make-poly (x degree)\n  \"Make the polynomial 0 + 0*x + 0*x^2 + ... 0*x^degree\"\n  (let ((p (make-array (+ degree 2) :initial-element 0)))\n    (setf (main-var p) x)\n    p))\n\n(defun prefix->canon (x)\n  \"Convert a prefix Lisp expression to canonical form.\n  Exs: (+ (^ x 2) (* 3 x)) => #(x 0 3 1)\n       (- (* (- x 1) (+ x 1)) (- (^ x 2) 1)) => 0\"\n  (cond ((numberp x) x)\n        ((symbolp x) (poly x 0 1))\n        ((and (exp-p x) (get (exp-op x) 'prefix->canon))\n         (apply (get (exp-op x) 'prefix->canon)\n                (mapcar #'prefix->canon (exp-args x))))\n        (t (error \"Not a polynomial: ~a\" x))))\n\n(dolist (item '((+ poly+) (- poly-) (* poly*poly)\n                (^ poly^n) (D deriv-poly)))\n  (setf (get (first item) 'prefix->canon) (second item)))\n\n(defun poly+ (&rest args)\n  \"Unary or binary polynomial addition.\"\n  (ecase (length args)\n    (1 (first args))\n    (2 (poly+poly (first args) (second args)))))\n\n(defun poly- (&rest args)\n  \"Unary or binary polynomial subtraction.\"\n  (ecase (length args)\n    (0 0)\n    (1 (poly*poly -1 (first args)))\n    (2 (poly+poly (first args) (poly*poly -1 (second args))))))\n\n(defun var= (x y) (eq x y))\n\n(defun var> (x y) (string> x y))\n\n(defun poly+poly (p q)\n  \"Add two polynomials.\"\n  (normalize-poly\n    (cond\n      ((numberp p)                      (k+poly p q))\n      ((numberp q)                      (k+poly q p))\n      ((var= (main-var p) (main-var q)) (poly+same p q))\n      ((var> (main-var q) (main-var p)) (k+poly q p))\n      (t                                (k+poly p q)))))\n\n(defun k+poly (k p)\n  \"Add a constant k to a polynomial p.\"\n  (cond ((eql k 0) p)                 ;; 0 + p = p\n        ((and (numberp k) (numberp p))\n         (+ k p))                     ;; Add numbers\n        (t (let ((r (copy-poly p)))   ;; Add k to x^0 term of p\n             (setf (coef r 0) (poly+poly (coef r 0) k))\n             r))))\n\n(defun poly+same (p q)\n  \"Add two polynomials with the same main variable.\"\n  ;; First assure that q is the higher degree polynomial\n  (if (> (degree p) (degree q))\n      (poly+same q p)\n      ;; Add each element of p into r (which is a copy of q).\n      (let ((r (copy-poly q)))\n        (loop for i from 0 to (degree p) do\n              (setf (coef r i) (poly+poly (coef r i) (coef p i))))\n        r)))\n\n(defun copy-poly (p)\n  \"Make a copy a polynomial.\"\n  (copy-seq p))\n\n(defun poly*poly (p q)\n  \"Multiply two polynomials.\"\n  (normalize-poly\n    (cond\n      ((numberp p)                      (k*poly p q))\n      ((numberp q)                      (k*poly q p))\n      ((var= (main-var p) (main-var q)) (poly*same p q))\n      ((var> (main-var q) (main-var p)) (k*poly q p))\n      (t                                (k*poly p q)))))\n\n(defun k*poly (k p)\n  \"Multiply a polynomial p by a constant factor k.\"\n  (cond\n    ((eql k 0)         0)       ;; 0 * p = 0\n    ((eql k 1)         p)       ;; 1 * p = p\n    ((and (numberp k)\n          (numberp p)) (* k p)) ;; Multiply numbers\n    (t ;; Multiply each coefficient\n     (let ((r (make-poly (main-var p) (degree p))))\n       ;; Accumulate result in r;  r[i] = k*p[i]\n       (loop for i from 0 to (degree p) do\n             (setf (coef r i) (poly*poly k (coef p i))))\n       r))))\n\n(defun poly*same (p q)\n  \"Multiply two polynomials with the same variable.\"\n  ;; r[i] = p[0]*q[i] + p[1]*q[i-1] + ...\n  (let* ((r-degree (+ (degree p) (degree q)))\n         (r (make-poly (main-var p) r-degree)))\n    (loop for i from 0 to (degree p) do\n          (unless (eql (coef p i) 0)\n            (loop for j from 0 to (degree q) do\n                  (setf (coef r (+ i j))\n                        (poly+poly (coef r (+ i j))\n                                   (poly*poly (coef p i)\n                                              (coef q j)))))))\n    r))\n\n(defun normalize-poly (p)\n  \"Alter a polynomial by dropping trailing zeros.\"\n  (if (numberp p)\n      p\n      (let ((p-degree (- (position 0 p :test (complement #'eql)\n                                       :from-end t)\n                         1)))\n        (cond ((<= p-degree 0) (normalize-poly (coef p 0)))\n              ((< p-degree (degree p))\n               (delete 0 p :start p-degree))\n              (t p)))))\n\n(defun deriv-poly (p x)\n  \"Return the derivative, dp/dx, of the polynomial p.\"\n  ;; If p is a number or a polynomial with main-var > x,\n  ;; then p is free of x, and the derivative is zero;\n  ;; otherwise do real work.\n  ;; But first, make sure X is a simple variable,\n  ;; of the form #(X 0 1).\n  (assert (and (typep x 'polynomial) (= (degree x) 1)\n\t       (eql (coef x 0) 0) (eql (coef x 1) 1)))\n  (cond\n    ((numberp p) 0)\n    ((var> (main-var p) (main-var x)) 0)\n    ((var= (main-var p) (main-var x))\n     ;; d(a + bx + cx^2 + dx^3)/dx = b + 2cx + 3dx^2\n     ;; So, shift the sequence p over by 1, then\n     ;; put x back in, and multiply by the exponents\n     (let ((r (subseq p 1)))\n       (setf (main-var r) (main-var x))\n       (loop for i from 1 to (degree r) do\n             (setf (coef r i) (poly*poly (+ i 1) (coef r i))))\n       (normalize-poly r)))\n    (t ;; Otherwise some coefficient may contain x.  Ex:\n     ;; d(z + 3x + 3zx^2 + z^2x^3)/dz\n     ;; = 1 +  0 +  3x^2 +  2zx^3\n     ;; So copy p, and differentiate the coefficients.\n     (let ((r (copy-poly p)))\n       (loop for i from 0 to (degree p) do\n             (setf (coef r i) (deriv-poly (coef r i) x)))\n       (normalize-poly r)))))\n\n(defun prefix->infix (exp)\n  \"Translate prefix to infix expressions.\n  Handles operators with any number of args.\"\n  (if (atom exp)\n      exp\n      (intersperse\n        (exp-op exp)\n        (mapcar #'prefix->infix (exp-args exp)))))\n\n(defun intersperse (op args)\n  \"Place op between each element of args.\n  Ex: (intersperse '+ '(a b c)) => '(a + b + c)\"\n  (if (length=1 args)\n      (first args)\n      (rest (loop for arg in args\n               collect op\n               collect arg))))\n\n(defun canon->prefix (p)\n  \"Convert a canonical polynomial to a lisp expression.\"\n  (if (numberp p)\n      p\n      (args->prefix\n        '+ 0\n        (loop for i from (degree p) downto 0\n              collect (args->prefix\n                        '* 1\n                        (list (canon->prefix (coef p i))\n                              (exponent->prefix\n                                (main-var p) i)))))))\n\n(defun exponent->prefix (base exponent)\n  \"Convert canonical base^exponent to prefix form.\"\n  (case exponent\n    (0 1)\n    (1 base)\n    (t `(^ ,base ,exponent))))\n\n(defun args->prefix (op identity args)\n  \"Convert arg1 op arg2 op ... to prefix form.\"\n  (let ((useful-args (remove identity args)))\n    (cond ((null useful-args) identity)\n          ((and (eq op '*) (member 0 args)) 0)\n          ((length=1 args) (first useful-args))\n          (t (cons op (mappend\n                        #'(lambda (exp)\n                            (if (starts-with exp op)\n                                (exp-args exp)\n                                (list exp)))\n                        useful-args))))))\n\n(defun canon (infix-exp)\n  \"Canonicalize argument and convert it back to infix\"\n  (prefix->infix (canon->prefix (prefix->canon (infix->prefix infix-exp)))))\n\n(defun canon-simplifier ()\n  \"Read an expression, canonicalize it, and print the result.\"\n  (loop\n    (print 'canon>)\n    (print (canon (read)))))\n\n(defun poly^n (p n)\n  \"Raise polynomial p to the nth power, n>=0.\"\n  ;; Uses the binomial theorem\n  (check-type n (integer 0 *))\n  (cond\n    ((= n 0) 1)\n    ((integerp p) (expt p n))\n    (t ;; First: split the polynomial p = a + b, where\n     ;; a = k*x^d and b is the rest of p\n     (let ((a (make-poly (main-var p) (degree p)))\n           (b (normalize-poly (subseq p 0 (- (length p) 1))))\n           ;; Allocate arrays of powers of a and b:\n           (a^n (make-array (+ n 1)))\n           (b^n (make-array (+ n 1)))\n           ;; Initialize the result:\n           (result (make-poly (main-var p) (* (degree p) n))))\n       (setf (coef a (degree p)) (coef p (degree p)))\n       ;; Second: Compute powers of a^i and b^i for i up to n\n       (setf (aref a^n 0) 1)\n       (setf (aref b^n 0) 1)\n       (loop for i from 1 to n do\n             (setf (aref a^n i) (poly*poly a (aref a^n (- i 1))))\n             (setf (aref b^n i) (poly*poly b (aref b^n (- i 1)))))\n       ;; Third: add the products into the result,\n       ;; so that result[i] = (n choose i) * a^i * b^(n-i)\n       (let ((c 1)) ;; c helps compute (n choose i) incrementally\n         (loop for i from 0 to n do\n               (p-add-into! result c\n                            (poly*poly (aref a^n i)\n                                 (aref b^n (- n i))))\n               (setf c (/ (* c (- n i)) (+ i 1)))))\n       (normalize-poly result)))))\n\n(defun p-add-into! (result c p)\n  \"Destructively add c*p into result.\"\n  (if (or (numberp p)\n          (not (var= (main-var p) (main-var result))))\n      (setf (coef result 0)\n            (poly+poly (coef result 0) (poly*poly c p)))\n      (loop for i from 0 to (degree p) do\n            (setf (coef result i)\n                  (poly+poly (coef result i) (poly*poly c (coef p i))))))\n  result)\n\n(defun make-rat (numerator denominator)\n  \"Build a rational: a quotient of two polynomials.\"\n  (if (numberp denominator)\n      (k*poly (/ 1 denominator) numerator)\n      (cons numerator denominator)))\n\n(defun rat-numerator (rat)\n  \"The numerator of a rational expression.\"\n  (typecase rat\n    (cons (car rat))\n    (number (numerator rat))\n    (t rat)))\n\n(defun rat-denominator (rat)\n  \"The denominator of a rational expression.\"\n  (typecase rat\n    (cons (cdr rat))\n    (number (denominator rat))\n    (t 1)))\n\n(defun rat*rat (x y)\n  \"Multiply rationals: a/b * c/d = a*c/b*d\"\n  (poly/poly (poly*poly (rat-numerator x)\n                        (rat-numerator y))\n             (poly*poly (rat-denominator x)\n                        (rat-denominator y))))\n\n(defun rat+rat (x y)\n  \"Add rationals: a/b + c/d = (a*d + c*b)/b*d\"\n  ;; Bug fix by dst 4/6/92; b and c were switched\n  (let ((a (rat-numerator x))\n        (b (rat-denominator x))\n        (c (rat-numerator y))\n        (d (rat-denominator y)))\n    (poly/poly (poly+poly (poly*poly a d) (poly*poly c b))\n               (poly*poly b d))))\n\n(defun rat/rat (x y)\n  \"Divide rationals: a/b / c/d = a*d/b*c\"\n  (rat*rat x (make-rat (rat-denominator y) (rat-numerator y))))\n\n"
  },
  {
    "path": "lisp/compile1.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File compile1.lisp: Simplest version of Scheme compiler\n\n(requires \"interp1\") ; Uses the Scheme macro facility\n\n(defun comp (x env)\n  \"Compile the expression x into a list of instructions\"\n  (cond\n    ((symbolp x) (gen-var x env))\n    ((atom x) (gen 'CONST x))\n    ((scheme-macro (first x)) (comp (scheme-macro-expand x) env))\n    ((case (first x)\n       (QUOTE  (gen 'CONST (second x)))\n       (BEGIN  (comp-begin (rest x) env))\n       (SET!   (seq (comp (third x) env) (gen-set (second x) env)))\n       (IF     (comp-if (second x) (third x) (fourth x) env))\n       (LAMBDA (gen 'FN (comp-lambda (second x) (rest (rest x)) env)))\n       ;; Procedure application:\n       ;; Compile args, then fn, then the call\n       (t      (seq (mappend #'(lambda (y) (comp y env)) (rest x))\n                    (comp (first x) env)\n                              (gen 'call (length (rest x)))))))))\n\n;;; ==============================\n\n(defun comp-begin (exps env)\n  \"Compile a sequence of expressions, popping all but the last.\"\n  (cond ((null exps) (gen 'CONST nil))\n        ((length=1 exps) (comp (first exps) env))\n        (t (seq (comp (first exps) env)\n                (gen 'POP)\n                (comp-begin (rest exps) env)))))\n\n;;; ==============================\n\n(defun comp-if (pred then else env)\n  \"Compile a conditional expression.\"\n  (let ((L1 (gen-label))\n        (L2 (gen-label)))\n    (seq (comp pred env) (gen 'FJUMP L1)\n         (comp then env) (gen 'JUMP L2)\n         (list L1) (comp else env)\n         (list L2))))\n\n;;; ==============================\n\n(defstruct (fn (:print-function print-fn))\n  code (env nil) (name nil) (args nil))\n\n(defun comp-lambda (args body env)\n  \"Compile a lambda form into a closure with compiled code.\"\n  (assert (and (listp args) (every #'symbolp args)) ()\n          \"Lambda arglist must be a list of symbols, not ~a\" args)\n  ;; For now, no &rest parameters.\n  ;; The next version will support Scheme's version of &rest\n  (make-fn\n    :env env :args args\n    :code (seq (gen 'ARGS (length args))\n               (comp-begin body (cons args env))\n               (gen 'RETURN))))\n\n;;; ==============================\n\n(defvar *label-num* 0)\n\n(defun compiler (x)\n  \"Compile an expression as if it were in a parameterless lambda.\"\n  (setf *label-num* 0)\n  (comp-lambda '() (list x) nil))\n\n(defun comp-show (x)\n  \"Compile an expression and show the resulting code\"\n   (show-fn (compiler x))\n  (values))\n\n;;; ==============================\n\n(defun gen (opcode &rest args)\n  \"Return a one-element list of the specified instruction.\"\n  (list (cons opcode args)))\n\n(defun seq (&rest code)\n  \"Return a sequence of instructions\"\n  (apply #'append code))\n\n(defun gen-label (&optional (label 'L))\n  \"Generate a label (a symbol of the form Lnnn)\"\n  (intern (format nil \"~a~d\" label (incf *label-num*))))\n\n;;; ==============================\n\n(defun gen-var (var env)\n  \"Generate an instruction to reference a variable's value.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LVAR (first p) (second p) \";\" var)\n        (gen 'GVAR var))))\n\n(defun gen-set (var env)\n  \"Generate an instruction to set a variable to top-of-stack.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LSET (first p) (second p) \";\" var)\n        (gen 'GSET var))))\n\n;;; ==============================\n\n(def-scheme-macro define (name &rest body)\n  (if (atom name)\n      `(name! (set! ,name . ,body) ',name)\n      (scheme-macro-expand\n         `(define ,(first name)\n            (lambda ,(rest name) . ,body)))))\n\n(defun name! (fn name)\n  \"Set the name field of fn, if it is an un-named fn.\"\n  (when (and (fn-p fn) (null (fn-name fn)))\n    (setf (fn-name fn) name))\n  name)\n\n;; This should also go in init-scheme-interp:\n(set-global-var! 'name! #'name!)\n\n(defun print-fn (fn &optional (stream *standard-output*) depth)\n  (declare (ignore depth))\n  (format stream \"{~a}\" (or (fn-name fn) '??)))\n\n(defun show-fn (fn &optional (stream *standard-output*) (depth 0))\n  \"Print all the instructions in a function.\n  If the argument is not a function, just princ it,\n  but in a column at least 8 spaces wide.\"\n  (if (not (fn-p fn))\n      (format stream \"~8a\" fn)\n      (progn\n        (fresh-line)\n        (incf depth 8)\n        (dolist (instr (fn-code fn))\n          (if (label-p instr)\n              (format stream \"~a:\" instr)\n              (progn\n                (format stream \"~VT\" depth)\n                (dolist (arg instr)\n                  (show-fn arg stream depth))\n                (fresh-line)))))))\n\n(defun label-p (x) \"Is x a label?\" (atom x))\n\n(defun in-env-p (symbol env)\n  \"If symbol is in the environment, return its index numbers.\"\n  (let ((frame (find symbol env :test #'find)))\n    (if frame (list (position frame env) (position symbol frame)))))\n"
  },
  {
    "path": "lisp/compile2.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File compile2.lisp: Scheme compiler with tail recursion\n;;;; and some optimizations and primitive instructions.\n\n(requires \"interp1\") ; Uses the Scheme macro facility\n\n(defun comp (x env val? more?)\n  \"Compile the expression x into a list of instructions\"\n    (cond\n      ((member x '(t nil)) (comp-const x val? more?))\n      ((symbolp x) (comp-var x env val? more?))\n      ((atom x) (comp-const x val? more?))\n      ((scheme-macro (first x)) (comp (scheme-macro-expand x) env val? more?))\n      ((case (first x)\n         (QUOTE  (arg-count x 1)\n                 (comp-const (second x) val? more?))\n         (BEGIN  (comp-begin (rest x) env val? more?))\n         (SET!   (arg-count x 2)\n                 (assert (symbolp (second x)) (x)\n                         \"Only symbols can be set!, not ~a in ~a\"\n                         (second x) x)\n                 (seq (comp (third x) env t t)\n                      (gen-set (second x) env)\n                      (if (not val?) (gen 'POP))\n                      (unless more? (gen 'RETURN))))\n         (IF     (arg-count x 2 3)\n                 (comp-if (second x) (third x) (fourth x)\n                          env val? more?))\n         (LAMBDA (when val?\n                   (let ((f (comp-lambda (second x) (rest2 x) env)))\n                     (seq (gen 'FN f) (unless more? (gen 'RETURN))))))\n         (t      (comp-funcall (first x) (rest x) env val? more?))))))\n\n;;; ==============================\n\n(defun arg-count (form min &optional (max min))\n  \"Report an error if form has wrong number of args.\"\n  (let ((n-args (length (rest form))))\n    (assert (<= min n-args max) (form)\n      \"Wrong number of arguments for ~a in ~a:\n       ~d supplied, ~d~@[ to ~d~] expected\"\n      (first form) form n-args min (if (/= min max) max))))\n\n;;; ==============================\n\n(defun comp-begin (exps env val? more?)\n  \"Compile a sequence of expressions,\n  returning the last one as the value.\"\n  (cond ((null exps) (comp-const nil val? more?))\n        ((length=1 exps) (comp (first exps) env val? more?))\n        (t (seq (comp (first exps) env nil t)\n                (comp-begin (rest exps) env val? more?)))))\n\n(defun comp-list (exps env)\n  \"Compile a list, leaving them all on the stack.\"\n  (if (null exps) nil\n      (seq (comp (first exps) env t t)\n           (comp-list (rest exps) env))))\n\n;;; ==============================\n\n(defun comp-const (x val? more?)\n  \"Compile a constant expression.\"\n  (if val? (seq (if (member x '(t nil -1 0 1 2))\n                    (gen x)\n                    (gen 'CONST x))\n                (unless more? (gen 'RETURN)))))\n\n(defun comp-var (x env val? more?)\n  \"Compile a variable reference.\"\n  (if val? (seq (gen-var x env) (unless more? (gen 'RETURN)))))\n\n;;; ==============================\n\n(defun comp-if (pred then else env val? more?)\n  \"Compile a conditional (IF) expression.\"\n  (cond\n    ((null pred)          ; (if nil x y) ==> y\n     (comp else env val? more?))\n    ((constantp pred)     ; (if t x y) ==> x\n     (comp then env val? more?))\n    ((and (listp pred)    ; (if (not p) x y) ==> (if p y x)\n          (length=1 (rest pred))\n          (primitive-p (first pred) env 1)\n          (eq (prim-opcode (primitive-p (first pred) env 1)) 'not))\n     (comp-if (second pred) else then env val? more?))\n    (t (let ((pcode (comp pred env t t))\n             (tcode (comp then env val? more?))\n             (ecode (comp else env val? more?)))\n         (cond\n           ((equal tcode ecode) ; (if p x x) ==> (begin p x)\n            (seq (comp pred env nil t) ecode))\n           ((null tcode)  ; (if p nil y) ==> p (TJUMP L2) y L2:\n            (let ((L2 (gen-label)))\n              (seq pcode (gen 'TJUMP L2) ecode (list L2)\n                   (unless more? (gen 'RETURN)))))\n           ((null ecode)  ; (if p x) ==> p (FJUMP L1) x L1:\n            (let ((L1 (gen-label)))\n              (seq pcode (gen 'FJUMP L1) tcode (list L1)\n                   (unless more? (gen 'RETURN)))))\n           (t             ; (if p x y) ==> p (FJUMP L1) x L1: y\n                          ; or p (FJUMP L1) x (JUMP L2) L1: y L2:\n            (let ((L1 (gen-label))\n                  (L2 (if more? (gen-label))))\n              (seq pcode (gen 'FJUMP L1) tcode\n                   (if more? (gen 'JUMP L2))\n                   (list L1) ecode (if more? (list L2))))))))))\n\n;;; ==============================\n\n(defun comp-funcall (f args env val? more?)\n  \"Compile an application of a function to arguments.\"\n  (let ((prim (primitive-p f env (length args))))\n    (cond\n      (prim  ; function compilable to a primitive instruction\n       (if (and (not val?) (not (prim-side-effects prim)))\n           ;; Side-effect free primitive when value unused\n           (comp-begin args env nil more?)\n           ;; Primitive with value or call needed\n           (seq (comp-list args env)\n                (gen (prim-opcode prim))\n                (unless val? (gen 'POP))\n                (unless more? (gen 'RETURN)))))\n      ((and (starts-with f 'lambda) (null (second f)))\n       ;; ((lambda () body)) => (begin body)\n       (assert (null args) () \"Too many arguments supplied\")\n       (comp-begin (rest2 f) env val? more?))\n      (more? ; Need to save the continuation point\n       (let ((k (gen-label 'k)))\n         (seq (gen 'SAVE k)\n              (comp-list args env)\n              (comp f env t t)\n              (gen 'CALLJ (length args))\n              (list k)\n              (if (not val?) (gen 'POP)))))\n      (t     ; function call as rename plus goto\n       (seq (comp-list args env)\n            (comp f env t t)\n            (gen 'CALLJ (length args)))))))\n\n;;; ==============================\n\n(defstruct (prim (:type list))\n  symbol n-args opcode always side-effects)\n\n;;; Note change from book: some of the following primitive fns have had\n;;; trailing NIL fields made explicit, because some Lisp's will give\n;;; an error (rather than NIL), when asked to find the prim-side-effects\n;;; of a three-element list.\n\n(defparameter *primitive-fns*\n  '((+ 2 + true nil) (- 2 - true nil) (* 2 * true nil) (/ 2 / true nil)\n    (< 2 < nil nil) (> 2 > nil nil) (<= 2 <= nil nil) (>= 2 >= nil nil)\n    (/= 2 /= nil nil) (= 2 = nil nil)\n    (eq? 2 eq nil nil) (equal? 2 equal nil nil) (eqv? 2 eql nil nil)\n    (not 1 not nil nil) (null? 1 not nil nil) (cons 2 cons true nil)\n    (car 1 car nil nil) (cdr 1 cdr nil nil)  (cadr 1 cadr nil nil)\n    (list 1 list1 true nil) (list 2 list2 true nil) (list 3 list3 true nil)\n    (read 0 read nil t) (write 1 write nil t) (display 1 display nil t)\n    (newline 0 newline nil t) (compiler 1 compiler t nil)\n    (name! 2 name! true t) (random 1 random true nil)))\n\n(defun primitive-p (f env n-args)\n  \"F is a primitive if it is in the table, and is not shadowed\n  by something in the environment, and has the right number of args.\"\n  (and (not (in-env-p f env))\n       (find f *primitive-fns*\n             :test #'(lambda (f prim)\n                       (and (eq f (prim-symbol prim))\n                            (= n-args (prim-n-args prim)))))))\n\n(defun list1 (x) (list x))\n(defun list2 (x y) (list x y))\n(defun list3 (x y z) (list x y z))\n(defun display (x) (princ x))\n(defun newline () (terpri))\n\n;;; ==============================\n\n(defun gen-set (var env)\n  \"Generate an instruction to set a variable to top-of-stack.\"\n  (let ((p (in-env-p var env)))\n    (if p\n        (gen 'LSET (first p) (second p) \";\" var)\n        (if (assoc var *primitive-fns*)\n            (error \"Can't alter the constant ~a\" var)\n            (gen 'GSET var)))))\n\n;;; ==============================\n\n(defun init-scheme-comp ()\n  \"Initialize the primitive functions.\"\n  (dolist (prim *primitive-fns*)\n     (setf (get (prim-symbol prim) 'global-val)\n           (new-fn :env nil :name (prim-symbol prim)\n                   :code (seq (gen 'PRIM (prim-symbol prim))\n                              (gen 'RETURN))))))\n\n;;; ==============================\n\n(defun comp-lambda (args body env)\n  \"Compile a lambda form into a closure with compiled code.\"\n  (new-fn :env env :args args\n          :code (seq (gen-args args 0)\n                     (comp-begin body\n                                 (cons (make-true-list args) env)\n                                 t nil))))\n\n(defun gen-args (args n-so-far)\n  \"Generate an instruction to load the arguments.\"\n  (cond ((null args) (gen 'ARGS n-so-far))\n        ((symbolp args) (gen 'ARGS. n-so-far))\n        ((and (consp args) (symbolp (first args)))\n         (gen-args (rest args) (+ n-so-far 1)))\n        (t (error \"Illegal argument list\"))))\n\n(defun make-true-list (dotted-list)\n  \"Convert a possibly dotted list into a true, non-dotted list.\"\n  (cond ((null dotted-list) nil)\n        ((atom dotted-list) (list dotted-list))\n        (t (cons (first dotted-list)\n                 (make-true-list (rest dotted-list))))))\n\n(defun new-fn (&key code env name args)\n  \"Build a new function.\"\n  (assemble (make-fn :env env :name name :args args\n                     :code (optimize code))))\n\n;;; ==============================\n\n(defun optimize (code) code)\n(defun assemble (fn) fn)\n"
  },
  {
    "path": "lisp/compile3.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File compile3.lisp: Scheme compiler with assembler\n;;;; and peephole optimizer.  Also the abstract machine simulator.\n;;;; After loading this file, load the optimizers in compopt.lisp.\n\n;;; Bug fixes by Erann Gat, gat@aig.Jpl.Nasa.Gov, November 1992\n\n(requires \"interp1\" \"compile1\" \"compile2\")\n\n;;; ==============================\n\n(defun opcode (instr) (if (label-p instr) :label (first instr)))\n(defun args (instr) (if (listp instr) (rest instr)))\n(defun arg1 (instr) (if (listp instr) (second instr)))\n(defun arg2 (instr) (if (listp instr) (third instr)))\n(defun arg3 (instr) (if (listp instr) (fourth instr)))\n\n(defsetf arg1 (instr) (val) `(setf (second ,instr) ,val))\n\n;;; ==============================\n\n(defun assemble (fn)\n  \"Turn a list of instructions into a vector.\"\n  (multiple-value-bind (length labels)\n      (asm-first-pass (fn-code fn))\n    (setf (fn-code fn)\n          (asm-second-pass (fn-code fn)\n                           length labels))\n    fn))\n\n(defun asm-first-pass (code)\n  \"Return the labels and the total code length.\"\n  (let ((length 0)\n        (labels nil))\n    (dolist (instr code)\n      (if (label-p instr)\n          (push (cons instr length) labels)\n          (incf length)))\n    (values length labels)))\n\n(defun asm-second-pass (code length labels)\n  \"Put code into code-vector, adjusting for labels.\"\n  (let ((addr 0)\n        (code-vector (make-array length)))\n    (dolist (instr code)\n      (unless (label-p instr)\n        (if (is instr '(JUMP TJUMP FJUMP SAVE))\n            (setf (arg1 instr)\n                  (cdr (assoc (arg1 instr) labels))))\n        (setf (aref code-vector addr) instr)\n        (incf addr)))\n    code-vector))\n\n;;; ==============================\n\n(defun show-fn (fn &optional (stream *standard-output*) (indent 2))\n  \"Print all the instructions in a function.\n  If the argument is not a function, just princ it,\n  but in a column at least 8 spaces wide.\"\n  ;; This version handles code that has been assembled into a vector\n  (if (not (fn-p fn))\n      (format stream \"~8a\" fn)\n      (progn\n        (fresh-line)\n        (dotimes (i (length (fn-code fn)))\n          (let ((instr (elt (fn-code fn) i)))\n            (if (label-p instr)\n                (format stream \"~a:\" instr)\n                (progn\n                  (format stream \"~VT~2d: \" indent i)\n                  (dolist (arg instr)\n                    (show-fn arg stream (+ indent 8)))\n                  (fresh-line))))))))\n\n;;; ==============================\n\n(defstruct ret-addr fn pc env)\n\n(defun is (instr op)\n  \"True if instr's opcode is OP, or one of OP when OP is a list.\"\n  (if (listp op)\n      (member (opcode instr) op)\n      (eq (opcode instr) op)))\n\n(defun top (stack) (first stack))\n\n(defun machine (f)\n  \"Run the abstract machine on the code for f.\"\n  (let* ((code (fn-code f))\n         (pc 0)\n         (env nil)\n         (stack nil)\n         (n-args 0)\n         (instr nil))\n    (loop\n       (setf instr (elt code pc))\n       (incf pc)\n       (case (opcode instr)\n\n         ;; Variable/stack manipulation instructions:\n         (LVAR   (push (elt (elt env (arg1 instr)) (arg2 instr))\n                       stack))\n         (LSET   (setf (elt (elt env (arg1 instr)) (arg2 instr))\n                       (top stack)))\n         (GVAR   (push (get (arg1 instr) 'global-val) stack))\n         (GSET   (setf (get (arg1 instr) 'global-val) (top stack)))\n         (POP    (pop stack))\n         (CONST  (push (arg1 instr) stack))\n\n         ;; Branching instructions:\n         (JUMP   (setf pc (arg1 instr)))\n         (FJUMP  (if (null (pop stack)) (setf pc (arg1 instr))))\n         (TJUMP  (if (pop stack) (setf pc (arg1 instr))))\n\n         ;; Function call/return instructions:\n         (SAVE   (push (make-ret-addr :pc (arg1 instr)\n                                      :fn f :env env)\n                       stack))\n         (RETURN ;; return value is top of stack; ret-addr is second\n          (setf f (ret-addr-fn (second stack))\n                code (fn-code f)\n                env (ret-addr-env (second stack))\n                pc (ret-addr-pc (second stack)))\n          ;; Get rid of the ret-addr, but keep the value\n          (setf stack (cons (first stack) (rest2 stack))))\n         (CALLJ  (pop env)                 ; discard the top frame\n                 (setf f  (pop stack)\n                       code (fn-code f)\n                       env (fn-env f)\n                       pc 0\n                       n-args (arg1 instr)))\n         (ARGS   (assert (= n-args (arg1 instr)) ()\n                         \"Wrong number of arguments:~\n                         ~d expected, ~d supplied\"\n                         (arg1 instr) n-args)\n                 (push (make-array (arg1 instr)) env)\n                 (loop for i from (- n-args 1) downto 0 do\n                       (setf (elt (first env) i) (pop stack))))\n         (ARGS.  (assert (>= n-args (arg1 instr)) ()\n                         \"Wrong number of arguments:~\n                         ~d or more expected, ~d supplied\"\n                         (arg1 instr) n-args)\n                 (push (make-array (+ 1 (arg1 instr))) env)\n                 (loop repeat (- n-args (arg1 instr)) do\n                       (push (pop stack) (elt (first env) (arg1 instr))))\n                 (loop for i from (- (arg1 instr) 1) downto 0 do\n                       (setf (elt (first env) i) (pop stack))))\n         (FN     (push (make-fn :code (fn-code (arg1 instr))\n                                :env env) stack))\n         (PRIM   (push (apply (arg1 instr)\n                              (loop with args = nil repeat n-args\n                                    do (push (pop stack) args)\n                                    finally (return args)))\n                       stack))\n\n         ;; Continuation instructions:\n         (SET-CC (setf stack (top stack)))\n         (CC     (push (make-fn\n                         :env (list (vector stack))\n                         :code '((ARGS 1) (LVAR 1 0 \";\" stack) (SET-CC)\n                                 (LVAR 0 0) (RETURN)))\n                       stack))\n\n         ;; Nullary operations:\n         ((SCHEME-READ NEWLINE) ; *** fix, gat, 11/9/92\n          (push (funcall (opcode instr)) stack))\n\n         ;; Unary operations:\n         ((CAR CDR CADR NOT LIST1 COMPILER DISPLAY WRITE RANDOM)\n          (push (funcall (opcode instr) (pop stack)) stack))\n\n         ;; Binary operations:\n         ((+ - * / < > <= >= /= = CONS LIST2 NAME! EQ EQUAL EQL)\n          (setf stack (cons (funcall (opcode instr) (second stack)\n                                     (first stack))\n                            (rest2 stack))))\n\n         ;; Ternary operations:\n         (LIST3\n          (setf stack (cons (funcall (opcode instr) (third stack)\n                                     (second stack) (first stack))\n                            (rest3 stack))))\n\n         ;; Constants:\n         ((T NIL -1 0 1 2)\n          (push (opcode instr) stack))\n\n         ;; Other:\n         ((HALT) (RETURN (top stack)))\n         (otherwise (error \"Unknown opcode: ~a\" instr))))))\n\n(defun init-scheme-comp ()\n  \"Initialize values (including call/cc) for the Scheme compiler.\"\n  (set-global-var! 'exit\n    (new-fn :name 'exit :args '(val) :code '((HALT))))\n  (set-global-var! 'call/cc\n    (new-fn :name 'call/cc :args '(f)\n            :code '((ARGS 1) (CC) (LVAR 0 0 \";\" f)\n\t\t    (CALLJ 1)))) ; *** Bug fix, gat, 11/9/92\n  (dolist (prim *primitive-fns*)\n     (setf (get (prim-symbol prim) 'global-val)\n           (new-fn :env nil :name (prim-symbol prim)\n                   :code (seq (gen 'PRIM (prim-symbol prim))\n                              (gen 'RETURN))))))\n\n;;; ==============================\n\n(defconstant scheme-top-level\n  '(begin (define (scheme)\n            (newline)\n            (display \"=> \")\n            (write ((compiler (read))))\n            (scheme))\n          (scheme)))\n\n(defun scheme ()\n  \"A compiled Scheme read-eval-print loop\"\n  (init-scheme-comp)\n  (machine (compiler scheme-top-level)))\n\n(defun comp-go (exp)\n  \"Compile and execute the expression.\"\n  (machine (compiler `(exit ,exp))))\n\n;;;; Peephole Optimizer\n\n\n;;; ==============================\n\n(defun optimize (code)\n  \"Perform peephole optimization on assembly code.\"\n  (let ((any-change nil))\n    ;; Optimize each tail\n    (loop for code-tail on code do\n          (setf any-change (or (optimize-1 code-tail code)\n                               any-change)))\n    ;; If any changes were made, call optimize again\n    (if any-change\n        (optimize code)\n        code)))\n\n;;; ==============================\n\n(defun optimize-1 (code all-code)\n  \"Perform peephole optimization on a tail of the assembly code.\n  If a change is made, return true.\"\n  ;; Data-driven by the opcode of the first instruction\n  (let* ((instr (first code))\n         (optimizer (get-optimizer (opcode instr))))\n    (when optimizer\n      (funcall optimizer instr code all-code))))\n\n;;; ==============================\n\n(let ((optimizers (make-hash-table :test #'eql)))\n\n  (defun get-optimizer (opcode)\n    \"Get the assembly language optimizer for this opcode.\"\n    (gethash opcode optimizers))\n\n  (defun put-optimizer (opcode fn)\n    \"Store an assembly language optimizer for this opcode.\"\n    (setf (gethash opcode optimizers) fn)))\n\n;;; ==============================\n\n(defun gen1 (&rest args) \"Generate a single instruction\" args)\n(defun target (instr code) (second (member (arg1 instr) code)))\n(defun next-instr (code) (find-if (complement #'label-p) code))\n\n;;; ==============================\n\n(defmacro def-optimizer (opcodes args &body body)\n  \"Define assembly language optimizers for these opcodes.\"\n  (assert (and (listp opcodes) (listp args) (= (length args) 3)))\n  `(dolist (op ',opcodes)\n     (put-optimizer op #'(lambda ,args .,body))))\n\n;;;; Now for some additions and answers to exercises:\n\n;;; ==============================\n\n(defconstant eof \"EoF\")\n(defun eof-object? (x) (eq x eof))\n(defvar *scheme-readtable* (copy-readtable))\n\n(defun scheme-read (&optional (stream *standard-input*))\n  (let ((*readtable* *scheme-readtable*))\n    (read stream nil eof)))\n\n;;; ==============================\n\n(set-dispatch-macro-character #\\# #\\t\n  #'(lambda (&rest ignore) t)\n  *scheme-readtable*)\n\n(set-dispatch-macro-character #\\# #\\f\n  #'(lambda (&rest ignore) nil)\n  *scheme-readtable*)\n\n(set-dispatch-macro-character #\\# #\\d\n  ;; In both Common Lisp and Scheme,\n  ;; #x, #o and #b are hexidecimal, octal, and binary,\n  ;; e.g. #xff = #o377 = #b11111111 = 255\n  ;; In Scheme only, #d255 is decimal 255.\n  #'(lambda (stream &rest ignore)\n      (let ((*read-base* 10)) (scheme-read stream)))\n  *scheme-readtable*)\n\n(set-macro-character #\\`\n  #'(lambda (s ignore) (list 'quasiquote (scheme-read s)))\n  nil *scheme-readtable*)\n\n(set-macro-character #\\,\n   #'(lambda (stream ignore)\n       (let ((ch (read-char stream)))\n         (if (char= ch #\\@)\n             (list 'unquote-splicing (read stream))\n             (progn (unread-char ch stream)\n                    (list 'unquote (read stream))))))\n   nil *scheme-readtable*)\n\n;;; ==============================\n\n(defparameter *primitive-fns*\n  '((+ 2 + true) (- 2 - true) (* 2 * true) (/ 2 / true)\n    (< 2 <) (> 2 >) (<= 2 <=) (>= 2 >=) (/= 2 /=) (= 2 =)\n    (eq? 2 eq) (equal? 2 equal) (eqv? 2 eql)\n    (not 1 not) (null? 1 not)\n    (car 1 car) (cdr 1 cdr)  (cadr 1 cadr) (cons 2 cons true)\n    (list 1 list1 true) (list 2 list2 true) (list 3 list3 true)\n    (read 0 scheme-read nil t) (eof-object? 1 eof-object?) ;***\n    (write 1 write nil t) (display 1 display nil t)\n    (newline 0 newline nil t) (compiler 1 compiler t)\n    (name! 2 name! true t) (random 1 random true nil)))\n\n\n;;; ==============================\n\n;(setf (scheme-macro 'quasiquote) 'quasi-q)\n\n(defun quasi-q (x)\n  \"Expand a quasiquote form into append, list, and cons calls.\"\n  (cond\n    ((vectorp x)\n     (list 'apply 'vector (quasi-q (coerce x 'list))))\n    ((atom x)\n     (if (constantp x) x (list 'quote x)))\n    ((starts-with x 'unquote)\n     (assert (and (rest x) (null (rest2 x))))\n     (second x))\n    ((starts-with x 'quasiquote)\n     (assert (and (rest x) (null (rest2 x))))\n     (quasi-q (quasi-q (second x))))\n    ((starts-with (first x) 'unquote-splicing)\n     (if (null (rest x))\n         (second (first x))\n         (list 'append (second (first x)) (quasi-q (rest x)))))\n    (t (combine-quasiquote (quasi-q (car x))\n                           (quasi-q (cdr x))\n                           x))))\n\n(defun combine-quasiquote (left right x)\n  \"Combine left and right (car and cdr), possibly re-using x.\"\n  (cond ((and (constantp left) (constantp right))\n         (if (and (eql (eval left) (first x))\n                  (eql (eval right) (rest x)))\n             (list 'quote x)\n             (list 'quote (cons (eval left) (eval right)))))\n        ((null right) (list 'list left))\n        ((starts-with right 'list)\n         (list* 'list left (rest right)))\n        (t (list 'cons left right))))\n\n;;; ==============================\n\n(defun scheme-read (&optional (stream *standard-input*))\n  (let ((*readtable* *scheme-readtable*))\n    (convert-numbers (read stream nil eof))))\n\n(defun convert-numbers (x)\n  \"Replace symbols that look like Scheme numbers with their values.\"\n  ;; Don't copy structure, make changes in place.\n  (typecase x\n    (cons   (setf (car x) (convert-numbers (car x)))\n            (setf (cdr x) (convert-numbers (cdr x)))\n\t    x) ; *** Bug fix, gat, 11/9/92\n    (symbol (or (convert-number x) x))\n    (vector (dotimes (i (length x))\n              (setf (aref x i) (convert-numbers (aref x i))))\n\t    x) ; *** Bug fix, gat, 11/9/92\n    (t x)))\n\n(defun convert-number (symbol)\n  \"If str looks like a complex number, return the number.\"\n  (let* ((str (symbol-name symbol))\n         (pos (position-if #'sign-p str))\n         (end (- (length str) 1)))\n    (when (and pos (char-equal (char str end) #\\i))\n      (let ((re (read-from-string str nil nil :start 0 :end pos))\n            (im (read-from-string str nil nil :start pos :end end)))\n        (when (and (numberp re) (numberp im))\n          (complex re im))))))\n\n(defun sign-p (char) (find char \"+-\"))\n"
  },
  {
    "path": "lisp/compopt.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File compopt.lisp:  Optimizers for Scheme compiler (compile3.lisp).\n\n(def-optimizer (:LABEL) (instr code all-code)\n  ;; ... L ... => ... ... ;if no reference to L\n  (when (not (find instr all-code :key #'arg1))\n    (setf (first code) (second code)\n          (rest code) (rest2 code))\n    t))\n\n(def-optimizer (GSET LSET) (instr code all-code)\n  ;; ex: (begin (set! x y) (if x z))\n  ;; (SET X) (POP) (VAR X) ==> (SET X)\n  (when (and (is (second code) 'POP)\n             (is (third code) '(GVAR LVAR))\n             (eq (arg1 instr) (arg1 (third code))))\n    (setf (rest code) (nthcdr 3 code))\n    t))\n\n(def-optimizer (JUMP CALL CALLJ RETURN) (instr code all-code)\n  ;; (JUMP L1) ...dead code... L2 ==> (JUMP L1) L2\n  (setf (rest code) (member-if #'label-p (rest code)))\n  ;; (JUMP L1) ... L1 (JUMP L2) ==> (JUMP L2)  ... L1 (JUMP L2)\n  (when (and (is instr 'JUMP)\n             (is (target instr code) '(JUMP RETURN))\n    (setf (first code) (copy-list (target instr code)))\n    t)))\n\n(def-optimizer (TJUMP FJUMP) (instr code all-code)\n  ;; (FJUMP L1) ... L1 (JUMP L2) ==> (FJUMP L2) ... L1 (JUMP L2)\n  (when (is (target instr code) 'JUMP)\n    (setf (second instr) (arg1 (target instr code)))\n    t))\n\n(def-optimizer (T -1 0 1 2) (instr code all-code)\n  (case (opcode (second code))\n    (NOT ;; (T) (NOT) ==> NIL\n     (setf (first code) (gen1 'NIL)\n           (rest code) (rest2 code))\n     t)\n    (FJUMP ;; (T) (FJUMP L) ... => ...\n     (setf (first code) (third code)\n           (rest code) (rest3 code))\n     t)\n    (TJUMP ;; (T) (TJUMP L) ... => (JUMP L) ...\n     (setf (first code) (gen1 'JUMP (arg1 (next-instr code))))\n     t)))\n\n(def-optimizer (NIL) (instr code all-code)\n  (case (opcode (second code))\n    (NOT ;; (NIL) (NOT) ==> T\n     (setf (first code) (gen1 'T)\n           (rest code) (rest2 code))\n     t)\n    (TJUMP ;; (NIL) (TJUMP L) ... => ...\n     (setf (first code) (third code)\n             (rest code) (rest3 code))\n     t)\n    (FJUMP ;; (NIL) (FJUMP L) ==> (JUMP L)\n     (setf (first code) (gen1 'JUMP (arg1 (next-instr code))))\n     t)))\n"
  },
  {
    "path": "lisp/edge-tab.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File edge-tab.lisp: Compile this to save the edge table.\n\n(setf *edge-table* '#.*edge-table*)\n\n"
  },
  {
    "path": "lisp/eliza-pm.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File eliza-pm.lisp: Updated version of eliza in section 6.3\n\n(requires \"patmatch\" \"eliza\")\n\n(defun eliza ()\n  \"Respond to user input using pattern matching rules.\"\n  (loop\n    (print 'eliza>)\n    (print (flatten (use-eliza-rules (read))))))\n\n(defun use-eliza-rules (input)\n  \"Find some rule with which to transform the input.\"\n  (rule-based-translator input *eliza-rules*\n    :action #'(lambda (bindings responses)\n                (sublis (switch-viewpoint bindings)\n                        (random-elt responses)))))\n\n"
  },
  {
    "path": "lisp/eliza.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File eliza.lisp: Advanced version of Eliza.\n;;; Has more rules, and accepts input without parens.\n\n(requires \"eliza1\")\n\n;;; ==============================\n\n(defun read-line-no-punct ()\n  \"Read an input line, ignoring punctuation.\"\n  (read-from-string\n    (concatenate 'string \"(\" (substitute-if #\\space #'punctuation-p\n                                            (read-line))\n                 \")\")))\n\n(defun punctuation-p (char) (find char \".,;:`!?#-()\\\\\\\"\"))\n\n;;; ==============================\n\n(defun eliza ()\n  \"Respond to user input using pattern matching rules.\"\n  (loop\n    (print 'eliza>)\n    (let* ((input (read-line-no-punct))\n           (response (flatten (use-eliza-rules input))))\n      (print-with-spaces response)\n      (if (equal response '(good bye)) (RETURN)))))\n\n(defun print-with-spaces (list)\n  (mapc #'(lambda (x) (prin1 x) (princ \" \")) list))\n\n(defun print-with-spaces (list)\n  (format t \"~{~a ~}\" list))\n\n;;; ==============================\n\n(defun mappend (fn &rest lists)\n  \"Apply fn to each element of lists and append the results.\"\n  (apply #'append (apply #'mapcar fn lists)))\n\n;;; ==============================\n\n(defparameter *eliza-rules*\n '((((?* ?x) hello (?* ?y))\n    (How do you do.  Please state your problem.))\n   (((?* ?x) computer (?* ?y))\n    (Do computers worry you?) (What do you think about machines?)\n    (Why do you mention computers?)\n    (What do you think machines have to do with your problem?))\n   (((?* ?x) name (?* ?y))\n    (I am not interested in names))\n   (((?* ?x) sorry (?* ?y))\n    (Please don't apologize) (Apologies are not necessary)\n    (What feelings do you have when you apologize))\n   (((?* ?x) I remember (?* ?y))\n    (Do you often think of ?y)\n    (Does thinking of ?y bring anything else to mind?)\n    (What else do you remember) (Why do you recall ?y right now?)\n    (What in the present situation reminds you of ?y)\n    (What is the connection between me and ?y))\n   (((?* ?x) do you remember (?* ?y))\n    (Did you think I would forget ?y ?)\n    (Why do you think I should recall ?y now)\n    (What about ?y) (You mentioned ?y))\n   (((?* ?x) if (?* ?y))\n    (Do you really think its likely that ?y) (Do you wish that ?y)\n    (What do you think about ?y) (Really-- if ?y))\n\n   (((?* ?x) I dreamt (?* ?y))\n    (Really-- ?y) (Have you ever fantasized ?y while you were awake?)\n    (Have you dreamt ?y before?))\n   (((?* ?x) dream about (?* ?y))\n    (How do you feel about ?y in reality?))\n   (((?* ?x) dream (?* ?y))\n    (What does this dream suggest to you?) (Do you dream often?)\n    (What persons appear in your dreams?)\n    (Don't you believe that dream has to do with your problem?))\n   (((?* ?x) my mother (?* ?y))\n    (Who else in your family ?y) (Tell me more about your family))\n   (((?* ?x) my father (?* ?y))\n    (Your father) (Does he influence you strongly?)\n    (What else comes to mind when you think of your father?))\n\n   (((?* ?x) I want (?* ?y))\n    (What would it mean if you got ?y)\n    (Why do you want ?y) (Suppose you got ?y soon))\n   (((?* ?x) I am glad (?* ?y))\n    (How have I helped you to be ?y) (What makes you happy just now)\n    (Can you explain why you are suddenly ?y))\n   (((?* ?x) I am sad (?* ?y))\n    (I am sorry to hear you are depressed)\n    (I'm sure its not pleasant to be sad))\n   (((?* ?x) are like (?* ?y))\n    (What resemblance do you see between ?x and ?y))\n   (((?* ?x) is like (?* ?y))\n    (In what way is it that ?x is like ?y)\n    (What resemblance do you see?)\n    (Could there really be some connection?) (How?))\n   (((?* ?x) alike (?* ?y))\n    (In what way?) (What similarities are there?))\n   (((?* ?x) same (?* ?y))\n    (What other connections do you see?))\n\n   (((?* ?x) I was (?* ?y))\n    (Were you really?) (Perhaps I already knew you were ?y)\n    (Why do you tell me you were ?y now?))\n   (((?* ?x) was I (?* ?y))\n    (What if you were ?y ?) (Do you thin you were ?y)\n    (What would it mean if you were ?y))\n   (((?* ?x) I am (?* ?y))\n    (In what way are you ?y) (Do you want to be ?y ?))\n   (((?* ?x) am I (?* ?y))\n    (Do you believe you are ?y) (Would you want to be ?y)\n    (You wish I would tell you you are ?y)\n    (What would it mean if you were ?y))\n   (((?* ?x) am (?* ?y))\n    (Why do you say \"AM?\") (I don't understand that))\n   (((?* ?x) are you (?* ?y))\n    (Why are you interested in whether I am ?y or not?)\n    (Would you prefer if I weren't ?y)\n    (Perhaps I am ?y in your fantasies))\n   (((?* ?x) you are (?* ?y))\n    (What makes you think I am ?y ?))\n\n   (((?* ?x) because (?* ?y))\n    (Is that the real reason?) (What other reasons might there be?)\n    (Does that reason seem to explain anything else?))\n   (((?* ?x) were you (?* ?y))\n    (Perhaps I was ?y) (What do you think?) (What if I had been ?y))\n   (((?* ?x) I can't (?* ?y))\n    (Maybe you could ?y now) (What if you could ?y ?))\n   (((?* ?x) I feel (?* ?y))\n    (Do you often feel ?y ?))\n   (((?* ?x) I felt (?* ?y))\n    (What other feelings do you have?))\n   (((?* ?x) I (?* ?y) you (?* ?z))\n    (Perhaps in your fantasy we ?y each other))\n   (((?* ?x) why don't you (?* ?y))\n    (Should you ?y yourself?)\n    (Do you believe I don't ?y) (Perhaps I will ?y in good time))\n   (((?* ?x) yes (?* ?y))\n    (You seem quite positive) (You are sure) (I understand))\n   (((?* ?x) no (?* ?y))\n    (Why not?) (You are being a bit negative)\n    (Are you saying \"NO\" just to be negative?))\n\n   (((?* ?x) someone (?* ?y))\n    (Can you be more specific?))\n   (((?* ?x) everyone (?* ?y))\n    (surely not everyone) (Can you think of anyone in particular?)\n    (Who for example?) (You are thinking of a special person))\n   (((?* ?x) always (?* ?y))\n    (Can you think of a specific example) (When?)\n    (What incident are you thinking of?) (Really-- always))\n   (((?* ?x) what (?* ?y))\n    (Why do you ask?) (Does that question interest you?)\n    (What is it you really want to know?) (What do you think?)\n    (What comes to your mind when you ask that?))\n   (((?* ?x) perhaps (?* ?y))\n    (You do not seem quite certain))\n   (((?* ?x) are (?* ?y))\n    (Did you think they might not be ?y)\n    (Possibly they are ?y))\n   (((?* ?x))\n    (Very interesting) (I am not sure I understand you fully)\n    (What does that suggest to you?) (Please continue) (Go on)\n    (Do you feel strongly about discussing such things?))))\n\n;;; ==============================\n\n"
  },
  {
    "path": "lisp/eliza1.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File eliza1.lisp: Basic version of the Eliza program\n\n;;; The basic are in auxfns.lisp; look for \"PATTERN MATCHING FACILITY\"\n\n;; New version of pat-match with segment variables\n\n(defun variable-p (x)\n  \"Is x a variable (a symbol beginning with `?')?\"\n  (and (symbolp x) (equal (elt (symbol-name x) 0) #\\?)))\n\n(defun pat-match (pattern input &optional (bindings no-bindings))\n  \"Match pattern against input in the context of the bindings\"\n  (cond ((eq bindings fail) fail)\n        ((variable-p pattern)\n         (match-variable pattern input bindings))\n        ((eql pattern input) bindings)\n        ((segment-pattern-p pattern)                ; ***\n         (segment-match pattern input bindings))    ; ***\n        ((and (consp pattern) (consp input))\n         (pat-match (rest pattern) (rest input)\n                    (pat-match (first pattern) (first input)\n                               bindings)))\n        (t fail)))\n\n(defun segment-pattern-p (pattern)\n  \"Is this a segment matching pattern: ((?* var) . pat)\"\n  (and (consp pattern)\n       (starts-with (first pattern) '?*)))\n\n;;; ==============================\n\n(defun segment-match (pattern input bindings &optional (start 0))\n  \"Match the segment pattern ((?* var) . pat) against input.\"\n  (let ((var (second (first pattern)))\n        (pat (rest pattern)))\n    (if (null pat)\n        (match-variable var input bindings)\n        ;; We assume that pat starts with a constant\n        ;; In other words, a pattern can't have 2 consecutive vars\n        (let ((pos (position (first pat) input\n                             :start start :test #'equal)))\n          (if (null pos)\n              fail\n              (let ((b2 (pat-match pat (subseq input pos) bindings)))\n                ;; If this match failed, try another longer one\n                ;; If it worked, check that the variables match\n                (if (eq b2 fail)\n                    (segment-match pattern input bindings (+ pos 1))\n                    (match-variable var (subseq input 0 pos) b2))))))))\n\n;;; ==============================\n\n(defun segment-match (pattern input bindings &optional (start 0))\n  \"Match the segment pattern ((?* var) . pat) against input.\"\n  (let ((var (second (first pattern)))\n        (pat (rest pattern)))\n    (if (null pat)\n        (match-variable var input bindings)\n        ;; We assume that pat starts with a constant\n        ;; In other words, a pattern can't have 2 consecutive vars\n        (let ((pos (position (first pat) input\n                             :start start :test #'equal)))\n          (if (null pos)\n              fail\n              (let ((b2 (pat-match\n                          pat (subseq input pos)\n                          (match-variable var (subseq input 0 pos)\n                                          bindings))))\n                ;; If this match failed, try another longer one\n                (if (eq b2 fail)\n                    (segment-match pattern input bindings (+ pos 1))\n                    b2)))))))\n\n;;; ==============================\n\n(defun rule-pattern (rule) (first rule))\n(defun rule-responses (rule) (rest rule))\n\n;;; ==============================\n\n(defparameter *eliza-rules*\n '((((?* ?x) hello (?* ?y))\n    (How do you do.  Please state your problem.))\n   (((?* ?x) I want (?* ?y))\n    (What would it mean if you got ?y)\n    (Why do you want ?y) (Suppose you got ?y soon))\n   (((?* ?x) if (?* ?y))\n    (Do you really think its likely that ?y) (Do you wish that ?y)\n    (What do you think about ?y) (Really-- if ?y))\n   (((?* ?x) no (?* ?y))\n    (Why not?) (You are being a bit negative)\n    (Are you saying \"NO\" just to be negative?))\n   (((?* ?x) I was (?* ?y))\n    (Were you really?) (Perhaps I already knew you were ?y)\n    (Why do you tell me you were ?y now?))\n   (((?* ?x) I feel (?* ?y))\n    (Do you often feel ?y ?))\n   (((?* ?x) I felt (?* ?y))\n    (What other feelings do you have?))))\n\n;;; ==============================\n\n(defun eliza ()\n  \"Respond to user input using pattern matching rules.\"\n  (loop\n    (print 'eliza>)\n    (write (flatten (use-eliza-rules (read))) :pretty t)))\n\n(defun use-eliza-rules (input)\n  \"Find some rule with which to transform the input.\"\n  (some #'(lambda (rule)\n            (let ((result (pat-match (rule-pattern rule) input)))\n              (if (not (eq result fail))\n                  (sublis (switch-viewpoint result)\n                          (random-elt (rule-responses rule))))))\n        *eliza-rules*))\n\n(defun switch-viewpoint (words)\n  \"Change I to you and vice versa, and so on.\"\n  (sublis '((I . you) (you . I) (me . you) (am . are))\n          words))\n\n;;; ==============================\n\n(defun flatten (the-list)\n  \"Append together elements (or lists) in the list.\"\n  (mappend #'mklist the-list))\n\n(defun mklist (x)\n  \"Return x if it is a list, otherwise (x).\"\n  (if (listp x)\n      x\n      (list x)))\n\n(defun mappend (fn the-list)\n  \"Apply fn to each element of list and append the results.\"\n  (apply #'append (mapcar fn the-list)))\n\n(defun random-elt (choices)\n  \"Choose an element from a list at random.\"\n  (elt choices (random (length choices))))\n\n;;; ==============================\n\n;;;> (eliza)\n;;;ELIZA> (hello there)\n;;;(HOW DO YOU DO. PLEASE STATE YOUR PROBLEM.)\n;;;ELIZA> (i want to test this program)\n;;;(WHAT WOULD IT MEAN IF YOU GOT TO TEST THIS PROGRAM)\n;;;ELIZA> (i could see if it works)\n;;;(DO YOU REALLY THINK ITS LIKELY THAT IT WORKS)\n;;;ELIZA> (no not really)\n;;;(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?)\n;;;ELIZA> (no)\n;;;(ARE YOU SAYING \"NO\" JUST TO BE NEGATIVE?)\n;;;ELIZA> (forget it-- i was wondering how general the program is)\n;;;(WHY DO YOU TELL ME YOU WERE WONDERING HOW GENERAL THE PROGRAM IS NOW?)\n;;;ELIZA> (i felt like it)\n;;;(WHAT OTHER FEELINGS DO YOU HAVE?)\n;;;ELIZA> (i feel this is enough)\n;;;(DO YOU OFTEN FEEL THIS IS ENOUGH ?)\n;;;ELIZA> [Abort]\n\n;;; ==============================\n"
  },
  {
    "path": "lisp/examples.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991, 1996 Peter Norvig\n\n(requires \"tutor\")\n\n(defexamples 1 \"Introduction to Lisp\"\n  \"This chapter is for people with little or no experince in Lisp.\"\n  \"Intermediate or advanced readers can skim or skip this chapter.\"\n  \"\"\n  \"Lisp expressions are in prefix notation: the operator first.\"\n  ((+ 2 2) => 4 @ 4)\n  ((+ 1 2 3 4 5 6 7 8 9 10) => 55 @ 5)\n  \"This is Lisp for (900 + 900 + 90 + 9) - (5000 + 500 + 50 + 5)\"\n  ((- (+ 9000 900 90 9) (+ 5000 500 50 5)) => 4444)\n  (:section \"1.1 Symbolic Computation\")\n  \"This is an example of computation on lists:\"\n  ((append '(Pat Kim) '(Robin Sandy)) => (PAT KIM ROBIN SANDY) @ 6)\n  \"The quote mark instructs Lisp to treat the list as data.\"\n  ('(pat Kim) => (PAT KIM))\n  \"Let's look at some more list processing functions\"\n  (:section \"1.4 Lists\")\n  ((setf p '(John Q Public)) @ 10)\n  ((first p))\n  ((rest p))\n  ((second p))\n  ((third p))\n  ((fourth p))\n  ((length p))\n  \"It is also possible to build up new lists\"\n  (p @ 11)\n  ((cons 'Mr p))\n  ((cons (first p) (rest p)))\n  ((setf town (list 'Anytown 'USA)))\n  ((list p 'of town 'may 'have 'already 'won!))\n  ((append p '(of) town '(may have already won)))\n  (p)\n  (:section \"1.5 Defining New Functions\")\n  \"The special form DEFUN stands for 'define function.'\"\n  \"It is used here to define a new function called last-name:\"\n  ((requires \"intro\"))\n  ((last-name p) => PUBLIC @ 13)\n  ((last-name '(Rex Morgan MD)) => MD)\n  ((last-name '(Spot)) => SPOT)\n  ((last-name '(Aristotle)) => ARISTOTLE)\n  \"We can also define the function first-name.\"\n  \"Even though the definition is trivial (it is the same as FIRST),\"\n  \"it is good practice to define first-name explicitly.\"\n  (p)\n  ((first-name p) => JOHN)\n  ((first-name '(Wilma Flintstone)) => WILMA)\n  ((setf names '((John Q Public) (Malcolm X)\n              (Admiral Grace Murray Hopper) (Spot)\n              (Aristotle) (A A Milne) (Z Z Top)\n              (Sir Larry Olivier) (Miss Scarlet))) @ 14)\n  ((first-name (first names)) => JOHN)\n  (:section \"1.6 Using Functions\")\n  \"Consider the following expression, which can be used to test LAST-NAME:\"\n  ((mapcar #'last-name names))\n  \"The #' notation maps the name of a function to the function itself.\"\n  ((mapcar #'- '(1 2 3 4)) @ 15)\n  ((mapcar #'+ '(1 2 3 4) '(10 20 30 40)))\n  \"Now that we understand mapcar, let's use it to test FIRST-NAME:\"\n  ((mapcar #'first-name names))\n  \"Suppose we wanted a version of FIRST-NAME that ignored titles like Miss:\"\n  ((defparameter *titles*\n     '(Mr Mrs Miss Ms Sir Madam Dr Admiral Major General)\n     \"A list of titles that can appear at the start of a name.\"))\n  ((defun first-name (name)\n     \"Select the first name from a name represented as a list.\"\n     (if (member (first name) *titles*)\n\t (first-name (rest name))\n       (first name))) @ 16)\n  ((mapcar #'first-name names))\n  ((first-name '(Madam Major General Paula Jones)) => PAULA)\n  \"We can see how this works by tracing the execution of first-name:\"\n  ((trace first-name))\n  ((first-name '(John Q Public)) => JOHN @ 17)\n  ((first-name '(Madam Major General Paula Jones)) => PAULA)\n  ((untrace first-name))\n  (:section \"1.7 Higher-Order Functions\")\n  ((apply #'+ '(1 2 3 4)) => 10)\n  ((apply #'append '((1 2 3) (a b c))))\n  \"Now we define a new function, self-and-double, and apply it to arguments.\"\n  ((defun self-and-double (x) (list x (+ x x))))\n  ((self-and-double 3) => (3 6))\n  ((apply #'self-and-double '(3)) => (3 6))\n  \"Now let's return to the mapping functions:\"\n  ((mapcar #'self-and-double '(1 10 300)))\n  ((mappend #'self-and-double '(1 10 300)))\n  \"FUNCALL is similar to APPLY; it too takes a function as its\"\n  \"first argument and applies the function to a list of arguments,\"\n  \"but in the case of FUNCALL, the arguments are listed separately:\"\n  ((funcall #'+ 2 3) => 5 @ 20)\n  ((apply #'+ '(2 3)) => 5)\n  )\n\n(defexamples 2 \"A Simple Lisp Program\"\n  \"This chapter shows how to combine the basic functions and\"\n  \"special forms of Lisp into a complete program\"\n  \"The program generates random English sentences.\"\n  (:section \"2.2 A Straightforward Solution\")\n  \"We can test the program by generating a few random sentences.\"\n  \"(Note that since these are random, you won't get the same ones\"\n  \"as in the book.)\"\n  ((requires \"simple\"))\n  ((sentence) @ 36)\n  ((sentence) @ 36)\n  ((sentence) @ 36)\n  ((noun-phrase))\n  ((verb-phrase))\n  ((trace sentence noun-phrase verb-phrase article noun verb) @ 37)\n  ((sentence))\n  ((untrace))\n  (:section \"2.3 A Rule-Based Solution\")\n  \"An alternative implementation concentrates on making it easy\"\n  \"to write grammar rules.\"\n  ((generate 'sentence) @ 41)\n  ((generate 'sentence) @ 41)\n  ((generate 'noun-phrase) @ 41)\n  ((generate 'verb-phrase) @ 41)\n  \"One advantage of this approach is its easier to change grammars.\"\n  ((setf *grammar* *bigger-grammar*) @ 43)\n  ((generate 'sentence))\n  ((generate 'sentence))\n  \"Another advantage is that the same data (grammar) can be used\"\n  \"for more than one purpose.  Consider generate-tree:\"\n  ((generate-tree 'sentence) @ 45))\n\n\n(defexamples 3 \"Overview of Lisp\"\n  \"This chapter briefly covers the most important special forms and\"\n  \"functions in Lisp.\"\n  (:section \"3.2 Special Forms\")\n  \"Start with functions and special forms for repetition:\"\n  \"First, functions like MAPCAR can apply to any number of lists:\"\n  ((mapcar #'- '(1 2 3)) => (-1 -2 -3) @ 61)\n  ((mapcar #'+ '(1 2) '(10 20) '(100 200)) => (111 222))\n  \"Second, many of the functions accept keywords:\"\n  ((remove 1 '(1 2 3 2 1 0 -1)) => (2 3 2 0 -1) @ 61)\n  ((remove 1 '(1 2 3 2 1 0 -1) :key #'abs) => (2 3 2 0) @ 61)\n  ((remove 1 '(1 2 3 2 1 0 -1) :test #'<) => (1 1 0 -1) @ 61)\n  ((remove 1 '(1 2 3 2 1 0 -1) :start 4) => (1 2 3 2 0 -1) @ 61)\n  \"Third, some have corresponding -IF or -IF-NOT versions:\"\n  ((remove-if #'oddp '(1 2 3 2 1 0 -1)) => (2 2 0))\n  ((remove-if-not #'oddp '(1 2 3 2 1 0 -1)) => (1 3 1 -1))\n  \"The forms TRACE and UNTRACE are used to control debugging info:\"\n  ((requires \"overview\"))\n  ((trace length9) @ 65)\n  ((length9 '(1 b c)) => 3)\n  ((untrace length9))\n  ((length9 '(1 b c)) => 3)\n  (:section \"3.7 Functions on Trees\")\n  ((setf tree '((a b) ((c)) (d e))) @ 76)\n  ((tree-equal tree (copy-tree tree)) => t)\n  ((same-shape-tree tree '((1 2) ((3)) (4 5))) => t)\n  ((same-shape-tree tree '((1 2) (3) (4 5))) => nil)\n  \"There are two functions for substituting a new expression into a tree:\"\n  ((subst 'new 'old '(old ((very old)))) => (NEW ((VERY NEW))))\n  ((sublis '((old . new)) '(old ((very old)))) => (NEW ((VERY NEW))))\n  ((subst 'new 'old 'old) => NEW)\n  \"Here is an example:\"\n  ((english->french '(hello my friend - how are you today?))\n   => (bonjour mon ami - comment va tu today?) @ 77)\n  (:section \"3.10 Destructive Functions\")\n  \"Consider the following:\"\n  ((setq x '(a b c)) @ 80)\n  ((setq y '(1 2 3)))\n  ((nconc x y) => (a b c 1 2 3))\n  (x => (a b c 1 2 3))\n  (y => (1 2 3))\n  \"NCONC computes the same result as APPEND, but it alters the first argument.\"\n  \"It is called a 'destructive' function.\"\n  \"There is quite a conceptual load on the programmer who uses NCONC.\"\n  \"The advantage of NCONC is that it doesn't use any storage.\"\n  \"\"\n  (:section \"3.11 Overview of Data Types\")\n  \"The function TYPE-OF returns the type of its argument.\"\n  ((type-of 123) => fixnum @ 82)\n  ((typep 123 'fixnum) => t)\n  ((typep 123 'integer) => t)\n  ((typep 123.0 'integer) => nil)\n  ((subtypep 'fixnum 'integer) => t)\n  (:section \"3.12 Input/Output\")\n  \"FORMAT is the main function for formatted output:\"\n  ((format t \"hello, world\") @ 84)\n  ((format t \"~&~a plus ~s is ~f\" \"two\" \"two\" 4))\n  ((let ((numbers '( 1 2 3 4 5)))\n     (format t \"~&~{~r~^ plus ~} is ~@r\"\n\t     numbers (apply #'+ numbers))))\n  (:section \"3.13 Debugging tools\")\n  ((documentation 'first 'function) @ 87)\n  ((documentation 'pi 'variable))\n  (:section \"3.14 Antibugging Tools\")\n  ((defun f (n) (dotimes (i n) nil)) @ 90)\n  ((time (f 10000)))\n  ((compile 'f))\n  ((time (f 10000)))\n  (:section \"3.15 Evaluation\")\n  \"The following five forms are equivalent:\"\n  ((+ 1 2 3 4) => 10 @ 91)\n  ((funcall #'+ 1 2 3 4) => 10 @ 91)\n  ((apply #'+ '(1 2 3 4)) => 10 @ 91)\n  ((apply #'+ 1 2 '(3 4)) => 10 @ 91)\n  ((eval '(+ 1 2 3 4)) => 10 @ 91)\n  (:section \"3.16 Closures\")\n  \"In the general case, a function consists of the body of the function\"\n  \"coupled with any free lexical variables that the function references.\"\n  \"Consider the example:\"\n  ((mapcar (adder 3) '(1 3 10)) => (4 6 13) @ 92)\n  ((mapcar (adder 10) '(1 3 10)) => (11 13 20) @ 92)\n  \"In the following, two calls to BANK-ACCOUNT create two different closures,\"\n  \"each with a separate value for the lexical variable BALANCE.\"\n  ((setf my-account (bank-account 500.00)) @ 92)\n  ((setf your-account (bank-account 250.00)) @ 93)\n  ((funcall my-account 'withdraw 75.00) => 425.0)\n  ((funcall your-account 'deposit 250.00) => 500.0)\n  ((funcall your-account 'withdraw 100.00) => 400.0)\n  ((funcall my-account 'withdraw 25.00) => 400.0)\n  \"This style of programming is covered in more detail in chapter 13.\"\n  )\n\n(defexamples 4 \"GPS: The General Problem Solver\"\n  \"The General problem Solver, developed in 1957 by Alan Newell and Herbert\"\n  \"Simon, embodied a grandiose vision: a single computer program that could\"\n  \"solve ANY problem.  GPS caused quite a stir ...\"\n  (:section \"4.4 Stage 4: test\")\n  ((requires \"gps1\"))\n  \"Here are some examples of using GPS\"\n  \"The first example works with a complex chain of steps.\"\n  ((gps '(son-at-home car-needs-battery have-money have-phone-book)\n       '(son-at-school)\n       *school-ops*) => SOLVED @ 118)\n  \"The next example fails because there is no way to make the car work,\"\n  \"because we can't contact the shop to get the battery fixed.\"\n  ((gps '(son-at-home car-needs-battery have-money)\n       '(son-at-school)\n       *school-ops*) => NIL)\n  \"The third example is easy, because the car is currently working.\"\n  ((gps '(son-at-home car-works)\n       '(son-at-school)\n       *school-ops*) => SOLVED)\n\n  (:section \"4.7 The Clobbered Sibling Goal Problem\")\n  \"In the next example, GPS incorrectly reports success, when in fact it has\"\n  \"spent the money on the battery, and thus should fail.\"\n  ((gps '(son-at-home have-money car-works)\n       '(have-money son-at-school)\n       *school-ops*) => SOLVED @ 120)\n  \"The bug is that when (EVERY #'ACHIEVE GOALS) returns true, it means all the\"\n  \"goals were achieved in turn, but they might not still be all true.\"\n\n  (:section \"4.8 The Leaping before You Look Problem\")\n  \"What happens if we move the HAVE-MONEY goal to the end?\"\n  ((gps '(son-at-home car-needs-battery have-money have-phone-book)\n       '(have-money son-at-school)\n       *school-ops*) => SOLVED @ 121)\n  \"GPS returns nil, but only after executing all the actions.\"\n  \"I call this the 'leaping before you look' problem, because if you asked\"\n  \"the program to solve for the two goals (JUMP-OFF-CLIFF LAND-SAFELY) it\"\n  \"would happily jump first, only to discover that it had no operator to land\"\n  \"safely.  This is less than prudent behavior.\"\n\n  (:section \"4.9 The Recursive Subgoal Problem\")\n  \"We won't show the problem (because it gets into an infinite loop),\"\n  \"but we will add the new operator to the *school-ops*; we'll use it later.\"\n  ((push (make-op :action 'ask-phone-number\n               :preconds '(in-communication-with-shop)\n               :add-list '(know-phone-number))\n\t *school-ops*) @ 122)\n\n  (:section \"4.11 GPS Version 2: A More General problem Solver\")\n  \"At this point we are ready to put together a new version of GPS with\"\n  \"solutions for the 'running around the block,' 'prerequisite clobbers\"\n  \"sibling goal,' 'leaping before you look,' and 'recursive subgoal' problems.\"\n  \"The most important change is that, instead of printing a message when each\"\n  \"operator is applied, we will instead have GPS return the resulting state.\"\n  ((requires \"gps\"))\n  \"We use the list of operators that includes the 'asking the shop their\"\n  \"phone number' operator.\"\n  ((push (make-op :action 'ask-phone-number\n               :preconds '(in-communication-with-shop)\n               :add-list '(know-phone-number))\n      *school-ops*))\n  ((use *school-ops*) => 7 @ 130)\n \"First we make sure the new version works on some of the examples that\"\n \"version 1 worked on:\"\n  ((gps '(son-at-home car-needs-battery have-money have-phone-book)\n\t'(son-at-school)) =>\n\t((START)\n\t (EXECUTING LOOK-UP-NUMBER)\n\t (EXECUTING TELEPHONE-SHOP)\n\t (EXECUTING TELL-SHOP-PROBLEM)\n\t (EXECUTING GIVE-SHOP-MONEY)\n\t (EXECUTING SHOP-INSTALLS-BATTERY)\n\t (EXECUTING DRIVE-SON-TO-SCHOOL)) @ 131)\n  \"We can see what is going on here by turning on debugging temporarily:\"\n  ((debug :gps))\n  ((gps '(son-at-home car-needs-battery have-money have-phone-book)\n\t'(son-at-school)) =>\n\t((START)\n\t (EXECUTING LOOK-UP-NUMBER)\n\t (EXECUTING TELEPHONE-SHOP)\n\t (EXECUTING TELL-SHOP-PROBLEM)\n\t (EXECUTING GIVE-SHOP-MONEY)\n\t (EXECUTING SHOP-INSTALLS-BATTERY)\n\t (EXECUTING DRIVE-SON-TO-SCHOOL)) @ 131)\n  ((undebug))\n  \"Here is another old example:\"\n  ((gps '(son-at-home car-works)\n       '(son-at-school)) =>\n       ((START)\n\t(EXECUTING DRIVE-SON-TO-SCHOOL)) @ 132)\n  \"Now we see that version 2 can handle the three cases version 1 got wrong.\"\n  \"In each case the program avoids an infinite loop, and also avoids leaping\"\n  \"before it looks.\"\n  ((gps '(son-at-home car-needs-battery have-money have-phone-book)\n       '(have-money son-at-school)) => NIL)\n  ((gps '(son-at-home car-needs-battery have-money have-phone-book)\n       '(son-at-school have-money)) => NIL)\n  ((gps '(son-at-home car-needs-battery have-money)\n       '(son-at-school)) => NIL)\n  \"Finally, we see the new GPS also works on trivial problems:\"\n  ((gps '(son-at-home) '(son-at-home)) => ((START)))\n\n  (:section \"4.12 The New Domain Problem: Monkey and Bananas\")\n  \"To show that GPS is at all general, we have to make it work in different\"\n  \"domains.  We start with a 'classic' AI problem: Monkey and Bananas\"\n  ((use *banana-ops*) => 6 @ 133)\n  \"We pose the problem of becoming not-hungry, given an initial state.\"\n  \"GPS can find a solution to this problem:\"\n  ((GPS '(at-door on-floor has-ball hungry chair-at-door)\n\t'(not-hungry)) =>\n\t((START)\n\t (EXECUTING PUSH-CHAIR-FROM-DOOR-TO-MIDDLE-ROOM)\n\t (EXECUTING CLIMB-ON-CHAIR)\n\t (EXECUTING DROP-BALL)\n\t (EXECUTING GRASP-BANANAS)\n\t (EXECUTING EAT-BANANAS)) @ 133)\n  \"Notice we did not need to make any changes at all to the GPS program.\"\n  \"We just used a different set of operators.\"\n\n  (:section \"4.13 The Maze Searching Domain\")\n  \"Next we will consider another 'classic' problem, maze searching.\"\n  \"We will assume a particular maze, diagrammed on page 134.\"\n  ((use *maze-ops*) => 48 @ 134)\n  ((gps '((at 1)) '((at 25))) @ 135)\n\n  \"We can define FIND-PATH to use the results of a GPS search:\"\n  ((find-path 1 25) @ 136 =>\n   (1 2 3 4 9 8 7 12 11 16 17 22 23 24 19 20 25))\n  ((find-path 1 1) => (1))\n  ((equal (find-path 1 25) (reverse (find-path 25 1))) => T)\n\n  (:section \"4.14 The Blocks World Domain\")\n  \"Another domain that has attracted more than its share of attention in AI\"\n  \"circles is the blocks world domain.\"\n  ((use (make-block-ops '(a b))) => 4 @ 137)\n  \"The simplest possible problem is stacking one block on another.\"\n  ((gps '((a on table) (b on table) (space on a) (space on b)\n         (space on table))\n       '((a on b) (b on table))) =>\n       ((START)\n\t(EXECUTING (MOVE A FROM TABLE TO B))))\n  \"Here is a slightly more complex problem: inverting a stack of two blocks.\"\n  \"This time we show the debugging output:\"\n  ((debug :gps) @ 138)\n  ((gps '((a on b) (b on table) (space on a) (space on table))\n       '((b on a))) =>\n       ((START)\n\t(EXECUTING (MOVE A FROM B TO TABLE))\n\t(EXECUTING (MOVE B FROM TABLE TO A))))\n  ((undebug))\n  \"Now we move on to the three block world.\"\n  ((use (make-block-ops '(a b c))) => 18)\n  \"We try some problems:\"\n  ((gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n       '((b on a) (c on b))) =>\n       ((START)\n\t(EXECUTING (MOVE A FROM B TO TABLE))\n\t(EXECUTING (MOVE B FROM C TO A))\n\t(EXECUTING (MOVE C FROM TABLE TO B))))\n  ((gps '((c on a) (a on table) (b on table)\n         (space on c) (space on b) (space on table))\n       '((c on table) (a on b))) =>\n       ((START)\n\t(EXECUTING (MOVE C FROM A TO TABLE))\n\t(EXECUTING (MOVE A FROM TABLE TO B))) @ 141)\n  ((gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n\t'((b on a) (c on b))) @ 141 =>\n\t((START)\n\t (EXECUTING (MOVE A FROM B TO TABLE))\n\t (EXECUTING (MOVE B FROM C TO A))\n\t (EXECUTING (MOVE C FROM TABLE TO B))))\n\n  ((gps '((a on b) (b on c) (c on table) (space on a) (space on table))\n\t'((c on b) (b on a))) =>\n\t((START)\n\t (EXECUTING (MOVE A FROM B TO TABLE))\n\t (EXECUTING (MOVE B FROM C TO A))\n\t (EXECUTING (MOVE C FROM TABLE TO B))))\n  \"The Sussman Anomaly\"\n  ((setf start '((c on a) (a on table) (b on table) (space on c)\n                (space on b) (space on table))) @ 142)\n  ((gps start '((a on b) (b on c))) => NIL)\n  ((gps start '((b on c) (a on b))) => NIL)\n\n  (:section \"4.16 The Not Looking after You Don't Leap Problem\")\n  ((use (push (op 'taxi-son-to-school\n               :preconds '(son-at-home have-money)\n               :add-list '(son-at-school)\n               :del-list '(son-at-home have-money))\n           *school-ops*)) @ 143)\n  ((debug :gps))\n  ((gps '(son-at-home have-money car-works)\n       '(son-at-school have-money)) => NIL)\n  ((undebug))\n  )\n\n(defexamples 5 \"Eliza: Dialog with a Machine\"\n  \"ELIZA was one of the first programs to feature English output as well as input.\"\n  \"The program was named after the heroine of Pygmalion, who was taught to\"\n  \"speak proper English by a dedicated teacher.\"\n  (:section \"5.2 Pattern Matching\")\n  ((requires \"eliza1\"))\n  \"The hard part is the notion of pattern matching and transformation.\"\n  \"All symbols beginning with ? are variables for the pattern matcher.\"\n  \"First we see how to substitute variable/value pairs into expressions:\"\n  ((sublis '((?X . vacation)) '(what would it mean to you if you got a ?X ?))\n   => (what would it mean to you if you got a VACATION ?) @ 156)\n  \"Now a version of pat-match that works with such pairs:\"\n  ((pat-match '(I need a ?x) '(I need a vacation))  @ 158)\n  \"Showing how to plug it in:\"\n  ((sublis (pat-match '(I need a ?x) '(I need a vacation))\n\t   '(what would it mean to you if you got a ?X ?))\n   => (what would it mean to you if you got a VACATION ?) @ 159)\n  ((pat-match '(I need a ?x) '(I really need a vacation)) => nil)\n  ((pat-match '(this is easy) '(this is easy)) => ((t . t)))\n  ((pat-match '(?x is ?x) '((2 + 2) is 4)) => nil)\n  ((pat-match '(?x is ?x) '((2 + 2) is (2 + 2))) => ((?x 2 + 2)))\n  ((pat-match '(?P need . ?X) '(I need a long vacation))\n   => ((?X a long vacation) (?P . I)))\n\n  (:section \"5.3 Segment Pattern Matching\")\n  \"We show how to have a variable that will match more than one element.\"\n  \"We call these segment variables, and denote them (?* name).\"\n  ((pat-match '((?* ?p) need (?* ?x))\n\t      '(Mr Hulot and I need a vacation)) @ 160)\n  (:section \"5.4 The Eliza Program: A Rule-Based Translator\")\n  ((requires \"eliza\"))\n  \"We can't show you an interactive ELIZA session, because the replies are\"\n  \"random, and thus change every time.  You can experiment on your own by\"\n  \"evaluating (ELIZA) and typing in your end of the conversation.\n  Type (good bye) when you are done.\"\n  )\n\n(defexamples 6 \"Building Software Tools\"\n  \"In chapters 4 and 5 we were concerned with buildinng two particular\"\n  \"programs, GPS and ELIZA.  In this chapter, we will reexamine those\"\n  \"two programs to discover some common patterns.  Those patterns will be\"\n  \"abstracted out to form reusable software tools.\"\n  (:section \"6.2 A Pattern-Matching tool\")\n  ((requires \"patmatch\"))\n  ((pat-match '(x = (?is ?n numberp)) '(x = 34)) => ((?n . 34)) @ 179)\n  ((pat-match '(x = (?is ?n numberp)) '(x = x)) => NIL)\n  ((pat-match '(?x (?or < = >) ?y) '(3 < 4)) => ((?Y . 4) (?X . 3)))\n  ((pat-match '(x = (?and (?is ?n numberp) (?is ?n oddp))) '(x = 3))\n   => ((?N . 3)))\n  ((pat-match '(?x /= (?not ?x)) '(3 /= 4)) => ((?X . 3)) @ 180)\n  ((pat-match '(?x > ?y (?if (> ?x ?y))) '(4 > 3)) => ((?Y . 3) (?X . 4)))\n  ((pat-match '(a (?* ?x) d) '(a b c d)) => ((?X B C)) @ 185)\n  ((pat-match '(a (?* ?x) (?* ?y) d) '(a b c d)) => ((?Y B C) (?X)))\n  ((pat-match '(a (?* ?x) (?* ?y) ?x ?y) '(a b c d (b c) (d)))\n   => ((?Y D) (?X B C)) @ 186)\n  ((pat-match '(?x ?op ?y is ?z (?if (eql (funcall ?op ?x ?y) ?z)))\n\t      '(3 + 4 is 7))\n   => ((?Z . 7) (?Y . 4) (?OP . +) (?X . 3)))\n  ((pat-match '(?x ?op ?y (?if (funcall ?op ?x ?y))) '(3 > 4)) => NIL)\n  ((pat-match-abbrev '?x* '(?* ?x)) => (?* ?X) @ 187)\n  ((pat-match-abbrev '?y* '(?* ?y)) => (?* ?Y))\n  ((setf axyd (expand-pat-match-abbrev '(a ?x* ?y* d)))\n   => (A (?* ?X) (?* ?Y) D))\n  ((pat-match axyd '(a b c d)) => ((?Y B C) (?X)))\n  ((pat-match '(((?* ?x) (?* ?y)) ?x ?y) '((a b c d) (a b) (c d)))\n   => NIL)\n  ((requires \"eliza-pm\"))\n\n  (:section \"6.4 A Set of Searching Tools\")\n  ((requires \"search\"))\n  ((debug :search) @ 192)\n  \"We can search through the binary tree, looking for, say, 12 as the goal.\"\n  \"With breadth-first search this would yield an infinite loop, so we won't\"\n  \"do it.  Breadth-first search works better:\"\n  ((breadth-first-search 1 (is 12) 'binary-tree) => 12 @ 193)\n  ((depth-first-search 1 (is 12) (finite-binary-tree 15)) => 12 @ 193)\n  \"Guiding the Search\"\n  \"Best-first search takes an additional argument which estimates how close\"\n  \"we are to the goal.  We call this the cost function.\"\n  ((best-first-search 1 (is 12) #'binary-tree (diff 12)) => 12 @ 195)\n  ((best-first-search 1 (is 12) #'binary-tree (price-is-right 12)) => 12)\n  \"The function beam-search is just like best-first-search, except that after\"\n  \"we sort the states, we then take only the first beam-width states.\"\n  ((beam-search 1 (is 12) #'binary-tree (price-is-right 12) 2) => 12)\n  \"As a concrete example of a problem that can be solved by search,\"\n  \"consider planning a flight across North America in a plane whose range is\"\n  \"limited to 1000 kilometers.  Here we plan a trip from SF to Boston.\"\n  ((path-state (trip (city 'san-francisco) (city 'boston)))\n   => (BOSTON 71.05 42.21) @ 199)\n  ((path-state (trip (city 'boston) (city 'san-francisco)))\n   => (SAN-FRANCISCO 122.26 37.47))\n  ((undebug :search))\n  ((show-city-path (trip (city 'san-francisco) (city 'boston) 1)) @ 201)\n  ((show-city-path (trip (city 'boston) (city 'san-francisco) 1)))\n  ((show-city-path (trip (city 'boston) (city 'san-francisco) 3)) @ 202)\n  ((iter-wide-search 1 (is 12) (finite-binary-tree 15) (diff 12))  => 12 @ 205)\n  ((tree-search '(1) (is 6) #'next2 #'prepend) => 6 @ 208)\n  ((graph-search '(1) (is 6) #'next2 #'prepend) => 6)\n  ((path-states\n    (a*-search (list (make-path :state 1)) (is 6)\n               #'next2 #'(lambda (x y) 1) (diff 6))) => (6 5 3 1) @ 210)\n  (:section \"6.5 GPS as Search\")\n  ((requires \"gps-srch\"))\n  ((setf start '((c on a) (a on table) (b on table) (space on c)\n                 (space on b) (space on table))) @ 213)\n  ((use (make-block-ops '(a b c))) => 18)\n  ((search-gps start '((a on b) (b on c)))\n   => ((START)\n       (EXECUTING (MOVE C FROM A TO TABLE))\n       (EXECUTING (MOVE B FROM TABLE TO C))\n       (EXECUTING (MOVE A FROM TABLE TO B))) @ 213)\n  ((search-gps start '((b on c) (a on b)))\n   => ((START)\n       (EXECUTING (MOVE C FROM A TO TABLE))\n       (EXECUTING (MOVE B FROM TABLE TO C))\n       (EXECUTING (MOVE A FROM TABLE TO B))))\n  )\n\n(defexamples 7 \"STUDENT: Solving Algebra Word Problems\"\n  \"STUDENT was another early language understanding program, written by Daniel\"\n  \"Bobrow in 1964.  It was designed to read and solve the kind of word\"\n  \"problems found in high school algebra books.\"\n  (:section \"7.1 Translating English into Equations\")\n  ((requires \"student\"))\n  ((translate-to-expression '(if z is 3 |,| what is twice z))\n   => ((= z 3) (= what (* 2 z))) @ 222)\n  (:section \"7.2 Solving Algebra Equations\")\n  ((trace isolate solve) @ 229)\n  ((solve-equations '((= (+ 3 4) (* (- 5 (+ 2 x)) 7))\n                   (= (+ (* 3 x) y) 12))) => nil)\n  ((untrace isolate solve))\n  (:section \"7.3 Examples\")\n  ((student '(If the number of customers Tom gets is twice the square of\n           20 % of the number of advertisements he runs |,|\n           and the number of advertisements is 45 |,|\n           then what is the number of customers Tom gets ?)) => nil @ 231)\n  ((student '(The daily cost of living for a group is the overhead cost plus\n           the running cost for each person times the number of people in\n           the group |.|  This cost for one group equals $ 100 |,|\n           and the number of people in the group is 40 |.|\n           If the overhead cost is 10 times the running cost |,|\n           find the overhead and running cost for each person |.|)))\n  ((student '(Fran's age divided by Robin's height is one half Kelly's IQ |.|\n           Kelly's IQ minus 80 is Robin's height |.|\n           If Robin is 4 feet tall |,| how old is Fran ?)))\n  ((student '(Fran's age divided by Robin's height is one half Kelly's IQ |.|\n           Kelly's IQ minus 80 is Robin's height |.|\n           If Robin is 0 feet tall |,| how old is Fran ?)))\n  )\n\n(defexamples 8 \"Symbolic Mathematics: A Simplification Program\"\n  \"'Symbolic mathematics' is to numerical mathematics as algebra is to\"\n  \"arithmetic: it deals with variables and expressions, not just numbers.\"\n  \"This chapter develops a program that simplifies algebraic expressions.\"\n  \"We then show that differentiation and even integration can be seen as\"\n  \"special cases of 'simplification.'  (Note that we replace calls to the\"\n  \"interactive function SIMPLIFIER with calls to the function SIMP.)\"\n  (:section \"8.2 Simplification Rules\")\n  ((requires \"macsymar\"))\n  ((simp '(2 + 2)) => 4 @ 245)\n  ((simp '(5 * 20 + 30 + 7)) => 137 )\n  ((simp '(5 * x - (4 + 1) * x)) => 0 )\n  ((simp '(y / z * (5 * x - (4 + 1) * x))) => 0 )\n  ((simp '((4 - 3) * x + (y / y - 1) * z)) => X )\n  ((simp '(1 * f(x) + 0)) => (F X) )\n\n  (:section \"8.3 Associativity and Commutativity\")\n  ((simp '(3 * 2 * x)) => (6 * X) @ 247)\n  ((simp '(2 * x * x * 3)) => (6 * (X ^ 2)) )\n  ((simp '(2 * x * 3 * y * 4 * z * 5 * 6)) => (720 * (X * (Y * Z))) )\n  ((simp '(3 + x + 4 + x)) => ((2 * X) + 7) )\n  ((simp '(2 * x * 3 * x * 4 * (1 / x) * 5 * 6)) => (720 * X))\n\n  (:section \"8.4 Logs, Trig, and Differentiation\")\n  ((simp '(d (x + x) / d x)) => 2 @ 250)\n  ((simp '(d (a * x ^ 2 + b * x + c) / d x)) => ((2 * (A * X)) + B) )\n  \"For the next one, note we had an error in the first printing of the book;\"\n  \"the sign was reversed on the (d (u / v) ...) rule.\"\n  ((simp '(d ((a * x ^ 2 + b * x + c) / x) / d x))\n   => (((X * ((2 * (A * X)) + B)) - ((A * (X ^ 2)) + ((B * X) + C))) /\n       (X ^ 2)))\n  ((simp '(log ((d (x + x) / d x) / 2))) => 0 )\n  ((simp '(log(x + x) - log x)) => (LOG 2))\n  ((simp '(x ^ cos pi)) => (1 / X) )\n  \"These next two examples were also affected by the (d (u / v) ...) rule.\"\n  ((simp '(d (3 * x + (cos x) / x) / d x))\n   => ((((X * (- (SIN X))) - (COS X)) / (X ^ 2)) + 3))\n  ((simp '(d ((cos x) / x) / d x))\n   => (((X * (- (SIN X))) - (COS X)) / (X ^ 2)))\n  ((simp '(d (3 * x ^ 2 + 2 * x + 1) / d x)) => ((6 * X) + 2))\n  ((simp '(sin(x + x) ^ 2 + cos(d x ^ 2 / d x) ^ 2)) => 1 )\n  ((simp '(sin(x + x) * sin(d x ^ 2 / d x) +\n\t      cos(2 * x) * cos(x * d 2 * y / d y))) => 1 )\n\n  (:section \"8.5 Limits of Rule-Based Approaches\")\n  \"In this section we return to some examples that pose problems.\"\n  \"For the following, we would prefer (2 * (x + y))\"\n  ((simp '(x + y + y + x)) => (X + (Y + (Y + X))))\n  \"For the following, we would prefer (7 * X) and (Y + (8 * X)), respectively:\"\n  ((simp '(3 * x + 4 * x)) => ((3 * X) + (4 * X)))\n  ((simp '(3 * x + y + x + 4 * x)) => ((3 * X) + (Y + (X + (4 * X)))) )\n  \"In chapter 15, we develop a new version of the program that handles this problem.\"\n\n  (:section \"8.6 Integration\")\n  ((set-simp-fn 'Int #'(lambda (exp)\n\t\t\t(integrate (exp-lhs exp) (exp-rhs exp)))) @ 258)\n  ((simp '(Int x * sin(x ^ 2) d x)) => (1/2 * (- (COS (X ^ 2)))) )\n  ((simp '(Int ((3 * x ^ 3) - 1 / (3 * x ^ 3)) d x))\n   => ((3 * ((X ^ 4) / 4)) - (1/3 * ((X ^ -2) / -2))) )\n  ((simp '(Int (3 * x + 2) ^ -2/3 d x)) => (((3 * X) + 2) ^ 1/3) )\n  ((simp '(Int sin(x) ^ 2 * cos(x) d x)) => (((SIN X) ^ 3) / 3) )\n  ((simp '(Int sin(x) / (1 + cos(x)) d x)) => (-1 * (LOG ((COS X) + 1))) )\n  ((simp '(Int (2 * x + 1) / (x ^ 2 + x - 1) d x))\n   => (LOG ((X ^ 2) + (X - 1))) )\n  ((simp '(Int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x))\n   => (8 * ((1/3 * (((X ^ 3) + 2) ^ -2)) / -2)) )\n  ((set-simp-fn 'Int\n\t       #'(lambda (exp)\n\t\t   (unfactorize\n\t\t    (factorize\n\t\t     (integrate (exp-lhs exp) (exp-rhs exp)))))) @ 259)\n  ((simp '(Int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x))\n   => (-4/3 * (((X ^ 3) + 2) ^ -2)) )\n  )\n\n(defexamples 9 \"Efficiency Issues\"\n  \"One of the reasons Lisp has enjoyed a long history is because it is an\"\n  \"ideal language for what is called rapid-prototyping or rapid development.\"\n  \"Most real AI programs deal with large amounts of data.  Thus, efficiency\"\n  \"is important.  This chapter shows some ways to make programs efficient.\"\n  (:section \"9.1 Caching Results of Previous Computations: Memoization\")\n  ((defun fib (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2))))) @ 269)\n  ((setf memo-fib (memo #'fib)) @ 270)\n  ((trace fib))\n  ((funcall memo-fib 3) => 3 @ 270)\n  ((funcall memo-fib 3) => 3)\n  ((untrace fib))\n  ((memoize 'fib) @ 272)\n  ((trace fib))\n  ((fib 5) => 8)\n  ((fib 5) => 8)\n  ((fib 6) => 13)\n  ((untrace fib))\n)\n\n(defexamples 10 \"Low-Level Efficiency Issues\"\n  \"The efficiency techniques of the previous chapter all involved fairly\"\n  \"significant changes to an algorithm.  But what happens when you are already\"\n  \"using the best imaginable algorithms, and performance is still a problem?\"\n  (:section \"10.1 Use Declarations\")\n  \"Compare these functions with and without declarations:\"\n  ((defun f (x y)\n     (declare (fixnum x y) (optimize (safety 0) (speed 3)))\n     (the fixnum (+ x y))) @ 318)\n  ((defun g (x y) (+ x y)))\n  \"Here is the disassembled code for f and g:\"\n  ((disassemble 'f))\n  ((disassemble 'g) @ 319)\n)\n\n(defexamples 11 \"Logic Programming\"\n  \"The idea behind logic programming is that the programmer should state the\"\n  \"relationships that describe a problem and its solution.\"\n  \"In this chapter we develop an interpreter for the Prolog language.\"\n\n  (:section \"11.1 Idea 1: A Uniform Data Base\")\n  ((requires \"prolog1\"))\n  \"First let's make sure we're dealing with a brand new database.\"\n  ((clear-db))\n  \"Facts are entered into the data base with the <- macro\"\n  ((<- (likes Kim Robin)) @ 350)\n  ((<- (likes Sandy Lee)))\n  ((<- (likes Sandy Kim)))\n  ((<- (likes Robin cats)))\n  \"We can also enter rules, which state contingent facts.\"\n  ((<- (likes Sandy ?x) (likes ?x cats)) @ 351)\n  ((<- (likes Kim ?x) (likes ?x Lee) (likes ?x Kim)))\n\n  (:section \"11.2 Idea 2: Unification of Logic Variables\")\n  ((requires \"unify\"))\n  ((pat-match '(?x + ?y) '(2 + 1)) => ((?y . 1) (?x . 2)) @ 352)\n  ((unify '(?x + 1) '(2 + ?y)) => ((?y . 1) (?x . 2)))\n  ((unify '(f ?x) '(f ?y)) => ((?x . ?y)))\n  ((unify '(?a + ?a = 0) '(?x + ?y = ?y)) => ((?y . 0) (?x . ?y) (?a . ?x)))\n  ((unifier '(?a + ?a = 0) '(?x + ?y = ?y)) => (0 + 0 = 0))\n  \"Let's try UNIFY on some (more) examples:\"\n  ((unify '(?x ?y a) '(?y ?x ?x)) => ((?y . a) (?x . ?y)) @ 357)\n  ((unify '?x '(f ?x)) => nil)\n  ((unify 'a 'a) => ((t . t)))\n  \"Here are some examples of UNIFIER:\"\n  ((unifier '(?x ?y a) '(?y ?x ?x)) => (a a a))\n  ((unifier '((?a * ?x ^ 2) + (?b * ?x) + ?c)\n\t    '(?z + (4 * 5) + 3))\n   => ((?a * 5 ^ 2) + (4 * 5) + 3))\n\n  \"Programming with Prolog\"\n  \"First we define the MEMBER relation in Prolog:\"\n  ((<- (member ?item (?item . ?rest))) @ 358)\n  ((<- (member ?item (?x . ?rest)) (member ?item ?rest)))\n  \"Now we can make some queries:\"\n  ((?- (member 2 (1 2 3))))\n  ((?- (member 2 (1 2 3 2 1))))\n  ((?- (member ?x (1 2 3))))\n  \"Let's add one more rule to the Sandy and the cats facts:\"\n  ((<- (likes ?x ?x)) @ 363)\n  \"Now we can ask some queries:\"\n  ((?- (likes Sandy ?who)) @ 365)\n  ((?- (likes ?who Sandy)))\n  ((?- (likes Robin Lee)))\n  ((?- (likes ?x ?y) (likes ?y ?x)) @ 366)\n\n  (:section \"11.3 Idea 3: Automatic Backtracking\")\n  \"Now we load the version that does automatic backtracking one step at a time\"\n  \"as opposed to the previous version, which collects all answers at once.\"\n  \"Since we don't want to involve you, the user, in typing input to move on\"\n  \"to the next step, we supply the input (a ; or a .) as in the book.\"\n  \"Unfortunately, it is not specified in Common Lisp whether read-char echoes\"\n  \"the character it reads, so you may or may not see the ; and . characters.\"\n  ((requires \"prolog\"))\n  \"Let's add the definition of the relation LENGTH:\"\n  ((<- (length () 0)) @ 370)\n  ((<- (length (?x . ?y) (1+ ?n)) (length ?y ?n)))\n  \"Here are some queries:\"\n  ((?- (length (a b c d) ?n)) :input \";\")\n  ((?- (length ?list (1+ (1+ 0)))) :input \";\")\n  ((?- (length ?list ?n)) :input \";;.\")\n  ((?- (length ?l (1+ (1+ 0))) (member a ?l)) :input \";;\")\n  \"(We won't try the example that leads to an infinite loop.)\"\n  (:section \"11.4 The Zebra Puzzle\")\n  \"First we define the NEXTO and IRIGHT (to the immediate right) relations:\"\n  ((<- (nextto ?x ?y ?list) (iright ?x ?y ?list)) @ 374)\n  ((<- (nextto ?x ?y ?list) (iright ?y ?x ?list)))\n  ((<- (iright ?left ?right (?left ?right . ?rest))))\n  ((<- (iright ?left ?right (?x . ?rest))\n       (iright ?left ?right ?rest)))\n  ((<- (= ?x ?x)))\n  \"Now we define the zebra puzzle:\"\n  ((<- (zebra ?h ?w ?z)\n       ;; Each house is of the form:\n       ;; (house nationality pet cigarette drink house-color)\n       (= ?h ((house norwegian ? ? ? ?)\t;1,10\n\t      ?\n\t      (house ? ? ? milk ?) ? ?)) ; 9\n       (member (house englishman ? ? ? red) ?h)\t; 2\n       (member (house spaniard dog ? ? ?) ?h) ; 3\n       (member (house ? ? ? coffee green) ?h) ; 4\n       (member (house ukrainian ? ? tea ?) ?h) ; 5\n       (iright (house ? ? ? ? ivory)\t; 6\n\t       (house ? ? ? ? green) ?h)\n       (member (house ? snails winston ? ?) ?h)\t; 7\n       (member (house ? ? kools ? yellow) ?h) ; 8\n       (nextto (house ? ? chesterfield ? ?) ;11\n\t       (house ? fox ? ? ?) ?h)\n       (nextto (house ? ? kools ? ?)\t;12\n\t       (house ? horse ? ? ?) ?h)\n       (member (house ? ? luckystrike oj ?) ?h)\t;13\n       (member (house japanese ? parliaments ? ?) ?h) ;14\n       (nextto (house norwegian ? ? ? ?) ;15\n\t       (house ? ? ? ? blue) ?h)\n       (member (house ?w ? ? water ?) ?h) ;Q1\n       (member (house ?z zebra ? ? ?) ?h))) ;Q2\n  \"If you want to test this out, run the following query:\"\n  \"   ((?- (zebra ?houses ?water-drinker ?zebra-owner)))\"\n  \"It is not included as an example because it takes a minute or so to run.\"\n  )\n\n\n(defexamples 12 \"Compiling Logic Programs\"\n  \"This chapter presents a compiler that translates from Prolog to Lisp.\"\n  \"Unfortunatley, there's not much to see in terms of examples.\"\n  \"But we load the files for you, in case you want to play with them.\"\n  ((requires \"prologc1\" \"prologc2\" \"prologcp\"))\n  ((prolog-compile 'likes) @ 389)\n  ((prolog-compile 'member))\n  )\n\n(defexamples 13 \"Object Oriented Programming\"\n  \"It is only natural that a wide range of programming styles have been\"\n  \"introduced to attack the wide range of problems in this book.\"\n  \"One style not yet covered is 'object-oriented programming'.\"\n  \"Peter Wegner (1987) proposes the following formula as a definition:\"\n  \"Object-orientation = Objects + Classes + Inheritance\"\n\n  (:section \"13.2 Objects\")\n  \"Now we're ready to get started.\"\n  ((requires \"clos\"))\n  ((setf acct (new-account \"J. Random Customer\" 1000.00)) @ 438)\n  ((send acct 'withdraw 500.00) => 500.0)\n  ((send acct 'deposit 123.45) => 623.45)\n  ((send acct 'name) => \"J. Random Customer\")\n  ((send acct 'balance) => 623.45)\n\n  (:section \"13.4 Classes\")\n  \"Now we define the class ACCOUNT with the define-class macro.\"\n  ((define-class account (name &optional (balance 0.00))\n        ((interest-rate .06))\n     (withdraw (amt) (if (<= amt balance)\n                       (decf balance amt)\n                       'insufficient-funds))\n     (deposit  (amt) (incf balance amt))\n     (balance  ()    balance)\n     (name     ()    name)\n     (interest ()    (incf balance (* interest-rate balance)))) @ 440)\n  \"Here are the generic functions defined by this macro:\"\n  ((setf acct2 (account \"A. User\" 2000.00)))\n  ((deposit acct2 42.00) => 2042.0)\n  ((interest acct2) => 2164.52)\n  ((balance acct2) => 2164.52 @ 441)\n  ((balance acct) => 623.45)\n\n  (:section \"13.5 Delegation\")\n  ((define-class password-account (password acct) ()\n     (change-password (pass new-pass)\n                      (if (equal pass password)\n                        (setf password new-pass)\n                        'wrong-password))\n     (otherwise (pass &rest args)\n                (if (equal pass password)\n                  (apply message acct args)\n                  'wrong-password))))\n  \"Now we see how the class PASSWORD-ACCOUNT can be used to provide protection\"\n  \"for an existing account:\"\n  ((setf acct3 (password-account \"secret\" acct2)) @ 441)\n  ((balance acct3 \"secret\") => 2164.52)\n  ((withdraw acct3 \"guess\" 2000.00) => WRONG-PASSWORD)\n  ((withdraw acct3 \"secret\" 2000.00) => 164.52)\n\n  (:section \"13.7 CLOS: The Common Lisp Object System\")\n  \"Because some Lisp implementations can't convert a structure class into\"\n  \"a CLOS class, nor convert a regular function into a generic function,\"\n  \"we use the names account*, name*, balance*, interest-rate*.  If you were\"\n  \"doing a real application, not just some examples, you would choose one\"\n  \"implementation and get to use the regular names.\"\n  ; ?????? some problems here\n  ((defclass account* ()\n     ((name :initarg :name :reader name*)\n      (balance :initarg :balance :initform 0.00 :accessor balance*)\n      (interest-rate :allocation :class :initform .06\n                     :reader interest-rate*))) @ 445)\n  ((setf a1 (make-instance 'account* :balance 5000.00\n                          :name \"Fred\")) @ 446)\n  ((name* a1) => \"Fred\")\n  ((balance* a1) => 5000.0)\n  ((interest-rate* a1) => 0.06)\n  ((defmethod withdraw* ((acct account*) amt)\n     (if (< amt (balance* acct))\n       (decf (balance* acct) amt)\n       'insufficient-funds)) @ 446)\n  ((defclass limited-account (account*)\n     ((limit :initarg :limit :reader limit))))\n  ((defmethod withdraw* ((acct limited-account) amt)\n     (if (> amt (limit acct))\n       'over-limit\n       (call-next-method))))\n  ((setf a2 (make-instance 'limited-account\n                          :name \"A. Thrifty Spender\"\n                          :balance 500.00 :limit 100.00)) @ 447)\n  ((name* a2) => \"A. Thrifty Spender\")\n  ((withdraw* a2 200.00) => OVER-LIMIT)\n  ((withdraw* a2 20.00) => 480.0)\n\n  (:section \"13.8 A CLOS Example: Searching Tools\")\n  ((defclass problem ()\n     ((states :initarg :states :accessor problem-states))) @ 449)\n  ((defmethod searcher ((prob problem))\n  \"Find a state that solves the search problem.\"\n  (cond ((no-states-p prob) fail)\n        ((goal-p prob) (current-state prob))\n        (t (let ((current (pop-state prob)))\n             (setf (problem-states prob)\n                   (problem-combiner\n                     prob\n                     (problem-successors prob current)\n                     (problem-states prob))))\n           (searcher prob)))))\n  ((defmethod current-state ((prob problem))\n    \"The current state is the first of the possible states.\"\n    (first (problem-states prob))))\n\n  ((defmethod pop-state ((prob problem))\n  \"Remove and return the current state.\"\n  (pop (problem-states prob))))\n\n  ((defmethod no-states-p ((prob problem))\n  \"Are there any more unexplored states?\"\n  (null (problem-states prob))))\n\n  ((defmethod searcher :before ((prob problem))\n     (dbg 'search \"~&;; Search: ~a\" (problem-states prob))) @ 450)\n\n  ((defclass eql-problem (problem)\n     ((goal :initarg :goal :reader problem-goal))))\n\n  ((defmethod goal-p ((prob eql-problem))\n  (eql (current-state prob) (problem-goal prob))))\n\n  ((defclass dfs-problem (problem) ()\n     (:documentation \"Depth-first search problem.\")))\n\n  ((defclass bfs-problem (problem) ()\n     (:documentation \"Breadth-first search problem.\")))\n\n  ((defmethod problem-combiner ((prob dfs-problem) new old)\n     \"Depth-first search looks at new states first.\"\n     (append new old)))\n\n  ((defmethod problem-combiner ((prob bfs-problem) new old)\n     \"Depth-first search looks at old states first.\"\n     (append old new)))\n\n  ((defclass binary-tree-problem (problem) ()) @ 451)\n\n  ((defmethod problem-successors ((prob binary-tree-problem) state)\n     (let ((n (* 2 state)))\n       (list n (+ n 1)))))\n\n  ((defclass binary-tree-eql-bfs-problem\n     (binary-tree-problem eql-problem bfs-problem) ()))\n\n  ((setf p1 (make-instance 'binary-tree-eql-bfs-problem\n                          :states '(1) :goal 12)))\n  ((searcher p1) => 12)\n\n  ((defclass best-problem (problem) ()\n     (:documentation \"A Best-first search problem.\")) @ 452)\n\n  ((defmethod problem-combiner ((prob best-problem) new old)\n     \"Best-first search sorts new and old according to cost-fn.\"\n     (sort (append new old) #'<\n           :key #'(lambda (state) (cost-fn prob state)))))\n\n  ((defmethod cost-fn ((prob eql-problem) state)\n     (abs (- state (problem-goal prob)))))\n\n  ((defclass beam-problem (problem)\n     ((beam-width :initarg :beam-width :initform nil\n                  :reader problem-beam-width))))\n\n  ((defmethod problem-combiner :around ((prob beam-problem) new old)\n     (let ((combined (call-next-method)))\n       (subseq combined 0 (min (problem-beam-width prob)\n                               (length combined))))))\n\n  ((defclass binary-tree-eql-best-beam-problem\n     (binary-tree-problem eql-problem best-problem beam-problem)\n     ()))\n\n  ((setf p3 (make-instance 'binary-tree-eql-best-beam-problem\n                          :states '(1) :goal 12 :beam-width 3)))\n\n  ((searcher p3) => 12)\n\n  ((defclass trip-problem (binary-tree-eql-best-beam-problem)\n     ((beam-width :initform 1))) @ 453)\n\n  ((defmethod cost-fn ((prob trip-problem) city)\n     (air-distance (problem-goal prob) city)))\n\n  ((defmethod problem-successors ((prob trip-problem) city)\n     (neighbors city)))\n\n  ((setf p4 (make-instance 'trip-problem\n                          :states (list (city 'new-york))\n                          :goal (city 'san-francisco))))\n\n  ((searcher p4) =>\n   (SAN-FRANCISCO 122.26 37.47))\n\n  (:section \"13.9 Is CLOS Object-oriented?\")\n  ((defmethod conc ((x null) y) y) @ 454)\n\n  ((defmethod conc (x (y null)) x))\n\n  ((defmethod conc ((x list) (y list))\n     (cons (first x) (conc (rest x) y))))\n\n  ((defmethod conc ((x vector) (y vector))\n     (let ((vect (make-array (+ (length x) (length y)))))\n       (replace vect x)\n       (replace vect y :start1 (length x)))))\n\n  ((conc nil '(a b c)) => (A B C) @ 455)\n  ((conc '(a b c) nil) => (A B C))\n  ((conc '(a b c) '(d e f)) => (A B C D E F))\n  ((conc '#(a b c) '#(d e f)) => #(A B C D E F))\n  )\n\n(defexamples 14 \"Knowledge Representation and Reasoning\"\n  \"In this chapter we explore means of indexing facts so that they can be\"\n  \"retrieved and reasoned with efficiently.\"\n  \"Section 14.1 to 14.7 discuss problems with logical reasoning systems\"\n  \"such as Prolog.\"\n  (:section \"14.8 A Solution to the Indexing Problem\")\n  \"Here we show how to index facts in a kind of table that makes it easy to\"\n  \"add, delete, and retrieve entries.  We will develop an extension of the\"\n  \"trie or discrimination tree data structure built in section 10.5 (page 344).\"\n  ((requires \"krep1\"))\n  \"Now we define a function to test the indexing routine.  Compare the output\"\n  \"with figure 14.1 on page 474.\"\n  ((test-index) @ 478)\n  \"Here is an example of fetching from the index\"\n  ((fetch '(p ? c)) @ 480 =>\n   (((P B C) (P A C))\n    ((P A ?X))))\n  \"We can make a change to rename variables before indexing facts.\"\n  ((defun index (key)\n     \"Store key in a dtree node.  Key must be (predicate . args);\n  it is stored in the predicate's dtree.\"\n     (dtree-index key (rename-variables key) ; store unique vars\n\t\t  (get-dtree (predicate key)))) @ 481)\n  \"We have to reindex:\"\n  ((test-index))\n  \"We are now ready to test the retrieval mechanism:\"\n  ((fetch '(p ?x c)) @ 481)\n  ((retrieve '(p ?x c)) @ 481)\n  ((retrieve-matches '(p ?x c)) =>\n   ((P A C) (P A C) (P B C)))\n  ((retrieve-matches '(p ?x (?fn c))) =>\n   ((P A (?FN C)) (P A (F C)) (P B (F C))))\n  ((query-bind (?x ?fn) '(p ?x (?fn c))\n\t       (format t \"~&P holds between ~a and ~a of c.\" ?x ?fn)) @ 482)\n\n  (:section \"14.10 Solutions to the Expressiveness Problems\")\n  \"In this section we introduce a frame-like language, using the primitives\"\n  \"sub, rel, ind, val, and and.\"\n  ((requires \"krep\"))\n  \"We add some facts about dogs and bears, both as individuals and species:\"\n  ((add-fact '(sub dog animal)) @ 488)\n  ((add-fact '(sub bear animal)))\n  ((add-fact '(ind Fido dog)))\n  ((add-fact '(ind Yogi bear)))\n  ((add-fact '(val color Yogi brown)))\n  ((add-fact '(val color Fido golden)))\n  ((add-fact '(val latin-name bear ursidae)))\n  ((add-fact '(val latin-name dog canis-familiaris)))\n  \"Now retrieve-fact is used to answer three questions: What kinds of animals\"\n  \"are there?\"\n  ((retrieve-fact '(sub ?kind animal)) =>\n   (((?KIND . DOG))\n    ((?KIND . BEAR))))\n  \"What are the Latin names of each kind of animal?\"\n  ((retrieve-fact '(and (sub ?kind animal)\n                       (val latin-name ?kind ?latin))) =>\n   (((?LATIN . CANIS-FAMILIARIS) (?KIND . DOG))\n    ((?LATIN . URSIDAE) (?KIND . BEAR))))\n  \"What are the colors of each individual bear?\"\n  ((retrieve-fact '(and (ind ?x bear) (val color ?x ?c))) @ 489 =>\n   (((?C . BROWN) (?X . YOGI))))\n  ((test-bears) @ 492)\n  )\n\n(defexamples 15 \"Symbolic Mathematics with Canonical Forms\"\n  \"This chapter uses a canonical representation for polynomials\"\n  \"to achieve a more efficient program than the rules-based one in Chapter 8.\"\n  (:section \"15.1 A Canonical Form for Polynomials\")\n  ((requires \"cmacsyma\"))\n  \"We represent polynomials as vectors, with the variable in element 0,\"\n  \"and the coefficients starting in element 1 and going up from there.\"\n  \"Here is the representation of 5x^3 + 10x^2 + 20x + 30\"\n  ('#(x 30 20 10 5) @ 511)\n  \"Here are some examples (without the interactive loop):\"\n  ((canon '(3 + x + 4 - x)) => 7 @ 521)\n  ((canon '(x + y + y + x)) => ((2 * x) + (2 * y)))\n  ((canon '(3 * x + 4 * x)) => (7 * x))\n  ((canon '(3 * x + y + x + 4 * x)) => ((8 * x) + y))\n  ((canon '((x + 1) ^ 10)) =>\n   ((x ^ 10) + (10 * (x ^ 9)) + (45 * (x ^ 8)) + (120 * (x ^ 7))\n    + (210 * (x ^ 6)) + (252 * (x ^ 5)) + (210 * (x ^ 4))\n    + (120 * (x ^ 3)) + (45 * (x ^ 2)) + (10 * x) + 1))\n  ((canon '((x + 1) ^ 10 - (x - 1) ^ 10)) =>\n   ((20 * (x ^ 8)) + (240 * (x ^ 7)) + (504 * (x ^ 5))\n    + (240 * (x ^ 3)) + (20 * x)))\n  ((canon '(d (3 * x ^ 2 + 2 * x + 1) / d x)) @ 522 =>\n   ((6 * x) + 2))\n  ((canon '(d (z + 3 * x + 3 * z * x ^ 2 + z ^ 2 * x ^ 3) / d z)) =>\n   (((2 * z) * (x ^ 3)) + (3 * (x ^ 2)) + 1)))\n\n\n(defexamples 16 \"Expert Systems\"\n  \"In this chapter we develop an expert system shell, and give it a few rules\"\n  \"about infectious disease, thus duplicating some of the Mycin system.\"\n  ((requires \"mycin-r\"))\n  \"Because this is an interactive system, we can't show the interaction here.\"\n  \"You can try it yourself by evaluating (mycin)\"\n  )\n\n(defexamples 17 \"Line Diagram Labelling by Constraint Satisfaction\"\n  \"In this chapter we look at the line-diagram labeling problem: Given a list\"\n  \"of lines and the vertexes at which they intersect, how can we determine\"\n  \"what the lines represent?\"\n  ((requires \"waltz\"))\n  (:section \"17.2 Combining Constraints and Searching\")\n  \"First let's test that we can find the possible labelings for a vertex class:\"\n  ((possible-labelings 'Y) @ 574 =>\n   ((+ + +) (- - -) (L R -) (- L R) (R - L)))\n  \"Notice how matrix-transpose works:\"\n  ((matrix-transpose (possible-labelings 'Y)) =>\n   ((+ - L - R)\n    (+ - R L -)\n    (+ - - R L)))\n  ((defdiagram cube\n     (a Y b c d)\n     (b W g e a)\n     (c W e f a)\n     (d W f g a)\n     (e L c b)\n     (f L d c)\n     (g L b d)) @ 575)\n  (:section \"17.3 Labelling Diagrams\")\n  \"We are now ready to try labelling diagrams.  First the cube:\"\n  ((print-labelings (diagram 'cube)) @ 577)\n  \"The cube should have given four solutions.\"\n  \"We can get down to one solution by grounding line GD:\"\n  ((print-labelings (ground (diagram 'cube) 'g 'd)) @ 580)\n  \"For the more complex cube on a plate, we get similar results;\"\n  \"Four interpretations, which turn to one after grounding line KM:\"\n  ((defdiagram cube-on-plate\n     (a Y b c d)\n     (b W g e a)\n     (c W e f a)\n     (d W f g a)\n     (e L c b)\n     (f Y d c i)\n     (g Y b d h)\n     (h W l g j)\n     (i W f m j)\n     (j Y h i k)\n     (k W m l j)\n     (l L h k)\n     (m L k i)) @ 581)\n  ((print-labelings (ground (diagram 'cube-on-plate) 'k 'm)) @ 582)\n  \"It is interesting to try the algorithm on an 'impossible' diagram.\"\n  \"It turns out the algorithm correctly finds no interpretation for this\"\n  \"well-known illusion:\"\n  ((defdiagram poiuyt\n     (a L b g)\n     (b L j a)\n     (c L d l)\n     (d L h c)\n     (e L f i)\n     (f L k e)\n     (g L a l)\n     (h L l d)\n     (i L e k)\n     (j L k b)\n     (k W j i f)\n     (l W h g c)) @ 583)\n  ((print-labelings (diagram 'poiuyt)) @ 583)\n  \"Now we try a more complex diagram:\"\n  ((defdiagram tower\n     (a Y b c d)    (n L q o)\n     (b W g e a)    (o W y j n)\n     (c W e f a)    (p L r i)\n     (d W f g a)    (q W n s w)\n     (e L c b)      (r W s p x)\n     (f Y d c i)    (s L r q)\n     (g Y b d h)    (t W w x z)\n     (h W l g j)    (u W x y z)\n     (i W f m p)    (v W y w z)\n     (j Y h o k)    (w Y t v q)\n     (k W m l j)    (x Y r u t)\n     (l L h k)      (y Y v u o)\n     (m L k i)      (z Y t u v)) @ 584)\n  ((print-labelings (ground (diagram 'tower) 'l 'k)) @ 584))\n\n(defexamples 18 \"Search and the Game of Othello\"\n  \"In this chapter we will develop a simplified Othello-playing program.\"\n  \"It will not be a champion, but is much better than beginning players.\"\n  (:section \"18.2 Representation Choices\")\n  ((requires \"othello\"))\n  \"First, we see that our choices for representing the board seem to work:\"\n  ((print-board (initial-board)) @ 604)\n  \"Now we can compare the weighted squares and count difference strategies\"\n  \"by playing two games, alternating who goes first.  The NIL as third argument\"\n  \"means don't print the board after each move.\"\n  ((othello (maximizer #'weighted-squares)\n         (maximizer #'count-difference) nil) @ 610)\n  ((othello (maximizer #'count-difference)\n            (maximizer #'weighted-squares) nil))\n\n  (:section \"18.4 Searching Ahead: Minimax\")\n  \"We can test the minimax strategy, and see that searching ahead 3 ply is\"\n  \"indeed better than looking at only 1 ply.  We can follow the whole game\"\n  ((othello (minimax-searcher 3 #'count-difference)\n            (maximizer #'count-difference)) @ 614 => 53)\n\n  (:section \"18.5 Smarter Searching: Alpha-Beta Search\")\n  \"The following should produce the same result, only faster:\"\n  ((othello (alpha-beta-searcher 3 #'count-difference)\n\t (maximizer #'count-difference) nil) => 53)\n\n  (:section \"18.8 Playing a Series of Games\")\n  \"A single game is not enough to establish that one strategy is better than\"\n  \"another.  The function RANDOM-OTHELLO-SERIES allows two strategies to\"\n  \"compete in a series of games.\"\n  ((requires \"othello2\"))\n  ((random-othello-series\n    (alpha-beta-searcher 2 #'weighted-squares)\n    (alpha-beta-searcher 2 #'modified-weighted-squares)\n    5) @ 628)\n  \"Here is a comparison of five strategies that search only 1 ply.\"\n  \"To save time, we run 2 pairs of games each, not 5 pairs.\"\n  ((round-robin\n   (list (maximizer #'count-difference)\n         (maximizer #'mobility)\n         (maximizer #'weighted-squares)\n         (maximizer #'modified-weighted-squares)\n         #'random-strategy)\n   2 10\n   '(count-difference mobility weighted modified-weighted random)) @ 629)\n  \"Now we compare alpha-beta searchers at 3 ply for 1 pair of games each.\"\n  \"In the book it was 4 ply for 5 pairs each, but that takes too long.\"\n  ((round-robin\n   (list (alpha-beta-searcher 3 #'count-difference)\n         (alpha-beta-searcher 3 #'weighted-squares)\n         (alpha-beta-searcher 3 #'modified-weighted-squares)\n         #'random-strategy)\n   1 10\n   '(count-difference weighted modified-weighted random)))\n  )\n\n(defexamples 19 \"Introduction to Natural Language\"\n  \"This chapter is a brief introduction to natural language processing.\"\n  (:section \"19.1 Parsing with a Phrase-Structure Grammar\")\n  \"We start with the grammar defined on page 39 for the GENERATE program.\"\n  \"I include 'noun' and 'verb' as nouns in the grammar *grammar3*\"\n  ((requires \"syntax1\"))\n  (*grammar3* @ 657)\n  ((use *grammar3*))\n  ((parser '(the table)) => ((NP (ART THE) (NOUN TABLE))))\n  ((parser '(the ball hit the table)) =>\n   ((SENTENCE (NP (ART THE) (NOUN BALL))\n\t      (VP (VERB HIT)\n\t\t  (NP (ART THE) (NOUN TABLE))))))\n  ((parser '(the noun took the verb)) =>\n   ((SENTENCE (NP (ART THE) (NOUN NOUN))\n\t      (VP (VERB TOOK)\n\t\t  (NP (ART THE) (NOUN VERB))))))\n  \"The range of sentences we can parse is quite limited.\"\n  \"The following grammar includes a wider variety.\"\n  (*grammar4* @ 661)\n  ((use *grammar4*))\n  ((parser '(The man hit the table with the ball)) =>\n   ((S (NP (D THE) (N MAN))\n       (VP (VP (V HIT) (NP (D THE) (N TABLE)))\n\t   (PP (P WITH) (NP (D THE) (N BALL)))))\n    (S (NP (D THE) (N MAN))\n       (VP (V HIT)\n\t   (NP (NP (D THE) (N TABLE))\n\t       (PP (P WITH) (NP (D THE) (N BALL))))))))\n  \"Here we see a phrase that is ambiguous between a sentence and a noun phrase:\"\n  ((parser '(the orange saw)) @ 662 =>\n   ((S (NP (D THE) (N ORANGE)) (VP (V SAW)))\n    (NP (D THE) (A+ (A ORANGE)) (N SAW))))\n\n  (:section \"19.4 The Unknown-Word Problem\")\n  \"As it stands, the parser cannot deal with unknown words.\"\n  \"One way of treating unknown words is to allow them to be any of the\"\n  \"'open-class' categories--nouns, verbs, adjectives, and names.\"\n  ((parser '(John liked Mary)) @ 664 =>\n   ((S (NP (NAME JOHN))\n       (VP (V LIKED) (NP (NAME MARY))))))\n  ((parser '(Dana liked Dale)) @ 665 =>\n   ((S (NP (NAME DANA))\n       (VP (V LIKED) (NP (NAME DALE))))))\n  \"We see the parser works as well with words it knows (John and Mary)\"\n  \"as with new words (Dana and Dale), which it can recognize as names\"\n  \"because of their position in the sentence.\"\n  ((parser '(the rab zaggled the woogly quax)) =>\n   ((S (NP (D THE) (N RAB))\n       (VP (V ZAGGLED) (NP (D THE) (A+ (A WOOGLY)) (N QUAX))))))\n  ((parser '(the slithy toves gymbled)) =>\n   ((S (NP (D THE) (N SLITHY)) (VP (V TOVES) (NP (NAME GYMBLED))))\n    (S (NP (D THE) (A+ (A SLITHY)) (N TOVES)) (VP (V GYMBLED)))\n    (NP (D THE) (A+ (A SLITHY) (A+ (A TOVES))) (N GYMBLED))))\n  ((parser '(the slithy toves gymbled on the wabe)) =>\n   ((S (NP (D THE) (N SLITHY))\n       (VP (VP (V TOVES) (NP (NAME GYMBLED)))\n\t   (PP (P ON) (NP (D THE) (N WABE)))))\n    (S (NP (D THE) (N SLITHY))\n       (VP (V TOVES) (NP (NP (NAME GYMBLED))\n\t\t\t (PP (P ON) (NP (D THE) (N WABE))))))\n    (S (NP (D THE) (A+ (A SLITHY)) (N TOVES))\n       (VP (VP (V GYMBLED)) (PP (P ON) (NP (D THE) (N WABE)))))\n    (NP (NP (D THE) (A+ (A SLITHY) (A+ (A TOVES))) (N GYMBLED))\n\t(PP (P ON) (NP (D THE) (N WABE))))))\n  (:section \"19.5 Parsing into a Semantic Representation\")\n  ((requires \"syntax2\"))\n  \"Syntactic parse trees of a sentence may be interesting, but by themselves\"\n  \"they're not very useful.  We use sentences to communicate ideas, not to\"\n  \"display grammatical structures.\"\n  \"\"\n  \"Imagine a compact disc player for which you can punch buttons like\"\n  \"'play 1 to 5 without 3'.  We will define such a language.\"\n  \"The meaning of a sentence in the language is the list of tracks played.\"\n  (*grammar5* @ 667)\n  ((use *grammar5*))\n  ((meanings '(1 to 5 without 3)) @ 669 => ((1 2 4 5)))\n  ((meanings '(1 to 4 and 7 to 9)) => ((1 2 3 4 7 8 9)))\n  ((meanings '(1 to 6 without 3 and 4)) => ((1 2 4 5 6) (1 2 5 6)))\n  \"The example '1 to 6 without 3 and 4' is ambiguous.\"\n  \"The syntactic ambiguity leads to a semantic ambiguity.\"\n  \"We can define a new grammar that eliminates some ambiguities:\"\n  (*grammar6* @ 669)\n  ((use *grammar6*))\n  \"With this new grammar, we can get single interpretations out of most inputs\"\n  ((meanings '(1 to 6 without 3 and 4)) => ((1 2 5 6)))\n  ((meanings '(1 and 3 to 7 and 9 without 5 and 6)) => ((1 3 4 7 9)))\n  ((meanings '(1 and 3 to 7 and 9 without 5 and 2)) => ((1 3 4 6 7 9 2)))\n  ((meanings '(1 9 8 to 2 0 1)) => ((198 199 200 201)))\n  ((meanings '(1 2 3)) => (123 (123)))\n\n  (:section \"19.6 Parsing with Preferences\")\n  ((requires \"syntax3\"))\n  \"We need some compromise between the permissive grammar, which generated\"\n  \"all possible parses, and the restrictive grammar, which eliminates too\"\n  \"many parses.  To get the 'best' interpretation we will need not only a\"\n  \"new grammar, we will also need to modify the program to compare the\"\n  \"relative worth of candidate interpretations.\"\n  (*grammar7* @ 673)\n  ((use *grammar7*))\n  \"We will need a way to show off the prefernce rankings:\"\n  ((all-parses '(1 to 6 without 3 and 4)) @ 675)\n  ((all-parses '(1 and 3 to 7 and 9 without 5 and 6)))\n  ((all-parses '(1 and 3 to 7 and 9 without 5 and 2)) @ 676)\n  \"In each case, the preference rules are able to assign higher scores to\"\n  \"more reasonable interpretations.  What we really want is to pick the best.\"\n  \"Here we see some examples:\"\n  ((meaning '(1 to 5 without 3 and 4)) => (1 2 5))\n  ((meaning '(1 to 5 without 3 and 6)) => (1 2 4 5 6))\n  ((meaning '(1 to 5 without 3 and 6 shuffled)))\n  ((meaning '([ 1 to 5 without [ 3 and 6 ] ] reversed)) => (5 4 2 1))\n  ((meaning '(1 to 5 to 9)) => NIL)\n  )\n\n\n(defexamples 20 \"Unification Grammars\"\n  \"Prolog was invented as a formalism to describe the grammar of French.\"\n  \"It is still useful to view a grammar as a set of logic programming clauses.\"\n  \"This chapter describes how that can be done.\"\n  ((requires \"unifgram\"))\n  (:section \"20.3 A Simple Grammar in DCG Format\")\n  \"Here is the trivial grammar from page 688 in DCG format:\"\n  ((clear-db))\n  ((rule (S (?pred ?subj)) -->\n\t (NP ?agr ?subj)\n\t (VP ?agr ?pred)) @ 692)\n  ((rule (NP ?agr (?det ?n)) -->\n\t (Det ?agr ?det)\n\t (N ?agr ?n)))\n  ((rule (NP 3sg (the male))          --> (:word he)) @ 693)\n  ((rule (NP ~3sg (some objects))     --> (:word they)))\n  ((rule (VP 3sg sleep)               --> (:word sleeps)))\n  ((rule (VP ~3sg sleep)              --> (:word sleep)))\n  ((rule (Det ?any the)               --> (:word the)))\n  ((rule (N 3sg (young male human))   --> (:word boy)))\n  ((rule (N 3sg (young female human)) --> (:word girl)))\n  \"We can parse some of the sentences from page 689 (but in DCG format).\"\n  \"Parsing:\"\n  ((?- (S ?sem (He sleeps) ())) :input \".\")\n  \"Generating:\"\n  ((?- (S (sleep (the male)) ?words  ())) :input \".\")\n  \"Enumerating:\"\n  ((?- (S ?sem ?words ())) :input \";;;;\")\n  \"If we want the interpretation of 'Terry kisses Jean' to be\"\n  \"(kiss Terry Jean) not ((lambda (x) (kiss x Jean)) Terry), then we need\"\n  \"a way to unify semantic components together.  Here's one way:\"\n  ((clear-db))\n  ((rule (S ?pred) -->\n\t (NP ?agr ?subj)\n\t (VP ?agr ?subj ?pred)) @ 694)\n  ((rule (VP ?agr ?subj ?pred) -->\n\t (Verb/tr ?agr ?subj ?pred ?obj)\n\t (NP ?any-agr ?obj)))\n  ((rule (VP ?agr ?subj ?pred) -->\n\t (Verb/intr ?agr ?subj ?pred)))\n\n  ((rule (Verb/tr ~3sg ?x (kiss ?x ?y) ?y) --> (:word kiss)))\n  ((rule (Verb/tr 3sg ?x (kiss ?x ?y) ?y) --> (:word kisses)))\n  ((rule (Verb/tr ?any  ?x (kiss ?x ?y) ?y) --> (:word kissed)))\n\n  ((rule (Verb/intr ~3sg ?x (sleep ?x)) --> (:word sleep)))\n  ((rule (Verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps)))\n  ((rule (Verb/intr ?any  ?x (sleep ?x)) --> (:word slept)))\n\n  \"Here are the rules for noun phrases and nouns\"\n  ((rule (NP ?agr ?sem) -->\n\t (Name ?agr ?sem)))\n  ((rule (NP ?agr (?det-sem ?noun-sem)) -->\n\t (Det ?agr ?det-sem)\n\t (Noun ?agr ?noun-sem)))\n\n  ((rule (Name 3sg Terry) --> (:word Terry)))\n  ((rule (Name 3sg Jean)  --> (:word Jean)))\n\n  ((rule (Noun 3sg (young male human))           --> (:word boy)) @ 695)\n  ((rule (Noun 3sg (young female human))         --> (:word girl)))\n  ((rule (Noun ~3sg (group (young male human)))   --> (:word boys)))\n  ((rule (Noun ~3sg (group (young female human))) --> (:word girls)))\n\n  ((rule (Det ?any the)  --> (:word the)))\n  ((rule (Det 3sg a) --> (:word a)))\n\n  \"This grammar and lexicon generates more sentences, although it is still\"\n  \"rather limited.  Here are some examples:\"\n\n  ((?- (S ?sem (The boys kiss a girl) ())) @ 695 :input \";.\")\n  ((?- (S ?sem (The girls kissed the girls) ())) :input \";.\")\n  ((?- (S ?sem (Terry kissed the girl) ())) :input \";.\")\n  ((?- (S ?sem (The girls kisses the boys) ())) :input \";.\")\n  ((?- (S ?sem (Terry kissed a girls) ())) :input \";.\")\n  ((?- (S ?sem (Terry sleeps Jean) ())) :input \";.\")\n\n  (:section \"20.4 A DCG Grammar with Quantifiers\")\n  ((clear-db))\n  ((rule (Det ?any ?x ?p ?q (the ?x (and ?p ?q)))    --> (:word the)) @ 697)\n  ((rule (Det 3sg  ?x ?p ?q (exists ?x (and ?p ?q))) --> (:word a)))\n  ((rule (Det 3sg  ?x ?p ?q (all    ?x (-> ?p ?q)))  --> (:word every)))\n\n  ((rule (Noun 3sg ?x (picture ?x)) --> (:word picture)) @ 698)\n  ((rule (Noun 3sg ?x (story ?x)) --> (:word story)))\n  ((rule (Noun 3sg ?x (and (young ?x) (male ?x) (human ?x))) -->\n\t (:word boy)))\n\n  ((rule (NP ?agr ?x ?pred ?pred) -->\n\t (Name ?agr ?name)))\n\n  ((rule (NP ?agr ?x ?pred ?np) -->\n\t (Det ?agr ?x ?noun&rel ?pred ?np)\n\t (Noun ?agr ?x ?noun)\n\t (rel-clause ?agr ?x ?noun ?noun&rel)))\n\n  ((rule (rel-clause ?agr ?x ?np ?np) --> ))\n  ((rule (rel-clause ?agr ?x ?np (and ?np ?rel)) -->\n\t (:word that)\n\t (VP ?agr ?x ?rel)))\n\n  ((rule (Verb/tr ~3sg ?x ?y (paint ?x ?y)) --> (:word paint)) @ 699)\n  ((rule (Verb/tr 3sg  ?x ?y (paint ?x ?y)) --> (:word paints)))\n  ((rule (Verb/tr ?any ?x ?y (paint ?x ?y)) --> (:word painted)))\n\n  ((rule (Verb/intr ~3sg ?x (sleep ?x)) --> (:word sleep)))\n  ((rule (Verb/intr 3sg  ?x (sleep ?x)) --> (:word sleeps)))\n  ((rule (Verb/intr ?any ?x (sleep ?x)) --> (:word slept)))\n\n  ((rule (Verb/intr 3sg  ?x (sells ?x)) --> (:word sells)))\n  ((rule (Verb/intr 3sg  ?x (stinks ?x)) --> (:word stinks)))\n\n  ((rule (VP ?agr ?x ?vp) -->\n\t (Verb/tr ?agr ?x ?obj ?verb)\n\t (NP ?any-agr ?obj ?verb ?vp)))\n\n  ((rule (VP ?agr ?x ?vp) -->\n\t (Verb/intr ?agr ?x ?vp)))\n\n  ((rule (S ?np) -->\n\t (NP ?agr ?x ?vp ?np)\n\t (VP ?agr ?x ?vp)))\n\n  \"Now we define a function to show the output from a query.\"\n  \"In the book, you just saw the output of such a function.\"\n  ((defun do-s (words)\n     (top-level-prove `((S ?sem ,words ())))))\n\n  ((do-s '(Every picture paints a story)) :input \".\" @ 699)\n  ((do-s '(Every boy that paints a picture sleeps)) :input \".\")\n  ((do-s '(Every boy that sleeps paints a picture)) :input \".\")\n  ((do-s '(Every boy that paints a picture that sells paints a picture\n\t\t that stinks)) :input \".\" @ 700)\n\n  (:section \"20.5 Preserving Quantifier Scope Ambiguity\")\n  ((clear-db))\n  ((rule (S (and ?np ?vp)) -->\n\t (NP ?agr ?x ?np)\n\t (VP ?agr ?x ?vp)) @ 701)\n\n  ((rule (VP ?agr ?x (and ?verb ?obj)) -->\n\t (Verb/tr ?agr ?x ?o ?verb)\n\t (NP ?any-agr ?o ?obj)))\n\n  ((rule (VP ?agr ?x ?verb) -->\n\t (Verb/intr ?agr ?x ?verb)))\n\n  ((rule (NP ?agr ?name t) -->\n\t (Name ?agr ?name)))\n\n  ((rule (NP ?agr ?x ?det) -->\n\t (Det ?agr ?x (and ?noun ?rel) ?det)\n\t (Noun ?agr ?x ?noun)\n\t (rel-clause ?agr ?x ?rel)))\n\n  ((rule (rel-clause ?agr ?x t) --> ))\n  ((rule (rel-clause ?agr ?x ?rel) -->\n\t (:word that)\n\t (VP ?agr ?x ?rel)))\n\n  ((rule (Name 3sg Terry)                     --> (:word Terry)))\n  ((rule (Name 3sg Jean)                      --> (:word Jean)))\n  ((rule (Det 3sg  ?x ?restr (all ?x ?restr)) --> (:word every)))\n  ((rule (Noun 3sg ?x (man ?x))               --> (:word man)))\n  ((rule (Verb/tr 3sg ?x ?y (love ?x ?y))     --> (:word loves)))\n  ((rule (Verb/intr 3sg ?x (lives ?x))        --> (:word lives)))\n  ((rule (Det 3sg  ?x ?res (exists ?x ?res))  --> (:word a)))\n  ((rule (Noun 3sg ?x (woman ?x))             --> (:word woman)))\n\n  \"Here is an example of the new representation:\"\n  ((do-s '(every man loves a woman)) :input \".\" @ 701)\n  )\n\n(defexamples 21 \"A Grammar of English\"\n  ((if (boundp 'clear-db) (clear-db)) @ 715)\n  ((requires \"grammar\" \"lexicon\"))\n  ((prolog-compile-symbols))\n  (:section \"21.10 Word Categories\")\n  ((?- (word sees verb ?infl ?senses)) :input \".\")\n  ((try S John promised Kim to persuade Lee to sleep) :input \";;;.\")\n  (:section \"21.14 Examples\")\n  ((try S When did John promise Kim to persuade Lee to sleep)\n   @ 746 :input \";;;.\")\n  ((try S Kim would not have been looking for Lee) @ 747 :input \";;;.\")\n  ((try s It should not surprise you that Kim does not like Lee) :input \";;;.\")\n  )\n\n(defexamples 22 \"Scheme: An Uncommon Lisp\"\n  \"This chapter presents the Scheme dialect of Lisp and an interpreter for it.\"\n  \"Understanding the interpreter can give you a better appreciation of Lisp.\"\n  (:section \"22.1 A Scheme Interpreter\")\n  ((requires \"interp1\"))\n  \"We're ready to try out the interpreter.  Note we provide an argument\"\n  \"to avoid going into a read-eval-print loop with SCHEME.  This is a new\"\n  \"functionality, no in the book, added to make these examples easier.\"\n  ((scheme '(+ 2 2)) @ 760 => 4 )\n  ((scheme '((if (= 1 2) * +) 3 4)) => 7)\n  ((scheme '((if (= 1 1) * +) 3 4)) => 12 @ 761)\n  ((scheme '(set! fact (lambda (n) (if (= n 0) 1\n\t\t\t\t     (* n (fact (- n 1))))))))\n  ((scheme '(fact 5)) => 120)\n  ((scheme '(set! table (lambda (f start end)\n\t\t\t  (if (<= start end)\n\t\t\t      (begin\n\t\t\t       (write (list start (f start)))\n\t\t\t       (newline)\n\t\t\t       (table f (+ start 1) end)))))))\n\n  ((scheme '(table fact 1 10)) => NIL )\n  ((scheme '(table (lambda (x) (* x x x)) 5 10)) => NIL)\n\n  (:section \"22.2 Syntactic Extension with Macros\")\n  \"Scheme has a number of special forms that were not listed above.\"\n  \"These can be implemented by macros (although macros are not officially\"\n  \"part of Scheme).  We can test out the macro facility:\"\n  ((scheme-macro-expand '(and p q)) => (IF P (AND Q)) @ 765)\n  ((scheme-macro-expand '(and q)) => Q)\n  ((scheme-macro-expand '(let ((x 1) (y 2)) (+ x y))) =>\n   ((LAMBDA (X Y) (+ X Y)) 1 2))\n  ((scheme-macro-expand\n    '(letrec\n      ((even? (lambda (x) (or (= x 0) (odd? (- x 1)))))\n       (odd?  (lambda (x) (even? (- x 1)))))\n      (even? z))))\n  \"Now let's look at uses of the macros DEFINE and LET*\"\n  ((scheme '(define (reverse l)\n\t      (if (null? l) nil\n\t\t(append (reverse (cdr l)) (list (car l)))))) => REVERSE)\n  ((scheme '(reverse '(a b c d))) => (D C B A))\n  ((scheme '(let* ((x 5) (y (+ x x)))\n\t      (if (or (= x 0) (and (< 0 y) (< y 20)))\n\t\t  (list x y)\n\t\t(+ y x)))) => (5 10))\n\n\n  (:section \"22.4 Throw, Catch, and Call/cc\")\n  ((requires \"interp3\"))\n  \"Non-local flow of control is provided in Scheme with a very general and\"\n  \"powerful procedure, CALL-WITH-CURRENT-CONTINUATION, which is often\"\n  \"abbreviated CALL/CC.  Here are some examples:\"\n  ((scheme '(+ 1 (call/cc (lambda (cc) (+ 20 300))))) @ 770 => 321)\n  \"The above example ignores CC and computes (+ 1 (+ 20 300))\"\n  \"The next example does make use of CC:\"\n  ((scheme '(+ 1 (call/cc (lambda (cc) (+ 20 (cc 300)))))) => 301)\n  \"The above passes 300 to CC, thus bypassing the addition of 20.\"\n  \"It effectively throws 300 out to the catch point established by call/cc.\"\n  )\n\n(defexamples 23 \"Compiling Lisp\"\n  \"Compilers are simple to write and useful to know about.\"\n  \"In this chapter we develop a simple compiler for Scheme.\"\n  \"\"\n  ((requires \"compile1\"))\n  \"Now we are ready to show the simple compiler at work:\"\n  ((comp-show '(if (= x y) (f (g x)) (h x y (h 1 2)))) @ 791)\n  \"Here are some places where a compiler could do better than an interpreter\"\n  \"(although our compiler currently does not):\"\n  ((comp-show '(begin \"doc\" (write x) y)) @ 792)\n  \"We should not have to push 'doc' on the stack just to pop it off.\"\n  \"Here's another example:\"\n  ((comp-show '(begin (+ (* a x) (f x)) x)))\n  \"Here's an example using local variables:\"\n  ((comp-show '((lambda (x) ((lambda (y z) (f x y z)) 3 x)) 4)) @ 794)\n  (:section \"23.1 A Properly Tail-Recursive Compiler\")\n  \"Notice the two new instructions, CALLJ and SAVE\"\n  ((requires \"compile2\"))\n  \"First we see how nested function calls work:\"\n  ((comp-show '(f (g x))) @ 796)\n  \"In the next example we see that unneeded constants and variables in BEGIN\"\n  \"expressions are ignored:\"\n  ((comp-show '(begin \"doc\" x (f x) y)) @ 797)\n  ((comp-show '(begin (+ (* a x) (f x)) x)))\n  \"Here are some examples of IF expressions:\"\n  ((comp-show '(if p (+ x y) (* x y))) @ 801)\n  \"If we put the same code inside a BEGIN we get something quite different:\"\n  ((comp-show '(begin (if p (+ x y) (* x y)) z)) @ 802)\n  \"Here are some more examples of the compiler at work:\"\n  ((comp-show '(if (null? (car l)) (f (+ (* a x) b))\n                  (g (/ x 2)))) @ 806)\n  ((comp-show '(define (last1 l)\n                (if (null? (cdr l)) (car l)\n                    (last1 (cdr l))))) @ 807)\n  ((comp-show '(define (length l)\n                (if (null? l) 0 (+ 1 (length (cdr l)))))) @ 808)\n  \"Of course, it is possible to write LENGTH in tail-recursive fashion:\"\n  ((comp-show '(define (length l)\n                (letrec ((len (lambda (l n)\n                                (if (null? l) n\n                                    (len (rest l) (+ n 1))))))\n                  (len l 0)))))\n  (:section \"23.4 A Peephole Optimizer\")\n  \"In this section we investigate a simple technique that will generate\"\n  \"slightly better code in cases where the compiler is less than perfect.\"\n  ((requires \"compile3\"  \"compopt\"))\n  ((comp-show '(begin (if (if t 1 (f x)) (set! x 2)) x)) @ 818)\n  )\n"
  },
  {
    "path": "lisp/gps-srch.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File gps-srch.lisp: Section 6.4 GPS based on explicit search\n\n(requires \"gps\" \"search\")\n\n(defun search-gps (start goal &optional (beam-width 10))\n  \"Search for a sequence of operators leading to goal.\"\n  (find-all-if\n    #'action-p\n    (beam-search\n      (cons '(start) start)\n      #'(lambda (state) (subsetp goal state :test #'equal))\n      #'gps-successors\n      #'(lambda (state)\n          (+ (count-if #'action-p state)\n             (count-if #'(lambda (con)\n                           (not (member-equal con state)))\n                       goal)))\n      beam-width)))\n\n(defun gps-successors (state)\n  \"Return a list of states reachable from this one using ops.\"\n  (mapcar\n    #'(lambda (op)\n        (append\n          (remove-if #'(lambda (x)\n                         (member-equal x (op-del-list op)))\n                     state)\n          (op-add-list op)))\n    (applicable-ops state)))\n\n(defun applicable-ops (state)\n  \"Return a list of all ops that are applicable now.\"\n  (find-all-if\n    #'(lambda (op)\n        (subsetp (op-preconds op) state :test #'equal))\n    *ops*))\n\n"
  },
  {
    "path": "lisp/gps.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File gps.lisp: Final version of GPS\n\n(requires \"gps1\")\n\n;;; ==============================\n\n(defun executing-p (x)\n  \"Is x of the form: (executing ...) ?\"\n  (starts-with x 'executing))\n\n(defun starts-with (list x)\n  \"Is this a list whose first element is x?\"\n  (and (consp list) (eql (first list) x)))\n\n(defun convert-op (op)\n  \"Make op conform to the (EXECUTING op) convention.\"\n  (unless (some #'executing-p (op-add-list op))\n    (push (list 'executing (op-action op)) (op-add-list op)))\n  op)\n\n(defun op (action &key preconds add-list del-list)\n  \"Make a new operator that obeys the (EXECUTING op) convention.\"\n  (convert-op\n    (make-op :action action :preconds preconds\n             :add-list add-list :del-list del-list)))\n\n;;; ==============================\n\n(mapc #'convert-op *school-ops*)\n\n;;; ==============================\n\n(defvar *ops* nil \"A list of available operators.\")\n\n(defstruct op \"An operation\"\n  (action nil) (preconds nil) (add-list nil) (del-list nil))\n\n(defun GPS (state goals &optional (*ops* *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (remove-if #'atom (achieve-all (cons '(start) state) goals nil)))\n\n;;; ==============================\n\n(defun achieve-all (state goals goal-stack)\n  \"Achieve each goal, and make sure they still hold at the end.\"\n  (let ((current-state state))\n    (if (and (every #'(lambda (g)\n                        (setf current-state\n                              (achieve current-state g goal-stack)))\n                    goals)\n             (subsetp goals current-state :test #'equal))\n        current-state)))\n\n(defun achieve (state goal goal-stack)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Goal: ~a\" goal)\n  (cond ((member-equal goal state) state)\n        ((member-equal goal goal-stack) nil)\n        (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n                 (find-all goal *ops* :test #'appropriate-p)))))\n\n;;; ==============================\n\n(defun member-equal (item list)\n  (member item list :test #'equal))\n\n;;; ==============================\n\n(defun apply-op (state goal op goal-stack)\n  \"Return a new, transformed state if op is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Consider: ~a\" (op-action op))\n  (let ((state2 (achieve-all state (op-preconds op)\n                             (cons goal goal-stack))))\n    (unless (null state2)\n      ;; Return an updated state\n      (dbg-indent :gps (length goal-stack) \"Action: ~a\" (op-action op))\n      (append (remove-if #'(lambda (x)\n                             (member-equal x (op-del-list op)))\n                         state2)\n              (op-add-list op)))))\n\n(defun appropriate-p (goal op)\n  \"An op is appropriate to a goal if it is in its add list.\"\n  (member-equal goal (op-add-list op)))\n\n;;; ==============================\n\n(defun use (oplist)\n  \"Use oplist as the default list of operators.\"\n  ;; Return something useful, but not too verbose:\n  ;; the number of operators.\n  (length (setf *ops* oplist)))\n\n;;; ==============================\n\n(defparameter *banana-ops*\n  (list\n    (op 'climb-on-chair\n        :preconds '(chair-at-middle-room at-middle-room on-floor)\n        :add-list '(at-bananas on-chair)\n        :del-list '(at-middle-room on-floor))\n    (op 'push-chair-from-door-to-middle-room\n        :preconds '(chair-at-door at-door)\n        :add-list '(chair-at-middle-room at-middle-room)\n        :del-list '(chair-at-door at-door))\n    (op 'walk-from-door-to-middle-room\n        :preconds '(at-door on-floor)\n        :add-list '(at-middle-room)\n        :del-list '(at-door))\n    (op 'grasp-bananas\n        :preconds '(at-bananas empty-handed)\n        :add-list '(has-bananas)\n        :del-list '(empty-handed))\n    (op 'drop-ball\n        :preconds '(has-ball)\n        :add-list '(empty-handed)\n        :del-list '(has-ball))\n    (op 'eat-bananas\n        :preconds '(has-bananas)\n        :add-list '(empty-handed not-hungry)\n        :del-list '(has-bananas hungry))))\n\n;;; ==============================\n\n(defun make-maze-ops (pair)\n  \"Make maze ops in both directions\"\n  (list (make-maze-op (first pair) (second pair))\n        (make-maze-op (second pair) (first pair))))\n\n(defun make-maze-op (here there)\n  \"Make an operator to move between two places\"\n  (op `(move from ,here to ,there)\n      :preconds `((at ,here))\n      :add-list `((at ,there))\n      :del-list `((at ,here))))\n\n(defparameter *maze-ops*\n  (mappend #'make-maze-ops\n     '((1 2) (2 3) (3 4) (4 9) (9 14) (9 8) (8 7) (7 12) (12 13)\n       (12 11) (11 6) (11 16) (16 17) (17 22) (21 22) (22 23)\n       (23 18) (23 24) (24 19) (19 20) (20 15) (15 10) (10 5) (20 25))))\n\n;;; ==============================\n\n(defun GPS (state goals &optional (*ops* *ops*))\n  \"General Problem Solver: from state, achieve goals using *ops*.\"\n  (find-all-if #'action-p\n               (achieve-all (cons '(start) state) goals nil)))\n\n(defun action-p (x)\n  \"Is x something that is (start) or (executing ...)?\"\n  (or (equal x '(start)) (executing-p x)))\n\n;;; ==============================\n\n(defun find-path (start end)\n  \"Search a maze for a path from start to end.\"\n  (let ((results (GPS `((at ,start)) `((at ,end)))))\n    (unless (null results)\n      (cons start (mapcar #'destination\n                          (remove '(start) results\n                                  :test #'equal))))))\n\n(defun destination (action)\n  \"Find the Y in (executing (move from X to Y))\"\n  (fifth (second action)))\n\n;;; ==============================\n\n(defun make-block-ops (blocks)\n  (let ((ops nil))\n    (dolist (a blocks)\n      (dolist (b blocks)\n        (unless (equal a b)\n          (dolist (c blocks)\n            (unless (or (equal c a) (equal c b))\n              (push (move-op a b c) ops)))\n          (push (move-op a 'table b) ops)\n          (push (move-op a b 'table) ops))))\n    ops))\n\n(defun move-op (a b c)\n  \"Make an operator to move A from B to C.\"\n  (op `(move ,a from ,b to ,c)\n      :preconds `((space on ,a) (space on ,c) (,a on ,b))\n      :add-list (move-ons a b c)\n      :del-list (move-ons a c b)))\n\n(defun move-ons (a b c)\n  (if (eq b 'table)\n      `((,a on ,c))\n      `((,a on ,c) (space on ,b))))\n\n\n;;; ==============================\n\n(defun achieve-all (state goals goal-stack)\n  \"Achieve each goal, trying several orderings.\"\n  (some #'(lambda (goals) (achieve-each state goals goal-stack))\n        (orderings goals)))\n\n(defun achieve-each (state goals goal-stack)\n  \"Achieve each goal, and make sure they still hold at the end.\"\n  (let ((current-state state))\n    (if (and (every #'(lambda (g)\n                        (setf current-state\n                              (achieve current-state g goal-stack)))\n                    goals)\n             (subsetp goals current-state :test #'equal))\n        current-state)))\n\n(defun orderings (l)\n  (if (> (length l) 1)\n      (list l (reverse l))\n      (list l)))\n\n;;; ==============================\n\n(defun achieve (state goal goal-stack)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (dbg-indent :gps (length goal-stack) \"Goal: ~a\" goal)\n  (cond ((member-equal goal state) state)\n        ((member-equal goal goal-stack) nil)\n        (t (some #'(lambda (op) (apply-op state goal op goal-stack))\n                 (appropriate-ops goal state))))) ;***\n\n(defun appropriate-ops (goal state)\n  \"Return a list of appropriate operators,\n  sorted by the number of unfulfilled preconditions.\"\n  (sort (copy-list (find-all goal *ops* :test #'appropriate-p)) #'<\n        :key #'(lambda (op)\n                 (count-if #'(lambda (precond)\n                               (not (member-equal precond state)))\n                           (op-preconds op)))))\n\n;;; ==============================\n\n(defun permutations (bag)\n  \"Return a list of all the permutations of the input.\"\n  ;; If the input is nil, there is only one permutation:\n  ;; nil itself\n  (if (null bag)\n      '(())\n      ;; Otherwise, take an element, e, out of the bag.\n      ;; Generate all permutations of the remaining elements,\n      ;; And add e to the front of each of these.\n      ;; Do this for all possible e to generate all permutations.\n      (mapcan #'(lambda (e)\n                  (mapcar #'(lambda (p) (cons e p))\n                          (permutations\n                            (remove e bag :count 1 :test #'eq))))\n              bag)))\n\n;;; ==============================\n\n"
  },
  {
    "path": "lisp/gps1.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File gps1.lisp: First version of GPS (General Problem Solver)\n\n(defvar *state* nil \"The current state: a list of conditions.\")\n\n(defvar *ops* nil \"A list of available operators.\")\n\n(defstruct op \"An operation\"\n  (action nil) (preconds nil) (add-list nil) (del-list nil))\n\n(defun GPS (*state* goals *ops*)\n  \"General Problem Solver: achieve all goals using *ops*.\"\n  (if (every #'achieve goals) 'solved))\n\n(defun achieve (goal)\n  \"A goal is achieved if it already holds,\n  or if there is an appropriate op for it that is applicable.\"\n  (or (member goal *state*)\n      (some #'apply-op\n            (find-all goal *ops* :test #'appropriate-p))))\n\n(defun appropriate-p (goal op)\n  \"An op is appropriate to a goal if it is in its add list.\"\n  (member goal (op-add-list op)))\n\n(defun apply-op (op)\n  \"Print a message and update *state* if op is applicable.\"\n  (when (every #'achieve (op-preconds op))\n    (print (list 'executing (op-action op)))\n    (setf *state* (set-difference *state* (op-del-list op)))\n    (setf *state* (union *state* (op-add-list op)))\n    t))\n\n;;; ==============================\n\n(defparameter *school-ops*\n  (list\n    (make-op :action 'drive-son-to-school\n         :preconds '(son-at-home car-works)\n         :add-list '(son-at-school)\n         :del-list '(son-at-home))\n    (make-op :action 'shop-installs-battery\n         :preconds '(car-needs-battery shop-knows-problem shop-has-money)\n         :add-list '(car-works))\n    (make-op :action 'tell-shop-problem\n         :preconds '(in-communication-with-shop)\n         :add-list '(shop-knows-problem))\n    (make-op :action 'telephone-shop\n         :preconds '(know-phone-number)\n         :add-list '(in-communication-with-shop))\n    (make-op :action 'look-up-number\n         :preconds '(have-phone-book)\n         :add-list '(know-phone-number))\n    (make-op :action 'give-shop-money\n         :preconds '(have-money)\n         :add-list '(shop-has-money)\n         :del-list '(have-money))))\n"
  },
  {
    "path": "lisp/grammar.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File grammar.lisp:  The grammar of English given in Chapter 21.\n\n(requires \"unifgram\" \"lexicon\")\n\n(rule (NP ?agr (common ?) -wh ?x ?g1 ?g1 (the ?x (name ?name ?x))) ==>\n  (name ?agr ?name))\n\n(rule (NP ?agr ?case ?wh ?x ?g1 ?g1 ?sem) ==>\n  (pronoun ?agr ?case ?wh ?x ?sem))\n\n(rule (NP (- - - +) ?case -wh ?x ?g1 ?g2 (group ?x ?sem)) ==>\n  (:ex \"dogs\") ; Plural nouns don't need a determiner\n  (NP2 (- - - +) ?case ?x ?g1 ?g2 ?sem))\n\n(rule (NP ?agr (common ?) ?wh ?x ?g1 ?g2 ?sem) ==>\n  (:ex \"Every man\" \"The dogs on the beach\")\n  (Det ?agr ?wh ?x ?restriction ?sem)\n  (NP2 ?agr (common ?) ?x ?g1 ?g2 ?restriction))\n\n(rule (NP ?agr ?case ?wh ?x (gap (NP ?agr ?case ?x)) (gap nil) t)\n  ==> ;; Gapped NP\n  )\n\n(rule (NP2 ?agr (common ?) ?x ?g1 ?g2 :sem) ==>\n  (modifiers pre noun ?agr () ?x (gap nil) (gap nil) ?pre)\n  (noun ?agr ?slots ?x ?noun)\n  (modifiers post noun ?agr ?slots ?x ?g1 ?g2 ?post))\n\n(rule (modifiers ?pre/post ?cat ?info (?slot . ?slots) ?h\n                 ?g1 ?g3 :sem) ==>\n  (complement ?cat ?info ?slot ?h ?g1 ?g2 ?mod)\n  (modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods))\n\n(rule (modifiers ?pre/post ?cat ?info ((? (?) ?) . ?slots) ?h\n                 ?g1 ?g2 ?mods) ==>\n  (modifiers ?pre/post ?cat ?info ?slots ?h ?g1 ?g2 ?mods))\n\n(rule (modifiers ?pre/post ?cat ?info ?slots ?h ?g1 ?g3 :sem) ==>\n  (adjunct ?pre/post ?cat ?info ?h ?g1 ?g2 ?adjunct)\n  (modifiers ?pre/post ?cat ?info ?slots ?h ?g2 ?g3 ?mods))\n\n(rule (modifiers ? ? ? () ? ?g1 ?g1 t) ==> )\n\n(rule (adjunct pre noun ?info ?x ?gap ?gap ?sem) ==>\n  (adj ?x ?sem))\n\n(rule (adjunct pre noun ?info ?h ?gap ?gap :sem) ==>\n  (:sem (noun-noun ?h ?x))\n  (noun ?agr () ?x ?sem))\n\n(rule (adjunct post ?cat ?info ?x ?g1 ?g2 ?sem) ==>\n  (PP ?prep ?prep ?wh ?np ?x ?g1 ?g2 ?sem))\n\n(rule (PP ?prep ?role ?wh ?np ?x ?g1 ?g2 :sem) ==>\n  (prep ?prep t)\n  (:sem (?role ?x ?np))\n  (NP ?agr (common obj) ?wh ?np ?g1 ?g2 ?np-sem))\n\n(rule (PP ?prep ?role ?wh ?np ?x\n          (gap (PP ?prep ?role ?np ?x)) (gap nil) t) ==> )\n\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==>\n  (:ex (the man) \"visiting me\" (the man) \"visited by me\")\n  (:test (member ?infl (-ing passive)))\n  (clause ?infl ?x ? ?v (gap (NP ?agr ? ?x)) (gap nil) ?sem))\n\n(rule (adjunct post noun ?agr ?x ?gap ?gap ?sem) ==>\n  (rel-clause ?agr ?x ?sem))\n\n(rule (rel-clause ?agr ?x :sem) ==>\n  (:ex (the man) \"that she liked\" \"that liked her\"\n       \"that I know Lee liked\")\n  (opt-rel-pronoun ?case ?x ?int-subj ?rel-sem)\n  (clause (finite ? ?) ? ?int-subj ?v\n          (gap (NP ?agr ?case ?x)) (gap nil) ?clause-sem))\n\n(rule (opt-rel-pronoun ?case ?x ?int-subj (?type ?x)) ==>\n  (:word ?rel-pro)\n  (:test (word ?rel-pro rel-pro ?case ?type)))\n\n(rule (opt-rel-pronoun (common obj) ?x int-subj t) ==> )\n\n(rule (Det ?agr ?wh ?x ?restriction (?art ?x ?restriction)) ==>\n  (:ex \"the\" \"every\")\n  (art ?agr ?art)\n  (:test (if (= ?art wh) (= ?wh +wh) (= ?wh -wh))))\n\n(rule (Det ?agr ?wh ?x ?r (the ?x ?restriction)) ==>\n  (:ex \"his\" \"her\")\n  (pronoun ?agr gen ?wh ?y ?sem)\n  (:test (and* ((genitive ?y ?x) ?sem ?r) ?restriction)))\n\n(rule (Det ?agr -wh ?x ?r ((number ?n) ?x ?r)) ==>\n  (:ex \"three\")\n  (cardinal ?n ?agr))\n\n(rule (VP ?infl ?x ?subject-slot ?v ?g1 ?g2 :sem) ==>\n  (:ex \"sleeps\" \"quickly give the dog a bone\")\n  (modifiers pre verb ? () ?v (gap nil) (gap nil) ?pre-sem)\n  (:sem (?role ?x ?v)) (:test (= ?subject-slot (?role 1 ?)))\n  (verb ?verb ?infl (?subject-slot . ?slots) ?v ?v-sem)\n  (modifiers post verb ? ?slots ?v ?g1 ?g2 ?mod-sem))\n\n(rule (VP ?infl ?x ?subject-slot ?v ?g1 ?g2 :sem) ==>\n  (:ex \"is sleeping\" \"would have given a bone to the dog.\"\n       \"did not sleep\" \"was given a bone by this old man\")\n  ;; An aux verb, followed by a VP\n  (aux ?infl ?needs-infl ?v ?aux)\n  (modifiers post aux ? () ?v (gap nil) (gap nil) ?mod)\n  (VP ?needs-infl ?x ?subject-slot ?v ?g1 ?g2 ?vp))\n\n(rule (adjunct post aux ? ?v ?gap ?gap (not ?v)) ==>\n  (:word not))\n\n(rule (adjunct ?pre/post verb ?info ?v ?g1 ?g2 ?sem) ==>\n  (advp ?wh ?v ?g1 ?g2 ?sem))\n\n(rule (advp ?wh ?v ?gap ?gap ?sem) ==>\n  (adverb ?wh ?v ?sem))\n\n(rule (advp ?wh ?v (gap (advp ?v)) (gap nil) t) ==> )\n\n(rule (clause ?infl ?x ?int-subj ?v ?gap1 ?gap3 :sem) ==>\n  (subject ?agr ?x ?subj-slot ?int-subj ?gap1 ?gap2 ?subj-sem)\n  (VP ?infl ?x ?subj-slot ?v ?gap2 ?gap3 ?pred-sem)\n  (:test (subj-pred-agree ?agr ?infl)))\n\n(rule (subject ?agree ?x ?subj-slot ext-subj\n               (gap ?subj) (gap nil) t) ==>\n  ;; Externally realized subject (the normal case for S)\n  (:test (slot-constituent ?subj-slot ?subj ?x ?)\n         (if (= ?subj (NP ?agr ?case ?x))\n             (= ?agree ?agr)\n             (= ?agree (- - + -))))) ;Non-NP subjects are 3sing\n\n(rule (subject ?agr ?x (?role 1 (NP ?x)) int-subj ?gap ?gap ?sem)\n  ==>\n  (NP ?agr (common nom) ?wh ?x (gap nil) (gap nil) ?sem))\n\n(<- (subj-pred-agree ?agr (finite ?agr ?)))\n(<- (subj-pred-agree ? ?infl) (atom ?infl))\n\n(rule (S ?s :sem) ==>\n  (:ex \"Kim likes Lee\" \"Lee, I like _\" \"In god, we trust _\"\n       \"Who likes Lee?\" \"Kim likes who?\")\n  (XP ?kind ?constituent ?wh ?x (gap nil) (gap nil) ?topic-sem)\n  (clause (finite ? ?) ?x ? ?s (gap ?constituent) (gap nil) ?sem))\n\n(rule (S ?s :sem) ==>\n  ;; Commands have implied second-person subject\n  (:ex \"Give the dog a bone.\")\n  (:sem (command ?s))\n  (:sem (listener ?x))\n  (clause nonfinite ?x ext-subj ?s\n          (gap (NP ? ? ?x)) (gap nil) ?sem))\n\n(rule (S ?s (yes-no ?s ?sem)) ==>\n  (:ex \"Does Kim like Lee?\" \"Is he a doctor?\")\n  (aux-inv-S nil ?s ?sem))\n\n(rule (S ?s :sem) ==>\n  (:ex \"Who does Kim like _?\" \"To whom did he give it _?\"\n       \"What dog does Kim like _?\")\n  (XP ?slot ?constituent +wh ?x (gap nil) (gap nil) ?subj-sem)\n  (aux-inv-S ?constituent ?s ?sem))\n\n(rule (aux-inv-S ?constituent ?v :sem) ==>\n  (:ex \"Does Kim like Lee?\" (who) \"would Kim have liked\")\n  (aux (finite ?agr ?tense) ?needs-infl ?v ?aux-sem)\n  (modifiers post aux ? () ?v (gap nil) (gap nil) ?mod)\n  (clause ?needs-infl ?x int-subj ?v (gap ?constituent) (gap nil)\n          ?clause-sem))\n\n(rule (aux-inv-S ?ext ?v :sem) ==>\n  (:ex \"Is he a doctor?\")\n  (verb ?be (finite ?agr ?) ((?role ?n ?xp) . ?slots) ?v ?sem)\n  (:test (word ?be be))\n  (subject ?agr ?x (?role ?n ?xp) int-subj\n           (gap nil) (gap nil) ?subj-sem)\n  (:sem (?role ?v ?x))\n  (modifiers post verb ? ?slots ?v (gap ?ext) (gap nil) ?mod-sem))\n\n(<- (slot-constituent (?role ?n (NP ?x))\n                      (NP ?agr ?case ?x) ?x ?h))\n(<- (slot-constituent (?role ?n (clause ?word ?infl))\n                      (clause ?word ?infl ?v) ?v ?h))\n(<- (slot-constituent (?role ?n (PP ?prep ?np))\n                      (PP ?prep ?role ?np ?h) ?np ?h))\n(<- (slot-constituent (?role ?n it)            (it ? ? ?x) ?x ?))\n(<- (slot-constituent (manner 3 (advp ?x))     (advp ?v) ? ?v))\n(<- (slot-constituent (?role ?n (VP ?infl ?x)) *** ? ?))\n(<- (slot-constituent (?role ?n (Adj ?x))      *** ?x ?))\n(<- (slot-constituent (?role ?n (P ?particle)) *** ? ?))\n\n(rule (complement ?cat ?info (?role ?n ?xp) ?h ?gap1 ?gap2 :sem)\n  ==>\n  ;; A complement is anything expected by a slot\n  (:sem (?role ?h ?x))\n  (:test (slot-constituent (?role ?n ?xp) ?constituent ?x ?h))\n  (XP ?xp ?constituent ?wh ?x ?gap1 ?gap2 ?sem))\n\n(rule (XP (PP ?prep ?np) (PP ?prep ?role ?np ?h) ?wh ?np\n          ?gap1 ?gap2 ?sem) ==>\n  (PP ?prep ?role ?wh ?np ?h ?gap1 ?gap2 ?sem))\n\n(rule (XP (NP ?x) (NP ?agr ?case ?x) ?wh ?x ?gap1 ?gap2 ?sem) ==>\n  (NP ?agr ?case ?wh ?x ?gap1 ?gap2 ?sem))\n\n(rule (XP it (it ? ? ?x) -wh ?x ?gap ?gap t) ==>\n  (:word it))\n\n(rule (XP (clause ?word ?infl) (clause ?word ?infl ?v) -wh ?v\n          ?gap1 ?gap2 ?sem) ==>\n  (:ex (he thinks) \"that she is tall\")\n  (opt-word ?word)\n  (clause ?infl ?x int-subj ?v ?gap1 ?gap2 ?sem))\n\n(rule (XP (?role ?n (advp ?v)) (advp ?v) ?wh ?v ?gap1 ?gap2 ?sem)\n  ==>\n  (advp ?wh ?v ?gap1 ?gap2 ?sem))\n\n(rule (opt-word ?word) ==> (:word ?word))\n(rule (opt-word (?word)) ==> (:word ?word))\n(rule (opt-word (?word)) ==>)\n\n(rule (XP (VP ?infl ?x) *** -wh ?v ?gap1 ?gap2 ?sem) ==>\n  (:ex (he promised her) \"to sleep\")\n  (VP ?infl ?x ?subj-slot ?v ?gap1 ?gap2 ?sem))\n\n(rule (XP (Adj ?x) *** -wh ?x ?gap ?gap ?sem) ==>\n  (Adj ?x ?sem))\n\n(rule (XP (P ?particle) *** -wh ?x ?gap ?gap t) ==>\n  (prep ?particle t))\n\n(rule (verb ?verb ?infl ?slots ?v :sem) ==>\n  (:word ?verb)\n  (:test (word ?verb verb ?infl ?senses)\n         (member (?sem . ?subcats) ?senses)\n         (member ?slots ?subcats)\n         (tense-sem ?infl ?v ?tense-sem))\n  (:sem ?tense-sem)\n  (:sem (?sem ?v)))\n\n(<- (tense-sem (finite ? ?tense) ?v (?tense ?v)))\n(<- (tense-sem -ing ?v (progressive ?v)))\n(<- (tense-sem -en  ?v (past-participle ?v)))\n(<- (tense-sem infinitive ?v t))\n(<- (tense-sem nonfinite ?v t))\n(<- (tense-sem passive ?v (passive ?v)))\n\n(rule (aux ?infl ?needs-infl ?v ?tense-sem) ==>\n  (:word ?aux)\n  (:test (word ?aux aux ?infl ?needs-infl)\n         (tense-sem ?infl ?v ?tense-sem)))\n\n(rule (aux (finite ?agr ?tense) nonfinite ?v (?sem ?v)) ==>\n  (:word ?modal)\n  (:test (word ?modal modal ?sem ?tense)))\n\n(rule (noun ?agr ?slots ?x (?sem ?x)) ==>\n  (:word ?noun)\n  (:test (word ?noun noun ?agr ?slots ?sem)))\n\n(rule (pronoun ?agr ?case ?wh ?x (?quant ?x (?sem ?x))) ==>\n  (:word ?pro)\n  (:test (word ?pro pronoun ?agr ?case ?wh ?sem)\n         (if (= ?wh +wh) (= ?quant wh) (= ?quant pro))))\n\n(rule (name ?agr ?name) ==>\n  (:word ?name)\n  (:test (word ?name name ?agr)))\n\n(rule (adj ?x (?sem ?x)) ==>\n  (:word ?adj)\n  (:test (word ?adj adj ?sem)))\n\n(rule (adj ?x ((nth ?n) ?x)) ==> (ordinal ?n))\n\n(rule (art ?agr ?quant) ==>\n  (:word ?art)\n  (:test (word ?art art ?agr ?quant)))\n\n(rule (prep ?prep t) ==>\n  (:word ?prep)\n  (:test (word ?prep prep)))\n\n(rule (adverb ?wh ?x ?sem) ==>\n  (:word ?adv)\n  (:test (word ?adv adv ?wh ?pred)\n         (if (= ?wh +wh)\n             (= ?sem (wh ?y (?pred ?x ?y)))\n             (= ?sem (?pred ?x)))))\n\n(rule (cardinal ?n ?agr) ==>\n  (:ex \"five\")\n  (:word ?num)\n  (:test (word ?num cardinal ?n ?agr)))\n\n(rule (cardinal ?n ?agr) ==>\n  (:ex \"5\")\n  (:word ?n)\n  (:test (numberp ?n)\n         (if (= ?n 1)\n             (= ?agr (- - + -))    ;3sing\n             (= ?agr (- - - +))))) ;3plur\n\n(rule (ordinal ?n) ==>\n  (:ex \"fifth\")\n  (:word ?num)\n  (:test (word ?num ordinal ?n)))\n\n(abbrev 1sing       (+ - - -))\n(abbrev 1plur       (- + - -))\n(abbrev 3sing       (- - + -))\n(abbrev 3plur       (- - - +))\n(abbrev 2pers       (- - - -))\n(abbrev ~3sing      (? ? - ?))\n\n(abbrev v/intrans   ((agt 1 (NP ?))))\n(abbrev v/trans     ((agt 1 (NP ?)) (obj 2 (NP ?))))\n(abbrev v/ditrans   ((agt 1 (NP ?)) (goal 2 (NP ?)) (obj 3 (NP ?))))\n(abbrev v/trans2    ((agt 1 (NP ?)) (obj 2 (NP ?)) (goal 2 (PP to ?))))\n(abbrev v/trans4    ((agt 1 (NP ?)) (obj 2 (NP ?)) (ben 2 (PP for ?))))\n(abbrev v/it-null   ((nil 1 it)))\n(abbrev v/opt-that  ((exp 1 (NP ?)) (con 2 (clause (that) (finite ? ?)))))\n(abbrev v/subj-that ((con 1 (clause that (finite ? ?))) (exp 2 (NP ?))))\n(abbrev v/it-that   ((nil 1 it) (exp 2 (NP ?))\n                     (con 3 (clause that (finite ? ?)))))\n(abbrev v/inf       ((agt 1 (NP ?x)) (con 3 (VP infinitive ?x))))\n(abbrev v/promise   ((agt 1 (NP ?x)) (goal (2) (NP ?y))\n                     (con 3 (VP infinitive ?x))))\n(abbrev v/persuade  ((agt 1 (NP ?x)) (goal 2 (NP ?y))\n                     (con 3 (VP infinitive ?y))))\n(abbrev v/want      ((agt 1 (NP ?x)) (con 3 (VP infinitive ?x))))\n(abbrev v/p-up      ((agt 1 (NP ?)) (pat 2 (NP ?)) (nil 3 (P up))))\n(abbrev v/pp-for    ((agt 1 (NP ?)) (pat 2 (PP for ?))))\n(abbrev v/pp-after  ((agt 1 (NP ?)) (pat 2 (PP after ?))))\n\n(verb (ask) (query v/ditrans))\n(verb (delete) (delete v/trans))\n(verb (do did done doing does) (perform v/trans))\n(verb (eat ate eaten) (eat v/trans))\n(verb (give gave given giving) (give-1 v/trans2 v/ditrans)\n      (donate v/trans v/intrans))\n(verb (go went gone going goes))\n(verb (have had had having has) (possess v/trans))\n(verb (know knew known) (know-that v/opt-that) (know-of v/trans))\n(verb (like) (like-1 v/trans))\n(verb (look) (look-up v/p-up) (search v/pp-for)\n      (take-care v/pp-after) (look v/intrans))\n(verb (move moved moved moving moves)\n      (self-propel v/intrans) (transfer v/trans2))\n(verb (persuade) (persuade v/persuade))\n(verb (promise) (promise v/promise))\n(verb (put put put putting))\n(verb (rain) (rain v/it-null))\n(verb (saw) (cut-with-saw v/trans v/intrans))\n(verb (see saw seen seeing) (understand v/intrans v/opt-that)\n      (look v/trans) (dating v/trans))\n(verb (sleep slept) (sleep v/intrans))\n(verb (surprise) (surprise v/subj-that v/it-that))\n(verb (tell told) (tell v/persuade))\n(verb (trust) (trust v/trans ((agt 1 (NP ?)) (obj 2 (PP in ?)))))\n(verb (try tried tried trying tries) (attempt v/inf))\n(verb (visit) (visit v/trans))\n(verb (want) (desire v/want v/persuade))\n\n(word have    aux nonfinite -en)\n(word have    aux (finite ~3sing present) -en)\n(word has     aux (finite 3sing present) -en)\n(word had     aux (finite ? past) -en)\n(word having  aux -ing -en)\n\n(word do      aux (finite ~3sing present) nonfinite)\n(word does    aux (finite  3sing present) nonfinite)\n(word did     aux (finite  ?     past)    nonfinite)\n\n(word to      aux infinitive nonfinite)\n\n(copula\n  '((nil      ((nil 1 (NP ?x)) (nil 2 (Adj ?x))))\n    (is-a     ((exp 1 (NP ?x)) (arg2 2 (NP ?y))))\n    (is-loc   ((exp 1 (NP ?x)) (?prep 2 (PP ?prep ?)))))\n  '((be       nonfinite -ing)\n    (been     -en -ing)\n    (being    -ing -en)\n    (am       (finite 1sing present) -ing)\n    (is       (finite 3sing present) -ing)\n    (are      (finite 2pers present) -ing)\n    (were     (finite (- - ? ?) past) -ing)   ; 2nd sing or pl\n    (was      (finite (? - ? -) past) -ing))) ; 1st or 3rd sing\n\n(word can    modal able      past)\n(word could  modal able      present)\n(word may    modal possible  past)\n(word might  modal possible  present)\n(word shall  modal mandatory past)\n(word should modal mandatory present)\n(word will   modal expected  past)\n(word would  modal expected  present)\n(word must   modal necessary present)\n\n(word not not)\n\n(noun destruction * destruction\n      (pat (2) (PP of ?)) (agt (2) (PP by ?)))\n(noun beach)\n(noun bone)\n(noun box boxes)\n(noun city cities)\n(noun color)\n(noun cube)\n(noun doctor)\n(noun dog dogs)\n(noun enemy enemies)\n(noun file)\n(noun friend friends friend (friend-of (2) (PP of ?)))\n(noun furniture *)\n(noun hat)\n(noun man men)\n(noun saw)\n(noun woman women)\n\n(word I     pronoun 1sing (common nom) -wh speaker)\n(word we    pronoun 1plur (common nom) -wh speaker+other)\n(word you   pronoun 2pers (common   ?) -wh listener)\n(word he    pronoun 3sing (common nom) -wh male)\n(word she   pronoun 3sing (common nom) -wh female)\n(word it    pronoun 3sing (common   ?) -wh anything)\n(word they  pronoun 3plur (common nom) -wh anything)\n\n(word me    pronoun 1sing (common obj) -wh speaker)\n(word us    pronoun 1plur (common obj) -wh speaker+other)\n(word him   pronoun 3sing (common obj) -wh male)\n(word her   pronoun 3sing (common obj) -wh female)\n(word them  pronoun 3plur (common obj) -wh anything)\n\n(word my    pronoun 1sing gen -wh speaker)\n(word our   pronoun 1plur gen -wh speaker+other)\n(word your  pronoun 2pers gen -wh listener)\n(word his   pronoun 3sing gen -wh male)\n(word her   pronoun 3sing gen -wh female)\n(word its   pronoun 3sing gen -wh anything)\n(word their pronoun 3plur gen -wh anything)\n(word whose pronoun 3sing gen +wh anything)\n\n(word who   pronoun ? (common ?) +wh person)\n(word whom  pronoun ? (common obj) +wh person)\n(word what  pronoun ? (common ?) +wh thing)\n(word which pronoun ? (common ?) +wh thing)\n\n(word who   rel-pro ? person)\n(word which rel-pro ? thing)\n(word that  rel-pro ? thing)\n(word whom  rel-pro (common obj) person)\n\n(word God   name 3sing)  (word Lynn  name 3sing)\n(word Jan   name 3sing)  (word Mary  name 3sing)\n(word John  name 3sing)  (word NY    name 3sing)\n(word Kim   name 3sing)  (word LA    name 3sing)\n(word Lee   name 3sing)  (word SF    name 3sing)\n\n(word big   adj big)    (word bad   adj bad)\n(word old   adj old)    (word smart adj smart)\n(word green adj green)  (word red   adj red)\n(word tall  adj tall)   (word fun   adj fun)\n\n(word quickly adv -wh quickly)\n(word slowly  adv -wh slowly)\n\n(word where   adv +wh loc)\n(word when    adv +wh time)\n(word why     adv +wh reason)\n(word how     adv +wh manner)\n\n(word the   art 3sing the)\n(word the   art 3plur group)\n(word a     art 3sing a)\n(word an    art 3sing a)\n(word every art 3sing every)\n(word each  art 3sing each)\n(word all   art 3sing all)\n(word some  art ?     some)\n\n(word this  art 3sing this)\n(word that  art 3sing that)\n(word these art 3plur this)\n(word those art 3plur that)\n\n(word what  art ?     wh)\n(word which art ?     wh)\n\n;; This puts in numbers up to twenty, as if by\n;; (word five cardinal 5 3plur)\n;; (word fifth ordinal 5)\n\n(dotimes (i 21)\n  (add-word (read-from-string (format nil \"~r\" i))\n            'cardinal i (if (= i 1) '3sing '3plur))\n  (add-word (read-from-string (format nil \"~:r\" i)) 'ordinal i))\n\n(word above prep)  (word about prep)  (word around prep)\n(word across prep) (word after prep)  (word against prep)\n(word along prep)  (word at prep)     (word away prep)\n(word before prep) (word behind prep) (word below prep)\n(word beyond prep) (word by prep)     (word down prep)\n(word for prep)    (word from prep)   (word in prep)\n(word of prep)     (word off prep)    (word on prep)\n(word out prep)    (word over prep)   (word past prep)\n(word since prep)  (word through prep)(word throughout prep)\n(word till prep)   (word to prep)     (word under prep)\n(word until prep)  (word up prep)     (word with prep)\n(word without prep)\n\n"
  },
  {
    "path": "lisp/interp1.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;; File interp1.lisp: simple Scheme interpreter, including macros.\n\n(defun interp (x &optional env)\n  \"Interpret (evaluate) the expression x in the environment env.\"\n  (cond\n    ((symbolp x) (get-var x env))\n    ((atom x) x)\n    ((case (first x)\n       (QUOTE  (second x))\n       (BEGIN  (last1 (mapcar #'(lambda (y) (interp y env))\n                              (rest x))))\n       (SET!   (set-var! (second x) (interp (third x) env) env))\n       (IF     (if (interp (second x) env)\n                   (interp (third x) env)\n                   (interp (fourth x) env)))\n       (LAMBDA (let ((parms (second x))\n                     (code (maybe-add 'begin (rest2 x))))\n                 #'(lambda (&rest args)\n                     (interp code (extend-env parms args env)))))\n       (t      ;; a procedure application\n               (apply (interp (first x) env)\n                      (mapcar #'(lambda (v) (interp v env))\n                              (rest x))))))))\n\n(defun set-var! (var val env)\n  \"Set a variable to a value, in the given or global environment.\"\n  (if (assoc var env)\n      (setf (second (assoc var env)) val)\n      (set-global-var! var val))\n  val)\n\n(defun get-var (var env)\n  \"Get the value of a variable, from the given or global environment.\"\n    (if (assoc var env)\n        (second (assoc var env))\n        (get-global-var var)))\n\n(defun set-global-var! (var val)\n  (setf (get var 'global-val) val))\n\n(defun get-global-var (var)\n  (let* ((default \"unbound\")\n         (val (get var 'global-val default)))\n    (if (eq val default)\n        (error \"Unbound scheme variable: ~a\" var)\n        val)))\n\n(defun extend-env (vars vals env)\n  \"Add some variables and values to an environment.\"\n  (nconc (mapcar #'list vars vals) env))\n\n(defparameter *scheme-procs*\n  '(+ - * / = < > <= >= cons car cdr not append list read member\n    (null? null) (eq? eq) (equal? equal) (eqv? eql)\n    (write prin1) (display princ) (newline terpri)))\n\n(defun init-scheme-interp ()\n  \"Initialize the scheme interpreter with some global variables.\"\n  ;; Define Scheme procedures as CL functions:\n  (mapc #'init-scheme-proc *scheme-procs*)\n  ;; Define the boolean `constants'. Unfortunately, this won't\n  ;; stop someone from saying: (set! t nil)\n  (set-global-var! t t)\n  (set-global-var! nil nil))\n\n(defun init-scheme-proc (f)\n  \"Define a Scheme procedure as a corresponding CL function.\"\n  (if (listp f)\n      (set-global-var! (first f) (symbol-function (second f)))\n      (set-global-var! f (symbol-function f))))\n\n(defun scheme (&optional x)\n  \"A Scheme read-eval-print loop (using interp)\"\n  ;; Modified by norvig Jun 11 96 to handle optional argument\n  ;; instead of always going into a loop.\n  (init-scheme-interp)\n  (if x\n      (interp x nil)\n    (loop (format t \"~&==> \")\n      (print (interp (read) nil)))))\n\n;;;; The following version handles macros:\n\n(defun interp (x &optional env)\n  \"Interpret (evaluate) the expression x in the environment env.\n  This version handles macros.\"\n  (cond\n    ((symbolp x) (get-var x env))\n    ((atom x) x)\n    ((scheme-macro (first x))              ;***\n     (interp (scheme-macro-expand x) env)) ;***\n    ((case (first x)\n       (QUOTE  (second x))\n       (BEGIN  (last1 (mapcar #'(lambda (y) (interp y env))\n                              (rest x))))\n       (SET!   (set-var! (second x) (interp (third x) env) env))\n       (IF     (if (interp (second x) env)\n                   (interp (third x) env)\n                   (interp (fourth x) env)))\n       (LAMBDA (let ((parms (second x))\n                     (code (maybe-add 'begin (rest2 x))))\n                 #'(lambda (&rest args)\n                     (interp code (extend-env parms args env)))))\n       (t      ;; a procedure application\n               (apply (interp (first x) env)\n                      (mapcar #'(lambda (v) (interp v env))\n                              (rest x))))))))\n\n;;; ==============================\n\n(defun scheme-macro (symbol)\n  (and (symbolp symbol) (get symbol 'scheme-macro)))\n\n(defmacro def-scheme-macro (name parmlist &body body)\n  \"Define a Scheme macro.\"\n  `(setf (get ',name 'scheme-macro)\n         #'(lambda ,parmlist .,body)))\n\n(defun scheme-macro-expand (x)\n  \"Macro-expand this Scheme expression.\"\n  (if (and (listp x) (scheme-macro (first x)))\n      (scheme-macro-expand\n        (apply (scheme-macro (first x)) (rest x)))\n      x))\n\n;;; ==============================\n\n(def-scheme-macro let (bindings &rest body)\n  `((lambda ,(mapcar #'first bindings) . ,body)\n    .,(mapcar #'second bindings)))\n\n(def-scheme-macro let* (bindings &rest body)\n  (if (null bindings)\n      `(begin .,body)\n      `(let (,(first bindings))\n         (let* ,(rest bindings) . ,body))))\n\n(def-scheme-macro and (&rest args)\n  (cond ((null args) 'T)\n        ((length=1 args) (first args))\n        (t `(if ,(first args)\n                (and . ,(rest args))))))\n\n(def-scheme-macro or (&rest args)\n  (cond ((null args) 'nil)\n        ((length=1 args) (first args))\n        (t (let ((var (gensym)))\n             `(let ((,var ,(first args)))\n                (if ,var ,var (or . ,(rest args))))))))\n\n(def-scheme-macro cond (&rest clauses)\n  (cond ((null clauses) nil)\n        ((length=1 (first clauses))\n         `(or ,(first clauses) (cond .,(rest clauses))))\n        ((starts-with (first clauses) 'else)\n         `(begin .,(rest (first clauses))))\n        (t `(if ,(first (first clauses))\n                (begin .,(rest (first clauses)))\n                (cond .,(rest clauses))))))\n\n(def-scheme-macro case (key &rest clauses)\n  (let ((key-val (gensym \"KEY\")))\n    `(let ((,key-val ,key))\n       (cond ,@(mapcar\n                #'(lambda (clause)\n                    (if (starts-with clause 'else)\n                        clause\n                        `((member ,key-val ',(first clause))\n                          .,(rest clause))))\n                clauses)))))\n\n(def-scheme-macro define (name &rest body)\n  (if (atom name)\n      `(begin (set! ,name . ,body) ',name)\n      `(define ,(first name)\n         (lambda ,(rest name) . ,body))))\n\n(def-scheme-macro delay (computation)\n  `(lambda () ,computation))\n\n(def-scheme-macro letrec (bindings &rest body)\n  `(let ,(mapcar #'(lambda (v) (list (first v) nil)) bindings)\n     ,@(mapcar #'(lambda (v) `(set! .,v)) bindings)\n     .,body))\n"
  },
  {
    "path": "lisp/interp2.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;; File interp2.lisp: Tail-recursive Scheme interpreter.\n\n(requires \"interp1\")\n\n(defun interp (x &optional env)\n  \"Evaluate the expression x in the environment env.\n  This version is properly tail-recursive.\"\n  (prog ()\n    :INTERP\n    (return\n      (cond\n        ((symbolp x) (get-var x env))\n        ((atom x) x)\n        ((scheme-macro (first x))\n         (setf x (scheme-macro-expand x)) (go :INTERP))\n        ((case (first x)\n           (QUOTE  (second x))\n           (BEGIN  (pop x) ; pop off the BEGIN to get at the args\n                   ;; Now interpret all but the last expression\n                   (loop while (rest x) do (interp (pop x) env))\n                   ;; Finally, rename the last expression as x\n                   (setf x (first x))\n                   (GO :INTERP))\n           (SET!   (set-var! (second x) (interp (third x) env) env))\n           (IF     (setf x (if (interp (second x) env)\n                               (third x)\n                               (fourth x)))\n                   ;; That is, rename the right expression as x\n                   (GO :INTERP))\n           (LAMBDA (make-proc :env env :parms (second x)\n                              :code (maybe-add 'begin (rest2 x))))\n           (t      ;; a procedure application\n                   (let ((proc (interp (first x) env))\n                         (args (mapcar #'(lambda (v) (interp v env))\n                                       (rest x))))\n                     (if (proc-p proc)\n                         ;; Execute procedure with rename+goto\n                         (progn\n                           (setf x (proc-code proc))\n                           (setf env (extend-env (proc-parms proc) args\n                                                 (proc-env proc)))\n                           (GO :INTERP))\n                         ;; else apply primitive procedure\n                         (apply proc args))))))))))\n\n(defstruct (proc (:print-function print-proc))\n  \"Represent a Scheme procedure\"\n  code (env nil) (name nil) (parms nil))\n\n(defun print-proc (proc &optional (stream *standard-output*) depth)\n  (declare (ignore depth))\n  (format stream \"{~a}\" (or (proc-name proc) '??)))\n"
  },
  {
    "path": "lisp/interp3.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;; File interp3.lisp: Scheme interpreter with explicit continuations\n\n;;; One bug fix by Cheng Lu Hsu, hsuc@cory.Berkeley.EDU\n\n(requires \"interp1\")\n\n(defun interp (x env cc)\n  \"Evaluate the expression x in the environment env,\n  and pass the result to the continuation cc.\"\n  (cond\n    ((symbolp x) (funcall cc (get-var x env)))\n    ((atom x) (funcall cc x))\n    ((scheme-macro (first x))\n     (interp (scheme-macro-expand x) env cc))\n    ((case (first x)\n       (QUOTE  (funcall cc (second x)))\n       (BEGIN  (interp-begin (rest x) env cc))\n       (SET!   (interp (third x) env\n                       #'(lambda (val)\n                           (funcall cc (set-var! (second x)\n                                                 val env)))))\n       (IF     (interp (second x) env\n                       #'(lambda (pred)\n                           (interp (if pred (third x) (fourth x))\n                                   env cc))))\n       (LAMBDA (let ((parms (second x))\n                     (code (maybe-add 'begin (rest2 x))))\n                 (funcall\n                   cc\n                   #'(lambda (cont &rest args)\n                       (interp code\n                               (extend-env parms args env)\n                               cont)))))\n       (t      (interp-call x env cc))))))\n\n;;; ==============================\n\n(defun scheme (&optional x)\n  \"A Scheme read-eval-print loop (using interp).\n  Handles call/cc by explicitly passing continuations.\"\n  ;; Modified by norvig Jun 11 96 to handle optional argument\n  ;; instead of always going into a loop.\n  (init-scheme-interp)\n  (if x\n      (interp x nil #'print)\n    (loop (format t \"~&==> \")\n      (interp (read) nil #'print))))\n\n(defun interp-begin (body env cc)\n  \"Interpret each element of BODY, passing the last to CC.\"\n  (interp (first body) env\n          #'(lambda (val)\n              (if (null (rest body))\n                  (funcall cc val) ;; fix, hsuc 2/20/93; forgot to call cc\n                  (interp-begin (rest body) env cc)))))\n\n(defun interp-call (call env cc)\n  \"Interpret the call (f x...) and pass the result to CC.\"\n  (map-interp call env\n              #'(lambda (fn-and-args)\n                  (apply (first fn-and-args)\n                         cc\n                         (rest fn-and-args)))))\n\n(defun map-interp (list env cc)\n  \"Interpret each element of LIST, and pass the list to CC.\"\n  (if (null list)\n      (funcall cc nil)\n      (interp (first list) env\n              #'(lambda (x)\n                  (map-interp (rest list) env\n                              #'(lambda (y)\n                                  (funcall cc (cons x y))))))))\n\n;;; ==============================\n\n(defun init-scheme-proc (f)\n  \"Define a Scheme primitive procedure as a CL function.\"\n  (if (listp f)\n      (set-global-var! (first f)\n                       #'(lambda (cont &rest args)\n                           (funcall cont (apply (second f) args))))\n      (init-scheme-proc (list f f))))\n\n;;; ==============================\n\n(defun call/cc (cc computation)\n  \"Make the continuation accessible to a Scheme procedure.\"\n  (funcall computation cc\n           ;; Package up CC into a Scheme function:\n           #'(lambda (cont val)\n               (declare (ignore cont))\n               (funcall cc val))))\n\n;; Now install call/cc in the global environment\n(set-global-var! 'call/cc #'call/cc)\n(set-global-var! 'call-with-current-continuation #'call/cc)\n"
  },
  {
    "path": "lisp/intro.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File intro.lisp: Miscellaneous functions from the introduction.\n\n(defun last-name (name)\n  \"Select the last name from a name represented as a list.\"\n  (first (last name)))\n\n(defun first-name (name)\n  \"Select the first name from a name represented as a list.\"\n  (first name))\n\n(setf names '((John Q Public) (Malcolm X)\n              (Admiral Grace Murray Hopper) (Spot)\n              (Aristotle) (A A Milne) (Z Z Top)\n              (Sir Larry Olivier) (Miss Scarlet)))\n\n;;; ==============================\n\n(defparameter *titles*\n  '(Mr Mrs Miss Ms Sir Madam Dr Admiral Major General)\n  \"A list of titles that can appear at the start of a name.\")\n\n;;; ==============================\n\n(defun first-name (name)\n  \"Select the first name from a name represented as a list.\"\n  (if (member (first name) *titles*)\n      (first-name (rest name))\n      (first name)))\n\n;;; ==============================\n\n;;; ==============================\n\n(defun numbers-and-negations (input)\n  \"Given a list, return only the numbers and their negations.\"\n  (mappend #'number-and-negation input))\n\n(defun number-and-negation (x)\n  \"If x is a number, return a list of x and -x.\"\n  (if (numberp x)\n      (list x (- x))\n      nil))\n\n;;; ==============================\n\n(defun atomprint (exp &optional (depth 0))\n  \"Print each atom in exp, along with its depth of nesting.\"\n  (if (atom exp)\n      (format t \"~&ATOM: ~a, DEPTH ~d\" exp depth)\n      (dolist (element exp)\n        (atomprint element (+ depth 1)))))\n\n;;; ==============================\n\n(defun power (x n)\n  \"Power raises x to the nth power.  N must be an integer >= 0.\n   This executes in log n time, because of the check for even n.\"\n  (cond ((= n 0) 1)\n        ((evenp n) (expt (power x (/ n 2)) 2))\n        (t (* x (power x (- n 1))))))\n\n;;; ==============================\n\n(defun count-atoms (exp)\n  \"Return the total number of non-nil atoms in the expression.\"\n  (cond ((null exp) 0)\n        ((atom exp) 1)\n        (t (+ (count-atoms (first exp))\n              (count-atoms (rest exp))))))\n\n(defun count-all-atoms (exp &optional (if-null 1))\n  \"Return the total number of atoms in the expression,\n  counting nil as an atom only in non-tail position.\"\n  (cond ((null exp) if-null)\n        ((atom exp) 1)\n        (t (+ (count-all-atoms (first exp) 1)\n              (count-all-atoms (rest exp) 0)))))\n\n;;; ==============================\n\n(defun count-anywhere (item tree)\n  \"Count the times item appears anywhere within tree.\"\n  (cond ((eql item tree) 1)\n        ((atom tree) 0)\n        (t (+ (count-anywhere item (first tree))\n              (count-anywhere item (rest tree))))))\n\n;;; ==============================\n\n(defun dot-product (a b)\n  \"Compute the mathematical dot product of two vectors.\"\n  (if (or (null a) (null b))\n      0\n      (+ (* (first a) (first b))\n         (dot-product (rest a) (rest b)))))\n\n(defun dot-product (a b)\n  \"Compute the mathematical dot product of two vectors.\"\n  (let ((sum 0))\n    (dotimes (i (length a))\n      (incf sum (* (elt a i) (elt b i))))\n    sum))\n\n(defun dot-product (a b)\n  \"Compute the mathematical dot product of two vectors.\"\n  (apply #'+ (mapcar #'* a b)))\n\n;;; ==============================\n\n"
  },
  {
    "path": "lisp/krep.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp;  -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;; krep.lisp: Knowledge representation code; final version.\n;;; Adds support for worlds and attached functions.\n\n(requires \"krep2\") ; Need some functions from previous version\n\n(defparameter *primitives* '(and sub ind rel val))\n\n(defun add-fact (fact)\n  \"Add the fact to the data base.\"\n  (cond ((eq (predicate fact) 'and)\n         (mapc #'add-fact (args fact)))\n        ((or (not (every #'atom (args fact)))\n             (some #'variable-p (args fact))\n             (not (member (predicate fact) *primitives*)))\n         (error \"Ill-formed fact: ~a\" fact))\n        ((not (fact-present-p fact))\n         (index fact)\n         (run-attached-fn fact)))\n  t)\n\n(defun fact-present-p (fact)\n  \"Is this fact present in the data base?\"\n  (retrieve fact))\n\n;;; ==============================\n\n(defun run-attached-fn (fact)\n  \"Run the function associated with the predicate of this fact.\"\n  (apply (get (predicate fact) 'attached-fn) (args fact)))\n\n;;; ==============================\n\n(defun index-new-fact (fact)\n  \"Index the fact in the data base unless it is already there.\"\n  (unless (fact-present-p fact)\n    (index fact)))\n\n;;; ==============================\n\n(defun test-bears ()\n  (clear-dtrees)\n  (mapc #'add-fact\n        '((sub animal living-thing)\n          (sub living-thing thing) (sub polar-bear bear)\n          (sub grizzly bear) (ind Yogi bear) (ind Lars polar-bear)\n          (ind Helga grizzly)))\n  (trace index)\n  (add-fact '(sub bear animal))\n  (untrace index))\n\n(defmacro a (&rest args)\n  \"Define a new individual and assert facts about it in the data base.\"\n  `(add-fact ',(translate-exp (cons 'a args))))\n\n(defmacro each (&rest args)\n  \"Define a new category and assert facts about it in the data base.\"\n  `(add-fact ',(translate-exp (cons 'each args))))\n\n(defmacro ?? (&rest queries)\n  \"Return a list of answers satisfying the query or queries.\"\n  `(retrieve-setof\n     ',(translate-exp (maybe-add 'and (replace-?-vars queries))\n                      :query)))\n\n;;; ==============================\n\n(defun translate-exp (exp &optional query-mode-p)\n  \"Translate exp into a conjunction of the four primitives.\"\n  (let ((conjuncts nil))\n    (labels\n      ((collect-fact (&rest terms) (push terms conjuncts))\n\n       (translate (exp)\n         ;; Figure out what kind of expression this is\n         (cond\n           ((atom exp) exp)\n           ((eq (first exp) 'a) (translate-a (rest exp)))\n           ((eq (first exp) 'each) (translate-each (rest exp)))\n           (t (apply #'collect-fact exp) exp)))\n\n       (translate-a (args)\n         ;; translate (A category [ind] (rel filler)*)\n         (let* ((category (pop args))\n                (self (cond ((and args (atom (first args)))\n                             (pop args))\n                            (query-mode-p (gentemp \"?\"))\n                            (t (gentemp (string category))))))\n           (collect-fact 'ind self category)\n           (dolist (slot args)\n             (translate-slot 'val self slot))\n           self))\n\n       (translate-each (args)\n         ;; translate (EACH category [(isa cat*)] (slot cat)*)\n         (let* ((category (pop args)))\n           (when (eq (predicate (first args)) 'isa)\n             (dolist (super (rest (pop args)))\n               (collect-fact 'sub category super)))\n           (dolist (slot args)\n             (translate-slot 'rel category slot))\n           category))\n\n       (translate-slot (primitive self slot)\n         ;; translate (relation value) into a REL or SUB\n         (assert (= (length slot) 2))\n         (collect-fact primitive (first slot) self\n                       (translate (second slot)))))\n\n      ;; Body of translate-exp:\n      (translate exp) ;; Build up the list of conjuncts\n      (maybe-add 'and (nreverse conjuncts)))))\n\n;;; ==============================\n\n(defun replace-?-vars (exp)\n  \"Replace each ? in exp with a temporary var: ?123\"\n  (cond ((eq exp '?) (gentemp \"?\"))\n        ((atom exp) exp)\n        (t (reuse-cons (replace-?-vars (first exp))\n                       (replace-?-vars (rest exp))\n                       exp))))\n\n;;;; Support for Multiple Worlds\n\n;; In the book, we redefine index, but that screws up other things,\n;; so we'll define index-in-world instead of index.\n\n(defvar *world* 'W0 \"The current world used by index and fetch.\")\n\n(defun index-in-world (key &optional (world *world*))\n  \"Store key in a dtree node.  Key must be (predicate . args);\n  it is stored in the dtree, indexed by the world.\"\n  (dtree-index-in-world key key world (get-dtree (predicate key))))\n\n(defun dtree-index-in-world (key value world dtree)\n  \"Index value under all atoms of key in dtree.\"\n  (cond\n    ((consp key)                ; index on both first and rest\n     (dtree-index-in-world (first key) value world\n                  (or (dtree-first dtree)\n                      (setf (dtree-first dtree) (make-dtree))))\n     (dtree-index-in-world (rest key) value world\n                  (or (dtree-rest dtree)\n                      (setf (dtree-rest dtree) (make-dtree)))))\n    ((null key))                ; don't index on nil\n\n    ((variable-p key)           ; index a variable\n     (nalist-push world value (dtree-var dtree)))\n    (t ;; Make sure there is an nlist for this atom, and add to it\n     (nalist-push world value (lookup-atom key dtree)))))\n\n;;; ==============================\n\n(defun nalist-push (key val nalist)\n  \"Index val under key in a numbered alist.\"\n  ;; An nalist is of the form (count (key val*)*)\n  ;; Ex: (6 (nums 1 2 3) (letters a b c))\n  (incf (car nalist))\n  (let ((pair (assoc key (cdr nalist))))\n    (if pair\n        (push val (cdr pair))\n        (push (list key val) (cdr nalist)))))\n\n;;; ==============================\n\n(defstruct (world (:print-function print-world))\n  name parents current)\n\n;;; ==============================\n\n(defun get-world (name &optional current (parents (list *world*)))\n  \"Look up or create the world with this name.\n  If the world is new, give it the list of parents.\"\n  (cond ((world-p name) name) ; ok if it already is a world\n        ((get name 'world))\n        (t (setf (get name 'world)\n                 (make-world :name name :parents parents\n                             :current current)))))\n\n(setf *world* (get-world 'W0 nil nil))\n\n;;; ==============================\n\n(defun use-world (world)\n  \"Make this world current.\"\n  ;; If passed a name, look up the world it names\n  (setf world (get-world world))\n  (unless (eq world *world*)\n    ;; Turn the old world(s) off and the new one(s) on,\n    ;; unless we are already using the new world\n    (set-world-current *world* nil)\n    (set-world-current world t)\n    (setf *world* world)))\n\n(defun use-new-world ()\n  \"Make up a new world and use it.\n  The world inherits from the current world.\"\n  (setf *world* (get-world (gensym \"W\")))\n  (setf (world-current *world*) t)\n  *world*)\n\n(defun set-world-current (world on/off)\n  \"Set the current field of world and its parents on or off.\"\n  ;; nil is off, anything else is on.\n  (setf (world-current world) on/off)\n  (dolist (parent (world-parents world))\n    (set-world-current parent on/off)))\n\n;;; ==============================\n\n(defun print-world (world &optional (stream t) depth)\n  (declare (ignore depth))\n  (prin1 (world-name world) stream))\n\n;;; ==============================\n\n(defun mapc-retrieve-in-world (fn query)\n  \"For every fact in the current world that matches the query,\n  apply the function to the binding list.\"\n  (dolist (bucket (fetch query))\n    (dolist (world/entries bucket)\n      (when (world-current (first world/entries))\n        (dolist (answer (rest world/entries))\n          (let ((bindings (unify query answer)))\n            (unless (eq bindings fail)\n              (funcall fn bindings))))))))\n\n(defun retrieve-in-world (query)\n  \"Find all facts that match query.  Return a list of bindings.\"\n  (let ((answers nil))\n    (mapc-retrieve-in-world\n      #'(lambda (bindings) (push bindings answers))\n      query)\n    answers))\n\n(defun retrieve-bagof-in-world (query)\n  \"Find all facts in the current world that match query.\n  Return a list of queries with bindings filled in.\"\n  (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n          (retrieve-in-world query)))\n\n;;; ==============================\n\n(defun nlist-delete (item nlist)\n  \"Remove an element from an nlist.\n  Assumes that item is present exactly once.\"\n  (decf (car nlist))\n  (setf (cdr nlist) (delete item (cdr nlist) :count 1))\n  nlist)\n\n;;; ==============================\n\n;;;; The attached functions:\n\n(def-attached-fn ind (individual category)\n  ;; Cache facts about inherited categories\n  (query-bind (?super) `(sub ,category ?super)\n    (add-fact `(ind ,individual ,?super))))\n\n(def-attached-fn val (relation ind1 ind2)\n  ;; Make sure the individuals are the right kinds\n  (query-bind (?cat1 ?cat2) `(rel ,relation ?cat1 ?cat2)\n    (add-fact `(ind ,ind1 ,?cat1))\n    (add-fact `(ind ,ind2 ,?cat2))))\n\n(def-attached-fn rel (relation cat1 cat2)\n  ;; Run attached function for any IND's of this relation\n  (query-bind (?a ?b) `(ind ,relation ?a ?b)\n    (run-attached-fn `(ind ,relation ,?a ,?b))))\n\n(def-attached-fn sub (subcat supercat)\n  ;; Cache SUB facts\n  (query-bind (?super-super) `(sub ,supercat ?super-super)\n    (index-new-fact `(sub ,subcat ,?super-super))\n    (query-bind (?sub-sub) `(sub ?sub-sub ,subcat)\n      (index-new-fact `(sub ,?sub-sub ,?super-super))))\n  (query-bind (?sub-sub) `(sub ?sub-sub ,subcat)\n    (index-new-fact `(sub ,?sub-sub ,supercat)))\n  ;; Cache IND facts\n  (query-bind (?super-super) `(sub ,subcat ?super-super)\n    (query-bind (?sub-sub) `(sub ?sub-sub ,supercat)\n      (query-bind (?ind) `(ind ?ind ,?sub-sub)\n        (index-new-fact `(ind ,?ind ,?super-super))))))\n"
  },
  {
    "path": "lisp/krep1.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp;  -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;; krep1.lisp: Knowledge representation code; first version.\n\n(requires \"prolog\")\n\n;;; ==============================\n\n;; An nlist is implemented as a (count . elements) pair:\n(defun make-empty-nlist ()\n  \"Create a new, empty nlist.\"\n  (cons 0 nil))\n\n(defun nlist-n (x) \"The number of elements in an nlist.\" (car x))\n(defun nlist-list (x) \"The elements in an nlist.\" (cdr x))\n\n(defun nlist-push (item nlist)\n  \"Add a new element to an nlist.\"\n  (incf (car nlist))\n  (push item (cdr nlist))\n  nlist)\n\n;;; ==============================\n\n(defstruct (dtree (:type vector))\n  (first nil) (rest nil) (atoms nil) (var (make-empty-nlist)))\n\n;;; ==============================\n\n;; Not all Lisps handle the closure properly, so change the local PREDICATES\n;; to a global *predicates* - norvig Jun 11 1996\n(defvar *predicates* nil)\n\n(defun get-dtree (predicate)\n  \"Fetch (or make) the dtree for this predicate.\"\n  (cond ((get predicate 'dtree))\n\t(t (push predicate *predicates*)\n\t   (setf (get predicate 'dtree) (make-dtree)))))\n\n(defun clear-dtrees ()\n  \"Remove all the dtrees for all the predicates.\"\n  (dolist (predicate *predicates*)\n    (setf (get predicate 'dtree) nil))\n  (setf *predicates* nil))\n\n;;; ==============================\n\n(defun index (key)\n  \"Store key in a dtree node.  Key must be (predicate . args);\n  it is stored in the predicate's dtree.\"\n  (dtree-index key key (get-dtree (predicate key))))\n\n(defun dtree-index (key value dtree)\n  \"Index value under all atoms of key in dtree.\"\n  (cond\n    ((consp key)               ; index on both first and rest\n     (dtree-index (first key) value\n                  (or (dtree-first dtree)\n                      (setf (dtree-first dtree) (make-dtree))))\n     (dtree-index (rest key) value\n                  (or (dtree-rest dtree)\n                      (setf (dtree-rest dtree) (make-dtree)))))\n    ((null key))               ; don't index on nil\n    ((variable-p key)          ; index a variable\n     (nlist-push value (dtree-var dtree)))\n    (t ;; Make sure there is an nlist for this atom, and add to it\n     (nlist-push value (lookup-atom key dtree)))))\n\n(defun lookup-atom (atom dtree)\n  \"Return (or create) the nlist for this atom in dtree.\"\n  (or (lookup atom (dtree-atoms dtree))\n      (let ((new (make-empty-nlist)))\n        (push (cons atom new) (dtree-atoms dtree))\n        new)))\n\n;;; ==============================\n\n(defun test-index ()\n  (let ((props '((p a b) (p a c) (p a ?x) (p b c)\n                 (p b (f c)) (p a (f . ?x)))))\n    (clear-dtrees)\n    (mapc #'index props)\n    (write (list props (get-dtree 'p))\n           :circle t :array t :pretty t)\n    (values)))\n\n;;; ==============================\n\n(defun fetch (query)\n  \"Return a list of buckets potentially matching the query,\n  which must be a relation of form (predicate . args).\"\n  (dtree-fetch query (get-dtree (predicate query))\n               nil 0 nil most-positive-fixnum))\n\n;;; ==============================\n\n(defun dtree-fetch (pat dtree var-list-in var-n-in best-list best-n)\n  \"Return two values: a list-of-lists of possible matches to pat,\n  and the number of elements in the list-of-lists.\"\n  (if (or (null dtree) (null pat) (variable-p pat))\n      (values best-list best-n)\n      (let* ((var-nlist (dtree-var dtree))\n             (var-n (+ var-n-in (nlist-n var-nlist)))\n             (var-list (if (null (nlist-list var-nlist))\n                           var-list-in\n                           (cons (nlist-list var-nlist)\n                                 var-list-in))))\n        (cond\n          ((>= var-n best-n) (values best-list best-n))\n          ((atom pat) (dtree-atom-fetch pat dtree var-list var-n\n                                        best-list best-n))\n          (t (multiple-value-bind (list1 n1)\n                 (dtree-fetch (first pat) (dtree-first dtree)\n                              var-list var-n best-list best-n)\n               (dtree-fetch (rest pat) (dtree-rest dtree)\n                            var-list var-n list1 n1)))))))\n\n(defun dtree-atom-fetch (atom dtree var-list var-n best-list best-n)\n  \"Return the answers indexed at this atom (along with the vars),\n  or return the previous best answer, if it is better.\"\n  (let ((atom-nlist (lookup atom (dtree-atoms dtree))))\n    (cond\n      ((or (null atom-nlist) (null (nlist-list atom-nlist)))\n       (values var-list var-n))\n      ((and atom-nlist (< (incf var-n (nlist-n atom-nlist)) best-n))\n       (values (cons (nlist-list atom-nlist) var-list) var-n))\n      (t (values best-list best-n)))))\n\n;;; ==============================\n\n(proclaim '(inline mapc-retrieve))\n\n(defun mapc-retrieve (fn query)\n  \"For every fact that matches the query,\n  apply the function to the binding list.\"\n  (dolist (bucket (fetch query))\n    (dolist (answer bucket)\n      (let ((bindings (unify query answer)))\n        (unless (eq bindings fail)\n          (funcall fn bindings))))))\n\n;;; ==============================\n\n(defun retrieve (query)\n  \"Find all facts that match query.  Return a list of bindings.\"\n  (let ((answers nil))\n    (mapc-retrieve #'(lambda (bindings) (push bindings answers))\n                   query)\n    answers))\n\n(defun retrieve-matches (query)\n  \"Find all facts that match query.\n  Return a list of expressions that match the query.\"\n  (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n          (retrieve query)))\n\n;;; ==============================\n\n(defmacro query-bind (variables query &body body)\n  \"Execute the body for each match to the query.\n  Within the body, bind each variable.\"\n  (let* ((bindings (gensym \"BINDINGS\"))\n         (vars-and-vals\n           (mapcar\n             #'(lambda (var)\n                 (list var `(subst-bindings ,bindings ',var)))\n             variables)))\n    `(mapc-retrieve\n       #'(lambda (,bindings)\n           (let ,vars-and-vals\n             ,@body))\n       ,query)))\n"
  },
  {
    "path": "lisp/krep2.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp;  -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;; krep1.lisp: Knowledge representation code; second version.\n;;; Fixes problem with renaming variables; adds conjunctions.\n\n(requires \"krep1\") ; Need some functions from previous version\n\n(defun index (key)\n  \"Store key in a dtree node.  Key must be (predicate . args);\n  it is stored in the predicate's dtree.\"\n  (dtree-index key (rename-variables key)    ; store unique vars\n               (get-dtree (predicate key))))\n\n;;; ==============================\n\n;;; The following iterated-deepening code is not used, but is\n;;; included for those who want to incorporate it into prolog.\n\n(defvar *search-cut-off* nil \"Has the search been stopped?\")\n\n(defun prove-all (goals bindings depth)\n  \"Find a solution to the conjunction of goals.\"\n  ;; This version just passes the depth on to PROVE.\n  (cond ((eq bindings fail) fail)\n        ((null goals) bindings)\n        (t (prove (first goals) bindings (rest goals) depth))))\n\n(defun prove (goal bindings other-goals depth)\n  \"Return a list of possible solutions to goal.\"\n  ;; Check if the depth bound has been exceeded\n  (if (= depth 0)                            ;***\n      (progn (setf *search-cut-off* t)       ;***\n             fail)                           ;***\n      (let ((clauses (get-clauses (predicate goal))))\n        (if (listp clauses)\n            (some\n              #'(lambda (clause)\n                  (let ((new-clause (rename-variables clause)))\n                    (prove-all\n                      (append (clause-body new-clause) other-goals)\n                      (unify goal (clause-head new-clause) bindings)\n                      (- depth 1))))          ;***\n              clauses)\n            ;; The predicate's \"clauses\" can be an atom:\n            ;; a primitive function to call\n            (funcall clauses (rest goal) bindings\n                     other-goals depth)))))   ;***\n\n;;; ==============================\n\n(defparameter *depth-start* 5\n  \"The depth of the first round of iterative search.\")\n(defparameter *depth-incr* 5\n  \"Increase each iteration of the search by this amount.\")\n(defparameter *depth-max* most-positive-fixnum\n  \"The deepest we will ever search.\")\n\n;;; ==============================\n\n(defun top-level-prove (goals)\n  (let ((all-goals\n          `(,@goals (show-prolog-vars ,@(variables-in goals)))))\n    (loop for depth from *depth-start* to *depth-max* by *depth-incr*\n          while (let ((*search-cut-off* nil))\n                  (prove-all all-goals no-bindings depth)\n                  *search-cut-off*)))\n  (format t \"~&No.\")\n  (values))\n\n;;; ==============================\n\n(defun show-prolog-vars (vars bindings other-goals depth)\n  \"Print each variable with its binding.\n  Then ask the user if more solutions are desired.\"\n  (if (> depth *depth-incr*)\n      fail\n      (progn\n        (if (null vars)\n            (format t \"~&Yes\")\n            (dolist (var vars)\n              (format t \"~&~a = ~a\" var\n                      (subst-bindings bindings var))))\n        (if (continue-p)\n            fail\n            (prove-all other-goals bindings depth)))))\n\n;;; ==============================\n\n;;;; Adding support for conjunctions:\n\n(defun add-fact (fact)\n  \"Add the fact to the data base.\"\n  (if (eq (predicate fact) 'and)\n      (mapc #'add-fact (args fact))\n      (index fact)))\n\n;;; ==============================\n\n(defun retrieve-fact (query &optional (bindings no-bindings))\n  \"Find all facts that match query.  Return a list of bindings.\"\n  (if (eq (predicate query) 'and)\n      (retrieve-conjunction (args query) (list bindings))\n      (retrieve query bindings)))\n\n(defun retrieve-conjunction (conjuncts bindings-lists)\n  \"Return a list of binding lists satisfying the conjuncts.\"\n  (mapcan\n    #'(lambda (bindings)\n        (cond ((eq bindings fail) nil)\n              ((null conjuncts) (list bindings))\n              (t (retrieve-conjunction\n                   (rest conjuncts)\n                   (retrieve-fact\n                     (subst-bindings bindings (first conjuncts))\n                     bindings)))))\n    bindings-lists))\n\n;;; ==============================\n\n(defun mapc-retrieve (fn query &optional (bindings no-bindings))\n  \"For every fact that matches the query,\n  apply the function to the binding list.\"\n  (dolist (bucket (fetch query))\n    (dolist (answer bucket)\n      (let ((new-bindings (unify query answer bindings)))\n        (unless (eq new-bindings fail)\n          (funcall fn new-bindings))))))\n\n(defun retrieve (query &optional (bindings no-bindings))\n  \"Find all facts that match query.  Return a list of bindings.\"\n  (let ((answers nil))\n    (mapc-retrieve #'(lambda (bindings) (push bindings answers))\n                   query bindings)\n    answers))\n\n\n;;; ==============================\n\n(defun retrieve-bagof (query)\n  \"Find all facts that match query.\n  Return a list of queries with bindings filled in.\"\n  (mapcar #'(lambda (bindings) (subst-bindings bindings query))\n          (retrieve-fact query)))\n\n(defun retrieve-setof (query)\n  \"Find all facts that match query.\n  Return a list of unique queries with bindings filled in.\"\n  (remove-duplicates (retrieve-bagof query) :test #'equal))\n\n;;; ==============================\n\n;;;; Get ready for attached functions in the next version:\n\n(defmacro def-attached-fn (pred args &body body)\n  \"Define the attached function for a primitive.\"\n  `(setf (get ',pred 'attached-fn)\n         #'(lambda ,args .,body)))\n"
  },
  {
    "path": "lisp/lexicon.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File lexicon.lisp:  Macros and functions to support the entry of\n;;;; words into the lexicon.\n\n(defvar *abbrevs* (make-hash-table))\n\n(defmacro abbrev (symbol definition)\n  \"Make symbol be an abbreviation for definition.\"\n  `(setf (gethash ',symbol *abbrevs*) ',definition))\n\n(defun clear-abbrevs () (clrhash *abbrevs*))\n(defun get-abbrev (symbol) (gethash symbol *abbrevs*))\n\n;;; ==============================\n\n(defvar *words* (make-hash-table :size 500))\n\n(defmacro word (word cat &rest info)\n  \"Put word, with category and subcat info, into lexicon.\"\n  `(add-word ',word ',cat .,(mapcar #'kwote info)))\n\n(defun add-word (word cat &rest info)\n  \"Put word, with category and other info, into lexicon.\"\n  (push (cons cat (mapcar #'expand-abbrevs-and-variables info))\n        (gethash word *words*))\n  word)\n\n(defun kwote (x) (list 'quote x))\n\n;;; ==============================\n\n(defun expand-abbrevs-and-variables (exp)\n  \"Replace all variables in exp with vars, and expand abbrevs.\"\n  (let ((bindings nil))\n    (labels\n      ((expand (exp)\n         (cond\n           ((lookup exp bindings))\n           ((eq exp '?) (?))\n           ((variable-p exp)\n            (let ((var (?)))\n              (push (cons exp var) bindings)\n              var))\n           ((consp exp)\n            (reuse-cons (expand (first exp))\n                        (expand (rest exp))\n                        exp))\n           (t (multiple-value-bind (expansion found?)\n                  (get-abbrev exp)\n                (if found?\n                    (expand-abbrevs-and-variables expansion)\n                    exp))))))\n      (expand exp))))\n\n;;; ==============================\n\n(defun word/n (word cat cont &rest info)\n  \"Retrieve a word from the lexicon.\"\n  (unless (unbound-var-p (deref word))\n    (let ((old-trail (fill-pointer *trail*)))\n      (dolist (old-entry (gethash word *words*))\n        (let ((entry (deref-copy old-entry)))\n          (when (and (consp entry)\n                     (unify! cat (first entry))\n                     (unify! info (rest entry)))\n            (funcall cont)))\n        (undo-bindings! old-trail)))))\n\n;;; ==============================\n\n(defun word/2 (w cat cont) (word/n w cat cont))\n(defun word/3 (w cat a cont) (word/n w cat cont a))\n(defun word/4 (w cat a b cont) (word/n w cat cont a b))\n(defun word/5 (w cat a b c cont) (word/n w cat cont a b c))\n(defun word/6 (w cat a b c d cont) (word/n w cat cont a b c d))\n\n;;; ==============================\n\n(defmacro noun (base &rest args)\n  \"Add a noun and its plural to the lexicon.\"\n  `(add-noun-form ',base ,@(mapcar #'kwote args)))\n\n(defun add-noun-form (base &optional (plural (symbol base 's))\n                      (sem base) &rest slots)\n  (if (eq plural '*)\n      (add-word base 'noun '? slots sem)\n      (progn\n        (add-word base 'noun '3sing slots sem)\n        (add-word plural 'noun '3plur slots sem))))\n\n(defmacro verb ((base &rest forms) &body senses)\n  \"Enter a verb into the lexicon.\"\n  `(add-verb ',senses ',base ,@(mapcar #'kwote (mklist forms))))\n\n(defun add-verb (senses base &optional\n                 (past (symbol (strip-vowel base) 'ed))\n                 (past-part past)\n                 (pres-part (symbol (strip-vowel base) 'ing))\n                 (plural (symbol base 's)))\n  \"Enter a verb into the lexicon.\"\n  (add-word base 'verb 'nonfinite senses)\n  (add-word base 'verb '(finite ~3sing present) senses)\n  (add-word past 'verb '(finite ? past) senses)\n  (add-word past-part 'verb '-en senses)\n  (add-word pres-part 'verb '-ing senses)\n  (add-word plural 'verb '(finite 3sing present) senses)\n  (add-word past-part 'verb 'passive\n            (mapcar #'passivize-sense\n                    (expand-abbrevs-and-variables senses))))\n\n;;; ==============================\n\n(defun strip-vowel (word)\n  \"Strip off a trailing vowel from a string.\"\n  (let* ((str (string word))\n         (end (- (length str) 1)))\n    (if (vowel-p (char str end))\n        (subseq str 0 end)\n        str)))\n\n(defun vowel-p (char) (find char \"aeiou\" :test #'char-equal))\n\n;;; ==============================\n\n(defun passivize-sense (sense)\n  ;; The first element of sense is the semantics; rest are slots\n  (cons (first sense) (mapcan #'passivize-subcat (rest sense))))\n\n(defun passivize-subcat (slots)\n  \"Return a list of passivizations of this subcat frame.\"\n  ;; Whenever the 1 slot is of the form (?any 1 (NP ?)),\n  ;; demote the 1 to a (3), and promote any 2 to a 1.\n  (when (and (eql (slot-number (first slots)) 1)\n             (starts-with (third (first slots)) 'NP))\n    (let ((old-1 `(,(first (first slots)) (3) (PP by ?))))\n      (loop for slot in slots\n            when (eql (slot-number slot) 2)\n            collect `((,(first slot) 1 ,(third slot))\n                      ,@(remove slot (rest slots))\n                      ,old-1)))))\n\n(defun slot-number (slot) (first-or-self (second slot)))\n\n;;; ==============================\n\n(defun copula (senses entries)\n  \"Copula entries are both aux and main verb.\"\n  ;; They also are used in passive verb phrases and aux-inv-S\n  (dolist (entry entries)\n    (add-word (first entry) 'aux (second entry) (third entry))\n    (add-word (first entry) 'verb (second entry) senses)\n    (add-word (first entry) 'aux (second entry) 'passive)\n    (add-word (first entry) 'be)))\n\n;;; ==============================\n\n(defun clear-lexicon ()\n  (clrhash *words*)\n  (clear-abbrevs))\n\n(defun clear-grammar ()\n  (clear-examples)\n  (clear-db))\n\n;;; ==============================\n\n(defmacro try (&optional cat &rest words)\n  \"Tries to parse WORDS as a constituent of category CAT.\n  With no words, runs all the :ex examples for category.\n  With no cat, runs all the examples.\"\n  `(try-dcg ',cat ',words))\n\n(defun try-dcg (&optional cat words)\n  \"Tries to parse WORDS as a constituent of category CAT.\n  With no words, runs all the :ex examples for category.\n  With no cat, runs all the examples.\"\n  (if (null words)\n      (run-examples cat)\n      (let ((args `((gap nil) (gap nil) ?sem ,words ())))\n        (mapc #'test-unknown-word words)\n        (top-level-prove\n          (ecase cat\n            (np `((np ? ? ?wh ?x ,@args)))\n            (vp `((vp ?infl ?x ?sl ?v ,@args)))\n            (pp `((pp ?prep ?role ?wh ?x ,@args)))\n            (xp `((xp ?slot ?constituent ?wh ?x ,@args)))\n            (s  `((s ? ?sem ,words ())))\n            (rel-clause `((rel-clause ? ?x ?sem ,words ())))\n            (clause `((clause ?infl ?x ?int-subj ?v ?g1 ?g2\n                              ?sem ,words ()))))))))\n\n(defun test-unknown-word (word)\n  \"Print a warning message if this is an unknown word.\"\n  (unless (or (gethash word *words*) (numberp word))\n    (warn \"~&Unknown word: ~a\" word)))\n\n;;; ==============================\n\n"
  },
  {
    "path": "lisp/loop.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: User; -*-\n\n#|| Examples of Loop expansion:\n\n(loop for i from 1 to n do (print (sqrt i))) ==\n(LET* ((I 1)\n       (TEMP N))\n  (TAGBODY\n   LOOP\n      (IF (> I TEMP)\n          (GO END))\n      (PRINT (SQRT I))\n      (SETF I (+ I 1))\n      (GO LOOP)\n   END))\n\n\n(loop for v in list do (print v)) ==\n(LET* ((IN LIST)\n       (V (CAR IN)))\n  (TAGBODY\n   LOOP\n      (IF (NULL IN)\n          (GO END))\n      (PRINT V)\n      (SETF IN (CDR IN))\n      (SETF V (CAR IN))\n      (GO LOOP)\n   END))\n\n;;; ==============================\n\n(let* (variables...)\n  (tagbody\n   loop\n      (if exit-tests\n          (go end))\n      body\n      (go loop)\n   end))\n\n;;; ==============================\n\n(let* (variables...)\n  (block name\n    prologue\n    (tagbody\n     loop\n        body\n        (go loop)\n     end\n        epilogue\n        (return result))))\n\n||#\n\n;;; ==============================\n\n(defstruct loop\n  \"A structure to hold parts of a loop as it is built.\"\n  (vars nil) (prologue nil) (body nil) (steps nil)\n  (epilogue nil) (result nil) (name nil))\n\n;;; ==============================\n\n(defmacro loop (&rest exps)\n  \"Supports both ANSI and simple LOOP.\n  Warning: Not every loop keyword is supported.\"\n  (if (every #'listp exps)\n      ;; No keywords implies simple loop:\n      `(block nil (tagbody loop ,@exps (go loop)))\n      ;; otherwise process loop keywords:\n      (let ((l (make-loop)))\n        (parse-loop-body l exps)\n        (fill-loop-template l))))\n\n(defun fill-loop-template (l)\n  \"Use a loop-structure instance to fill the template.\"\n  `(let* ,(nreverse (loop-vars l))\n     (block ,(loop-name l)\n       ,@(nreverse (loop-prologue l))\n       (tagbody\n        loop\n           ,@(nreverse (loop-body l))\n           ,@(nreverse (loop-steps l))\n           (go loop)\n        end\n           ,@(nreverse (loop-epilogue l))\n           (return ,(loop-result l))))))\n\n;;; ==============================\n\n(defun add-body (l exp) (push exp (loop-body l)))\n\n(defun add-test (l test)\n  \"Put in a test for loop termination.\"\n  (push `(if ,test (go end)) (loop-body l)))\n\n(defun add-var (l var init &optional (update nil update?))\n  \"Add a variable, maybe including an update step.\"\n  (unless (assoc var (loop-vars l))\n    (push (list var init) (loop-vars l)))\n  (when update?\n    (push `(setq ,var ,update) (loop-steps l))))\n\n;;; ==============================\n\n(defun parse-loop-body (l exps)\n  \"Parse the exps based on the first exp being a keyword.\n  Continue until all the exps are parsed.\"\n  (unless (null exps)\n    (parse-loop-body\n      l (call-loop-fn l (first exps) (rest exps)))))\n\n(defun call-loop-fn (l key exps)\n  \"Return the loop parsing function for this keyword\"\n  (if (and (symbolp key) (get key 'loop-fn))\n      (funcall (get key 'loop-fn) l (first exps) (rest exps))\n      (error \"Unknown loop key: ~a\" key)))\n\n(defmacro defloop (key args &rest body)\n  \"Define a new LOOP keyword.\"\n  ;; If the args do not have a third arg, one is supplied.\n  ;; Also, we can define an alias with (defloop key other-key)\n  `(setf (get ',key 'loop-fn)\n         ,(cond ((and (symbolp args) (null body))\n                 `#'(lambda (l x y)\n                      (call-loop-fn l ',args (cons x y))))\n                ((and (listp args) (= (length args) 2))\n                 `#'(lambda (,@args -exps-) ,@body -exps-))\n                (t `#'(lambda ,args ,@body)))))\n\n;;; ==============================\n\n(defloop repeat (l times)\n  \"(LOOP REPEAT n ...) does loop body n times\"\n  (let ((i (gensym \"REPEAT\")))\n    (add-var l i times `(- ,i 1))\n    (add-test l `(<= ,i 0))))\n\n;;; ==============================\n\n(defloop as for)  ;; AS is the same as FOR\n\n(defloop for (l var exps)\n  \"4 of the 7 cases for FOR are covered here:\n  (LOOP FOR i FROM s TO e BY inc ...) does arithemtic iteration\n  (LOOP FOR v IN l ...) iterates for each element of l\n  (LOOP FOR v ON l ...) iterates for each tail of l\n  (LOOP FOR v = expr [THEN step]) initializes and iterates v\"\n  (let ((key (first exps))\n        (source (second exps))\n        (rest (rest2 exps)))\n    (ecase key\n      ((from downfrom upfrom to downto upto by)\n       (loop-for-arithmetic l var exps))\n      (in (let ((v (gensym \"IN\")))\n            (add-var l v source `(cdr ,v))\n            (add-var l var `(car ,v) `(car ,v))\n            (add-test l `(null ,v))\n            rest))\n      (on (add-var l var source `(cdr ,var))\n          (add-test l `(null ,var))\n          rest)\n      (= (if (eq (first rest) 'then)\n             (progn\n               (pop rest)\n               (add-var l var source (pop rest)))\n             (progn\n               (add-var l var nil)\n               (add-body l `(setq ,var ,source))))\n         rest)\n      ;; ACROSS, BEING clauses omitted\n      )))\n\n(defun loop-for-arithmetic (l var exps)\n  \"Parse loop expressions of the form:\n  (LOOP FOR var [FROM|DOWNFROM|UPFROM exp1] [TO|DOWNTO|UPTO exp2]\n        [BY exp3]\"\n  ;; The prepositions BELOW and ABOVE are omitted\n  (let ((exp1 0)\n        (exp2 nil)\n        (exp3 1)\n        (down? nil))\n    ;; Parse the keywords:\n    (when (member (first exps) '(from downfrom upfrom))\n      (setf exp1 (second exps)\n            down? (eq (first exps) 'downfrom)\n            exps (rest2 exps)))\n    (when (member (first exps) '(to downto upto))\n      (setf exp2 (second exps)\n            down? (or down? (eq (first exps) 'downto))\n            exps (rest2 exps)))\n    (when (eq (first exps) 'by)\n      (setf exp3 (second exps)\n            exps (rest2 exps)))\n    ;; Add variables and tests:\n    (add-var l var exp1\n             `(,(if down? '- '+) ,var ,(maybe-temp l exp3)))\n    (when exp2\n      (add-test l `(,(if down? '< '>) ,var ,(maybe-temp l exp2))))\n    ;; and return the remaining expressions:\n    exps))\n\n(defun maybe-temp (l exp)\n  \"Generate a temporary variable, if needed.\"\n  (if (constantp exp)\n      exp\n      (let ((temp (gensym \"TEMP\")))\n        (add-var l temp exp)\n        temp)))\n\n;;; ==============================\n\n(defloop until (l test) (add-test l test))\n\n(defloop while (l test) (add-test l `(not ,test)))\n\n(defloop always (l test)\n  (setf (loop-result l) t)\n  (add-body l `(if (not ,test) (return nil))))\n\n(defloop never (l test)\n  (setf (loop-result l) t)\n  (add-body l `(if ,test (return nil))))\n\n(defloop thereis (l test) (add-body l `(return-if ,test)))\n\n(defmacro return-if (test)\n  \"Return TEST if it is non-nil\"\n  (let ((var (gensym)))\n    `(let ((,var ,test))\n      (if ,var (return ,var)))))\n\n(defmacro loop-finish () `(go end))\n\n;;; ==============================\n\n(defconstant *acc* (gensym \"ACC\")\n  \"Variable used for value accumulation in LOOP.\")\n\n;;; INTO preposition is omitted\n\n(defloop collect (l exp)\n  (add-var l *acc* '(make-queue))\n  (add-body l `(enqueue ,exp ,*acc*))\n  (setf (loop-result l) `(queue-contents ,*acc*)))\n\n(defloop nconc (l exp)\n  (add-var l *acc* '(make-queue))\n  (add-body l `(queue-nconc ,*acc* ,exp))\n  (setf (loop-result l) `(queue-contents ,*acc*)))\n\n(defloop append (l exp exps)\n  (call-loop-fn l 'nconc `((copy-list ,exp) .,exps)))\n\n(defloop count (l exp)\n  (add-var l *acc* 0)\n  (add-body l `(when ,exp (incf ,*acc*)))\n  (setf (loop-result l) *acc*))\n\n(defloop sum (l exp)\n  (add-var l *acc* 0)\n  (add-body l `(incf ,*acc* ,exp))\n  (setf (loop-result l) *acc*))\n\n(defloop maximize (l exp)\n  (add-var l *acc* nil)\n  (add-body l `(setf ,*acc*\n                     (if ,*acc*\n                         (max ,*acc* ,exp)\n                         ,exp)))\n  (setf (loop-result l) *acc*))\n\n(defloop minimize (l exp)\n  (add-var l *acc* nil)\n  (add-body l `(setf ,*acc*\n                     (if ,*acc*\n                         (min ,*acc* ,exp)\n                         ,exp)))\n  (setf (loop-result l) *acc*))\n\n(defloop collecting collect)\n(defloop nconcing   nconc)\n(defloop appending  append)\n(defloop counting   count)\n(defloop summing    sum)\n(defloop maximizing maximize)\n(defloop minimizing minimize)\n\n;;; ==============================\n\n;;;; 26.9. Variable Initializations (\"and\" omitted)\n\n(defloop with (l var exps)\n  (let ((init nil))\n    (when (eq (first exps) '=)\n      (setf init (second exps)\n            exps (rest2 exps)))\n    (add-var l var init)\n    exps))\n\n;;; ==============================\n\n(defloop when (l test exps)\n  (loop-unless l `(not ,(maybe-set-it test exps)) exps))\n\n(defloop unless (l test exps)\n  (loop-unless l (maybe-set-it test exps) exps))\n\n(defun maybe-set-it (test exps)\n  \"Return value, but if the variable IT appears in exps,\n  then return code that sets IT to value.\"\n  (if (find-anywhere 'it exps)\n      `(setq it ,test)\n      test))\n\n(defloop if when)\n\n(defun loop-unless (l test exps)\n  (let ((label (gensym \"L\")))\n    (add-var l 'it nil)\n    ;; Emit code for the test and the THEN part\n    (add-body l `(if ,test (go ,label)))\n    (setf exps (call-loop-fn l (first exps) (rest exps)))\n    ;; Optionally emit code for the ELSE part\n    (if (eq (first exps) 'else)\n        (progn\n          (let ((label2 (gensym \"L\")))\n            (add-body l `(go ,label2))\n            (add-body l label)\n            (setf exps (call-loop-fn l (second exps) (rest2 exps)))\n            (add-body l label2)))\n        (add-body l label)))\n    exps)\n\n;;; ==============================\n\n(defloop do (l exp exps)\n  (add-body l exp)\n  (loop (if (symbolp (first exps)) (RETURN exps))\n        (add-body l (pop exps))))\n\n(defloop return (l exp) (add-body l `(return ,exp)))\n\n;;; ==============================\n\n(defloop initially (l exp exps)\n  (push exp (loop-prologue l))\n  (loop (if (symbolp (first exps)) (RETURN exps))\n        (push (pop exps) (loop-prologue l))))\n\n(defloop finally (l exp exps)\n  (push exp (loop-epilogue l))\n  (loop (if (symbolp (first exps)) (RETURN exps))\n        (push (pop exps) (loop-epilogue l))))\n\n(defloop named (l exp) (setf (loop-name l) exp))\n\n"
  },
  {
    "path": "lisp/macsyma.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File macsyma.lisp: The implementation of MACSYMA in Chapter 8\n\n(requires \"patmatch\")\n\n(defun variable-p (exp)\n  \"Variables are the symbols M through Z.\"\n  ;; put x,y,z first to find them a little faster\n  (member exp '(x y z m n o p q r s t u v w)))\n\n;;; From student.lisp:\n(defstruct (rule (:type list)) pattern response)\n(defstruct (exp (:type list)\n                (:constructor mkexp (lhs op rhs)))\n  op lhs rhs)\n\n(defun exp-p (x) (consp x))\n(defun exp-args (x) (rest x))\n\n(defun binary-exp-p (x)\n  (and (exp-p x) (= (length (exp-args x)) 2)))\n\n(defun prefix->infix (exp)\n  \"Translate prefix to infix expressions.\"\n  (if (atom exp) exp\n      (mapcar #'prefix->infix\n              (if (binary-exp-p exp)\n                  (list (exp-lhs exp) (exp-op exp) (exp-rhs exp))\n                  exp))))\n\n;; Define x+ and y+ as a sequence:\n(pat-match-abbrev 'x+ '(?+ x))\n(pat-match-abbrev 'y+ '(?+ y))\n\n;; Define n and m as numbers; s as a non-number:\n(pat-match-abbrev 'n '(?is n numberp))\n(pat-match-abbrev 'm '(?is m numberp))\n(pat-match-abbrev 's '(?is s not-numberp))\n\n(defparameter *infix->prefix-rules*\n  (mapcar #'expand-pat-match-abbrev\n    '(((x+ = y+) (= x y))\n      ((- x+)    (- x))\n      ((+ x+)    (+ x))\n      ((x+ + y+) (+ x y))\n      ((x+ - y+) (- x y))\n      ((d y+ / d x) (d y x))        ;*** New rule\n      ((Int y+ d x) (int y x))      ;*** New rule\n      ((x+ * y+) (* x y))\n      ((x+ / y+) (/ x y))\n      ((x+ ^ y+) (^ x y)))))\n\n(defun infix->prefix (exp)\n  \"Translate an infix expression into prefix notation.\"\n  ;; Note we cannot do implicit multiplication in this system\n  (cond ((atom exp) exp)\n        ((= (length exp) 1) (infix->prefix (first exp)))\n        ((rule-based-translator exp *infix->prefix-rules*\n           :rule-if #'rule-pattern :rule-then #'rule-response\n           :action\n           #'(lambda (bindings response)\n               (sublis (mapcar\n                         #'(lambda (pair)\n                             (cons (first pair)\n                                   (infix->prefix (rest pair))))\n                         bindings)\n                       response))))\n        ((symbolp (first exp))\n         (list (first exp) (infix->prefix (rest exp))))\n        (t (error \"Illegal exp\"))))\n\n(defvar *simplification-rules* nil) ;Rules are in file macsymar.lisp\n\n(defun ^ (x y) \"Exponentiation\" (expt x y))\n\n(defun simplifier ()\n  \"Read a mathematical expression, simplify it, and print the result.\"\n  (loop\n    (print 'simplifier>)\n    (print (simp (read)))))\n\n(defun simp (inf) (prefix->infix (simplify (infix->prefix inf))))\n\n(defun simplify (exp)\n  \"Simplify an expression by first simplifying its components.\"\n  (if (atom exp) exp\n      (simplify-exp (mapcar #'simplify exp))))\n\n;;; simplify-exp is redefined below\n;(defun simplify-exp (exp)\n;  \"Simplify using a rule, or by doing arithmetic.\"\n;  (cond ((rule-based-translator exp *simplification-rules*\n;           :rule-if #'exp-lhs :rule-then #'exp-rhs\n;           :action #'(lambda (bindings response)\n;                       (simplify (sublis bindings response)))))\n;        ((evaluable exp) (eval exp))\n;        (t exp)))\n\n(defun evaluable (exp)\n  \"Is this an arithmetic expression that can be evaluated?\"\n  (and (every #'numberp (exp-args exp))\n       (or (member (exp-op exp) '(+ - * /))\n           (and (eq (exp-op exp) '^)\n                (integerp (second (exp-args exp)))))))\n\n(defun not-numberp (x) (not (numberp x)))\n\n(defun simp-rule (rule)\n  \"Transform a rule into proper format.\"\n  (let ((exp (infix->prefix rule)))\n    (mkexp (expand-pat-match-abbrev (exp-lhs exp))\n           (exp-op exp) (exp-rhs exp))))\n\n(defun simp-fn (op) (get op 'simp-fn))\n(defun set-simp-fn (op fn) (setf (get op 'simp-fn) fn))\n\n(defun simplify-exp (exp)\n  \"Simplify using a rule, or by doing arithmetic,\n  or by using the simp function supplied for this operator.\"\n  (cond ((simplify-by-fn exp))                             ;***\n        ((rule-based-translator exp *simplification-rules*\n           :rule-if #'exp-lhs :rule-then #'exp-rhs\n           :action #'(lambda (bindings response)\n                       (simplify (sublis bindings response)))))\n        ((evaluable exp) (eval exp))\n        (t exp)))\n\n(defun simplify-by-fn (exp)\n  \"If there is a simplification fn for this exp,\n  and if applying it gives a non-null result,\n  then simplify the result and return that.\"\n  (let* ((fn (simp-fn (exp-op exp)))\n         (result (if fn (funcall fn exp))))\n    (if (null result)\n        nil\n        (simplify result))))\n\n(defun factorize (exp)\n  \"Return a list of the factors of exp^n,\n  where each factor is of the form (^ y n).\"\n  (let ((factors nil)\n        (constant 1))\n    (labels\n      ((fac (x n)\n         (cond\n           ((numberp x)\n            (setf constant (* constant (expt x n))))\n           ((starts-with x '*)\n            (fac (exp-lhs x) n)\n            (fac (exp-rhs x) n))\n           ((starts-with x '/)\n            (fac (exp-lhs x) n)\n            (fac (exp-rhs x) (- n)))\n           ((and (starts-with x '-) (length=1 (exp-args x)))\n            (setf constant (- constant))\n            (fac (exp-lhs x) n))\n           ((and (starts-with x '^) (numberp (exp-rhs x)))\n            (fac (exp-lhs x) (* n (exp-rhs x))))\n           (t (let ((factor (find x factors :key #'exp-lhs\n                                  :test #'equal)))\n                (if factor\n                    (incf (exp-rhs factor) n)\n                    (push `(^ ,x ,n) factors)))))))\n      ;; Body of factorize:\n      (fac exp 1)\n      (case constant\n        (0 '((^ 0 1)))\n        (1 factors)\n        (t `((^ ,constant 1) .,factors))))))\n\n(defun unfactorize (factors)\n  \"Convert a list of factors back into prefix form.\"\n  (cond ((null factors) 1)\n        ((length=1 factors) (first factors))\n        (t `(* ,(first factors) ,(unfactorize (rest factors))))))\n\n(defun divide-factors (numer denom)\n  \"Divide a list of factors by another, producing a third.\"\n  (let ((result (mapcar #'copy-list numer)))\n    (dolist (d denom)\n      (let ((factor (find (exp-lhs d) result :key #'exp-lhs\n                          :test #'equal)))\n        (if factor\n            (decf (exp-rhs factor) (exp-rhs d))\n            (push `(^ ,(exp-lhs d) ,(- (exp-rhs d))) result))))\n    (delete 0 result :key #'exp-rhs)))\n\n(defun free-of (exp var)\n  \"True if expression has no occurrence of var.\"\n  (not (find-anywhere var exp)))\n\n(defun find-anywhere (item tree)\n  \"Does item occur anywhere in tree?  If so, return it.\"\n  (cond ((eql item tree) tree)\n        ((atom tree) nil)\n        ((find-anywhere item (first tree)))\n        ((find-anywhere item (rest tree)))))\n\n(defun integrate (exp x)\n  ;; First try some trivial cases\n  (cond\n    ((free-of exp x) `(* ,exp ,x))         ; Int c dx = c*x\n    ((starts-with exp '+)                  ; Int f + g  =\n     `(+ ,(integrate (exp-lhs exp) x)      ;   Int f + Int g\n         ,(integrate (exp-rhs exp) x)))\n    ((starts-with exp '-)\n     (ecase (length (exp-args exp))\n       (1 `(- ,(integrate (exp-lhs exp) x))) ; Int - f = - Int f\n       (2 `(- ,(integrate (exp-lhs exp) x)   ; Int f - g  =\n              ,(integrate (exp-rhs exp) x)))))  ; Int f - Int g\n    ;; Now move the constant factors to the left of the integral\n    ((multiple-value-bind (const-factors x-factors)\n         (partition-if #'(lambda (factor) (free-of factor x))\n                       (factorize exp))\n       (identity ;simplify\n         `(* ,(unfactorize const-factors)\n             ;; And try to integrate:\n             ,(cond ((null x-factors) x)\n                    ((some #'(lambda (factor)\n                               (deriv-divides factor x-factors x))\n                           x-factors))\n                    ;; <other methods here>\n                    (t `(int? ,(unfactorize x-factors) ,x)))))))))\n\n(defun partition-if (pred list)\n  \"Return 2 values: elements of list that satisfy pred,\n  and elements that don't.\"\n  (let ((yes-list nil)\n        (no-list nil))\n    (dolist (item list)\n      (if (funcall pred item)\n          (push item yes-list)\n          (push item no-list)))\n    (values (nreverse yes-list) (nreverse no-list))))\n\n(defun deriv-divides (factor factors x)\n  (assert (starts-with factor '^))\n  (let* ((u (exp-lhs factor))              ; factor = u^n\n         (n (exp-rhs factor))\n         (k (divide-factors\n              factors (factorize `(* ,factor ,(deriv u x))))))\n    (cond ((free-of k x)\n           ;; Int k*u^n*du/dx dx = k*Int u^n du\n           ;;                    = k*u^(n+1)/(n+1) for n/=1\n           ;;                    = k*log(u) for n=1\n           (if (= n -1)\n               `(* ,(unfactorize k) (log ,u))\n               `(/ (* ,(unfactorize k) (^ ,u ,(+ n 1)))\n                   ,(+ n 1))))\n          ((and (= n 1) (in-integral-table? u))\n           ;; Int y'*f(y) dx = Int f(y) dy\n           (let ((k2 (divide-factors\n                       factors\n                       (factorize `(* ,u ,(deriv (exp-lhs u) x))))))\n             (if (free-of k2 x)\n                 `(* ,(integrate-from-table (exp-op u) (exp-lhs u))\n                     ,(unfactorize k2))))))))\n\n(defun deriv (y x) (simplify `(d ,y ,x)))\n\n(defun integration-table (rules)\n  (dolist (i-rule rules)\n    ;; changed infix->prefix to simp-rule - norvig Jun 11 1996\n    (let ((rule (simp-rule i-rule)))\n      (setf (get (exp-op (exp-lhs (exp-lhs rule))) 'int)\n            rule))))\n\n(defun in-integral-table? (exp)\n  (and (exp-p exp) (get (exp-op exp) 'int)))\n\n(defun integrate-from-table (op arg)\n  (let ((rule (get op 'int)))\n    (subst arg (exp-lhs (exp-lhs (exp-lhs rule))) (exp-rhs rule))))\n\n(set-simp-fn 'Int #'(lambda (exp)\n                      (unfactorize\n                        (factorize\n                          (integrate (exp-lhs exp) (exp-rhs exp))))))\n"
  },
  {
    "path": "lisp/macsymar.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File macsymar.lisp: The rewrite rules for MACSYMA in Chapter 8\n\n(requires \"macsyma\")\n\n(setf *simplification-rules* (mapcar #'simp-rule '(\n  (x + 0  = x)\n  (0 + x  = x)\n  (x + x  = 2 * x)\n  (x - 0  = x)\n  (0 - x  = - x)\n  (x - x  = 0)\n  (- - x  = x)\n  (x * 1  = x)\n  (1 * x  = x)\n  (x * 0  = 0)\n  (0 * x  = 0)\n  (x * x  = x ^ 2)\n  (x / 0  = undefined)\n  (0 / x  = 0)\n  (x / 1  = x)\n  (x / x  = 1)\n  (0 ^ 0  = undefined)\n  (x ^ 0  = 1)\n  (0 ^ x  = 0)\n  (1 ^ x  = 1)\n  (x ^ 1  = x)\n  (x ^ -1 = 1 / x)\n  (x * (y / x) = y)\n  ((y / x) * x = y)\n  ((y * x) / x = y)\n  ((x * y) / x = y)\n  (x + - x = 0)\n  ((- x) + x = 0)\n  (x + y - x = y)\n  )))\n\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule\n  '((s * n = n * s)\n    (n * (m * x) = (n * m) * x)\n    (x * (n * y) = n * (x * y))\n    ((n * x) * y = n * (x * y))\n    (n + s = s + n)\n    ((x + m) + n = x + n + m)\n    (x + (y + n) = (x + y) + n)\n    ((x + n) + y = (x + y) + n)))))\n\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule '(\n  (log 1         = 0)\n  (log 0         = undefined)\n  (log e         = 1)\n  (sin 0         = 0)\n  (sin pi        = 0)\n  (cos 0         = 1)\n  (cos pi        = -1)\n  (sin(pi / 2)   = 1)\n  (cos(pi / 2)   = 0)\n  (log (e ^ x)   = x)\n  (e ^ (log x)   = x)\n  ((x ^ y) * (x ^ z) = x ^ (y + z))\n  ((x ^ y) / (x ^ z) = x ^ (y - z))\n  (log x + log y = log(x * y))\n  (log x - log y = log(x / y))\n  ((sin x) ^ 2 + (cos x) ^ 2 = 1)\n  ))))\n\n\n(setf *simplification-rules*\n (append *simplification-rules* (mapcar #'simp-rule '(\n  (d x / d x       = 1)\n  (d (u + v) / d x = (d u / d x) + (d v / d x))\n  (d (u - v) / d x = (d u / d x) - (d v / d x))\n  (d (- u) / d x   = - (d u / d x))\n  (d (u * v) / d x = u * (d v / d x) + v * (d u / d x))\n  (d (u / v) / d x = (v * (d u / d x) - u * (d v / d x))\n                     / v ^ 2) ; [This corrects an error in the first printing]\n  (d (u ^ n) / d x = n * u ^ (n - 1) * (d u / d x))\n  (d (u ^ v) / d x = v * u ^ (v - 1) * (d u / d x)\n                   + u ^ v * (log u) * (d v / d x))\n  (d (log u) / d x = (d u / d x) / u)\n  (d (sin u) / d x = (cos u) * (d u / d x))\n  (d (cos u) / d x = - (sin u) * (d u / d x))\n  (d (e ^ u) / d x = (e ^ u) * (d u / d x))\n  (d u / d x       = 0)))))\n\n\n(integration-table\n  '((Int log(x) d x = x * log(x) - x)\n    (Int exp(x) d x = exp(x))\n    (Int sin(x) d x = - cos(x))\n    (Int cos(x) d x = sin(x))\n    (Int tan(x) d x = - log(cos(x)))\n    (Int sinh(x) d x = cosh(x))\n    (Int cosh(x) d x = sinh(x))\n    (Int tanh(x) d x = log(cosh(x)))\n    ))\n\n;;; Some examples to try (from an integration table):\n\n; (simp '(int sin(x) / cos(x) ^ 2 d x))\n; (simp '(int sin(x / a) d x))\n; (simp '(int sin(a + b * x) d x))\n; (simp '(int sin x * cos x d x))\n; (simp '(Int log x / x d x))\n; (simp '(Int 1 / (x * log x) d x))\n; (simp '(Int (log x) ^ 3 / x d x))\n; (simp '(Int exp(a * x) d x))\n"
  },
  {
    "path": "lisp/mycin-r.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File mycin-r.lisp: Sample parameter list and rulebase for mycin.\n\n(requires \"mycin\")\n\n;;; Parameters for patient:\n(defparm name patient t \"Patient's name: \" t read-line)\n(defparm sex patient (member male female) \"Sex:\" t)\n(defparm age patient number \"Age:\" t)\n(defparm burn patient (member no mild serious)\n  \"Is ~a a burn patient?  If so, mild or serious?\" t)\n(defparm compromised-host patient yes/no\n  \"Is ~a a compromised host?\")\n\n;;; Parameters for culture:\n(defparm site culture (member blood)\n  \"From what site was the specimen for ~a taken?\" t)\n(defparm days-old culture number\n  \"How many days ago was this culture (~a) obtained?\" t)\n\n;;; Parameters for organism:\n(defparm identity organism\n  (member pseudomonas klebsiella enterobacteriaceae\n          staphylococcus bacteroides streptococcus)\n  \"Enter the identity (genus) of ~a:\" t)\n(defparm gram organism (member acid-fast pos neg)\n  \"The gram stain of ~a:\" t)\n(defparm morphology organism (member rod coccus)\n  \"Is ~a a rod or coccus (etc.):\")\n(defparm aerobicity organism (member aerobic anaerobic))\n(defparm growth-conformation organism\n  (member chains pairs clumps))\n\n(clear-rules)\n\n(defrule 52\n  if (site culture is blood)\n     (gram organism is neg)\n     (morphology organism is rod)\n     (burn patient is serious)\n  then .4\n     (identity organism is pseudomonas))\n\n(defrule 71\n  if (gram organism is pos)\n     (morphology organism is coccus)\n     (growth-conformation organism is clumps)\n  then .7\n     (identity organism is staphylococcus))\n\n(defrule 73\n  if (site culture is blood)\n     (gram organism is neg)\n     (morphology organism is rod)\n     (aerobicity organism is anaerobic)\n  then .9\n     (identity organism is bacteroides))\n\n(defrule 75\n  if (gram organism is neg)\n     (morphology organism is rod)\n     (compromised-host patient is yes)\n  then .6\n     (identity organism is pseudomonas))\n\n(defrule 107\n  if (gram organism is neg)\n     (morphology organism is rod)\n     (aerobicity organism is aerobic)\n  then .8\n     (identity organism is enterobacteriaceae))\n\n(defrule 165\n  if (gram organism is pos)\n     (morphology organism is coccus)\n     (growth-conformation organism is chains)\n  then .7\n     (identity organism is streptococcus))\n\n"
  },
  {
    "path": "lisp/mycin.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File mycin.lisp: Chapter 16's implementation of MYCIN.\n;;;; A sample rulebase is provided in \"mycin-rules.lisp\".\n\n(defconstant true   +1.0)\n(defconstant false  -1.0)\n(defconstant unknown 0.0)\n\n(defun cf-or (a b)\n  \"Combine the certainty factors for the formula (A or B).\n  This is used when two rules support the same conclusion.\"\n  (cond ((and (> a 0) (> b 0))\n         (+ a b (* -1 a b)))\n        ((and (< a 0) (< b 0))\n         (+ a b (* a b)))\n        (t (/ (+ a b)\n              (- 1 (min (abs a) (abs b)))))))\n\n(defun cf-and (a b)\n  \"Combine the certainty factors for the formula (A and B).\"\n  (min a b))\n\n(defconstant cf-cut-off 0.2\n  \"Below this certainty we cut off search.\")\n\n(defun true-p (cf)\n  \"Is this certainty factor considered true?\"\n  (and (cf-p cf) (> cf cf-cut-off)))\n\n(defun false-p (cf)\n  \"Is this certainty factor considered false?\"\n  (and (cf-p cf) (< cf (- cf-cut-off 1.0))))\n\n(defun cf-p (x)\n  \"Is X a valid numeric certainty factor?\"\n  (and (numberp x) (<= false x true)))\n\n(let ((db (make-hash-table :test #'equal)))\n  (defun get-db (key) (gethash key db))\n  (defun put-db (key val) (setf (gethash key db) val))\n  (defun clear-db () (clrhash db)))\n\n(defun get-vals (parm inst)\n  \"Return a list of (val cf) pairs for this (parm inst).\"\n  (get-db (list parm inst)))\n\n(defun get-cf (parm inst val)\n  \"Look up the certainty factor or return unknown.\"\n  (or (second (assoc val (get-vals parm inst)))\n      unknown))\n\n(defun update-cf (parm inst val cf)\n  \"Change the certianty factor for (parm inst is val),\n  by combining the given cf with the old.\"\n  (let ((new-cf (cf-or cf (get-cf parm inst val))))\n    (put-db (list parm inst)\n            (cons (list val new-cf)\n                  (remove val (get-db (list parm inst))\n                          :key #'first)))))\n\n(defconstant help-string\n  \"~&Type one of the following:\n ?     - to see possible answers for this parameter\n rule  - to show the current rule\n why   - to see why this question is asked\n help  - to see this list\n xxx   - (for some specific xxx) if there is a definite answer\n (xxx .5 yyy .4) - If there are several answers with\n                   different certainty factors.\")\n\n(defun ask-vals (parm inst)\n  \"Ask the user for the value(s) of inst's parm parameter,\n  unless this has already been asked.  Keep asking until the\n  user types UNKNOWN (return nil) or a valid reply (return t).\"\n  (unless (get-db `(asked ,parm ,inst))\n    (put-db `(asked ,parm ,inst) t)\n    (loop\n      (let ((ans (prompt-and-read-vals parm inst)))\n        (case ans\n          (help (format t help-string))\n          (why  (print-why (get-db 'current-rule) parm))\n          (rule (princ (get-db 'current-rule)))\n          ((unk unknown) (RETURN nil))\n          (?    (format t \"~&A ~a must be of type ~a\"\n                        parm (parm-type parm)) nil)\n          (t    (if (check-reply ans parm inst)\n                    (RETURN t)\n                    (format t \"~&Illegal reply.  ~\n                             Type ? to see legal ones.\"))))))))\n\n(defun prompt-and-read-vals (parm inst)\n  \"Print the prompt for this parameter (or make one up) and\n  read the reply.\"\n  (fresh-line)\n  (format t (parm-prompt (get-parm parm)) (inst-name inst) parm)\n  (princ \" \")\n  (finish-output)\n  (funcall (parm-reader (get-parm parm))))\n\n(defun inst-name (inst)\n  \"The name of this instance.\"\n  ;; The stored name is either like ((\"Jan Doe\" 1.0)) or nil\n  (or (first (first (get-vals 'name inst)))\n      inst))\n\n(defun check-reply (reply parm inst)\n  \"If reply is valid for this parm, update the DB.\n  Reply should be a val or (val1 cf1 val2 cf2 ...).\n  Each val must be of the right type for this parm.\"\n  (let ((answers (parse-reply reply)))\n    (when (every #'(lambda (pair)\n                     (and (typep (first pair) (parm-type parm))\n                          (cf-p (second pair))))\n                 answers)\n      ;; Add replies to the data base\n      (dolist (pair answers)\n        (update-cf parm inst (first pair) (second pair)))\n      answers)))\n\n(defun parse-reply (reply)\n  \"Convert the reply into a list of (value cf) pairs.\"\n  (cond ((null reply) nil)\n        ((atom reply) `((,reply ,true)))\n        (t (cons (list (first reply) (second reply))\n                 (parse-reply (rest2 reply))))))\n\n(defstruct (parm (:constructor\n                  new-parm (name &optional context type-restriction\n                            prompt ask-first reader)))\n  name (context nil) (prompt \"~&What is the ~*~a of ~2:*~a?\")\n  (ask-first nil) (type-restriction t) (reader 'read))\n\n(defmacro defparm (parm &rest args)\n  \"Define a parameter.\"\n  `(setf (get ',parm 'parm) (apply #'new-parm ',parm ',args)))\n\n(defun parm-type (parm-name)\n  \"What type is expected for a value of this parameter?\"\n  (parm-type-restriction (get-parm parm-name)))\n\n(defun get-parm (parm-name)\n  \"Look up the parameter structure with this name.\"\n  ;; If there is none, make one\n  (or (get parm-name 'parm)\n      (setf (get parm-name 'parm) (new-parm parm-name))))\n\n(deftype yes/no () '(member yes no))\n\n(defstruct context\n  \"A context is a sub-domain, a type.\"\n  name (number 0) initial-data goals)\n\n(defmacro defcontext (name &optional initial-data goals)\n  \"Define a context.\"\n  `(make-context :name ',name :initial-data ',initial-data\n                 :goals ',goals))\n\n(defun new-instance (context)\n  \"Create a new instance of this context.\"\n  (let ((instance (format nil \"~a-~d\"\n                          (context-name context)\n                          (incf (context-number context)))))\n  (format t \"~&------ ~a ------~&\" instance)\n    (put-db (context-name context) instance)\n    (put-db 'current-instance instance)))\n\n(defstruct (rule (:print-function print-rule))\n  number premises conclusions cf)\n\n(let ((rules (make-hash-table)))\n\n  (defun put-rule (rule)\n    \"Put the rule in a table, indexed under each\n    parm in the conclusion.\"\n    (dolist (concl (rule-conclusions rule))\n      (push rule (gethash (first concl) rules)))\n    rule)\n\n  (defun get-rules (parm)\n    \"A list of rules that help determine this parameter.\"\n    (gethash parm rules))\n\n  (defun clear-rules () (clrhash rules)))\n\n(defun find-out (parm &optional (inst (get-db 'current-instance)))\n  \"Find the value(s) of this parameter for this instance,\n  unless the values are already known.\n  Some parameters we ask first; others we use rules first.\"\n  (or (get-db `(known ,parm ,inst))\n      (put-db `(known ,parm ,inst)\n              (if (parm-ask-first (get-parm parm))\n                  (or (ask-vals parm inst) (use-rules parm))\n                  (or (use-rules parm) (ask-vals parm inst))))))\n\n(defun use-rules (parm)\n  \"Try every rule associated with this parameter.\n  Return true if one of the rules returns true.\"\n  (some #'true-p (mapcar #'use-rule (get-rules parm))))\n\n(defun use-rule (rule)\n  \"Apply a rule to the current situation.\"\n  ;; Keep track of the rule for the explanation system:\n  (put-db 'current-rule rule)\n  ;; If any premise is known false, give up.\n  ;; If every premise can be proved true,  then\n  ;; draw conclusions (weighted with the certainty factor).\n  (unless (some #'reject-premise (rule-premises rule))\n    (let ((cf (satisfy-premises (rule-premises rule) true)))\n      (when (true-p cf)\n        (dolist (conclusion (rule-conclusions rule))\n          (conclude conclusion (* cf (rule-cf rule))))\n        cf))))\n\n(defun satisfy-premises (premises cf-so-far)\n  \"A list of premises is satisfied if they are all true.\n  A combined cf is returned.\"\n  ;; cf-so-far is an accumulator of certainty factors\n  (cond ((null premises) cf-so-far)\n        ((not (true-p cf-so-far)) false)\n        (t (satisfy-premises\n             (rest premises)\n             (cf-and cf-so-far\n                     (eval-condition (first premises)))))))\n\n(defun eval-condition (condition &optional (find-out-p t))\n  \"See if this condition is true, optionally using FIND-OUT\n  to determine unknown parameters.\"\n  (multiple-value-bind (parm inst op val)\n      (parse-condition condition)\n    (when find-out-p\n      (find-out parm inst))\n    ;; Add up all the (val cf) pairs that satisfy the test\n    (loop for pair in (get-vals parm inst)\n          when (funcall op (first pair) val)\n          sum (second pair))))\n\n(defun reject-premise (premise)\n  \"A premise is rejected if it is known false, without\n  needing to call find-out recursively.\"\n  (false-p (eval-condition premise nil)))\n\n(defun conclude (conclusion cf)\n  \"Add a conclusion (with specified certainty factor) to DB.\"\n  (multiple-value-bind (parm inst op val)\n      (parse-condition conclusion)\n    (update-cf parm inst val cf)))\n\n(defun is (a b) (equal a b))\n\n(defun parse-condition (condition)\n  \"A condition is of the form (parm inst op val).\n  So for (age patient is 21), we would return 4 values:\n  (age patient-1 is 21), where patient-1 is the current patient.\"\n  (values (first condition)\n          (get-db (second condition))\n          (third condition)\n          (fourth condition)))\n\n(defun emycin (contexts)\n  \"An Expert System Shell.  Accumulate data for instances of each\n  context, and solve for goals.  Then report the findings.\"\n  (clear-db)\n  (get-context-data contexts))\n\n(defun get-context-data (contexts)\n  \"For each context, create an instance and try to find out\n  required data.  Then go on to other contexts, depth first,\n  and finally ask if there are other instances of this context.\"\n  (unless (null contexts)\n    (let* ((context (first contexts))\n           (inst (new-instance context)))\n      (put-db 'current-rule 'initial)\n      (mapc #'find-out (context-initial-data context))\n      (put-db 'current-rule 'goal)\n      (mapc #'find-out (context-goals context))\n      (report-findings context inst)\n      (get-context-data (rest contexts))\n      (when (y-or-n-p \"Is there another ~a?\"\n                      (context-name context))\n        (get-context-data contexts)))))\n\n(defmacro defrule (number &body body)\n  \"Define a rule with conditions, a certainty factor, and\n  conclusions.  Example: (defrule R001 if ... then .9 ...)\"\n  (assert (eq (first body) 'if))\n  (let* ((then-part (member 'then body))\n         (premises (ldiff (rest body) then-part))\n         (conclusions (rest2 then-part))\n         (cf (second then-part)))\n    ;; Do some error checking:\n    (check-conditions number premises 'premise)\n    (check-conditions number conclusions 'conclusion)\n    (when (not (cf-p cf))\n      (warn \"Rule ~a: Illegal certainty factor: ~a\" number cf))\n    ;; Now build the rule:\n    `(put-rule\n       (make-rule :number ',number :cf ,cf :premises ',premises\n                  :conclusions ',conclusions))))\n\n(defun check-conditions (rule-num conditions kind)\n  \"Warn if any conditions are invalid.\"\n  (when (null conditions)\n    (warn \"Rule ~a: Missing ~a\" rule-num kind))\n  (dolist (condition conditions)\n    (when (not (consp condition))\n      (warn \"Rule ~a: Illegal ~a: ~a\" rule-num kind condition))\n    (multiple-value-bind (parm inst op val)\n        (parse-condition condition)\n      (declare (ignore inst))\n      (when (and (eq kind 'conclusion) (not (eq op 'is)))\n        (warn \"Rule ~a: Illegal operator (~a) in conclusion: ~a\"\n              rule-num op condition))\n      (when (not (typep val (parm-type parm)))\n        (warn \"Rule ~a: Illegal value (~a) in ~a: ~a\"\n              rule-num val kind condition)))))\n\n(defun report-findings (context inst)\n  \"Print findings on each goal for this instance.\"\n  (when (context-goals context)\n    (format t \"~&Findings for ~a:\" (inst-name inst))\n    (dolist (goal (context-goals context))\n      (let ((values (get-vals goal inst)))\n        ;; If there are any values for this goal,\n        ;; print them sorted by certainty factor.\n        (if values\n            (format t \"~& ~a:~{~{ ~a (~,3f)  ~}~}\" goal\n                    (sort (copy-list values) #'> :key #'second))\n            (format t \"~& ~a: unknown\" goal))))))\n\n(defun print-rule (rule &optional (stream t) depth)\n  (declare (ignore depth))\n  (format stream \"~&Rule ~a:~&  If\" (rule-number rule))\n  (print-conditions (rule-premises rule) stream)\n  (format stream \"~&  Then ~a (~a) that\"\n          (cf->english (rule-cf rule)) (rule-cf rule))\n  (print-conditions (rule-conclusions rule) stream))\n\n(defun print-conditions (conditions &optional\n                         (stream t) (num 1))\n  \"Print a list of numbered conditions.\"\n  (dolist (condition conditions)\n    (print-condition condition stream num)))\n\n(defun print-condition (condition stream number)\n  \"Print a single condition in pseudo-English.\"\n  (format stream \"~&    ~d)~{ ~a~}\" number\n          (let ((parm (first condition))\n                (inst (second condition))\n                (op (third condition))\n                (val (fourth condition)))\n            (case val\n              (YES `(the ,inst ,op ,parm))\n              (NO  `(the ,inst ,op not ,parm))\n              (T   `(the ,parm of the ,inst ,op ,val))))))\n\n(defun cf->english (cf)\n  \"Convert a certainy factor to an English phrase.\"\n  (cond ((= cf  1.0) \"there is certain evidence\")\n        ((> cf   .8) \"there is strongly suggestive evidence\")\n        ((> cf   .5) \"there is suggestive evidence\")\n        ((> cf  0.0) \"there is weakly suggestive evidence\")\n        ((= cf  0.0) \"there is NO evidence either way\")\n        ((< cf  0.0) (concatenate 'string (cf->english (- cf))\n                                  \" AGAINST the conclusion\"))))\n\n(defun print-why (rule parm)\n  \"Tell why this rule is being used.  Print what is known,\n  what we are trying to find out, and what we can conclude.\"\n  (format t \"~&[Why is the value of ~a being asked for?]\" parm)\n  (if (member rule '(initial goal))\n      (format t \"~&~a is one of the ~a parameters.\"\n              parm rule)\n      (multiple-value-bind (knowns unknowns)\n          (partition-if #'(lambda (premise)\n                            (true-p (eval-condition premise nil)))\n                        (rule-premises rule))\n        (when knowns\n          (format t \"~&It is known that:\")\n          (print-conditions knowns)\n          (format t \"~&Therefore,\"))\n        (let ((new-rule (copy-rule rule)))\n          (setf (rule-premises new-rule) unknowns)\n          (print new-rule)))))\n\n(defun mycin ()\n  \"Determine what organism is infecting a patient.\"\n  (emycin\n    (list (defcontext patient  (name sex age)  ())\n          (defcontext culture  (site days-old) ())\n          (defcontext organism ()              (identity)))))\n\n"
  },
  {
    "path": "lisp/open-pdf.lisp",
    "content": "(defvar *paip-pdf-uri* \"https://github.com/norvig/paip-lisp/raw/master/\")\n\n(defun open-pdf (&optional (part 1))\n  (let* ((name (format nil \"PAIP-part~A.pdf\" part))\n         (path (namestring\n                (merge-pathnames\n                 name\n                 (asdf:system-source-directory (asdf:find-system :paip))))))\n    (when (<= 1 part 2)\n      (unless (probe-file path)\n        #+quicklisp(ql:quickload :dexador)\n        (uiop:symbol-call :dex :fetch (format nil \"~A~A\" *paip-pdf-uri* name) path))\n      #+quicklisp(ql:quickload :trivial-open-browser)\n      (uiop:symbol-call :trivial-open-browser :open-browser path)\n      path)))\n"
  },
  {
    "path": "lisp/othello.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File othello.lisp: An othello monitor, with all strategies\n;;;; up to and including section 18.8\n\n;;; One bug fix by Alberto Segre, segre@cs.cornell.edu, March 1993.\n\n(defun cross-product (fn xlist ylist)\n  \"Return a list of all (fn x y) values.\"\n  (mappend #'(lambda (y)\n               (mapcar #'(lambda (x) (funcall fn x y))\n                       xlist))\n           ylist))\n\n(defconstant all-directions '(-11 -10 -9 -1 1 9 10 11))\n\n(defconstant empty 0 \"An empty square\")\n(defconstant black 1 \"A black piece\")\n(defconstant white 2 \"A white piece\")\n(defconstant outer 3 \"Marks squares outside the 8x8 board\")\n\n(deftype piece () `(integer ,empty ,outer))\n\n(defun name-of (piece) (char \".@O?\" piece))\n\n(defun opponent (player) (if (eql player black) white black))\n\n(deftype board () '(simple-array piece (100)))\n\n(defun bref (board square) (aref board square))\n(defsetf bref (board square) (val)\n  `(setf (aref ,board ,square) ,val))\n\n(defun copy-board (board)\n  (copy-seq board))\n\n(defconstant all-squares\n  (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i))\n\n(defun initial-board ()\n  \"Return a board, empty except for four pieces in the middle.\"\n  ;; Boards are 100-element vectors, with elements 11-88 used,\n  ;; and the others marked with the sentinel OUTER.  Initially\n  ;; the 4 center squares are taken, the others empty.\n  (let ((board (make-array 100 :element-type 'piece\n                           :initial-element outer)))\n    (dolist (square all-squares)\n      (setf (bref board square) empty))\n    (setf (bref board 44) white   (bref board 45) black\n          (bref board 54) black   (bref board 55) white)\n    board))\n\n(defun count-difference (player board)\n  \"Count player's pieces minus opponent's pieces.\"\n  (- (count player board)\n     (count (opponent player) board)))\n\n(defun valid-p (move)\n  \"Valid moves are numbers in the range 11-88 that end in 1-8.\"\n  (and (integerp move) (<= 11 move 88) (<= 1 (mod move 10) 8)))\n\n(defun legal-p (move player board)\n  \"A Legal move must be into an empty square, and it must\n  flip at least one opponent piece.\"\n  (and (eql (bref board move) empty)\n       (some #'(lambda (dir) (would-flip? move player board dir))\n             all-directions)))\n\n(defun make-move (move player board)\n  \"Update board to reflect move by player\"\n  ;; First make the move, then make any flips\n  (setf (bref board move) player)\n  (dolist (dir all-directions)\n    (make-flips move player board dir))\n  board)\n\n(defun make-flips (move player board dir)\n  \"Make any flips in the given direction.\"\n  (let ((bracketer (would-flip? move player board dir)))\n    (when bracketer\n      (loop for c from (+ move dir) by dir until (eql c bracketer)\n            do (setf (bref board c) player)))))\n\n(defun would-flip? (move player board dir)\n  \"Would this move result in any flips in this direction?\n  If so, return the square number of the bracketing piece.\"\n  ;; A flip occurs if, starting at the adjacent square, c, there\n  ;; is a string of at least one opponent pieces, bracketed by\n  ;; one of player's pieces\n  (let ((c (+ move dir)))\n    (and (eql (bref board c) (opponent player))\n         (find-bracketing-piece (+ c dir) player board dir))))\n\n(defun find-bracketing-piece (square player board dir)\n  \"Return the square number of the bracketing piece.\"\n  (cond ((eql (bref board square) player) square)\n        ((eql (bref board square) (opponent player))\n         (find-bracketing-piece (+ square dir) player board dir))\n        (t nil)))\n\n(defun next-to-play (board previous-player print)\n  \"Compute the player to move next, or NIL if nobody can move.\"\n  (let ((opp (opponent previous-player)))\n    (cond ((any-legal-move? opp board) opp)\n          ((any-legal-move? previous-player board)\n           (when print\n             (format t \"~&~c has no moves and must pass.\"\n                     (name-of opp)))\n           previous-player)\n          (t nil))))\n\n(defun any-legal-move? (player board)\n  \"Does player have any legal moves in this position?\"\n  (some #'(lambda (move) (legal-p move player board))\n        all-squares))\n\n(defun random-strategy (player board)\n  \"Make any legal move.\"\n  (random-elt (legal-moves player board)))\n\n(defun legal-moves (player board)\n  \"Returns a list of legal moves for player\"\n  ;;*** fix, segre, 3/30/93.  Was remove-if, which can share with all-squares.\n  (loop for move in all-squares\n\twhen (legal-p move player board) collect move))\n\n(defun maximize-difference (player board)\n  \"A strategy that maximizes the difference in pieces.\"\n  (funcall (maximizer #'count-difference) player board))\n\n(defun maximizer (eval-fn)\n  \"Return a strategy that will consider every legal move,\n  apply EVAL-FN to each resulting board, and choose\n  the move for which EVAL-FN returns the best score.\n  FN takes two arguments: the player-to-move and board\"\n  #'(lambda (player board)\n      (let* ((moves (legal-moves player board))\n             (scores (mapcar #'(lambda (move)\n\t\t\t\t (funcall\n\t\t\t\t  eval-fn\n\t\t\t\t  player\n\t\t\t\t  (make-move move player\n\t\t\t\t\t     (copy-board board))))\n                             moves))\n             (best  (apply #'max scores)))\n        (elt moves (position best scores)))))\n\n(defparameter *weights*\n  '#(0   0   0  0  0  0  0   0   0 0\n     0 120 -20 20  5  5 20 -20 120 0\n     0 -20 -40 -5 -5 -5 -5 -40 -20 0\n     0  20  -5 15  3  3 15  -5  20 0\n     0   5  -5  3  3  3  3  -5   5 0\n     0   5  -5  3  3  3  3  -5   5 0\n     0  20  -5 15  3  3 15  -5  20 0\n     0 -20 -40 -5 -5 -5 -5 -40 -20 0\n     0 120 -20 20  5  5 20 -20 120 0\n     0   0   0  0  0  0  0   0   0 0))\n\n(defun weighted-squares (player board)\n  \"Sum of the weights of player's squares minus opponent's.\"\n  (let ((opp (opponent player)))\n    (loop for i in all-squares\n          when (eql (bref board i) player)\n          sum (aref *weights* i)\n          when (eql (bref board i) opp)\n          sum (- (aref *weights* i)))))\n\n(defconstant winning-value most-positive-fixnum)\n(defconstant losing-value  most-negative-fixnum)\n\n(defun final-value (player board)\n  \"Is this a win, loss, or draw for player?\"\n  (case (signum (count-difference player board))\n    (-1 losing-value)\n    ( 0 0)\n    (+1 winning-value)))\n\n(defun minimax (player board ply eval-fn)\n  \"Find the best move, for PLAYER, according to EVAL-FN,\n  searching PLY levels deep and backing up values.\"\n  (if (= ply 0)\n      (funcall eval-fn player board)\n      (let ((moves (legal-moves player board)))\n        (if (null moves)\n            (if (any-legal-move? (opponent player) board)\n                (- (minimax (opponent player) board\n                            (- ply 1) eval-fn))\n                (final-value player board))\n            (let ((best-move nil)\n                  (best-val nil))\n              (dolist (move moves)\n                (let* ((board2 (make-move move player\n                                          (copy-board board)))\n                       (val (- (minimax\n                                 (opponent player) board2\n                                 (- ply 1) eval-fn))))\n                  (when (or (null best-val)\n                            (> val best-val))\n                    (setf best-val val)\n                    (setf best-move move))))\n              (values best-val best-move))))))\n\n(defun minimax-searcher (ply eval-fn)\n  \"A strategy that searches PLY levels and then uses EVAL-FN.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value move)\n          (minimax player board ply eval-fn)\n        (declare (ignore value))\n        move)))\n\n(defun alpha-beta (player board achievable cutoff ply eval-fn)\n  \"Find the best move, for PLAYER, according to EVAL-FN,\n  searching PLY levels deep and backing up values,\n  using cutoffs whenever possible.\"\n  (if (= ply 0)\n      (funcall eval-fn player board)\n      (let ((moves (legal-moves player board)))\n        (if (null moves)\n            (if (any-legal-move? (opponent player) board)\n                (- (alpha-beta (opponent player) board\n                               (- cutoff) (- achievable)\n                               (- ply 1) eval-fn))\n                (final-value player board))\n            (let ((best-move (first moves)))\n              (loop for move in moves do\n                (let* ((board2 (make-move move player\n                                          (copy-board board)))\n                       (val (- (alpha-beta\n                                 (opponent player) board2\n                                 (- cutoff) (- achievable)\n                                 (- ply 1) eval-fn))))\n                  (when (> val achievable)\n                    (setf achievable val)\n                    (setf best-move move)))\n                until (>= achievable cutoff))\n              (values achievable best-move))))))\n\n(defun alpha-beta-searcher (depth eval-fn)\n  \"A strategy that searches to DEPTH and then uses EVAL-FN.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value move)\n          (alpha-beta player board losing-value winning-value\n                      depth eval-fn)\n        (declare (ignore value))\n        move)))\n\n(defun modified-weighted-squares (player board)\n  \"Like WEIGHTED-SQUARES, but don't take off for moving\n  near an occupied corner.\"\n  (let ((w (weighted-squares player board)))\n    (dolist (corner '(11 18 81 88))\n      (when (not (eql (bref board corner) empty))\n        (dolist (c (neighbors corner))\n          (when (not (eql (bref board c) empty))\n            (incf w (* (- 5 (aref *weights* c))\n                       (if (eql (bref board c) player)\n                           +1 -1)))))))\n    w))\n\n(let ((neighbor-table (make-array 100 :initial-element nil)))\n  ;; Initialize the neighbor table\n  (dolist (square all-squares)\n    (dolist (dir all-directions)\n      (if (valid-p (+ square dir))\n          (push (+ square dir)\n                (aref neighbor-table square)))))\n\n  (defun neighbors (square)\n    \"Return a list of all squares adjacent to a square.\"\n    (aref neighbor-table square)))\n\n(let ((square-names\n        (cross-product #'symbol\n                       '(? a b c d e f g h ?)\n                       '(? 1 2 3 4 5 6 7 8 ?))))\n\n  (defun h8->88 (str)\n    \"Convert from alphanumeric to numeric square notation.\"\n    (or (position (string str) square-names :test #'string-equal)\n        str))\n\n  (defun 88->h8 (num)\n    \"Convert from numeric to alphanumeric square notation.\"\n    (if (valid-p num)\n        (elt square-names num)\n        num)))\n\n(defun human (player board)\n  \"A human player for the game of Othello\"\n  (format t \"~&~c to move ~a: \" (name-of player)\n          (mapcar #'88->h8 (legal-moves player board)))\n  (h8->88 (read)))\n\n(defvar *move-number* 1 \"The number of the move to be played\")\n\n(defun othello (bl-strategy wh-strategy\n                &optional (print t) (minutes 30))\n  \"Play a game of othello.  Return the score, where a positive\n  difference means black, the first player, wins.\"\n  (let ((board (initial-board))\n        (clock (make-array (+ 1 (max black white))\n                           :initial-element\n                           (* minutes 60\n                              internal-time-units-per-second))))\n    (catch 'game-over\n      (loop for *move-number* from 1\n            for player = black then (next-to-play board player print)\n            for strategy = (if (eql player black)\n                               bl-strategy\n                               wh-strategy)\n            until (null player)\n            do (get-move strategy player board print clock))\n      (when print\n        (format t \"~&The game is over.  Final result:\")\n        (print-board board clock))\n      (count-difference black board))))\n\n(defvar *clock* (make-array 3) \"A copy of the game clock\")\n(defvar *board* (initial-board) \"A copy of the game board\")\n\n(defun get-move (strategy player board print clock)\n  \"Call the player's strategy function to get a move.\n  Keep calling until a legal move is made.\"\n  ;; Note we don't pass the strategy function the REAL board.\n  ;; If we did, it could cheat by changing the pieces on the board.\n  (when print (print-board board clock))\n  (replace *clock* clock)\n  (let* ((t0 (get-internal-real-time))\n         (move (funcall strategy player (replace *board* board)))\n         (t1 (get-internal-real-time)))\n    (decf (elt clock player) (- t1 t0))\n    (cond\n      ((< (elt clock player) 0)\n       (format t \"~&~c has no time left and forfeits.\"\n               (name-of player))\n       (THROW 'game-over (if (eql player black) -64 64)))\n      ((eq move 'resign)\n       (THROW 'game-over (if (eql player black) -64 64)))\n      ((and (valid-p move) (legal-p move player board))\n       (when print\n         (format t \"~&~c moves to ~a.\"\n                 (name-of player) (88->h8 move)))\n       (make-move move player board))\n      (t (warn \"Illegal move: ~a\" (88->h8 move))\n         (get-move strategy player board print clock)))))\n\n(defun print-board (&optional (board *board*) clock)\n  \"Print a board, along with some statistics.\"\n  ;; First print the header and the current score\n  (format t \"~2&    a b c d e f g h   [~c=~2a ~c=~2a (~@d)]\"\n          (name-of black) (count black board)\n          (name-of white) (count white board)\n          (count-difference black board))\n  ;; Print the board itself\n  (loop for row from 1 to 8 do\n        (format t \"~&  ~d \" row)\n        (loop for col from 1 to 8\n              for piece = (bref board (+ col (* 10 row)))\n              do (format t \"~c \" (name-of piece))))\n  ;; Finally print the time remaining for each player\n  (when clock\n    (format t \"  [~c=~a ~c=~a]~2&\"\n            (name-of black) (time-string (elt clock black))\n            (name-of white) (time-string (elt clock white)))))\n\n(defun time-string (time)\n  \"Return a string representing this internal time in min:secs.\"\n  (multiple-value-bind (min sec)\n      (floor (round time internal-time-units-per-second) 60)\n    (format nil \"~2d:~2,'0d\" min sec)))\n\n(defun random-othello-series (strategy1 strategy2\n                              n-pairs &optional (n-random 10))\n  \"Play a series of 2*n games, starting from a random position.\"\n  (othello-series\n    (switch-strategies #'random-strategy n-random strategy1)\n    (switch-strategies #'random-strategy n-random strategy2)\n    n-pairs))\n\n(defun switch-strategies (strategy1 m strategy2)\n  \"Make a new strategy that plays strategy1 for m moves,\n  then plays according to strategy2.\"\n  #'(lambda (player board)\n      (funcall (if (<= *move-number* m) strategy1 strategy2)\n               player board)))\n\n(defun othello-series (strategy1 strategy2 n-pairs)\n  \"Play a series of 2*n-pairs games, swapping sides.\"\n  (let ((scores\n          (loop repeat n-pairs\n             for random-state = (make-random-state)\n             collect (othello strategy1 strategy2 nil)\n             do (setf *random-state* random-state)\n             collect (- (othello strategy2 strategy1 nil)))))\n    ;; Return the number of wins (1/2 for a tie),\n    ;; the total of the point differences, and the\n    ;; scores themselves, all from strategy1's point of view.\n    (values (+ (count-if #'plusp scores)\n               (/ (count-if #'zerop scores) 2))\n            (apply #'+ scores)\n            scores)))\n\n(defun round-robin (strategies n-pairs &optional\n                    (n-random 10) (names strategies))\n  \"Play a tournament among the strategies.\n  N-PAIRS = games each strategy plays as each color against\n  each opponent.  So with N strategies, a total of\n  N*(N-1)*N-PAIRS games are played.\"\n  (let* ((N (length strategies))\n         (totals (make-array N :initial-element 0))\n         (scores (make-array (list N N)\n                             :initial-element 0)))\n    ;; Play the games\n    (dotimes (i N)\n      (loop for j from (+ i 1) to (- N 1) do\n          (let* ((wins (random-othello-series\n                         (elt strategies i)\n                         (elt strategies j)\n                         n-pairs n-random))\n                 (losses (- (* 2 n-pairs) wins)))\n            (incf (aref scores i j) wins)\n            (incf (aref scores j i) losses)\n            (incf (aref totals i) wins)\n            (incf (aref totals j) losses))))\n    ;; Print the results\n    (dotimes (i N)\n      (format t \"~&~a~20T ~4f: \" (elt names i) (elt totals i))\n      (dotimes (j N)\n        (format t \"~4f \" (if (= i j) '---\n                             (aref scores i j)))))))\n\n(defun mobility (player board)\n  \"The number of moves a player has.\"\n  (length (legal-moves player board)))\n\n"
  },
  {
    "path": "lisp/othello2.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File othello2.lisp:  More strategies for othello.lisp,\n;;;; from section 18.9 onward (alpha-beta2, alpha-beta3, iago).\n;;;; If a compiled version of edge-table.lisp exists, then merely\n;;;; load it after you load this file.  Otherwise, load this file,\n;;;; evaluate (init-edge-table) (this will take a really long time),\n;;;; then compile edge-table.lisp.  This will save the edge-table for\n;;;; future use.\n\n(requires \"othello\")\n\n(defconstant all-squares\n  (sort (loop for i from 11 to 88\n\t      when (<= 1 (mod i 10) 8) collect i)\n        #'> :key #'(lambda (sq) (elt *weights* sq))))\n\n(defstruct (node) square board value)\n\n(defun alpha-beta-searcher2 (depth eval-fn)\n  \"Return a strategy that does A-B search with sorted moves.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value node)\n          (alpha-beta2\n            player (make-node :board board\n                              :value (funcall eval-fn player board))\n            losing-value winning-value depth eval-fn)\n        (declare (ignore value))\n        (node-square node))))\n\n(defun alpha-beta2 (player node achievable cutoff ply eval-fn)\n  \"A-B search, sorting moves by eval-fn\"\n  ;; Returns two values: achievable-value and move-to-make\n  (if (= ply 0)\n      (values (node-value node) node)\n      (let* ((board (node-board node))\n             (nodes (legal-nodes player board eval-fn)))\n        (if (null nodes)\n            (if (any-legal-move? (opponent player) board)\n                (values (- (alpha-beta2 (opponent player)\n                                        (negate-value node)\n                                        (- cutoff) (- achievable)\n                                        (- ply 1) eval-fn))\n                        nil)\n                (values (final-value player board) nil))\n            (let ((best-node (first nodes)))\n              (loop for move in nodes\n                    for val = (- (alpha-beta2\n                                   (opponent player)\n                                   (negate-value move)\n                                   (- cutoff) (- achievable)\n                                   (- ply 1) eval-fn))\n                    do (when (> val achievable)\n                         (setf achievable val)\n                         (setf best-node move))\n                    until (>= achievable cutoff))\n              (values achievable best-node))))))\n\n(defun negate-value (node)\n  \"Set the value of a node to its negative.\"\n  (setf (node-value node) (- (node-value node)))\n  node)\n\n(defun legal-nodes (player board eval-fn)\n  \"Return a list of legal moves, each one packed into a node.\"\n  (let ((moves (legal-moves player board)))\n    (sort (map-into\n            moves\n            #'(lambda (move)\n                (let ((new-board (make-move move player\n                                            (copy-board board))))\n                  (make-node\n                    :square move :board new-board\n                    :value (funcall eval-fn player new-board))))\n            moves)\n          #'> :key #'node-value)))\n\n(defvar *ply-boards*\n  (apply #'vector (loop repeat 40 collect (initial-board))))\n\n(defun alpha-beta3 (player board achievable cutoff ply eval-fn\n                    killer)\n  \"A-B search, putting killer move first.\"\n  (if (= ply 0)\n      (funcall eval-fn player board)\n      (let ((moves (put-first killer (legal-moves player board))))\n        (if (null moves)\n            (if (any-legal-move? (opponent player) board)\n                (- (alpha-beta3 (opponent player) board\n                                (- cutoff) (- achievable)\n                                (- ply 1) eval-fn nil))\n                (final-value player board))\n            (let ((best-move (first moves))\n                  (new-board (aref *ply-boards* ply))\n                  (killer2 nil)\n                  (killer2-val winning-value))\n              (loop for move in moves\n                    do (multiple-value-bind (val reply)\n                           (alpha-beta3\n                             (opponent player)\n                             (make-move move player\n                                        (replace new-board board))\n                             (- cutoff) (- achievable)\n                             (- ply 1) eval-fn killer2)\n                         (setf val (- val))\n                         (when (> val achievable)\n                           (setf achievable val)\n                           (setf best-move move))\n                         (when (and reply (< val killer2-val))\n                           (setf killer2 reply)\n                           (setf killer2-val val)))\n                    until (>= achievable cutoff))\n              (values achievable best-move))))))\n\n(defun alpha-beta-searcher3 (depth eval-fn)\n  \"Return a strategy that does A-B search with killer moves.\"\n  #'(lambda (player board)\n      (multiple-value-bind (value move)\n          (alpha-beta3 player board losing-value winning-value\n                       depth eval-fn nil)\n        (declare (ignore value))\n        move)))\n\n(defun put-first (killer moves)\n  \"Move the killer move to the front of moves,\n  if the killer move is in fact a legal move.\"\n  (if (member killer moves)\n      (cons killer (delete killer moves))\n      moves))\n\n(defun mobility (player board)\n  \"Current Mobility is the number of legal moves.\n  Potential mobility is the number of blank squares\n  adjacent to an opponent that are not legal moves.\n  Returns current and potential mobility for player.\"\n  (let ((opp (opponent player))\n        (current 0)    ; player's current mobility\n        (potential 0)) ; player's potential mobility\n    (dolist (square all-squares)\n      (when (eql (bref board square) empty)\n        (cond ((legal-p square player board)\n               (incf current))\n              ((some #'(lambda (sq) (eql (bref board sq) opp))\n                     (neighbors square))\n               (incf potential)))))\n    (values current (+ current potential))))\n\n(defvar *edge-table* (make-array (expt 3 10))\n  \"Array of values to player-to-move for edge positions.\")\n\n(defconstant edge-and-x-lists\n  '((22 11 12 13 14 15 16 17 18 27)\n    (72 81 82 83 84 85 86 87 88 77)\n    (22 11 21 31 41 51 61 71 81 72)\n    (27 18 28 38 48 58 68 78 88 77))\n  \"The four edges (with their X-squares).\")\n\n(defun edge-index (player board squares)\n  \"The index counts 1 for player; 2 for opponent,\n  on each square---summed as a base 3 number.\"\n  (let ((index 0))\n    (dolist (sq squares)\n      (setq index (+ (* index 3)\n                     (cond ((eql (bref board sq) empty) 0)\n                           ((eql (bref board sq) player) 1)\n                           (t 2)))))\n    index))\n\n(defun edge-stability (player board)\n  \"Total edge evaluation for player to move on board.\"\n  (loop for edge-list in edge-and-x-lists\n        sum (aref *edge-table*\n                  (edge-index player board edge-list))))\n\n(defconstant top-edge (first edge-and-x-lists))\n\n(defun init-edge-table ()\n  \"Initialize *edge-table*, starting from the empty board.\"\n  ;; Initialize the static values\n  (loop for n-pieces from 0 to 10 do\n        (map-edge-n-pieces\n          #'(lambda (board index)\n              (setf (aref *edge-table* index)\n                    (static-edge-stability black board)))\n          black (initial-board) n-pieces top-edge 0))\n  ;; Now iterate five times trying to improve:\n  (dotimes (i 5)\n    ;; Do the indexes with most pieces first\n    (loop for n-pieces from 9 downto 1 do\n          (map-edge-n-pieces\n            #'(lambda (board index)\n                (setf (aref *edge-table* index)\n                      (possible-edge-moves-value\n                        black board index)))\n            black (initial-board) n-pieces top-edge 0))))\n\n(defun map-edge-n-pieces (fn player board n squares index)\n  \"Call fn on all edges with n pieces.\"\n  ;; Index counts 1 for player; 2 for opponent\n  (cond\n    ((< (length squares) n) nil)\n    ((null squares) (funcall fn board index))\n    (t (let ((index3 (* 3 index))\n             (sq (first squares)))\n         (map-edge-n-pieces fn player board n (rest squares) index3)\n         (when (and (> n 0) (eql (bref board sq) empty))\n           (setf (bref board sq) player)\n           (map-edge-n-pieces fn player board (- n 1) (rest squares)\n                              (+ 1 index3))\n           (setf (bref board sq) (opponent player))\n           (map-edge-n-pieces fn player board (- n 1) (rest squares)\n                              (+ 2 index3))\n           (setf (bref board sq) empty))))))\n\n(defun possible-edge-moves-value (player board index)\n  \"Consider all possible edge moves.\n  Combine their values into a single number.\"\n  (combine-edge-moves\n    (cons\n      (list 1.0 (aref *edge-table* index)) ;; no move\n      (loop for sq in top-edge             ;; possible moves\n            when (eql (bref board sq) empty)\n            collect (possible-edge-move player board sq)))\n    player))\n\n(defun possible-edge-move (player board sq)\n  \"Return a (prob val) pair for a possible edge move.\"\n  (let ((new-board (replace (aref *ply-boards* player) board)))\n    (make-move sq player new-board)\n    (list (edge-move-probability player board sq)\n          (- (aref *edge-table*\n                   (edge-index (opponent player)\n                               new-board top-edge))))))\n\n(defun combine-edge-moves (possibilities player)\n  \"Combine the best moves.\"\n  (let ((prob 1.0)\n        (val 0.0)\n        (fn (if (eql player black) #'> #'<)))\n    (loop for pair in (sort possibilities fn :key #'second)\n          while (>= prob 0.0)\n          do (incf val (* prob (first pair) (second pair)))\n             (decf prob (* prob (first pair))))\n    (round val)))\n\n(let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77))))\n  (defun corner-p (sq) (assoc sq corner/xsqs))\n  (defun x-square-p (sq) (rassoc sq corner/xsqs))\n  (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))\n  (defun corner-for (xsq) (car (rassoc xsq corner/xsqs))))\n\n(defun edge-move-probability (player board square)\n  \"What's the probability that player can move to this square?\"\n  (cond\n    ((x-square-p square) .5) ;; X-squares\n    ((legal-p square player board) 1.0) ;; immediate capture\n    ((corner-p square) ;; move to corner depends on X-square\n     (let ((x-sq (x-square-for square)))\n       (cond\n         ((eql (bref board x-sq) empty) .1)\n         ((eql (bref board x-sq) player) 0.001)\n         (t .9))))\n    (t (/ (aref\n            '#2A((.1  .4 .7)\n                 (.05 .3  *)\n                 (.01  *  *))\n            (count-edge-neighbors player board square)\n            (count-edge-neighbors (opponent player) board square))\n          (if (legal-p square (opponent player) board) 2 1)))))\n\n(defun count-edge-neighbors (player board square)\n  \"Count the neighbors of this square occupied by player.\"\n  (count-if #'(lambda (inc)\n                (eql (bref board (+ square inc)) player))\n            '(+1 -1)))\n\n(defparameter *static-edge-table*\n  '#2A(;stab  semi    un\n       (   *    0 -2000) ; X\n       ( 700    *     *) ; corner\n       (1200  200   -25) ; C\n       (1000  200    75) ; A\n       (1000  200    50) ; B\n       (1000  200    50) ; B\n       (1000  200    75) ; A\n       (1200  200   -25) ; C\n       ( 700    *     *) ; corner\n       (   *    0 -2000) ; X\n       ))\n\n(defun static-edge-stability (player board)\n  \"Compute this edge's static stability\"\n  (loop for sq in top-edge\n        for i from 0\n        sum (cond\n              ((eql (bref board sq) empty) 0)\n              ((eql (bref board sq) player)\n               (aref *static-edge-table* i\n                     (piece-stability board sq)))\n              (t (- (aref *static-edge-table* i\n                          (piece-stability board sq)))))))\n\n(let ((stable 0) (semi-stable 1) (unstable 2))\n\n  (defun piece-stability (board sq)\n    (cond\n      ((corner-p sq) stable)\n      ((x-square-p sq)\n       (if (eql (bref board (corner-for sq)) empty)\n           unstable semi-stable))\n      (t (let* ((player (bref board sq))\n                (opp (opponent player))\n                (p1 (find player board :test-not #'eql\n                          :start sq :end 19))\n                (p2 (find player board :test-not #'eql\n                          :start 11 :end sq\n                          :from-end t)))\n           (cond\n             ;; unstable pieces can be captured immediately\n             ;; by playing in the empty square\n             ((or (and (eql p1 empty) (eql p2 opp))\n                  (and (eql p2 empty) (eql p1 opp)))\n              unstable)\n             ;; Semi-stable pieces might be captured\n             ((and (eql p1 opp) (eql p2 opp)\n                   (find empty board :start 11 :end 19))\n              semi-stable)\n             ((and (eql p1 empty) (eql p2 empty))\n              semi-stable)\n             ;; Stable pieces can never be captured\n             (t stable)))))))\n\n(defun Iago-eval (player board)\n  \"Combine edge-stability, current mobility and\n  potential mobility to arrive at an evaluation.\"\n  ;; The three factors are multiplied by coefficients\n  ;; that vary by move number:\n  (let ((c-edg (+ 312000 (* 6240 *move-number*)))\n        (c-cur (if (< *move-number* 25)\n                   (+ 50000 (* 2000 *move-number*))\n                   (+ 75000 (* 1000 *move-number*))))\n        (c-pot 20000))\n    (multiple-value-bind (p-cur p-pot)\n        (mobility player board)\n      (multiple-value-bind (o-cur o-pot)\n          (mobility (opponent player) board)\n        ;; Combine the three factors into one sum:\n        (+ (round (* c-edg (edge-stability player board)) 32000)\n           (round (* c-cur (- p-cur o-cur)) (+ p-cur o-cur 2))\n           (round (* c-pot  (- p-pot o-pot)) (+ p-pot o-pot 2)))))))\n\n(defun Iago (depth)\n  \"Use an approximation of Iago's evaluation function.\"\n  (alpha-beta-searcher3 depth #'iago-eval))\n\n"
  },
  {
    "path": "lisp/overview.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File overview.lisp: miscellaneous functions from Overview chapter\n\n(defun tax-bracket (income)\n  \"Determine what percent tax should be paid for this income.\"\n  (cond ((< income 10000.00) 0.00)\n        ((< income 30000.00) 0.20)\n        ((< income 50000.00) 0.25)\n        ((< income 70000.00) 0.30)\n        (t                   0.35)))\n\n;;; ==============================\n\n(defstruct player (score 0) (wins 0))\n\n(defun determine-winner (players)\n  \"Increment the WINS for the player with highest score.\"\n  (incf (player-wins (first (sort players #'>\n                                  :key #'player-score)))))\n\n;;; ==============================\n\n(defun length1 (list)\n  (let ((len 0))            ; start with LEN=0\n    (dolist (element list)  ; and on each iteration\n      (incf len))           ;  increment LEN by 1\n    len))                   ; and return LEN\n\n;;; ==============================\n\n(defun length1.1 (list)         ; alternate version:\n  (let ((len 0))                ; (not my preference)\n    (dolist (element list len)  ; uses len as result here\n      (incf len))))\n\n;;; ==============================\n\n(defun length2 (list)\n  (let ((len 0))                    ; start with LEN=0\n    (mapc #'(lambda (element)       ; and on each iteration\n              (incf len))           ;  increment LEN by 1\n          list)\n    len))                           ; and return LEN\n\n;;; ==============================\n\n(defun length3 (list)\n  (do ((len 0 (+ len 1))   ; start with LEN=0, increment\n       (l list (rest l)))  ; ... on each iteration\n      ((null l) len)))     ; (until the end of the list)\n\n;;; ==============================\n\n(defun length4 (list)\n  (loop for element in list      ; go through each element\n        count t))                ;   counting each one\n\n(defun length5 (list)\n  (loop for element in list      ; go through each element\n        summing 1))              ;   adding 1 each time\n\n(defun length6 (list)\n  (loop with len = 0             ; start with LEN=0\n        until (null list)        ; and (until end of list)\n        for element = (pop list) ; on each iteration\n        do (incf len)            ;  increment LEN by 1\n        finally (return len)))   ; and return LEN\n\n;;; ==============================\n\n(defun length7 (list)\n  (count-if #'true list))\n\n(defun true (x) t)\n\n;;; ==============================\n\n(defun length8 (list)\n  (if (null list)\n      0\n      (+ 1 (position-if #'true list :from-end t))))\n\n;;; ==============================\n\n(defun length9 (list)\n  (if (null list)\n      0\n      (+ 1 (length9 (rest list)))))\n\n;;; ==============================\n\n(defun length10 (list)\n  (length10-aux list 0))\n\n(defun length10-aux (sublist len-so-far)\n  (if (null sublist)\n      len-so-far\n      (length10-aux (rest sublist) (+ 1 len-so-far))))\n\n;;; ==============================\n\n(defun length11 (list &optional (len-so-far 0))\n  (if (null list)\n      len-so-far\n      (length11 (rest list) (+ 1 len-so-far))))\n\n;;; ==============================\n\n(defun length12 (the-list)\n  (labels\n    ((length13 (list len-so-far)\n       (if (null list)\n           len-so-far\n           (length13 (rest list) (+ 1 len-so-far)))))\n    (length13 the-list 0)))\n\n;;; ==============================\n\n(defun product (numbers)\n  \"Multiply all the numbers together to compute their product.\"\n  (let ((prod 1))\n    (dolist (n numbers prod)\n      (if (= n 0)\n          (RETURN 0)\n          (setf prod (* n prod))))))\n\n;;; ==============================\n\n(defmacro while (test &rest body)\n  \"Repeat body while test is true.\"\n  (list* 'loop\n         (list 'unless test '(return nil))\n         body))\n\n;;; ==============================\n\n(defmacro while (test &rest body)\n  \"Repeat body while test is true.\"\n  (let ((code '(loop (unless test (return nil)) . body)))\n    (subst test 'test (subst body 'body code))))\n\n;;; ==============================\n\n(defmacro while (test &rest body)\n  \"Repeat body while test is true.\"\n  `(loop (unless ,test (return nil))\n         ,@body))\n\n;;; ==============================\n\n(defun dprint (x)\n  \"Print an expression in dotted pair notation.\"\n  (cond ((atom x) (princ x))\n        (t (princ \"(\")\n           (dprint (first x))\n           (pr-rest (rest x))\n           (princ \")\")\n           x)))\n\n(defun pr-rest (x)\n  (princ \" . \")\n  (dprint x))\n\n;;; ==============================\n\n(defun pr-rest (x)\n  (cond ((null x))\n        ((atom x) (princ \" . \") (princ x))\n        (t (princ \" \") (dprint (first x)) (pr-rest (rest x)))))\n\n;;; ==============================\n\n(defun same-shape-tree (a b)\n  \"Are two trees the same except for the leaves?\"\n  (tree-equal a b :test #'true))\n\n(defun true (&rest ignore) t)\n\n;;; ==============================\n\n(defun english->french (words)\n  (sublis '((are . va) (book . libre) (friend . ami)\n            (hello . bonjour) (how . comment) (my . mon)\n            (red . rouge) (you . tu))\n          words))\n\n;;; ==============================\n\n(defstruct node\n  name\n  (yes nil)\n  (no nil))\n\n(defvar *db*\n  (make-node :name 'animal\n             :yes (make-node :name 'mammal)\n             :no (make-node\n                   :name 'vegetable\n                   :no (make-node :name 'mineral))))\n\n\n(defun questions (&optional (node *db*))\n  (format t \"~&Is it a ~a? \" (node-name node))\n  (case (read)\n    ((y yes) (if (not (null (node-yes node)))\n                 (questions (node-yes node))\n                 (setf (node-yes node) (give-up))))\n    ((n no)  (if (not (null (node-no node)))\n                 (questions (node-no node))\n                 (setf (node-no node) (give-up))))\n    (it 'aha!)\n    (t (format t \"Reply with YES, NO, or IT if I have guessed it.\")\n       (questions node))))\n\n(defun give-up ()\n  (format t \"~&I give up - what is it? \")\n  (make-node :name (read)))\n\n;;; ==============================\n\n(defun average (numbers)\n  (if (null numbers)\n      (error \"Average of the empty list is undefined.\")\n      (/ (reduce #'+ numbers)\n         (length numbers))))\n\n;;; ==============================\n\n(defun average (numbers)\n  (if (null numbers)\n      (progn\n        (cerror \"Use 0 as the average.\"\n                \"Average of the empty list is undefined.\")\n        0)\n      (/ (reduce #'+ numbers)\n         (length numbers))))\n\n;;; ==============================\n\n(defun sqr (x)\n  \"Multiply x by itself.\"\n  (check-type x number)\n  (* x x))\n\n;;; ==============================\n\n(defun sqr (x)\n  \"Multiply x by itself.\"\n  (assert (numberp x))\n  (* x x))\n\n;;; ==============================\n\n(defun sqr (x)\n  \"Multiply x by itself.\"\n  (assert (numberp x) (x))\n  (* x x))\n\n;;; ==============================\n\n(defun eat-porridge (bear)\n  (assert (< too-cold (temperature (bear-porridge bear)) too-hot)\n          (bear (bear-porridge bear))\n          \"~a's porridge is not just right: ~a\"\n          bear (hotness (bear-porridge bear)))\n  (eat (bear-porridge bear)))\n\n;;; ==============================\n\n(defun adder (c)\n  \"Return a function that adds c to its argument.\"\n  #'(lambda (x) (+ x c)))\n\n;;; ==============================\n\n(defun bank-account (balance)\n  \"Open a bank account starting with the given balance.\"\n  #'(lambda (action amount)\n      (case action\n        (deposit  (setf balance (+ balance amount)))\n        (withdraw (setf balance (- balance amount))))))\n\n;;; ==============================\n\n(defun math-quiz (op range n)\n  \"Ask the user a series of math problems.\"\n  (dotimes (i n)\n    (problem (random range) op (random range))))\n\n(defun problem (x op y)\n  \"Ask a math problem, read a reply, and say if it is correct.\"\n  (format t \"~&How much is ~d ~a ~d?\" x op y)\n  (if (eql (read) (funcall op x y))\n      (princ \"Correct!\")\n      (princ \"Sorry, that's not right.\")))\n\n;;; ==============================\n\n(defun math-quiz (&optional (op '+) (range 100) (n 10))\n  \"Ask the user a series of math problems.\"\n  (dotimes (i n)\n    (problem (random range) op (random range))))\n\n;;; ==============================\n\n(defun math-quiz (&key (op '+) (range 100) (n 10))\n  \"Ask the user a series of math problems.\"\n  (dotimes (i n)\n    (problem (random range) op (random range))))\n\n;;; ==============================\n\n(defun find-all (item sequence &rest keyword-args\n                 &key (test #'eql) test-not &allow-other-keys)\n  \"Find all those elements of sequence that match item,\n  according to the keywords.  Doesn't alter sequence.\"\n  (if test-not\n      (apply #'remove item sequence\n             :test-not (complement test-not) keyword-args)\n      (apply #'remove item sequence\n             :test (complement test) keyword-args)))\n\n;;; ==============================\n\n(defmacro while2 (test &body body)\n  \"Repeat body while test is true.\"\n  `(loop (if (not ,test) (return nil))\n         . ,body))\n\n;;; ==============================\n\n(defun length14 (list &aux (len 0))\n  (dolist (element list len)\n    (incf len)))\n\n;;; ==============================\n\n(defun length-r (list)\n  (reduce #'+ (mapcar #'(lambda (x) 1) list)))\n\n(defun length-r (list)\n  (reduce #'(lambda (x y) (+ x 1)) list\n          :initial-value 0))\n\n(defun length-r (list)\n  (reduce #'+ list :key #'(lambda (x) 1)))\n\n;;; ==============================\n\n"
  },
  {
    "path": "lisp/patmatch.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File pat-match.lisp: Pattern matcher from section 6.2\n\n;;; Two bug fixes By Richard Fateman, rjf@cs.berkeley.edu  October 92.\n\n;;; The basic are in auxfns.lisp; look for \"PATTERN MATCHING FACILITY\"\n\n(defun variable-p (x)\n  \"Is x a variable (a symbol beginning with `?')?\"\n  (and (symbolp x) (equal (elt (symbol-name x) 0) #\\?)))\n\n(defun pat-match (pattern input &optional (bindings no-bindings))\n  \"Match pattern against input in the context of the bindings\"\n  (cond ((eq bindings fail) fail)\n        ((variable-p pattern)\n         (match-variable pattern input bindings))\n        ((eql pattern input) bindings)\n        ((segment-pattern-p pattern)\n         (segment-matcher pattern input bindings))\n        ((single-pattern-p pattern)                 ; ***\n         (single-matcher pattern input bindings))   ; ***\n        ((and (consp pattern) (consp input))\n         (pat-match (rest pattern) (rest input)\n                    (pat-match (first pattern) (first input)\n                               bindings)))\n        (t fail)))\n\n\n(setf (get '?is  'single-match) 'match-is)\n(setf (get '?or  'single-match) 'match-or)\n(setf (get '?and 'single-match) 'match-and)\n(setf (get '?not 'single-match) 'match-not)\n\n(setf (get '?*  'segment-match) 'segment-match)\n(setf (get '?+  'segment-match) 'segment-match+)\n(setf (get '??  'segment-match) 'segment-match?)\n(setf (get '?if 'segment-match) 'match-if)\n\n(defun segment-pattern-p (pattern)\n  \"Is this a segment-matching pattern like ((?* var) . pat)?\"\n  (and (consp pattern) (consp (first pattern))\n       (symbolp (first (first pattern)))\n       (segment-match-fn (first (first pattern)))))\n\n(defun single-pattern-p (pattern)\n  \"Is this a single-matching pattern?\n  E.g. (?is x predicate) (?and . patterns) (?or . patterns).\"\n  (and (consp pattern)\n       (single-match-fn (first pattern))))\n\n(defun segment-matcher (pattern input bindings)\n  \"Call the right function for this kind of segment pattern.\"\n  (funcall (segment-match-fn (first (first pattern)))\n           pattern input bindings))\n\n(defun single-matcher (pattern input bindings)\n  \"Call the right function for this kind of single pattern.\"\n  (funcall (single-match-fn (first pattern))\n           (rest pattern) input bindings))\n\n(defun segment-match-fn (x)\n  \"Get the segment-match function for x,\n  if it is a symbol that has one.\"\n  (when (symbolp x) (get x 'segment-match)))\n\n(defun single-match-fn (x)\n  \"Get the single-match function for x,\n  if it is a symbol that has one.\"\n  (when (symbolp x) (get x 'single-match)))\n\n(defun match-is (var-and-pred input bindings)\n  \"Succeed and bind var if the input satisfies pred,\n  where var-and-pred is the list (var pred).\"\n  (let* ((var (first var-and-pred))\n         (pred (second var-and-pred))\n         (new-bindings (pat-match var input bindings)))\n    (if (or (eq new-bindings fail)\n            (not (funcall pred input)))\n        fail\n        new-bindings)))\n\n(defun match-and (patterns input bindings)\n  \"Succeed if all the patterns match the input.\"\n  (cond ((eq bindings fail) fail)\n        ((null patterns) bindings)\n        (t (match-and (rest patterns) input\n                      (pat-match (first patterns) input\n                                 bindings)))))\n\n(defun match-or (patterns input bindings)\n  \"Succeed if any one of the patterns match the input.\"\n  (if (null patterns)\n      fail\n      (let ((new-bindings (pat-match (first patterns)\n                                     input bindings)))\n        (if (eq new-bindings fail)\n            (match-or (rest patterns) input bindings)\n            new-bindings))))\n\n(defun match-not (patterns input bindings)\n  \"Succeed if none of the patterns match the input.\n  This will never bind any variables.\"\n  (if (match-or patterns input bindings)\n      fail\n      bindings))\n\n(defun segment-match (pattern input bindings &optional (start 0))\n  \"Match the segment pattern ((?* var) . pat) against input.\"\n  (let ((var (second (first pattern)))\n        (pat (rest pattern)))\n    (if (null pat)\n        (match-variable var input bindings)\n        (let ((pos (first-match-pos (first pat) input start)))\n          (if (null pos)\n              fail\n              (let ((b2 (pat-match\n                          pat (subseq input pos)\n                          (match-variable var (subseq input 0 pos)\n                                          bindings))))\n                ;; If this match failed, try another longer one\n                (if (eq b2 fail)\n                    (segment-match pattern input bindings (+ pos 1))\n                    b2)))))))\n\n(defun first-match-pos (pat1 input start)\n  \"Find the first position that pat1 could possibly match input,\n  starting at position start.  If pat1 is non-constant, then just\n  return start.\"\n  (cond ((and (atom pat1) (not (variable-p pat1)))\n         (position pat1 input :start start :test #'equal))\n        ((<= start (length input)) start) ;*** fix, rjf 10/1/92 (was <)\n        (t nil)))\n\n(defun segment-match+ (pattern input bindings)\n  \"Match one or more elements of input.\"\n  (segment-match pattern input bindings 1))\n\n(defun segment-match? (pattern input bindings)\n  \"Match zero or one element of input.\"\n  (let ((var (second (first pattern)))\n        (pat (rest pattern)))\n    (or (pat-match (cons var pat) input bindings)\n        (pat-match pat input bindings))))\n\n(defun match-if (pattern input bindings)\n  \"Test an arbitrary expression involving variables.\n  The pattern looks like ((?if code) . rest).\"\n  ;; *** fix, rjf 10/1/92 (used to eval binding values)\n  (and (progv (mapcar #'car bindings)\n              (mapcar #'cdr bindings)\n          (eval (second (first pattern))))\n       (pat-match (rest pattern) input bindings)))\n\n(defun pat-match-abbrev (symbol expansion)\n  \"Define symbol as a macro standing for a pat-match pattern.\"\n  (setf (get symbol 'expand-pat-match-abbrev)\n    (expand-pat-match-abbrev expansion)))\n\n(defun expand-pat-match-abbrev (pat)\n  \"Expand out all pattern matching abbreviations in pat.\"\n  (cond ((and (symbolp pat) (get pat 'expand-pat-match-abbrev)))\n        ((atom pat) pat)\n        (t (cons (expand-pat-match-abbrev (first pat))\n                 (expand-pat-match-abbrev (rest pat))))))\n\n(defun rule-based-translator\n       (input rules &key (matcher 'pat-match)\n        (rule-if #'first) (rule-then #'rest) (action #'sublis))\n  \"Find the first rule in rules that matches input,\n  and apply the action to that rule.\"\n  (some\n    #'(lambda (rule)\n        (let ((result (funcall matcher (funcall rule-if rule)\n                               input)))\n          (if (not (eq result fail))\n              (funcall action result (funcall rule-then rule)))))\n    rules))\n"
  },
  {
    "path": "lisp/prolog.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File prolog.lisp: prolog from (11.3), with interactive backtracking.\n\n(requires \"unify\") ; does not require \"prolog1\"\n\n;;;; does not include destructive unification (11.6); see prologc.lisp\n\n;; clauses are represented as (head . body) cons cells\n(defun clause-head (clause) (first clause))\n(defun clause-body (clause) (rest clause))\n\n;; clauses are stored on the predicate's plist\n(defun get-clauses (pred) (get pred 'clauses))\n(defun predicate (relation) (first relation))\n(defun args (x) \"The arguments of a relation\" (rest x))\n\n(defvar *db-predicates* nil\n  \"a list of all predicates stored in the database.\")\n\n(defmacro <- (&rest clause)\n  \"add a clause to the data base.\"\n  `(add-clause ',(replace-?-vars clause)))\n\n(defun add-clause (clause)\n  \"add a clause to the data base, indexed by head's predicate.\"\n  ;; the predicate must be a non-variable symbol.\n  (let ((pred (predicate (clause-head clause))))\n    (assert (and (symbolp pred) (not (variable-p pred))))\n    (pushnew pred *db-predicates*)\n    (setf (get pred 'clauses)\n          (nconc (get-clauses pred) (list clause)))\n    pred))\n\n(defun clear-db ()\n  \"remove all clauses (for all predicates) from the data base.\"\n  (mapc #'clear-predicate *db-predicates*))\n\n(defun clear-predicate (predicate)\n  \"remove the clauses for a single predicate.\"\n  (setf (get predicate 'clauses) nil))\n\n(defun rename-variables (x)\n  \"replace all variables in x with new ones.\"\n  (sublis (mapcar #'(lambda (var) (cons var (gensym (string var))))\n                  (variables-in x))\n          x))\n\n(defun unique-find-anywhere-if (predicate tree\n                                &optional found-so-far)\n  \"return a list of leaves of tree satisfying predicate,\n  with duplicates removed.\"\n  (if (atom tree)\n      (if (funcall predicate tree)\n          (adjoin tree found-so-far)\n          found-so-far)\n      (unique-find-anywhere-if\n        predicate\n        (first tree)\n        (unique-find-anywhere-if predicate (rest tree)\n                                 found-so-far))))\n\n(defun find-anywhere-if (predicate tree)\n  \"does predicate apply to any atom in the tree?\"\n  (if (atom tree)\n      (funcall predicate tree)\n      (or (find-anywhere-if predicate (first tree))\n          (find-anywhere-if predicate (rest tree)))))\n\n(defmacro ?- (&rest goals) `(top-level-prove ',(replace-?-vars goals)))\n\n(defun prove-all (goals bindings)\n  \"Find a solution to the conjunction of goals.\"\n  (cond ((eq bindings fail) fail)\n        ((null goals) bindings)\n        (t (prove (first goals) bindings (rest goals)))))\n\n(defun prove (goal bindings other-goals)\n  \"Return a list of possible solutions to goal.\"\n  (let ((clauses (get-clauses (predicate goal))))\n    (if (listp clauses)\n        (some\n          #'(lambda (clause)\n              (let ((new-clause (rename-variables clause)))\n                (prove-all\n                  (append (clause-body new-clause) other-goals)\n                  (unify goal (clause-head new-clause) bindings))))\n          clauses)\n        ;; The predicate's \"clauses\" can be an atom:\n        ;; a primitive function to call\n        (funcall clauses (rest goal) bindings\n                 other-goals))))\n\n(defun top-level-prove (goals)\n  (prove-all `(,@goals (show-prolog-vars ,@(variables-in goals)))\n             no-bindings)\n  (format t \"~&No.\")\n  (values))\n\n(defun show-prolog-vars (vars bindings other-goals)\n  \"Print each variable with its binding.\n  Then ask the user if more solutions are desired.\"\n  (if (null vars)\n      (format t \"~&Yes\")\n      (dolist (var vars)\n        (format t \"~&~a = ~a\" var\n                (subst-bindings bindings var))))\n  (if (continue-p)\n      fail\n      (prove-all other-goals bindings)))\n\n(setf (get 'show-prolog-vars 'clauses) 'show-prolog-vars)\n\n(defun continue-p ()\n  \"Ask user if we should continue looking for solutions.\"\n  (case (read-char)\n    (#\\; t)\n    (#\\. nil)\n    (#\\newline (continue-p))\n    (otherwise\n      (format t \" Type ; to see more or . to stop\")\n      (continue-p))))\n\n(defun variables-in (exp)\n  \"Return a list of all the variables in EXP.\"\n  (unique-find-anywhere-if #'non-anon-variable-p exp))\n\n(defun non-anon-variable-p (x)\n  (and (variable-p x) (not (eq x '?))))\n\n(defun replace-?-vars (exp)\n    \"Replace any ? within exp with a var of the form ?123.\"\n    (cond ((eq exp '?) (gensym \"?\"))\n\t  ((atom exp) exp)\n\t  (t (reuse-cons (replace-?-vars (first exp))\n\t\t\t (replace-?-vars (rest exp))\n\t\t\t exp))))\n"
  },
  {
    "path": "lisp/prolog1.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File prolog1.lisp: First version of the prolog interpreter (11.2).\n\n(requires \"unify\")\n\n;; Clauses are represented as (head . body) cons cells\n(defun clause-head (clause) (first clause))\n(defun clause-body (clause) (rest clause))\n\n;; Clauses are stored on the predicate's plist\n(defun get-clauses (pred) (get pred 'clauses))\n(defun predicate (relation) (first relation))\n\n(defvar *db-predicates* nil\n  \"A list of all predicates stored in the database.\")\n\n(defmacro <- (&rest clause)\n  \"Add a clause to the data base.\"\n  `(add-clause ',clause))\n\n(defun add-clause (clause)\n  \"Add a clause to the data base, indexed by head's predicate.\"\n  ;; The predicate must be a non-variable symbol.\n  (let ((pred (predicate (clause-head clause))))\n    (assert (and (symbolp pred) (not (variable-p pred))))\n    (pushnew pred *db-predicates*)\n    (setf (get pred 'clauses)\n          (nconc (get-clauses pred) (list clause)))\n    pred))\n\n(defun clear-db ()\n  \"Remove all clauses (for all predicates) from the data base.\"\n  (mapc #'clear-predicate *db-predicates*))\n\n(defun clear-predicate (predicate)\n  \"Remove the clauses for a single predicate.\"\n  (setf (get predicate 'clauses) nil))\n\n(defun prove (goal bindings)\n  \"Return a list of possible solutions to goal.\"\n  (mapcan #'(lambda (clause)\n              (let ((new-clause (rename-variables clause)))\n                (prove-all (clause-body new-clause)\n                           (unify goal (clause-head new-clause) bindings))))\n          (get-clauses (predicate goal))))\n\n(defun prove-all (goals bindings)\n  \"Return a list of solutions to the conjunction of goals.\"\n  (cond ((eq bindings fail) fail)\n        ((null goals) (list bindings))\n        (t (mapcan #'(lambda (goal1-solution)\n                       (prove-all (rest goals) goal1-solution))\n                   (prove (first goals) bindings)))))\n\n(defun rename-variables (x)\n  \"Replace all variables in x with new ones.\"\n  (sublis (mapcar #'(lambda (var) (cons var (gensym (string var))))\n                  (variables-in x))\n          x))\n\n(defun unique-find-anywhere-if (predicate tree\n                                &optional found-so-far)\n  \"Return a list of leaves of tree satisfying predicate,\n  with duplicates removed.\"\n  (if (atom tree)\n      (if (funcall predicate tree)\n          (adjoin tree found-so-far)\n          found-so-far)\n      (unique-find-anywhere-if\n        predicate\n        (first tree)\n        (unique-find-anywhere-if predicate (rest tree)\n                                 found-so-far))))\n\n(defun find-anywhere-if (predicate tree)\n  \"Does predicate apply to any atom in the tree?\"\n  (if (atom tree)\n      (funcall predicate tree)\n      (or (find-anywhere-if predicate (first tree))\n          (find-anywhere-if predicate (rest tree)))))\n\n(defmacro ?- (&rest goals) `(top-level-prove ',goals))\n\n(defun top-level-prove (goals)\n  \"Prove the goals, and print variables readably.\"\n  (show-prolog-solutions\n    (variables-in goals)\n    (prove-all goals no-bindings)))\n\n(defun show-prolog-solutions (vars solutions)\n  \"Print the variables in each of the solutions.\"\n  (if (null solutions)\n      (format t \"~&No.\")\n      (mapc #'(lambda (solution) (show-prolog-vars vars solution))\n            solutions))\n  (values))\n\n(defun show-prolog-vars (vars bindings)\n  \"Print each variable with its binding.\"\n  (if (null vars)\n      (format t \"~&Yes\")\n      (dolist (var vars)\n        (format t \"~&~a = ~a\" var\n                (subst-bindings bindings var))))\n  (princ \";\"))\n\n(defun variables-in (exp)\n  \"Return a list of all the variables in EXP.\"\n  (unique-find-anywhere-if #'variable-p exp))\n\n"
  },
  {
    "path": "lisp/prologc.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File prologc.lisp: Final version of the compiler,\n;;;; including all improvements from the chapter.\n\n(requires \"prolog\")\n\n(defconstant unbound \"Unbound\")\n\n(defstruct var name (binding unbound))\n\n(defun bound-p (var) (not (eq (var-binding var) unbound)))\n\n(defmacro deref (exp)\n  \"Follow pointers for bound variables.\"\n  `(progn (loop while (and (var-p ,exp) (bound-p ,exp))\n             do (setf ,exp (var-binding ,exp)))\n          ,exp))\n\n(defun unify! (x y)\n  \"Destructively unify two expressions\"\n  (cond ((eql (deref x) (deref y)) t)\n        ((var-p x) (set-binding! x y))\n        ((var-p y) (set-binding! y x))\n        ((and (consp x) (consp y))\n         (and (unify! (first x) (first y))\n              (unify! (rest x) (rest y))))\n        (t nil)))\n\n(defun set-binding! (var value)\n  \"Set var's binding to value.  Always succeeds (returns t).\"\n  (setf (var-binding var) value)\n  t)\n\n(defun print-var (var stream depth)\n  (if (or (and *print-level*\n               (>= depth *print-level*))\n          (var-p (deref var)))\n      (format stream \"?~a\" (var-name var))\n      (write var :stream stream)))\n\n(defvar *trail* (make-array 200 :fill-pointer 0 :adjustable t))\n\n(defun set-binding! (var value)\n  \"Set var's binding to value, after saving the variable\n  in the trail.  Always returns t.\"\n  (unless (eq var value)\n    (vector-push-extend var *trail*)\n    (setf (var-binding var) value))\n  t)\n\n(defun undo-bindings! (old-trail)\n  \"Undo all bindings back to a given point in the trail.\"\n  (loop until (= (fill-pointer *trail*) old-trail)\n     do (setf (var-binding (vector-pop *trail*)) unbound)))\n\n(defvar *var-counter* 0)\n\n(defstruct (var (:constructor ? ())\n                (:print-function print-var))\n  (name (incf *var-counter*))\n  (binding unbound))\n\n(defun prolog-compile (symbol &optional\n                       (clauses (get-clauses symbol)))\n  \"Compile a symbol; make a separate function for each arity.\"\n  (unless (null clauses)\n    (let ((arity (relation-arity (clause-head (first clauses)))))\n      ;; Compile the clauses with this arity\n      (compile-predicate\n        symbol arity (clauses-with-arity clauses #'= arity))\n      ;; Compile all the clauses with any other arity\n      (prolog-compile\n        symbol (clauses-with-arity clauses #'/= arity)))))\n\n(defun clauses-with-arity (clauses test arity)\n  \"Return all clauses whose head has given arity.\"\n  (find-all arity clauses\n            :key #'(lambda (clause)\n                     (relation-arity (clause-head clause)))\n            :test test))\n\n(defun relation-arity (relation)\n  \"The number of arguments to a relation.\n  Example: (relation-arity '(p a b c)) => 3\"\n  (length (args relation)))\n\n(defun args (x) \"The arguments of a relation\" (rest x))\n\n(defun make-parameters (arity)\n  \"Return the list (?arg1 ?arg2 ... ?arg-arity)\"\n  (loop for i from 1 to arity\n        collect (new-symbol '?arg i)))\n\n(defun make-predicate (symbol arity)\n  \"Return the symbol: symbol/arity\"\n  (symbol symbol '/ arity))\n\n(defun make-= (x y) `(= ,x ,y))\n\n(defun compile-call (predicate args cont)\n  \"Compile a call to a prolog predicate.\"\n  `(,predicate ,@args ,cont))\n\n(defun prolog-compiler-macro (name)\n  \"Fetch the compiler macro for a Prolog predicate.\"\n  ;; Note NAME is the raw name, not the name/arity\n  (get name 'prolog-compiler-macro))\n\n(defmacro def-prolog-compiler-macro (name arglist &body body)\n  \"Define a compiler macro for Prolog.\"\n  `(setf (get ',name 'prolog-compiler-macro)\n         #'(lambda ,arglist .,body)))\n\n(defun compile-arg (arg)\n  \"Generate code for an argument to a goal in the body.\"\n  (cond ((variable-p arg) arg)\n        ((not (has-variable-p arg)) `',arg)\n        ((proper-listp arg)\n         `(list .,(mapcar #'compile-arg arg)))\n        (t `(cons ,(compile-arg (first arg))\n                  ,(compile-arg (rest arg))))))\n\n(defun has-variable-p (x)\n  \"Is there a variable anywhere in the expression x?\"\n  (find-if-anywhere #'variable-p x))\n\n(defun proper-listp (x)\n  \"Is x a proper (non-dotted) list?\"\n  (or (null x)\n      (and (consp x) (proper-listp (rest x)))))\n\n(defun maybe-add-undo-bindings (compiled-exps)\n  \"Undo any bindings that need undoing.\n  If there are any, bind the trail before we start.\"\n  (if (length=1 compiled-exps)\n      compiled-exps\n      `((let ((old-trail (fill-pointer *trail*)))\n          ,(first compiled-exps)\n          ,@(loop for exp in (rest compiled-exps)\n                  collect '(undo-bindings! old-trail)\n                  collect exp)))))\n\n(defun bind-unbound-vars (parameters exp)\n  \"If there are any variables in exp (besides the parameters)\n  then bind them to new vars.\"\n  (let ((exp-vars (set-difference (variables-in exp)\n                                  parameters)))\n    (if exp-vars\n        `(let ,(mapcar #'(lambda (var) `(,var (?)))\n                       exp-vars)\n           ,exp)\n        exp)))\n\n(defmacro <- (&rest clause)\n  \"Add a clause to the data base.\"\n  `(add-clause ',(make-anonymous clause)))\n\n(defun make-anonymous (exp &optional\n                       (anon-vars (anonymous-variables-in exp)))\n  \"Replace variables that are only used once with ?.\"\n  (cond ((consp exp)\n         (reuse-cons (make-anonymous (first exp) anon-vars)\n                     (make-anonymous (rest exp) anon-vars)\n                     exp))\n        ((member exp anon-vars) '?)\n        (t exp)))\n\n(defun anonymous-variables-in (tree)\n  \"Return a list of all variables that occur only once in tree.\"\n  (values (anon-vars-in tree nil nil)))\n\n(defun anon-vars-in (tree seen-once seen-more)\n  \"Walk the data structure TREE, returning a list of variabless\n   seen once, and a list of variables seen more than once.\"\n  (cond\n    ((consp tree)\n     (multiple-value-bind (new-seen-once new-seen-more)\n         (anon-vars-in (first tree) seen-once seen-more)\n       (anon-vars-in (rest tree) new-seen-once new-seen-more)))\n    ((not (variable-p tree)) (values seen-once seen-more))\n    ((member tree seen-once)\n     (values (delete tree seen-once) (cons tree seen-more)))\n    ((member tree seen-more)\n     (values seen-once seen-more))\n    (t (values (cons tree seen-once) seen-more))))\n\n(defun compile-unify (x y bindings)\n  \"Return 2 values: code to test if x and y unify,\n  and a new binding list.\"\n  (cond\n    ;; Unify constants and conses:                       ; Case\n    ((not (or (has-variable-p x) (has-variable-p y)))    ; 1,2\n     (values (equal x y) bindings))\n    ((and (consp x) (consp y))                           ; 3\n     (multiple-value-bind (code1 bindings1)\n         (compile-unify (first x) (first y) bindings)\n       (multiple-value-bind (code2 bindings2)\n           (compile-unify (rest x) (rest y) bindings1)\n         (values (compile-if code1 code2) bindings2))))\n    ;; Here x or y is a variable.  Pick the right one:\n    ((variable-p x) (compile-unify-variable x y bindings))\n    (t              (compile-unify-variable y x bindings))))\n\n(defun compile-if (pred then-part)\n  \"Compile a Lisp IF form. No else-part allowed.\"\n  (case pred\n    ((t) then-part)\n    ((nil) nil)\n    (otherwise `(if ,pred ,then-part))))\n\n(defun compile-unify-variable (x y bindings)\n  \"X is a variable, and Y may be.\"\n  (let* ((xb (follow-binding x bindings))\n         (x1 (if xb (cdr xb) x))\n         (yb (if (variable-p y) (follow-binding y bindings)))\n         (y1 (if yb (cdr yb) y)))\n    (cond                                                 ; Case:\n      ((or (eq x '?) (eq y '?)) (values t bindings))      ; 12\n      ((not (and (equal x x1) (equal y y1)))              ; deref\n       (compile-unify x1 y1 bindings))\n      ((find-anywhere x1 y1) (values nil bindings))       ; 11\n      ((consp y1)                                         ; 7,10\n       (values `(unify! ,x1 ,(compile-arg y1 bindings))\n               (bind-variables-in y1 bindings)))\n      ((not (null xb))\n       ;; i.e. x is an ?arg variable\n       (if (and (variable-p y1) (null yb))\n           (values 't (extend-bindings y1 x1 bindings))   ; 4\n           (values `(unify! ,x1 ,(compile-arg y1 bindings))\n                   (extend-bindings x1 y1 bindings))))    ; 5,6\n      ((not (null yb))\n       (compile-unify-variable y1 x1 bindings))\n      (t (values 't (extend-bindings x1 y1 bindings)))))) ; 8,9\n\n(defun bind-variables-in (exp bindings)\n  \"Bind all variables in exp to themselves, and add that to\n  bindings (except for variables already bound).\"\n  (dolist (var (variables-in exp))\n    (unless (get-binding var bindings)\n      (setf bindings (extend-bindings var var bindings))))\n  bindings)\n\n(defun follow-binding (var bindings)\n  \"Get the ultimate binding of var according to bindings.\"\n  (let ((b (get-binding var bindings)))\n    (if (eq (car b) (cdr b))\n        b\n        (or (follow-binding (cdr b) bindings)\n            b))))\n\n(defun compile-arg (arg bindings)\n  \"Generate code for an argument to a goal in the body.\"\n  (cond ((eq arg '?) '(?))\n        ((variable-p arg)\n         (let ((binding (get-binding arg bindings)))\n           (if (and (not (null binding))\n                    (not (eq arg (binding-val binding))))\n             (compile-arg (binding-val binding) bindings)\n             arg)))\n        ((not (find-if-anywhere #'variable-p arg)) `',arg)\n        ((proper-listp arg)\n         `(list .,(mapcar #'(lambda (a) (compile-arg a bindings))\n                          arg)))\n        (t `(cons ,(compile-arg (first arg) bindings)\n                  ,(compile-arg (rest arg) bindings)))))\n\n(defun bind-new-variables (bindings goal)\n  \"Extend bindings to include any unbound variables in goal.\"\n  (let ((variables (remove-if #'(lambda (v) (assoc v bindings))\n                              (variables-in goal))))\n    (nconc (mapcar #'self-cons variables) bindings)))\n\n(defun self-cons (x) (cons x x))\n\n(def-prolog-compiler-macro = (goal body cont bindings)\n  \"Compile a goal which is a call to =.\"\n  (let ((args (args goal)))\n    (if (/= (length args) 2)\n        :pass ;; decline to handle this goal\n        (multiple-value-bind (code1 bindings1)\n            (compile-unify (first args) (second args) bindings)\n          (compile-if\n            code1\n            (compile-body body cont bindings1))))))\n\n(defun compile-clause (parms clause cont)\n  \"Transform away the head, and compile the resulting body.\"\n  (bind-unbound-vars\n    parms\n    (compile-body\n      (nconc\n        (mapcar #'make-= parms (args (clause-head clause)))\n        (clause-body clause))\n      cont\n      (mapcar #'self-cons parms))))                    ;***\n\n(defvar *uncompiled* nil\n  \"Prolog symbols that have not been compiled.\")\n\n(defun add-clause (clause)\n  \"Add a clause to the data base, indexed by head's predicate.\"\n  ;; The predicate must be a non-variable symbol.\n  (let ((pred (predicate (clause-head clause))))\n    (assert (and (symbolp pred) (not (variable-p pred))))\n    (pushnew pred *db-predicates*)\n    (pushnew pred *uncompiled*)                          ;***\n    (setf (get pred 'clauses)\n          (nconc (get-clauses pred) (list clause)))\n    pred))\n\n(defun top-level-prove (goals)\n  \"Prove the list of goals by compiling and calling it.\"\n  ;; First redefine top-level-query\n  (clear-predicate 'top-level-query)\n  (let ((vars (delete '? (variables-in goals))))\n    (add-clause `((top-level-query)\n                  ,@goals\n                  (show-prolog-vars ,(mapcar #'symbol-name vars)\n                                    ,vars))))\n  ;; Now run it\n  (run-prolog 'top-level-query/0 #'ignore)\n  (format t \"~&No.\")\n  (values))\n\n(defun run-prolog (procedure cont)\n  \"Run a 0-ary prolog procedure with a given continuation.\"\n  ;; First compile anything else that needs it\n  (prolog-compile-symbols)\n  ;; Reset the trail and the new variable counter\n  (setf (fill-pointer *trail*) 0)\n  (setf *var-counter* 0)\n  ;; Finally, call the query\n  (catch 'top-level-prove\n    (funcall procedure cont)))\n\n(defun prolog-compile-symbols (&optional (symbols *uncompiled*))\n  \"Compile a list of Prolog symbols.\n  By default, the list is all symbols that need it.\"\n  (mapc #'prolog-compile symbols)\n  (setf *uncompiled* (set-difference *uncompiled* symbols)))\n\n(defun ignore (&rest args)\n  (declare (ignore args))\n  nil)\n\n(defun show-prolog-vars/2 (var-names vars cont)\n  \"Display the variables, and prompt the user to see\n  if we should continue.  If not, return to the top level.\"\n  (if (null vars)\n      (format t \"~&Yes\")\n      (loop for name in var-names\n            for var in vars do\n            (format t \"~&~a = ~a\" name (deref-exp var))))\n  (if (continue-p)\n      (funcall cont)\n      (throw 'top-level-prove nil)))\n\n(defun deref-exp (exp)\n  \"Build something equivalent to EXP with variables dereferenced.\"\n  (if (atom (deref exp))\n      exp\n      (reuse-cons\n        (deref-exp (first exp))\n        (deref-exp (rest exp))\n        exp)))\n\n(defvar *predicate* nil\n  \"The Prolog predicate currently being compiled\")\n\n(defun compile-predicate (symbol arity clauses)\n  \"Compile all the clauses for a given symbol/arity\n  into a single LISP function.\"\n  (let ((*predicate* (make-predicate symbol arity))    ;***\n        (parameters (make-parameters arity)))\n    (compile\n     (eval\n      `(defun ,*predicate* (,@parameters cont)\n\t.,(maybe-add-undo-bindings\n\t   (mapcar #'(lambda (clause)\n\t\t       (compile-clause parameters clause 'cont))\n\t    clauses)))))))\n\n(defun compile-body (body cont bindings)\n  \"Compile the body of a clause.\"\n  (cond\n    ((null body)\n     `(funcall ,cont))\n    ((eq (first body) '!)                              ;***\n     `(progn ,(compile-body (rest body) cont bindings) ;***\n             (return-from ,*predicate* nil)))          ;***\n    (t (let* ((goal (first body))\n              (macro (prolog-compiler-macro (predicate goal)))\n              (macro-val (if macro\n                             (funcall macro goal (rest body)\n                                      cont bindings))))\n        (if (and macro (not (eq macro-val :pass)))\n            macro-val\n            `(,(make-predicate (predicate goal)\n                               (relation-arity goal))\n              ,@(mapcar #'(lambda (arg)\n                            (compile-arg arg bindings))\n                        (args goal))\n              ,(if (null (rest body))\n                   cont\n                   `#'(lambda ()\n                        ,(compile-body\n                           (rest body) cont\n                           (bind-new-variables bindings goal))))))))))\n\n"
  },
  {
    "path": "lisp/prologc1.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File prologc1.lisp: Version 1 of the prolog compiler,\n;;;; including the destructive unification routines from Chapter 11.\n\n(requires \"prolog\")\n\n(defconstant unbound \"Unbound\")\n\n(defstruct var name (binding unbound))\n\n(defun bound-p (var) (not (eq (var-binding var) unbound)))\n\n(defmacro deref (exp)\n  \"Follow pointers for bound variables.\"\n  `(progn (loop while (and (var-p ,exp) (bound-p ,exp))\n             do (setf ,exp (var-binding ,exp)))\n          ,exp))\n\n(defun unify! (x y)\n  \"Destructively unify two expressions\"\n  (cond ((eql (deref x) (deref y)) t)\n        ((var-p x) (set-binding! x y))\n        ((var-p y) (set-binding! y x))\n        ((and (consp x) (consp y))\n         (and (unify! (first x) (first y))\n              (unify! (rest x) (rest y))))\n        (t nil)))\n\n(defun set-binding! (var value)\n  \"Set var's binding to value.  Always succeeds (returns t).\"\n  (setf (var-binding var) value)\n  t)\n\n(defun print-var (var stream depth)\n  (if (or (and *print-level*\n               (>= depth *print-level*))\n          (var-p (deref var)))\n      (format stream \"?~a\" (var-name var))\n      (write var :stream stream)))\n\n(defvar *trail* (make-array 200 :fill-pointer 0 :adjustable t))\n\n(defun set-binding! (var value)\n  \"Set var's binding to value, after saving the variable\n  in the trail.  Always returns t.\"\n  (unless (eq var value)\n    (vector-push-extend var *trail*)\n    (setf (var-binding var) value))\n  t)\n\n(defun undo-bindings! (old-trail)\n  \"Undo all bindings back to a given point in the trail.\"\n  (loop until (= (fill-pointer *trail*) old-trail)\n     do (setf (var-binding (vector-pop *trail*)) unbound)))\n\n(defvar *var-counter* 0)\n\n(defstruct (var (:constructor ? ())\n                (:print-function print-var))\n  (name (incf *var-counter*))\n  (binding unbound))\n\n(defun prolog-compile (symbol &optional\n                       (clauses (get-clauses symbol)))\n  \"Compile a symbol; make a separate function for each arity.\"\n  (unless (null clauses)\n    (let ((arity (relation-arity (clause-head (first clauses)))))\n      ;; Compile the clauses with this arity\n      (compile-predicate\n        symbol arity (clauses-with-arity clauses #'= arity))\n      ;; Compile all the clauses with any other arity\n      (prolog-compile\n        symbol (clauses-with-arity clauses #'/= arity)))))\n\n(defun clauses-with-arity (clauses test arity)\n  \"Return all clauses whose head has given arity.\"\n  (find-all arity clauses\n            :key #'(lambda (clause)\n                     (relation-arity (clause-head clause)))\n            :test test))\n\n(defun relation-arity (relation)\n  \"The number of arguments to a relation.\n  Example: (relation-arity '(p a b c)) => 3\"\n  (length (args relation)))\n\n(defun args (x) \"The arguments of a relation\" (rest x))\n\n(defun compile-predicate (symbol arity clauses)\n  \"Compile all the clauses for a given symbol/arity\n  into a single LISP function.\"\n  (let ((predicate (make-predicate symbol arity))\n        (parameters (make-parameters arity)))\n    (compile\n     (eval\n      `(defun ,predicate (,@parameters cont)\n\t.,(mapcar #'(lambda (clause)\n\t\t      (compile-clause parameters clause 'cont))\n\t   clauses))))))\n\n(defun make-parameters (arity)\n  \"Return the list (?arg1 ?arg2 ... ?arg-arity)\"\n  (loop for i from 1 to arity\n        collect (new-symbol '?arg i)))\n\n(defun make-predicate (symbol arity)\n  \"Return the symbol: symbol/arity\"\n  (symbol symbol '/ arity))\n\n(defun compile-clause (parms clause cont)\n  \"Transform away the head, and compile the resulting body.\"\n  (compile-body\n    (nconc\n      (mapcar #'make-= parms (args (clause-head clause)))\n      (clause-body clause))\n    cont))\n\n(defun make-= (x y) `(= ,x ,y))\n\n(defun compile-body (body cont)\n  \"Compile the body of a clause.\"\n  (if (null body)\n      `(funcall ,cont)\n      (let* ((goal (first body))\n             (macro (prolog-compiler-macro (predicate goal)))\n             (macro-val (if macro\n                            (funcall macro goal (rest body) cont))))\n        (if (and macro (not (eq macro-val :pass)))\n            macro-val\n            (compile-call\n               (make-predicate (predicate goal)\n                               (relation-arity goal))\n               (mapcar #'(lambda (arg) (compile-arg arg))\n                       (args goal))\n               (if (null (rest body))\n                   cont\n                   `#'(lambda ()\n                      ,(compile-body (rest body) cont))))))))\n\n(defun compile-call (predicate args cont)\n  \"Compile a call to a prolog predicate.\"\n  `(,predicate ,@args ,cont))\n\n(defun prolog-compiler-macro (name)\n  \"Fetch the compiler macro for a Prolog predicate.\"\n  ;; Note NAME is the raw name, not the name/arity\n  (get name 'prolog-compiler-macro))\n\n(defmacro def-prolog-compiler-macro (name arglist &body body)\n  \"Define a compiler macro for Prolog.\"\n  `(setf (get ',name 'prolog-compiler-macro)\n         #'(lambda ,arglist .,body)))\n\n(def-prolog-compiler-macro = (goal body cont)\n  (let ((args (args goal)))\n    (if (/= (length args) 2)\n        :pass\n        `(if ,(compile-unify (first args) (second args))\n             ,(compile-body body cont)))))\n\n(defun compile-unify (x y)\n  \"Return code that tests if var and term unify.\"\n  `(unify! ,(compile-arg x) ,(compile-arg y)))\n\n(defun compile-arg (arg)\n  \"Generate code for an argument to a goal in the body.\"\n  (cond ((variable-p arg) arg)\n        ((not (has-variable-p arg)) `',arg)\n        ((proper-listp arg)\n         `(list .,(mapcar #'compile-arg arg)))\n        (t `(cons ,(compile-arg (first arg))\n                  ,(compile-arg (rest arg))))))\n\n(defun has-variable-p (x)\n  \"Is there a variable anywhere in the expression x?\"\n  (find-if-anywhere #'variable-p x))\n\n(defun proper-listp (x)\n  \"Is x a proper (non-dotted) list?\"\n  (or (null x)\n      (and (consp x) (proper-listp (rest x)))))\n\n"
  },
  {
    "path": "lisp/prologc2.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File prologc2.lisp: Version 2 of the prolog compiler,\n;;;; fixing the first set of bugs.\n\n(requires \"prolog\")\n\n(defconstant unbound \"Unbound\")\n\n(defstruct var name (binding unbound))\n\n(defun bound-p (var) (not (eq (var-binding var) unbound)))\n\n(defmacro deref (exp)\n  \"Follow pointers for bound variables.\"\n  `(progn (loop while (and (var-p ,exp) (bound-p ,exp))\n             do (setf ,exp (var-binding ,exp)))\n          ,exp))\n\n(defun unify! (x y)\n  \"Destructively unify two expressions\"\n  (cond ((eql (deref x) (deref y)) t)\n        ((var-p x) (set-binding! x y))\n        ((var-p y) (set-binding! y x))\n        ((and (consp x) (consp y))\n         (and (unify! (first x) (first y))\n              (unify! (rest x) (rest y))))\n        (t nil)))\n\n(defun set-binding! (var value)\n  \"Set var's binding to value.  Always succeeds (returns t).\"\n  (setf (var-binding var) value)\n  t)\n\n(defun print-var (var stream depth)\n  (if (or (and *print-level*\n               (>= depth *print-level*))\n          (var-p (deref var)))\n      (format stream \"?~a\" (var-name var))\n      (write var :stream stream)))\n\n(defvar *trail* (make-array 200 :fill-pointer 0 :adjustable t))\n\n(defun set-binding! (var value)\n  \"Set var's binding to value, after saving the variable\n  in the trail.  Always returns t.\"\n  (unless (eq var value)\n    (vector-push-extend var *trail*)\n    (setf (var-binding var) value))\n  t)\n\n(defun undo-bindings! (old-trail)\n  \"Undo all bindings back to a given point in the trail.\"\n  (loop until (= (fill-pointer *trail*) old-trail)\n     do (setf (var-binding (vector-pop *trail*)) unbound)))\n\n(defvar *var-counter* 0)\n\n(defstruct (var (:constructor ? ())\n                (:print-function print-var))\n  (name (incf *var-counter*))\n  (binding unbound))\n\n(defun prolog-compile (symbol &optional\n                       (clauses (get-clauses symbol)))\n  \"Compile a symbol; make a separate function for each arity.\"\n  (unless (null clauses)\n    (let ((arity (relation-arity (clause-head (first clauses)))))\n      ;; Compile the clauses with this arity\n      (compile-predicate\n        symbol arity (clauses-with-arity clauses #'= arity))\n      ;; Compile all the clauses with any other arity\n      (prolog-compile\n        symbol (clauses-with-arity clauses #'/= arity)))))\n\n(defun clauses-with-arity (clauses test arity)\n  \"Return all clauses whose head has given arity.\"\n  (find-all arity clauses\n            :key #'(lambda (clause)\n                     (relation-arity (clause-head clause)))\n            :test test))\n\n(defun relation-arity (relation)\n  \"The number of arguments to a relation.\n  Example: (relation-arity '(p a b c)) => 3\"\n  (length (args relation)))\n\n(defun args (x) \"The arguments of a relation\" (rest x))\n\n(defun make-parameters (arity)\n  \"Return the list (?arg1 ?arg2 ... ?arg-arity)\"\n  (loop for i from 1 to arity\n        collect (new-symbol '?arg i)))\n\n(defun make-predicate (symbol arity)\n  \"Return the symbol: symbol/arity\"\n  (symbol symbol '/ arity))\n\n(defun make-= (x y) `(= ,x ,y))\n\n(defun compile-body (body cont)\n  \"Compile the body of a clause.\"\n  (if (null body)\n      `(funcall ,cont)\n      (let* ((goal (first body))\n             (macro (prolog-compiler-macro (predicate goal)))\n             (macro-val (if macro\n                            (funcall macro goal (rest body) cont))))\n        (if (and macro (not (eq macro-val :pass)))\n            macro-val\n            (compile-call\n               (make-predicate (predicate goal)\n                               (relation-arity goal))\n               (mapcar #'(lambda (arg) (compile-arg arg))\n                       (args goal))\n               (if (null (rest body))\n                   cont\n                   `#'(lambda ()\n                      ,(compile-body (rest body) cont))))))))\n\n(defun compile-call (predicate args cont)\n  \"Compile a call to a prolog predicate.\"\n  `(,predicate ,@args ,cont))\n\n(defun prolog-compiler-macro (name)\n  \"Fetch the compiler macro for a Prolog predicate.\"\n  ;; Note NAME is the raw name, not the name/arity\n  (get name 'prolog-compiler-macro))\n\n(defmacro def-prolog-compiler-macro (name arglist &body body)\n  \"Define a compiler macro for Prolog.\"\n  `(setf (get ',name 'prolog-compiler-macro)\n         #'(lambda ,arglist .,body)))\n\n(def-prolog-compiler-macro = (goal body cont)\n  (let ((args (args goal)))\n    (if (/= (length args) 2)\n        :pass\n        `(if ,(compile-unify (first args) (second args))\n             ,(compile-body body cont)))))\n\n(defun compile-unify (x y)\n  \"Return code that tests if var and term unify.\"\n  `(unify! ,(compile-arg x) ,(compile-arg y)))\n\n(defun compile-arg (arg)\n  \"Generate code for an argument to a goal in the body.\"\n  (cond ((variable-p arg) arg)\n        ((not (has-variable-p arg)) `',arg)\n        ((proper-listp arg)\n         `(list .,(mapcar #'compile-arg arg)))\n        (t `(cons ,(compile-arg (first arg))\n                  ,(compile-arg (rest arg))))))\n\n(defun has-variable-p (x)\n  \"Is there a variable anywhere in the expression x?\"\n  (find-if-anywhere #'variable-p x))\n\n(defun proper-listp (x)\n  \"Is x a proper (non-dotted) list?\"\n  (or (null x)\n      (and (consp x) (proper-listp (rest x)))))\n\n(defun compile-predicate (symbol arity clauses)\n  \"Compile all the clauses for a given symbol/arity\n  into a single LISP function.\"\n  (let ((predicate (make-predicate symbol arity))\n        (parameters (make-parameters arity)))\n    (compile\n     (eval\n      `(defun ,predicate (,@parameters cont)\n\t.,(maybe-add-undo-bindings                  ;***\n\t   (mapcar #'(lambda (clause)\n\t\t       (compile-clause parameters clause 'cont))\n\t    clauses)))))))\n\n(defun compile-clause (parms clause cont)\n  \"Transform away the head, and compile the resulting body.\"\n  (bind-unbound-vars                                   ;***\n    parms                                              ;***\n    (compile-body\n      (nconc\n        (mapcar #'make-= parms (args (clause-head clause)))\n        (clause-body clause))\n      cont)))\n\n(defun maybe-add-undo-bindings (compiled-exps)\n  \"Undo any bindings that need undoing.\n  If there are any, bind the trail before we start.\"\n  (if (length=1 compiled-exps)\n      compiled-exps\n      `((let ((old-trail (fill-pointer *trail*)))\n          ,(first compiled-exps)\n          ,@(loop for exp in (rest compiled-exps)\n                  collect '(undo-bindings! old-trail)\n                  collect exp)))))\n\n(defun bind-unbound-vars (parameters exp)\n  \"If there are any variables in exp (besides the parameters)\n  then bind them to new vars.\"\n  (let ((exp-vars (set-difference (variables-in exp)\n                                  parameters)))\n    (if exp-vars\n        `(let ,(mapcar #'(lambda (var) `(,var (?)))\n                       exp-vars)\n           ,exp)\n        exp)))\n\n"
  },
  {
    "path": "lisp/prologcp.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File prologcp.lisp:  Primitives for the prolog compiler\n;;;; needed to actually run some functions.\n\n;;; Bug fix by Adam Farquhar, farquhar@cs.utexas.edu.\n;;; Trivia: Farquhar is Norvig's cousin.\n\n(requires \"prologc\")\n\n(defun read/1 (exp cont)\n  (if (unify! exp (read))\n      (funcall cont)))\n\n(defun write/1 (exp cont)\n  (write (deref-exp exp) :pretty t)\n  (funcall cont))\n\n(defun nl/0 (cont) (terpri) (funcall cont))\n\n(defun =/2 (?arg1 ?arg2 cont)\n  (if (unify! ?arg1 ?arg2)\n      (funcall cont)))\n\n(defun ==/2 (?arg1 ?arg2 cont)\n  \"Are the two arguments EQUAL with no unification,\n  but with dereferencing?  If so, succeed.\"\n  (if (deref-equal ?arg1 ?arg2)\n      (funcall cont)))\n\n(defun deref-equal (x y)\n  \"Are the two arguments EQUAL with no unification,\n  but with dereferencing?\"\n  (or (eql (deref x) (deref y))\n      (and (consp x)\n           (consp y)\n           (deref-equal (first x) (first y))\n           (deref-equal (rest x) (rest y)))))\n\n(defun call/1 (goal cont)\n  \"Try to prove goal by calling it.\"\n  (deref goal)\n  (apply (make-predicate (first goal)\n                         (length (args goal)))\n         (append (args goal) (list cont))))\n\n(<- (or ?a ?b) (call ?a))\n(<- (or ?a ?b) (call ?b))\n\n(<- (and ?a ?b) (call ?a) (call ?b))\n\n(defmacro with-undo-bindings (&body body)\n  \"Undo bindings after each expression in body except the last.\"\n  (if (length=1 body)\n      (first body)\n      `(let ((old-trail (fill-pointer *trail*)))\n         ,(first body)\n         ,@(loop for exp in (rest body)\n                 collect '(undo-bindings! old-trail)\n                 collect exp))))\n\n(defun not/1 (relation cont)\n  \"Negation by failure: If you can't prove G, then (not G) true.\"\n  ;; Either way, undo the bindings.\n  (with-undo-bindings\n    (call/1 relation #'(lambda () (return-from not/1 nil)))\n    (funcall cont)))\n\n(defun bagof/3 (exp goal result cont)\n  \"Find all solutions to GOAL, and for each solution,\n  collect the value of EXP into the list RESULT.\"\n  ;; Ex: Assume (p 1) (p 2) (p 3).  Then:\n  ;;     (bagof ?x (p ?x) ?l) ==> ?l = (1 2 3)\n  (let ((answers nil))\n    (call/1 goal #'(lambda ()\n\t\t     ;; Bug fix by mdf0%shemesh@gte.com (Mark Feblowitz)\n\t\t     ;; on 25 Jan 1996; was deref-COPY\n                     (push (deref-EXP exp) answers)))\n    (if (and (not (null answers))\n             (unify! result (nreverse answers)))\n        (funcall cont))))\n\n(defun deref-copy (exp)\n  \"Copy the expression, replacing variables with new ones.\n  The part without variables can be returned as is.\"\n  ;; Bug fix by farquhar and norvig, 12/12/92.  Forgot to deref var.\n  (sublis (mapcar #'(lambda (var) (cons (deref var) (?)))\n                  (unique-find-anywhere-if #'var-p exp))\n          exp))\n\n(defun setof/3 (exp goal result cont)\n  \"Find all unique solutions to GOAL, and for each solution,\n  collect the value of EXP into the list RESULT.\"\n  ;; Ex: Assume (p 1) (p 2) (p 3).  Then:\n  ;;     (setof ?x (p ?x) ?l) ==> ?l = (1 2 3)\n  (let ((answers nil))\n    (call/1 goal #'(lambda ()\n                     (push (deref-copy exp) answers)))\n    (if (and (not (null answers))\n             (unify! result (delete-duplicates\n                              answers\n                              :test #'deref-equal)))\n        (funcall cont))))\n\n(defun is/2 (var exp cont)\n  ;; Example: (is ?x (+ 3 (* ?y (+ ?z 4))))\n  ;; Or even: (is (?x ?y ?x) (cons (first ?z) ?l))\n  (if (and (not (find-if-anywhere #'unbound-var-p exp))\n           (unify! var (eval (deref-exp exp))))\n      (funcall cont)))\n\n(defun unbound-var-p (exp)\n  \"Is EXP an unbound var?\"\n  (and (var-p exp) (not (bound-p exp))))\n\n(defun var/1 (?arg1 cont)\n  \"Succeeds if ?arg1 is an uninstantiated variable.\"\n  (if (unbound-var-p ?arg1)\n      (funcall cont)))\n\n(defun lisp/2 (?result exp cont)\n  \"Apply (first exp) to (rest exp), and return the result.\"\n  (if (and (consp (deref exp))\n           (unify! ?result (apply (first exp) (rest exp))))\n      (funcall cont)))\n\n(defun repeat/0 (cont)\n  (loop (funcall cont)))\n\n(<- (if ?test ?then) (if ?then ?else (fail)))\n\n(<- (if ?test ?then ?else)\n    (call ?test)\n    !\n    (call ?then))\n\n(<- (if ?test ?then ?else)\n    (call ?else))\n\n(<- (member ?item (?item . ?rest)))\n(<- (member ?item (?x . ?rest)) (member ?item ?rest))\n\n(<- (length () 0))\n(<- (length (?x . ?y) (1+ ?n)) (length ?y ?n))\n\n(defun numberp/1 (x cont)\n  (when (numberp (deref x))\n    (funcall cont)))\n\n(defun atom/1 (x cont)\n  (when (atom (deref x))\n    (funcall cont)))\n\n"
  },
  {
    "path": "lisp/search.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; search.lisp: Search routines from section 6.4\n\n(defun tree-search (states goal-p successors combiner)\n  \"Find a state that satisfies goal-p.  Start with states,\n  and search according to successors and combiner.\"\n  (dbg :search \"~&;; Search: ~a\" states)\n  (cond ((null states) fail)\n        ((funcall goal-p (first states)) (first states))\n        (t (tree-search\n             (funcall combiner\n                      (funcall successors (first states))\n                      (rest states))\n             goal-p successors combiner))))\n\n(defun depth-first-search (start goal-p successors)\n  \"Search new states first until goal is reached.\"\n  (tree-search (list start) goal-p successors #'append))\n\n(defun binary-tree (x) (list (* 2 x) (+ 1 (* 2 x))))\n\n(defun is (value) #'(lambda (x) (eql x value)))\n\n(defun prepend (x y) \"Prepend y to start of x\" (append y x))\n\n(defun breadth-first-search (start goal-p successors)\n  \"Search old states first until goal is reached.\"\n  (tree-search (list start) goal-p successors #'prepend))\n\n(defun finite-binary-tree (n)\n  \"Return a successor function that generates a binary tree\n  with n nodes.\"\n  #'(lambda (x)\n      (remove-if #'(lambda (child) (> child n))\n                 (binary-tree x))))\n\n(defun diff (num)\n  \"Return the function that finds the difference from num.\"\n  #'(lambda (x) (abs (- x num))))\n\n(defun sorter (cost-fn)\n  \"Return a combiner function that sorts according to cost-fn.\"\n  #'(lambda (new old)\n      (sort (append new old) #'< :key cost-fn)))\n\n(defun best-first-search (start goal-p successors cost-fn)\n  \"Search lowest cost states first until goal is reached.\"\n  (tree-search (list start) goal-p successors (sorter cost-fn)))\n\n(defun price-is-right (price)\n  \"Return a function that measures the difference from price,\n  but gives a big penalty for going over price.\"\n  #'(lambda (x) (if (> x price)\n                    most-positive-fixnum\n                    (- price x))))\n\n(defun beam-search (start goal-p successors cost-fn beam-width)\n  \"Search highest scoring states first until goal is reached,\n  but never consider more than beam-width states at a time.\"\n  (tree-search (list start) goal-p successors\n               #'(lambda (old new)\n                   (let ((sorted (funcall (sorter cost-fn) old new)))\n                     (if (> beam-width (length sorted))\n                         sorted\n                         (subseq sorted 0 beam-width))))))\n\n(defstruct (city (:type list)) name long lat)\n\n(defparameter *cities*\n  '((Atlanta      84.23 33.45) (Los-Angeles   118.15 34.03)\n    (Boston       71.05 42.21) (Memphis        90.03 35.09)\n    (Chicago      87.37 41.50) (New-York       73.58 40.47)\n    (Denver      105.00 39.45) (Oklahoma-City  97.28 35.26)\n    (Eugene      123.05 44.03) (Pittsburgh     79.57 40.27)\n    (Flagstaff   111.41 35.13) (Quebec         71.11 46.49)\n    (Grand-Jct   108.37 39.05) (Reno          119.49 39.30)\n    (Houston     105.00 34.00) (San-Francisco 122.26 37.47)\n    (Indianapolis 86.10 39.46) (Tampa          82.27 27.57)\n    (Jacksonville 81.40 30.22) (Victoria      123.21 48.25)\n    (Kansas-City  94.35 39.06) (Wilmington     77.57 34.14)))\n\n(defun neighbors (city)\n  \"Find all cities within 1000 kilometers.\"\n  (find-all-if #'(lambda (c)\n                   (and (not (eq c city))\n                        (< (air-distance c city) 1000.0)))\n               *cities*))\n\n(defun city (name)\n  \"Find the city with this name.\"\n  (assoc name *cities*))\n\n(defun trip (start dest)\n  \"Search for a way from the start to dest.\"\n  (beam-search start (is dest) #'neighbors\n               #'(lambda (c) (air-distance c dest))\n               1))\n\n(defstruct (path (:print-function print-path))\n  state (previous nil) (cost-so-far 0) (total-cost 0))\n\n(defun trip (start dest &optional (beam-width 1))\n  \"Search for the best path from the start to dest.\"\n  (beam-search\n    (make-path :state start)\n    (is dest :key #'path-state)\n    (path-saver #'neighbors #'air-distance\n                #'(lambda (c) (air-distance c dest)))\n    #'path-total-cost\n    beam-width))\n\n(defconstant earth-diameter 12765.0\n  \"Diameter of planet earth in kilometers.\")\n\n(defun air-distance (city1 city2)\n  \"The great circle distance between two cities.\"\n  (let ((d (distance (xyz-coords city1) (xyz-coords city2))))\n    ;; d is the straight-line chord between the two cities,\n    ;; The length of the subtending arc is given by:\n    (* earth-diameter (asin (/ d 2)))))\n\n(defun xyz-coords (city)\n  \"Returns the x,y,z coordinates of a point on a sphere.\n  The center is (0 0 0) and the north pole is (0 0 1).\"\n  (let ((psi (deg->radians (city-lat city)))\n        (phi (deg->radians (city-long city))))\n    (list (* (cos psi) (cos phi))\n          (* (cos psi) (sin phi))\n          (sin psi))))\n\n(defun distance (point1 point2)\n  \"The Euclidean distance between two points.\n  The points are coordinates in n-dimensional space.\"\n  (sqrt (reduce #'+ (mapcar #'(lambda (a b) (expt (- a b) 2))\n                            point1 point2))))\n\n(defun deg->radians (deg)\n  \"Convert degrees and minutes to radians.\"\n  (* (+ (truncate deg) (* (rem deg 1) 100/60)) pi 1/180))\n\n(defun is (value &key (key #'identity) (test #'eql))\n  \"Returns a predicate that tests for a given value.\"\n  #'(lambda (path) (funcall test value (funcall key path))))\n\n(defun path-saver (successors cost-fn cost-left-fn)\n  #'(lambda (old-path)\n      (let ((old-state (path-state old-path)))\n        (mapcar\n          #'(lambda (new-state)\n              (let ((old-cost\n                      (+ (path-cost-so-far old-path)\n                         (funcall cost-fn old-state new-state))))\n                (make-path\n                  :state new-state\n                  :previous old-path\n                  :cost-so-far old-cost\n                  :total-cost (+ old-cost (funcall cost-left-fn\n                                                   new-state)))))\n          (funcall successors old-state)))))\n\n(defun print-path (path &optional (stream t) depth)\n  (declare (ignore depth))\n  (format stream \"#<Path to ~a cost ~,1f>\"\n          (path-state path) (path-total-cost path)))\n\n(defun show-city-path (path &optional (stream t))\n  \"Show the length of a path, and the cities along it.\"\n  (format stream \"#<Path ~,1f km: ~{~:(~a~)~^ - ~}>\"\n          (path-total-cost path)\n          (reverse (map-path #'city-name path)))\n  (values))\n\n(defun map-path (fn path)\n  \"Call fn on each state in the path, collecting results.\"\n  (if (null path)\n      nil\n      (cons (funcall fn (path-state path))\n            (map-path fn (path-previous path)))))\n\n(defun iter-wide-search (start goal-p successors cost-fn\n                          &key (width 1) (max 100))\n  \"Search, increasing beam width from width to max.\n  Return the first solution found at any width.\"\n  (dbg :search \"; Width: ~d\" width)\n  (unless (> width max)\n    (or (beam-search start goal-p successors cost-fn width)\n        (iter-wide-search start goal-p successors cost-fn\n                           :width (+ width 1) :max max))))\n\n(defun graph-search (states goal-p successors combiner\n                     &optional (state= #'eql) old-states)\n  \"Find a state that satisfies goal-p.  Start with states,\n  and search according to successors and combiner.\n  Don't try the same state twice.\"\n  (dbg :search \"~&;; Search: ~a\" states)\n  (cond ((null states) fail)\n        ((funcall goal-p (first states)) (first states))\n        (t (graph-search\n             (funcall\n               combiner\n               (new-states states successors state= old-states)\n               (rest states))\n             goal-p successors combiner state=\n             (adjoin (first states) old-states\n                     :test state=)))))\n\n(defun new-states (states successors state= old-states)\n  \"Generate successor states that have not been seen before.\"\n  (remove-if\n    #'(lambda (state)\n        (or (member state states :test state=)\n            (member state old-states :test state=)))\n    (funcall successors (first states))))\n\n(defun next2 (x) (list (+ x 1) (+ x 2)))\n\n(defun a*-search (paths goal-p successors cost-fn cost-left-fn\n                  &optional (state= #'eql) old-paths)\n  \"Find a path whose state satisfies goal-p.  Start with paths,\n  and expand successors, exploring least cost first.\n  When there are duplicate states, keep the one with the\n  lower cost and discard the other.\"\n  (dbg :search \";; Search: ~a\" paths)\n  (cond\n    ((null paths) fail)\n    ((funcall goal-p (path-state (first paths)))\n     (values (first paths) paths))\n    (t (let* ((path (pop paths))\n              (state (path-state path)))\n         ;; Update PATHS and OLD-PATHS to reflect\n         ;; the new successors of STATE:\n         (setf old-paths (insert-path path old-paths))\n         (dolist (state2 (funcall successors state))\n           (let* ((cost (+ (path-cost-so-far path)\n                           (funcall cost-fn state state2)))\n                  (cost2 (funcall cost-left-fn state2))\n                  (path2 (make-path\n                           :state state2 :previous path\n                           :cost-so-far cost\n                           :total-cost (+ cost cost2)))\n                  (old nil))\n             ;; Place the new path, path2, in the right list:\n             (cond\n               ((setf old (find-path state2 paths state=))\n                (when (better-path path2 old)\n                  (setf paths (insert-path\n                                path2 (delete old paths)))))\n               ((setf old (find-path state2 old-paths state=))\n                (when (better-path path2 old)\n                  (setf paths (insert-path path2 paths))\n                  (setf old-paths (delete old old-paths))))\n               (t (setf paths (insert-path path2 paths))))))\n         ;; Finally, call A* again with the updated path lists:\n         (a*-search paths goal-p successors cost-fn cost-left-fn\n                    state= old-paths)))))\n\n(defun find-path (state paths state=)\n  \"Find the path with this state among a list of paths.\"\n  (find state paths :key #'path-state :test state=))\n\n(defun better-path (path1 path2)\n  \"Is path1 cheaper than path2?\"\n  (< (path-total-cost path1) (path-total-cost path2)))\n\n(defun insert-path (path paths)\n  \"Put path into the right position, sorted by total cost.\"\n  ;; MERGE is a built-in function\n  (merge 'list (list path) paths #'< :key #'path-total-cost))\n\n(defun path-states (path)\n  \"Collect the states along this path.\"\n  (if (null path)\n      nil\n      (cons (path-state path)\n            (path-states (path-previous path)))))\n\n(defun search-all (start goal-p successors cost-fn beam-width)\n  \"Find all solutions to a search problem, using beam search.\"\n  ;; Be careful: this can lead to an infinite loop.\n  (let ((solutions nil))\n    (beam-search\n      start #'(lambda (x)\n                (when (funcall goal-p x) (push x solutions))\n                nil)\n      successors cost-fn beam-width)\n    solutions))\n\n"
  },
  {
    "path": "lisp/simple.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n(defun sentence ()    (append (noun-phrase) (verb-phrase)))\n(defun noun-phrase () (append (Article) (Noun)))\n(defun verb-phrase () (append (Verb) (noun-phrase)))\n(defun Article ()     (one-of '(the a)))\n(defun Noun ()        (one-of '(man ball woman table)))\n(defun Verb ()        (one-of '(hit took saw liked)))\n\n;;; ==============================\n\n(defun one-of (set)\n  \"Pick one element of set, and make a list of it.\"\n  (list (random-elt set)))\n\n(defun random-elt (choices)\n  \"Choose an element from a list at random.\"\n  (elt choices (random (length choices))))\n\n;;; ==============================\n\n(defun Adj* ()\n  (if (= (random 2) 0)\n      nil\n      (append (Adj) (Adj*))))\n\n(defun PP* ()\n  (if (random-elt '(t nil))\n      (append (PP) (PP*))\n      nil))\n\n;; (defun noun-phrase () (append (Article) (Adj*) (Noun) (PP*)))\n(defun PP () (append (Prep) (noun-phrase)))\n(defun Adj () (one-of '(big little blue green adiabatic)))\n(defun Prep () (one-of '(to in by with on)))\n\n;;; ==============================\n\n(defparameter *simple-grammar*\n  '((sentence -> (noun-phrase verb-phrase))\n    (noun-phrase -> (Article Noun))\n    (verb-phrase -> (Verb noun-phrase))\n    (Article -> the a)\n    (Noun -> man ball woman table)\n    (Verb -> hit took saw liked))\n  \"A grammar for a trivial subset of English.\")\n\n(defvar *grammar* *simple-grammar*\n  \"The grammar used by generate.  Initially, this is\n  *simple-grammar*, but we can switch to other grammars.\")\n\n;;; ==============================\n\n(defun rule-lhs (rule)\n  \"The left hand side of a rule.\"\n  (first rule))\n\n(defun rule-rhs (rule)\n  \"The right hand side of a rule.\"\n  (rest (rest rule)))\n\n(defun rewrites (category)\n  \"Return a list of the possible rewrites for this category.\"\n  (rule-rhs (assoc category *grammar*)))\n\n;;; ==============================\n\n(defun generate (phrase)\n  \"Generate a random sentence or phrase\"\n  (cond ((listp phrase)\n         (mappend #'generate phrase))\n        ((rewrites phrase)\n         (generate (random-elt (rewrites phrase))))\n        (t (list phrase))))\n\n;;; ==============================\n\n(defparameter *bigger-grammar*\n  '((sentence -> (noun-phrase verb-phrase))\n    (noun-phrase -> (Article Adj* Noun PP*) (Name) (Pronoun))\n    (verb-phrase -> (Verb noun-phrase PP*))\n    (PP* -> () (PP PP*))\n    (Adj* -> () (Adj Adj*))\n    (PP -> (Prep noun-phrase))\n    (Prep -> to in by with on)\n    (Adj -> big little blue green adiabatic)\n    (Article -> the a)\n    (Name -> Pat Kim Lee Terry Robin)\n    (Noun -> man ball woman table)\n    (Verb -> hit took saw liked)\n    (Pronoun -> he she it these those that)))\n\n;; (setf *grammar* *bigger-grammar*)\n\n;;; ==============================\n\n(defun generate-tree (phrase)\n  \"Generate a random sentence or phrase,\n  with a complete parse tree.\"\n  (cond ((listp phrase)\n         (mapcar #'generate-tree phrase))\n        ((rewrites phrase)\n         (cons phrase\n               (generate-tree (random-elt (rewrites phrase)))))\n        (t (list phrase))))\n\n;;; ==============================\n\n(defun generate-all (phrase)\n  \"Generate a list of all possible expansions of this phrase.\"\n  (cond ((null phrase) (list nil))\n        ((listp phrase)\n         (combine-all (generate-all (first phrase))\n                      (generate-all (rest phrase))))\n        ((rewrites phrase)\n         (mappend #'generate-all (rewrites phrase)))\n        (t (list (list phrase)))))\n\n(defun combine-all (xlist ylist)\n  \"Return a list of lists formed by appending a y to an x.\n  E.g., (combine-all '((a) (b)) '((1) (2)))\n  -> ((A 1) (B 1) (A 2) (B 2)).\"\n  (mappend #'(lambda (y)\n               (mapcar #'(lambda (x) (append x y)) xlist))\n           ylist))\n\n"
  },
  {
    "path": "lisp/student.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; student.lisp: Chapter 7's STUDENT program to solve algebra word problems.\n\n(requires \"patmatch\")\n\n(defstruct (rule (:type list)) pattern response)\n\n(defstruct (exp (:type list)\n                (:constructor mkexp (lhs op rhs)))\n  op lhs rhs)\n\n(defun exp-p (x) (consp x))\n(defun exp-args (x) (rest x))\n\n(pat-match-abbrev '?x* '(?* ?x))\n(pat-match-abbrev '?y* '(?* ?y))\n\n(defparameter *student-rules* (mapcar #'expand-pat-match-abbrev\n  '(((?x* |.|)                  ?x)\n    ((?x* |.| ?y*)          (?x ?y))\n    ((if ?x* |,| then ?y*)  (?x ?y))\n    ((if ?x* then ?y*)      (?x ?y))\n    ((if ?x* |,| ?y*)       (?x ?y))\n    ((?x* |,| and ?y*)      (?x ?y))\n    ((find ?x* and ?y*)     ((= to-find-1 ?x) (= to-find-2 ?y)))\n    ((find ?x*)             (= to-find ?x))\n    ((?x* equals ?y*)       (= ?x ?y))\n    ((?x* same as ?y*)      (= ?x ?y))\n    ((?x* = ?y*)            (= ?x ?y))\n    ((?x* is equal to ?y*)  (= ?x ?y))\n    ((?x* is ?y*)           (= ?x ?y))\n    ((?x* - ?y*)            (- ?x ?y))\n    ((?x* minus ?y*)        (- ?x ?y))\n    ((difference between ?x* and ?y*)  (- ?y ?x))\n    ((difference ?x* and ?y*)          (- ?y ?x))\n    ((?x* + ?y*)            (+ ?x ?y))\n    ((?x* plus ?y*)         (+ ?x ?y))\n    ((sum ?x* and ?y*)      (+ ?x ?y))\n    ((product ?x* and ?y*)  (* ?x ?y))\n    ((?x* * ?y*)            (* ?x ?y))\n    ((?x* times ?y*)        (* ?x ?y))\n    ((?x* / ?y*)            (/ ?x ?y))\n    ((?x* per ?y*)          (/ ?x ?y))\n    ((?x* divided by ?y*)   (/ ?x ?y))\n    ((half ?x*)             (/ ?x 2))\n    ((one half ?x*)         (/ ?x 2))\n    ((twice ?x*)            (* 2 ?x))\n    ((square ?x*)           (* ?x ?x))\n    ((?x* % less than ?y*)  (* ?y (/ (- 100 ?x) 100)))\n    ((?x* % more than ?y*)  (* ?y (/ (+ 100 ?x) 100)))\n    ((?x* % ?y*)            (* (/ ?x 100) ?y)))))\n\n(defun student (words)\n  \"Solve certain Algebra Word Problems.\"\n  (solve-equations\n    (create-list-of-equations\n      (translate-to-expression (remove-if #'noise-word-p words)))))\n\n(defun translate-to-expression (words)\n  \"Translate an English phrase into an equation or expression.\"\n  (or (rule-based-translator\n        words *student-rules*\n        :rule-if #'rule-pattern :rule-then #'rule-response\n        :action #'(lambda (bindings response)\n                    (sublis (mapcar #'translate-pair bindings)\n                              response)))\n      (make-variable words)))\n\n(defun translate-pair (pair)\n  \"Translate the value part of the pair into an equation or expression.\"\n  (cons (binding-var pair)\n        (translate-to-expression (binding-val pair))))\n\n(defun create-list-of-equations (exp)\n  \"Separate out equations embedded in nested parens.\"\n  (cond ((null exp) nil)\n        ((atom (first exp)) (list exp))\n        (t (append (create-list-of-equations (first exp))\n                   (create-list-of-equations (rest exp))))))\n\n(defun noise-word-p (word)\n  \"Is this a low-content word which can be safely ignored?\"\n  (member word '(a an the this number of $)))\n\n(defun make-variable (words)\n  \"Create a variable name based on the given list of words\"\n  (first words))\n\n(defun solve-equations (equations)\n  \"Print the equations and their solution\"\n  (print-equations \"The equations to be solved are:\" equations)\n  (print-equations \"The solution is:\" (solve equations nil)))\n\n(defun solve (equations known)\n  \"Solve a system of equations by constraint propagation.\"\n  ;; Try to solve for one equation, and substitute its value into\n  ;; the others. If that doesn't work, return what is known.\n  (or (some #'(lambda (equation)\n                (let ((x (one-unknown equation)))\n                  (when x\n                    (let ((answer (solve-arithmetic\n\t\t\t\t   (isolate equation x))))\n                      (solve (subst (exp-rhs answer) (exp-lhs answer)\n                                    (remove equation equations))\n                             (cons answer known))))))\n            equations)\n      known))\n\n(defun isolate (e x)\n  \"Isolate the lone x in e on the left hand side of e.\"\n  ;; This assumes there is exactly one x in e,\n  ;; and that e is an equation.\n  (cond ((eq (exp-lhs e) x)\n         ;; Case I: X = A -> X = n\n         e)\n        ((in-exp x (exp-rhs e))\n         ;; Case II: A = f(X) -> f(X) = A\n         (isolate (mkexp (exp-rhs e) '= (exp-lhs e)) x))\n        ((in-exp x (exp-lhs (exp-lhs e)))\n         ;; Case III: f(X)*A = B -> f(X) = B/A\n         (isolate (mkexp (exp-lhs (exp-lhs e)) '=\n                         (mkexp (exp-rhs e)\n                                (inverse-op (exp-op (exp-lhs e)))\n                                (exp-rhs (exp-lhs e)))) x))\n        ((commutative-p (exp-op (exp-lhs e)))\n         ;; Case IV: A*f(X) = B -> f(X) = B/A\n         (isolate (mkexp (exp-rhs (exp-lhs e)) '=\n                         (mkexp (exp-rhs e)\n                                (inverse-op (exp-op (exp-lhs e)))\n                                (exp-lhs (exp-lhs e)))) x))\n        (t ;; Case V: A/f(X) = B -> f(X) = A/B\n         (isolate (mkexp (exp-rhs (exp-lhs e)) '=\n                         (mkexp (exp-lhs (exp-lhs e))\n                                (exp-op (exp-lhs e))\n                                (exp-rhs e))) x))))\n\n(defun print-equations (header equations)\n  \"Print a list of equations.\"\n  (format t \"~%~a~{~%  ~{ ~a~}~}~%\" header\n          (mapcar #'prefix->infix equations)))\n\n(defconstant operators-and-inverses\n  '((+ -) (- +) (* /) (/ *) (= =)))\n\n(defun inverse-op (op)\n  (second (assoc op operators-and-inverses)))\n\n(defun unknown-p (exp)\n  (symbolp exp))\n\n(defun in-exp (x exp)\n  \"True if x appears anywhere in exp\"\n  (or (eq x exp)\n      (and (listp exp)\n           (or (in-exp x (exp-lhs exp)) (in-exp x (exp-rhs exp))))))\n\n(defun no-unknown (exp)\n  \"Returns true if there are no unknowns in exp.\"\n  (cond ((unknown-p exp) nil)\n        ((atom exp) t)\n        ((no-unknown (exp-lhs exp)) (no-unknown (exp-rhs exp)))\n        (t nil)))\n\n(defun one-unknown (exp)\n  \"Returns the single unknown in exp, if there is exactly one.\"\n  (cond ((unknown-p exp) exp)\n        ((atom exp) nil)\n        ((no-unknown (exp-lhs exp)) (one-unknown (exp-rhs exp)))\n        ((no-unknown (exp-rhs exp)) (one-unknown (exp-lhs exp)))\n        (t nil)))\n\n(defun commutative-p (op)\n  \"Is operator commutative?\"\n  (member op '(+ * =)))\n\n(defun solve-arithmetic (equation)\n  \"Do the arithmetic for the right hand side.\"\n  ;; This assumes that the right hand side is in the right form.\n  (mkexp (exp-lhs equation) '= (eval (exp-rhs equation))))\n\n(defun binary-exp-p (x)\n  (and (exp-p x) (= (length (exp-args x)) 2)))\n\n(defun prefix->infix (exp)\n  \"Translate prefix to infix expressions.\"\n  (if (atom exp) exp\n      (mapcar #'prefix->infix\n              (if (binary-exp-p exp)\n                  (list (exp-lhs exp) (exp-op exp) (exp-rhs exp))\n                  exp))))\n\n"
  },
  {
    "path": "lisp/syntax1.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File syntax1.lisp: The PSG-based natural language parser.\n;;;; This is the more efficient version of the non-semantic parser,\n;;;; which uses the memoized functions in Section 19.3 and handles\n;;;; unknown words as described in Section 19.4.\n;;;; Remember to use a grammar, as in (use *grammar4*)\n\n(defvar *grammar* nil \"The grammar used by GENERATE.\")\n\n(defstruct (rule (:type list)) lhs -> rhs)\n\n(defstruct (parse) \"A parse tree and a remainder.\" tree rem)\n\n;; Trees are of the form: (lhs . rhs)\n(defun new-tree (cat rhs) (cons cat rhs))\n(defun tree-lhs (tree) (first tree))\n(defun tree-rhs (tree) (rest tree))\n\n(defun parse-lhs (parse) (tree-lhs (parse-tree parse)))\n\n(defparameter *open-categories* '(N V A Name)\n  \"Categories to consider for unknown words\")\n\n(defun lexical-rules (word)\n  \"Return a list of rules with word on the right hand side.\"\n  (or (find-all word *grammar* :key #'rule-rhs :test #'equal)\n      (mapcar #'(lambda (cat) `(,cat -> ,word)) *open-categories*)))\n\n(defun rules-starting-with (cat)\n  \"Return a list of rules where cat starts the rhs.\"\n  (find-all cat *grammar*\n            :key #'(lambda (rule) (first-or-nil (rule-rhs rule)))))\n\n(defun complete-parses (parses)\n  \"Those parses that are complete (have no remainder).\"\n  (find-all-if #'null parses :key #'parse-rem))\n\n(defun parse (words)\n  \"Bottom-up parse, returning all parses of any prefix of words.\"\n  (unless (null words)\n    (mapcan #'(lambda (rule)\n                (extend-parse (rule-lhs rule) (list (first words))\n                              (rest words) nil))\n            (lexical-rules (first words)))))\n\n(defun extend-parse (lhs rhs rem needed)\n  \"Look for the categories needed to complete the parse.\"\n  (if (null needed)\n      ;; If nothing needed, return parse and upward extensions\n      (let ((parse (make-parse :tree (new-tree lhs rhs) :rem rem)))\n        (cons parse\n              (mapcan\n                #'(lambda (rule)\n                    (extend-parse (rule-lhs rule)\n                                  (list (parse-tree parse))\n                                  rem (rest (rule-rhs rule))))\n                (rules-starting-with lhs))))\n      ;; otherwise try to extend rightward\n      (mapcan\n        #'(lambda (p)\n            (if (eq (parse-lhs p) (first needed))\n                (extend-parse lhs (append1 rhs (parse-tree p))\n                              (parse-rem p) (rest needed))))\n        (parse rem))))\n\n(defun append1 (items item)\n  \"Add item to end of list of items.\"\n  (append items (list item)))\n\n(memoize 'lexical-rules)\n(memoize 'rules-starting-with)\n(memoize 'parse :test #'eq)\n\n(defun parser (words)\n  \"Return all complete parses of a list of words.\"\n  (clear-memoize 'parse) ;***\n  (mapcar #'parse-tree (complete-parses (parse words))))\n\n(defun use (grammar)\n  \"Switch to a new grammar.\"\n  (clear-memoize 'rules-starting-with)\n  (clear-memoize 'lexical-rules)\n  (length (setf *grammar* grammar)))\n\n\n;;; Grammars\n\n(defparameter *grammar3*\n  '((Sentence -> (NP VP))\n    (NP -> (Art Noun))\n    (VP -> (Verb NP))\n    (Art -> the) (Art -> a)\n    (Noun -> man) (Noun -> ball) (Noun -> woman) (Noun -> table)\n    (Noun -> noun) (Noun -> verb)\n    (Verb -> hit) (Verb -> took) (Verb -> saw) (Verb -> liked)))\n\n(defparameter *grammar4*\n  '((S -> (NP VP))\n    (NP -> (D N))\n    (NP -> (D A+ N))\n    (NP -> (NP PP))\n    (NP -> (Pro))\n    (NP -> (Name))\n    (VP -> (V NP))\n    (VP -> (V))\n    (VP -> (VP PP))\n    (PP -> (P NP))\n    (A+ -> (A))\n    (A+ -> (A A+))\n    (Pro -> I) (Pro -> you) (Pro -> he) (Pro -> she)\n    (Pro -> it) (Pro -> me) (Pro -> him) (Pro -> her)\n    (Name -> John) (Name -> Mary)\n    (A -> big) (A -> little) (A -> old) (A -> young)\n    (A -> blue) (A -> green) (A -> orange) (A -> perspicuous)\n    (D -> the) (D -> a) (D -> an)\n    (N -> man) (N -> ball) (N -> woman) (N -> table) (N -> orange)\n    (N -> saw) (N -> saws) (N -> noun) (N -> verb)\n    (P -> with) (P -> for) (P -> at) (P -> on) (P -> by) (P -> of) (P -> in)\n    (V -> hit) (V -> took) (V -> saw) (V -> liked) (V -> saws)))\n"
  },
  {
    "path": "lisp/syntax2.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; syntax2.lisp: The PSG-based natural language parser.\n;;;; This version handles semantics as described in Section 19.5.\n;;;; Includes *grammar5* and *grammar6*; USE one of these.\n\n(defvar *grammar* \"The grammar used by GENERATE.\")\n\n(defstruct (rule (:type list)) lhs -> rhs sem)\n\n(defstruct (tree (:type list) (:include rule) (:copier nil)\n                 (:constructor new-tree (lhs sem rhs))))\n\n(defstruct (parse) \"A parse tree and a remainder.\" tree rem)\n\n(defun parse-lhs (parse) (tree-lhs (parse-tree parse)))\n\n(defun lexical-rules (word)\n  \"Return a list of rules with word on the right hand side.\"\n  (or (find-all word *grammar* :key #'rule-rhs :test #'equal)\n      (mapcar #'(lambda (cat) `(,cat -> ,word)) *open-categories*)))\n\n(defun rules-starting-with (cat)\n  \"Return a list of rules where cat starts the rhs.\"\n  (find-all cat *grammar*\n            :key #'(lambda (rule) (first-or-nil (rule-rhs rule)))))\n\n(defun first-or-nil (x)\n  \"The first element of x if it is a list; else nil.\"\n  (if (consp x) (first x) nil))\n\n(defun complete-parses (parses)\n  \"Those parses that are complete (have no remainder).\"\n  (find-all-if #'null parses :key #'parse-rem))\n\n(defun append1 (items item)\n  \"Add item to end of list of items.\"\n  (append items (list item)))\n\n(memoize 'lexical-rules)\n(memoize 'rules-starting-with)\n(memoize 'parse :test #'eq)\n\n(defun parser (words)\n  \"Return all complete parses of a list of words.\"\n  (clear-memoize 'parse) ;***\n  (mapcar #'parse-tree (complete-parses (parse words))))\n\n(defun use (grammar)\n  \"Switch to a new grammar.\"\n  (clear-memoize 'rules-starting-with)\n  (clear-memoize 'lexical-rules)\n  (length (setf *grammar* grammar)))\n\n(defparameter *open-categories* '(N V A Name)\n  \"Categories to consider for unknown words\")\n\n(defun parse (words)\n  \"Bottom-up parse, returning all parses of any prefix of words.\n  This version has semantics.\"\n  (unless (null words)\n    (mapcan #'(lambda (rule)\n                (extend-parse (rule-lhs rule) (rule-sem rule) ;***\n                              (list (first words)) (rest words) nil))\n            (lexical-rules (first words)))))\n\n(defun extend-parse (lhs sem rhs rem needed) ;***\n  \"Look for the categories needed to complete the parse.\n  This version has semantics.\"\n  (if (null needed)\n      ;; If nothing is needed, return this parse and upward extensions,\n      ;; unless the semantics fails\n      (let ((parse (make-parse :tree (new-tree lhs sem rhs) :rem rem)))\n        (unless (null (apply-semantics (parse-tree parse))) ;***\n          (cons parse\n                (mapcan\n                  #'(lambda (rule)\n                      (extend-parse (rule-lhs rule) (rule-sem rule) ;***\n                                    (list (parse-tree parse)) rem\n                                    (rest (rule-rhs rule))))\n                  (rules-starting-with lhs)))))\n      ;; otherwise try to extend rightward\n      (mapcan\n        #'(lambda (p)\n            (if (eq (parse-lhs p) (first needed))\n                (extend-parse lhs sem (append1 rhs (parse-tree p)) ;***\n                              (parse-rem p) (rest needed))))\n        (parse rem))))\n\n(defun apply-semantics (tree)\n  \"For terminal nodes, just fetch the semantics.\n  Otherwise, apply the sem function to its constituents.\"\n  (if (terminal-tree-p tree)\n      (tree-sem tree)\n      (setf (tree-sem tree)\n            (apply (tree-sem tree)\n                   (mapcar #'tree-sem (tree-rhs tree))))))\n\n(defun terminal-tree-p (tree)\n  \"Does this tree have a single word on the rhs?\"\n  (and (length=1 (tree-rhs tree))\n       (atom (first (tree-rhs tree)))))\n\n(defun meanings (words)\n  \"Return all possible meanings of a phrase.  Throw away the syntactic part.\"\n  (remove-duplicates (mapcar #'tree-sem (parser words)) :test #'equal))\n\n\n;;;; Grammars\n\n(defparameter *grammar5*\n  '((NP -> (NP CONJ NP) infix-funcall)\n    (NP -> (N)          list)\n    (NP -> (N P N)      infix-funcall)\n    (N ->  (DIGIT)      identity)\n    (P ->  to           integers)\n    (CONJ -> and        ordered-union)\n    (CONJ -> without    ordered-set-difference)\n    (N -> 1 1) (N -> 2 2) (N -> 3 3) (N -> 4 4) (N -> 5 5)\n    (N -> 6 6) (N -> 7 7) (N -> 8 8) (N -> 9 9) (N -> 0 0)))\n\n(defun infix-funcall (arg1 function arg2)\n  \"Apply the function to the two arguments\"\n  (funcall function arg1 arg2))\n\n(defun integers (start end)\n  \"A list of all the integers in the range [start...end] inclusive.\"\n  (if (> start end) nil\n      (cons start (integers (+ start 1) end))))\n\n(defun ordered-union (a b)\n  \"Add elements of B to A, but preserve order of A (and B).\"\n  ;; Added by norvig Jun 11 96; some Lisps don't preserve order\n (append a (ordered-set-difference b a)))\n\n(defun ordered-set-difference (a b)\n  \"Subtact elements of B from A, but preserve order of A.\"\n  ;; Added by norvig Jun 11 96; some Lisps don't preserve order\n  (remove-if #'(lambda (x) (member x b)) a))\n\n\n(defparameter *grammar6*\n  '((NP -> (NP CONJ NP) infix-funcall)\n    (NP -> (N)          list)\n    (NP -> (N P N)      infix-funcall)\n    (N ->  (DIGIT)      identity)\n    (N ->  (N DIGIT)    10*N+D)\n    (P ->  to           integers)\n    (CONJ -> and        union*)\n    (CONJ -> without    set-diff)\n    (DIGIT -> 1 1) (DIGIT -> 2 2) (DIGIT -> 3 3)\n    (DIGIT -> 4 4) (DIGIT -> 5 5) (DIGIT -> 6 6)\n    (DIGIT -> 7 7) (DIGIT -> 8 8) (DIGIT -> 9 9)\n    (DIGIT -> 0 0)))\n\n(defun union* (x y) (if (null (intersection x y)) (append x y)))\n(defun set-diff (x y) (if (subsetp y x) (ordered-set-difference x y)))\n(defun 10*N+D (N D) (+ (* 10 N) D))\n\n\n"
  },
  {
    "path": "lisp/syntax3.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; syntax3.lisp: The PSG natural language parser,\n;;;; with handling of preferences as described in Section 19.6.\n\n(defvar *grammar* \"The grammar used by GENERATE.\")\n\n(defstruct (rule (:type list)\n                 (:constructor rule (lhs -> rhs &optional sem score)))\n  lhs -> rhs sem score)\n\n(defstruct (tree (:type list) (:include rule) (:copier nil)\n                 (:constructor new-tree (lhs sem score rhs))))\n\n(defun use (grammar)\n  \"Switch to a new grammar.\"\n  (clear-memoize 'rules-starting-with)\n  (clear-memoize 'lexical-rules)\n  (length (setf *grammar*\n                (mapcar #'(lambda (r) (apply #'rule r))\n                        grammar))))\n\n(defstruct (parse) \"A parse tree and a remainder.\" tree rem)\n\n(defun parse-lhs (parse) (tree-lhs (parse-tree parse)))\n\n(defun lexical-rules (word)\n  \"Return a list of rules with word on the right hand side.\"\n  (find-all word *grammar* :key #'rule-rhs :test #'equal))\n\n(defun rules-starting-with (cat)\n  \"Return a list of rules where cat starts the rhs.\"\n  (find-all cat *grammar*\n            :key #'(lambda (rule) (first-or-nil (rule-rhs rule)))))\n\n(defun first-or-nil (x)\n  \"The first element of x if it is a list; else nil.\"\n  (if (consp x) (first x) nil))\n\n(defun complete-parses (parses)\n  \"Those parses that are complete (have no remainder).\"\n  (find-all-if #'null parses :key #'parse-rem))\n\n(defun append1 (items item)\n  \"Add item to end of list of items.\"\n  (append items (list item)))\n\n(defun parser (words)\n  \"Return all complete parses of a list of words.\"\n  (clear-memoize 'parse) ;***\n  (mapcar #'parse-tree (complete-parses (parse words))))\n\n(defparameter *open-categories* '(N V A Name)\n  \"Categories to consider for unknown words\")\n\n(defun lexical-rules (word)\n  \"Return a list of rules with word on the right hand side.\"\n  (or (find-all word *grammar* :key #'rule-rhs :test #'equal)\n      (mapcar #'(lambda (cat) `(,cat -> ,word)) *open-categories*)))\n\n(defun apply-semantics (tree)\n  \"For terminal nodes, just fetch the semantics.\n  Otherwise, apply the sem function to its constituents.\"\n  (if (terminal-tree-p tree)\n      (tree-sem tree)\n      (setf (tree-sem tree)\n            (apply (tree-sem tree)\n                   (mapcar #'tree-sem (tree-rhs tree))))))\n\n(defun terminal-tree-p (tree)\n  \"Does this tree have a single word on the rhs?\"\n  (and (length=1 (tree-rhs tree))\n       (atom (first (tree-rhs tree)))))\n\n(defun parse (words)\n  \"Bottom-up parse, returning all parses of any prefix of words.\n  This version has semantics and preference scores.\"\n  (unless (null words)\n    (mapcan #'(lambda (rule)\n                (extend-parse (rule-lhs rule) (rule-sem rule)\n                              (rule-score rule) (list (first words)) ;***\n                              (rest words) nil))\n            (lexical-rules (first words)))))\n\n(defun extend-parse (lhs sem score rhs rem needed) ;***\n  \"Look for the categories needed to complete the parse.\n  This version has semantics and preference scores.\"\n  (if (null needed)\n      ;; If nothing is needed, return this parse and upward extensions,\n      ;; unless the semantics fails\n      (let ((parse (make-parse :tree (new-tree lhs sem score rhs) ;***\n                               :rem rem)))\n        (unless (null (apply-semantics (parse-tree parse)))\n          (apply-scorer (parse-tree parse)) ;***\n          (cons parse\n                (mapcan\n                  #'(lambda (rule)\n                      (extend-parse\n                        (rule-lhs rule) (rule-sem rule)\n                        (rule-score rule) (list (parse-tree parse)) ;***\n                        rem (rest (rule-rhs rule))))\n                  (rules-starting-with lhs)))))\n      ;; otherwise try to extend rightward\n      (mapcan\n        #'(lambda (p)\n            (if (eq (parse-lhs p) (first needed))\n                (extend-parse lhs sem score\n                              (append1 rhs (parse-tree p)) ;***\n                              (parse-rem p) (rest needed))))\n        (parse rem))))\n\n(defun apply-scorer (tree)\n  \"Compute the score for this tree.\"\n  (let ((score (or (tree-score tree) 0)))\n    (setf (tree-score tree)\n          (if (terminal-tree-p tree)\n              score\n              ;; Add up the constituent's scores,\n              ;; along with the tree's score\n              (+ (sum (tree-rhs tree) #'tree-score-or-0)\n                 (if (numberp score)\n                     score\n                     (or (apply score (tree-rhs tree)) 0)))))))\n\n(defun tree-score-or-0 (tree)\n    (if (numberp (tree-score tree)) (tree-score tree) 0))\n\n(defun all-parses (words)\n  (format t \"~%Score  Semantics~25T~a\" words)\n  (format t \"~%=====  =========~25T============================~%\")\n  (loop for tree in (sort (parser words) #'> :key #'tree-score)\n    do (format t \"~5,1f  ~9a~25T~a~%\" (tree-score tree) (tree-sem tree)\n               (bracketing tree)))\n  (values))\n\n(defun bracketing (tree)\n  \"Extract the terminals, bracketed with parens.\"\n  (cond ((atom tree) tree)\n        ((length=1 (tree-rhs tree))\n         (bracketing (first (tree-rhs tree))))\n        (t (mapcar #'bracketing (tree-rhs tree)))))\n\n(defun meaning (words &optional (tie-breaker #'query-user))\n  \"Choose the single top-ranking meaning for the words.\"\n  (let* ((trees (sort (parser words) #'> :key #'tree-score))\n         (best-score (if trees (tree-score (first trees)) 0))\n         (best-trees (delete best-score trees\n                             :key #'tree-score :test-not #'eql))\n         (best-sems (delete-duplicates (mapcar #'tree-sem best-trees)\n                                       :test #'equal)))\n    (case (length best-sems)\n      (0 (format t \"~&Sorry, I didn't understand that.\") nil)\n      (1 (first best-sems))\n      (t (funcall tie-breaker best-sems)))))\n\n(defun query-user (choices &optional\n                           (header-str \"~&Please pick one:\")\n                           (footer-str \"~&Your choice? \"))\n  \"Ask user to make a choice.\"\n  (format *query-io* header-str)\n  (loop for choice in choices for i from 1 do\n        (format *query-io* \"~&~3d: ~a\" i choice))\n  (format *query-io* footer-str)\n  (nth (- (read) 1) choices))\n\n(memoize 'lexical-rules)\n(memoize 'rules-starting-with)\n(memoize 'parse :test #'eq)\n\n;;;; Grammar\n\n(defparameter *grammar7*\n  '((NP -> (NP CONJ NP) infix-funcall  infix-scorer)\n    (NP -> (N P N)      infix-funcall  infix-scorer)\n    (NP -> (N)          list)\n    (NP -> ([ NP ])     arg2)\n    (NP -> (NP ADJ)     rev-funcall    rev-scorer)\n    (NP -> (NP OP N)    infix-funcall)\n    (N  -> (D)          identity)\n    (N  -> (N D)        10*N+D)\n    (P  -> to           integers       prefer<)\n    ([  -> [            [)\n    (]  -> ]            ])\n    (OP -> repeat       repeat)\n    (CONJ -> and        append         prefer-disjoint)\n    (CONJ -> without    ordered-set-difference prefer-subset)\n    (ADJ -> reversed    reverse        inv-span)\n    (ADJ -> shuffled    permute        prefer-not-singleton)\n    (D -> 1 1) (D -> 2 2) (D -> 3 3) (D -> 4 4) (D -> 5 5)\n    (D -> 6 6) (D -> 7 7) (D -> 8 8) (D -> 9 9) (D -> 0 0)))\n\n(defun infix-funcall (arg1 function arg2)\n  \"Apply the function to the two arguments\"\n  (funcall function arg1 arg2))\n\n(defun 10*N+D (n d) (+ (* 10 N) D))\n(defun prefer< (x y) (if (>= (sem x) (sem y)) -1))\n(defun prefer-disjoint (x y) (if (intersection (sem x) (sem y)) -1))\n(defun prefer-subset (x y)\n  (+ (inv-span x) (if (subsetp (sem y) (sem x)) 0 -3)))\n(defun prefer-not-singleton (x)\n  (+ (inv-span x) (if (< (length (sem x)) 2) -4 0)))\n\n(defun infix-scorer (arg1 scorer arg2)\n  (funcall (tree-score scorer) arg1 arg2))\n\n(defun arg2 (a1 a2 &rest a-n) (declare (ignore a1 a-n)) a2)\n\n(defun rev-scorer (arg scorer) (funcall (tree-score scorer) arg))\n\n(defun rev-funcall (arg function) (funcall function arg))\n\n(defun repeat (list n)\n  \"Append list n times.\"\n  (if (= n 0)\n      nil\n      (append list (repeat list (- n 1)))))\n\n(defun span-length (tree)\n  \"How many words are in tree?\"\n  (if (terminal-tree-p tree) 1\n      (sum (tree-rhs tree) #'span-length)))\n\n(defun inv-span (tree) (/ 1 (span-length tree)))\n\n(defun sem (tree) (tree-sem tree))\n\n(defun integers (start end)\n  \"A list of all the integers in the range [start...end] inclusive.\n  This version allows start > end.\"\n  (cond ((< start end) (cons start (integers (+ start 1) end)))\n        ((> start end) (cons start (integers (- start 1) end)))\n        (t (list start))))\n\n(defun sum (numbers &optional fn)\n  \"Sum the numbers, or sum (mapcar fn numbers).\"\n  (if fn\n      (loop for x in numbers sum (funcall fn x))\n      (loop for x in numbers sum x)))\n\n(defun permute (bag)\n  \"Return a random permutation of the given input list.\"\n  (if (null bag)\n      nil\n      (let ((e (random-elt bag)))\n        (cons e (permute (remove e bag :count 1 :test #'eq))))))\n\n"
  },
  {
    "path": "lisp/tutor.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;; Code for Paradigms of AI Programming\n;;; Copyright (c) 1996 Peter Norvig\n\n;;;; PAIP TUTOR\n\n(requires \"auxfns\")\n\n(defvar *chapters* '() \"List of chapter structures, one per chapter.\")\n\n(defun do-examples (chapters &optional (stream *standard-output*))\n  \"Run examples from one or more chapters and sum the number of errors.\n  If all is well, this should return 0. If STREAM is nil, very little\n  output is produced.\"\n  (loop with *package* = (or (find-package :paip) *package*)\n\tfor chapter in (cond ((member chapters '(all :all)) *chapters*)\n\t\t\t     ((listp chapters) chapters)\n\t\t\t     (t (list chapters)))\n\tsum (do-chapter chapter stream)))\n\n(defmacro defexamples (chapter-number title &rest examples)\n  \"Define a set of test examples.  Each example is of the form\n     (exp [ => result ] [ @ page ] [ :input string ])\n  where [] indicates an optional part, and the parts can be in any order.\n  Evaluate exp and complain if it is not equal to result.  The page is\n  the page in the book where the example appears.  An 'example' may also be\n  one of the following:\n     string                   Serves as documentation\n     (:SECTION string)        Says what section of book we're in\"\n  `(add-chapter ',chapter-number ',title ',examples))\n\n(defun do-chapter (chapter interface)\n  \"Run the examples in a chapter.  Return the number of unexpected results.\"\n  (let ((chapter (find-chapter chapter)))\n    (set-chapter chapter interface)\n    (let ((n (count-if-not\n\t      #'(lambda (example)\n\t\t  (do-example example interface))\n\t      (chapter-examples chapter))))\n      (if (> n 0)\n\t  (format t \"~%**** ~D unexpected result~:p on Chapter ~D\"\n\t\t  n chapter)\n\t(format t \"~%Chapter ~D done.~%\" chapter))\n      n)))\n\n(defstruct (chapter (:print-function\n\t\t(lambda (chapter stream depth)\n\t\t  (declare (ignore depth))\n\t\t  (format stream \"~2D. ~A\" (chapter-number chapter)\n\t\t\t  (chapter-title chapter)))))\n  number title examples)\n\n(defun add-chapter (number title examples)\n  \"The functional interface for defexamples: adds test examples.\"\n  (let ((chapter (make-chapter :number number :title title\n\t\t\t       :examples examples)))\n    (setf *chapters*\n\t  (sort\n\t   (cons chapter (delete number *chapters* :key #'chapter-number))\n\t   #'< :key #'chapter-number))\n    chapter))\n\n(defun find-chapter (number)\n  \"Given a chapter number, find the chapter structure for it.\"\n  (typecase number\n    (chapter number) ; If given a chapter, just return it.\n    (t (find number *chapters* :key #'chapter-number))))\n\n(defun do-example (example interface)\n  \"Run an example; print out what's happening unless INTERFACE is nil.\n  Return nil if there is a unexpected result.\"\n  (let* ((stream (output-stream interface))\n\t (*print-pretty* t)\n         (*standard-output* stream)\n         (*trace-output* stream)\n\t (*debug-io* stream)\n\t (expected ':anything)\n\t (result nil))\n    (cond ((stringp example)\n\t   (when stream\n\t     (format stream \"~A~%\" example)))\n\t  ((starts-with example ':section)\n\t   (display-section (second example) interface))\n\t  ((consp example)\n\t   (let ((exp (copy-tree (first example))) ;; To avoid NCONC problems\n\t\t (page (getf (rest example) '@))\n\t\t (input (getf (rest example) ':input)))\n\t     (setf result nil)\n\t     (setf expected (getf (rest example) '=> ':anything))\n\t     (set-example example interface)\n             (when page\n               (set-page page interface))\n\t     (when stream\n\t       (let ((*print-case* ':downcase))\n\t\t (display-example exp interface)))\n\t     (if input\n\t\t (with-input-from-string (*standard-input* input)\n\t\t   (setf result (eval exp)))\n\t         (setf result (eval exp)))\n\t     (when stream\n\t       (format stream \"~&~S~%\" result))\n\t     (unless (or (equal expected ':anything)\n                         (nearly-equal result expected))\n\t       (if stream\n\t\t   (format *terminal-io*\n\t\t\t   \"~%**** expected ~S\" expected)\n\t\t   (format *terminal-io*\n\t\t\t   \"~%**** For ~S~%     expected ~S~%      got:~S~%\"\n\t\t\t   exp expected result)))))\n\t  ((atom example) (cerror \"Bad example: ~A\" example example)))\n    ;; Return nil if there is a unexpected result:\n    (or (eql expected ':anything) (nearly-equal result expected))))\n\n(defun do-documentation-examples (examples interface)\n  \"Go through any documentation strings or (:SECTION ...) examples.\"\n  (loop (let ((one (pop examples)))\n\t  (cond ((or (stringp one) (starts-with one ':section))\n\t\t (do-example one interface))\n\t\t(t (RETURN)))))\n  examples)\n\n(defun nearly-equal (x y)\n  \"Are two objects nearly equal?  Like equal, except floating point numbers\n  need only be within epsilon of each other.\"\n  (let ((epsilon 0.001)) ;; could be more mathematically sophisticated\n    (typecase x\n      (FLOAT (and (floatp y) (< (abs (- x y)) epsilon)))\n      (VECTOR (and (vectorp y) (eql (length x) (length y))\n\t\t   (nearly-equal (coerce x 'list) (coerce y 'list))))\n      (CONS (and (consp y)\n\t\t (nearly-equal (car x) (car y))\n\t\t (nearly-equal (cdr x) (cdr y))))\n      (T (equal x y)))))\n\n;;;; GUI Implementation\n\n;;; We started to implement guis in UNUSED/gui-*\n\n;;; If you want to write a GUI for the tutor, you need to do four things:\n\n;;; (1) Define a class (or structure) which we call an interface -- it\n;;; is the window in which the examples will be displayed.\n\n;;; (2) Define the function PAIP-TUTOR which should start up the interface.\n\n;;; (3) Implement the following six methods on your interface:\n;;; SET-CHAPTER, SET-PAGE, SET-EXAMPLE,\n;;; DISPLAY-EXAMPLE, DISPLAY-SECTION, OUTPUT-STREAM\n\n;;; (4) Edit the file \"auxfns.lisp\" to include your files.\n\n;;; Below we show an implementation for the five methods that is good\n;;; for output streams (without any fancy window GUI).\n\n\n(defmethod set-chapter (chapter interface)\n  ;; Update the interface to display this chapter\n  (format (output-stream interface) \"~2&Chapter ~A~%\" chapter))\n\n(defmethod set-page (page interface)\n  ;; Update the interface to display the page number\n  (format (output-stream interface) \"~&; page ~D\" page))\n\n(defmethod set-example (example interface)\n  ;; Update the interface to display this example. The idea is that\n  ;; this shows the example in a popup menu or something, but does not\n  ;; dsiplay it in the output stream.\n  (declare (ignore example interface)))\n\n(defmethod display-example (exp interface)\n  ;; Display a prompt and the expression on the interface's output stream\n  (format (output-stream interface) \"~&> ~S~%\" exp))\n\n(defmethod display-section (section interface)\n  ;; Display the string describing this section somewhere\n  (format (output-stream interface) \"~2&Section ~A~%\" section))\n\n(defmethod output-stream (interface)\n  ;; The stream on which output will be printed\n  interface)\n"
  },
  {
    "path": "lisp/unifgram.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File unifgram.lisp: The DCG parser from Chapter 20.\n\n(requires \"prologcp\")\n\n(defmacro rule (head &optional (arrow ':-) &body body)\n  \"Expand one of several types of logic rules into pure Prolog.\"\n  ;; This is data-driven, dispatching on the arrow\n  (funcall (get arrow 'rule-function) head body))\n\n(setf (get ':- 'rule-function)\n      #'(lambda (head body) `(<- ,head .,body)))\n\n(defun dcg-normal-goal-p (x) (or (starts-with x :test) (eq x '!)))\n\n(defun dcg-word-list-p (x) (starts-with x ':word))\n\n(setf (get '--> 'rule-function) 'make-dcg)\n\n(defun make-dcg (head body)\n  (let ((n (count-if (complement #'dcg-normal-goal-p) body)))\n    `(<- (,@head ?s0 ,(symbol '?s n))\n         .,(make-dcg-body body 0))))\n\n(defun make-dcg-body (body n)\n  \"Make the body of a Definite Clause Grammar (DCG) clause.\n  Add ?string-in and -out variables to each constituent.\n  Goals like (:test goal) are ordinary Prolog goals,\n  and goals like (:word hello) are literal words to be parsed.\"\n  (if (null body)\n      nil\n      (let ((goal (first body)))\n        (cond\n          ((eq goal '!) (cons '! (make-dcg-body (rest body) n)))\n          ((dcg-normal-goal-p goal)\n           (append (rest goal)\n                   (make-dcg-body (rest body) n)))\n          ((dcg-word-list-p goal)\n           (cons\n             `(= ,(symbol '?s n)\n                 (,@(rest goal) .,(symbol '?s (+ n 1))))\n             (make-dcg-body (rest body) (+ n 1))))\n          (t (cons\n               (append goal\n                       (list (symbol '?s n)\n                             (symbol '?s (+ n 1))))\n               (make-dcg-body (rest body) (+ n 1))))))))\n\n(setf (get '==> 'rule-function) 'make-augmented-dcg)\n\n(defun make-augmented-dcg (head body)\n  \"Build an augmented DCG rule that handles :sem, :ex,\n  and automatic conjunctiontive constituents.\"\n  (if (eq (last1 head) :sem)\n      ;; Handle :sem\n      (let* ((?sem (gensym \"?SEM\")))\n        (make-augmented-dcg\n          `(,@(butlast head) ,?sem)\n          `(,@(remove :sem body :key #'first-or-nil)\n            (:test ,(collect-sems body ?sem)))))\n      ;; Separate out examples from body\n      (multiple-value-bind (exs new-body)\n          (partition-if #'(lambda (x) (starts-with x :ex)) body)\n        ;; Handle conjunctions\n        (let ((rule `(rule ,(handle-conj head) --> ,@new-body)))\n          (if (null exs)\n              rule\n              `(progn (:ex ,head .,(mappend #'rest exs))\n                      ,rule))))))\n\n(defun collect-sems (body ?sem)\n  \"Get the semantics out of each constituent in body,\n  and combine them together into ?sem.\"\n  (let ((sems (loop for goal in body\n                    unless (or (dcg-normal-goal-p goal)\n                               (dcg-word-list-p goal)\n                               (starts-with goal :ex)\n                               (atom goal))\n                    collect (last1 goal))))\n    (case (length sems)\n      (0 `(= ,?sem t))\n      (1 `(= ,?sem ,(first sems)))\n      (t `(and* ,sems ,?sem)))))\n\n(defun and*/2 (in out cont)\n  \"IN is a list of conjuncts that are conjoined into OUT.\"\n  ;; E.g.: (and* (t (and a b) t (and c d) t) ?x) ==>\n  ;;        ?x = (and a b c d)\n  (if (unify! out (maybe-add 'and (conjuncts (cons 'and in)) t))\n      (funcall cont)))\n\n(defun conjuncts (exp)\n  \"Get all the conjuncts from an expression.\"\n  (deref exp)\n  (cond ((eq exp t) nil)\n        ((atom exp) (list exp))\n        ((eq (deref (first exp)) 'nil) nil)\n        ((eq (first exp) 'and)\n         (mappend #'conjuncts (rest exp)))\n        (t (list exp))))\n\n(defmacro :ex ((category . args) &body examples)\n  \"Add some example phrases, indexed under the category.\"\n  `(add-examples ',category ',args ',examples))\n\n(defvar *examples* (make-hash-table :test #'eq))\n\n(defun get-examples (category) (gethash category *examples*))\n\n(defun clear-examples () (clrhash *examples*))\n\n(defun add-examples (category args examples)\n  \"Add these example strings to this category,\n  and when it comes time to run them, use the args.\"\n  (dolist (example examples)\n    (when (stringp example)\n      (let ((ex `(,example\n                  (,category ,@args\n                   ,(string->list\n                      (remove-punctuation example)) ()))))\n        (unless (member ex (get-examples category)\n                        :test #'equal)\n          (setf (gethash category *examples*)\n                (nconc (get-examples category) (list ex))))))))\n\n(defun run-examples (&optional category)\n  \"Run all the example phrases stored under a category.\n  With no category, run ALL the examples.\"\n  (prolog-compile-symbols)\n  (if (null category)\n      (maphash #'(lambda (cat val)\n                   (declare (ignore val))\n                   (format t \"~2&Examples of ~a:~&\" cat)\n                   (run-examples cat))\n               *examples*)\n      (dolist (example (get-examples category))\n        (format t \"~2&EXAMPLE: ~{~a~&~9T~a~}\" example)\n        (top-level-prove (cdr example)))))\n\n(defun remove-punctuation (string)\n  \"Replace punctuation with spaces in string.\"\n  (substitute-if #\\space #'punctuation-p string))\n\n(defun string->list (string)\n  \"Convert a string to a list of words.\"\n  (read-from-string (concatenate 'string \"(\" string \")\")))\n\n(defun punctuation-p (char) (find char \"*_.,;:`!?#-()\\\\\\\"\"))\n\n(defmacro conj-rule ((conj-cat sem1 combined-sem) ==>\n                     conj (cat . args))\n  \"Define this category as an automatic conjunction.\"\n  (assert (eq ==> '==>))\n  `(progn\n     (setf (get ',cat 'conj-cat) ',(symbol cat '_))\n     (rule (,cat ,@(butlast args) ?combined-sem) ==>\n       (,(symbol cat '_) ,@(butlast args) ,sem1)\n       (,conj-cat ,sem1 ?combined-sem))\n     (rule (,conj-cat ,sem1 ,combined-sem) ==>\n       ,conj\n       (,cat ,@args))\n     (rule (,conj-cat ?sem1 ?sem1) ==>)))\n\n(defun handle-conj (head)\n  \"Replace (Cat ...) with (Cat_ ...) if Cat is declared\n  as a conjunctive category.\"\n  (if (and (listp head) (conj-category (predicate head)))\n      (cons (conj-category (predicate head)) (args head))\n      head))\n\n(defun conj-category (predicate)\n  \"If this is a conjunctive predicate, return the Cat_ symbol.\"\n  (get predicate 'conj-category))\n\n"
  },
  {
    "path": "lisp/unify.lisp",
    "content": ";;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-\n;;; Code from Paradigms of Artificial Intelligence Programming\n;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File unify.lisp: Unification functions\n\n(requires \"patmatch\")\n\n(defparameter *occurs-check* t \"Should we do the occurs check?\")\n\n(defun unify (x y &optional (bindings no-bindings))\n  \"See if x and y match with given bindings.\"\n  (cond ((eq bindings fail) fail)\n        ((eql x y) bindings)\n        ((variable-p x) (unify-variable x y bindings))\n        ((variable-p y) (unify-variable y x bindings))\n        ((and (consp x) (consp y))\n         (unify (rest x) (rest y)\n                (unify (first x) (first y) bindings)))\n        (t fail)))\n\n(defun unify-variable (var x bindings)\n  \"Unify var with x, using (and maybe extending) bindings.\"\n  (cond ((get-binding var bindings)\n         (unify (lookup var bindings) x bindings))\n        ((and (variable-p x) (get-binding x bindings))\n         (unify var (lookup x bindings) bindings))\n        ((and *occurs-check* (occurs-check var x bindings))\n         fail)\n        (t (extend-bindings var x bindings))))\n\n(defun occurs-check (var x bindings)\n  \"Does var occur anywhere inside x?\"\n  (cond ((eq var x) t)\n        ((and (variable-p x) (get-binding x bindings))\n         (occurs-check var (lookup x bindings) bindings))\n        ((consp x) (or (occurs-check var (first x) bindings)\n                       (occurs-check var (rest x) bindings)))\n        (t nil)))\n\n;;; ==============================\n\n(defun subst-bindings (bindings x)\n  \"Substitute the value of variables in bindings into x,\n  taking recursively bound variables into account.\"\n  (cond ((eq bindings fail) fail)\n        ((eq bindings no-bindings) x)\n        ((and (variable-p x) (get-binding x bindings))\n         (subst-bindings bindings (lookup x bindings)))\n        ((atom x) x)\n        (t (reuse-cons (subst-bindings bindings (car x))\n                       (subst-bindings bindings (cdr x))\n                       x))))\n\n;;; ==============================\n\n(defun unifier (x y)\n \"Return something that unifies with both x and y (or fail).\"\n (subst-bindings (unify x y) x))\n"
  },
  {
    "path": "lisp/waltz.lisp",
    "content": ";;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-\n;;;; Code from Paradigms of AI Programming\n;;;; Copyright (c) 1991 Peter Norvig\n\n;;;; File waltz.lisp: Line-labeling using Waltz filtering.\n\n(defstruct diagram \"A diagram is a list of vertexes.\" vertexes)\n\n(defstruct (vertex (:print-function print-vertex))\n  (name      nil :type atom)\n  (type      'L  :type (member L Y W T))\n  (neighbors nil :type list)  ; of vertex\n  (labelings nil :type list)) ; of lists of (member + - L R)))))\n\n(defun ambiguous-vertex-p (vertex)\n  \"A vertex is ambiguous if it has more than one labeling.\"\n  (> (number-of-labelings vertex) 1))\n\n(defun number-of-labelings (vertex)\n  (length (vertex-labelings vertex)))\n\n(defun impossible-vertex-p (vertex)\n  \"A vertex is impossible if it has no labeling.\"\n  (null (vertex-labelings vertex)))\n\n(defun impossible-diagram-p (diagram)\n  \"An impossible diagram is one with an impossible vertex.\"\n  (some #'impossible-vertex-p (diagram-vertexes diagram)))\n\n(defun possible-labelings (vertex-type)\n  \"The list of possible labelings for a given vertex type.\"\n  ;; In these labelings, R means an arrow pointing away from\n  ;; the vertex, L means an arrow pointing towards it.\n  (case vertex-type\n    ((L) '((R L)   (L R)   (+ R)   (L +)   (- L)   (R -)))\n    ((Y) '((+ + +) (- - -) (L R -) (- L R) (R - L)))\n    ((T) '((R L +) (R L -) (R L L) (R L R)))\n    ((W) '((L R +) (- - +) (+ + -)))))\n\n(defun print-labelings (diagram)\n  \"Label the diagram by propagating constraints and then\n  searching for solutions if necessary.  Print results.\"\n  (show-diagram diagram \"~&The initial diagram is:\")\n  (every #'propagate-constraints (diagram-vertexes diagram))\n  (show-diagram diagram\n                \"~2&After constraint propagation the diagram is:\")\n  (let* ((solutions (if (impossible-diagram-p diagram)\n                        nil\n                        (search-solutions diagram)))\n         (n (length solutions)))\n    (unless (= n 1)\n      (format t \"~2&There are ~r solution~:p:\" n)\n      (mapc #'show-diagram solutions)))\n  (values))\n\n(defun propagate-constraints (vertex)\n  \"Reduce the labelings on vertex by considering neighbors.\n  If we can reduce, propagate the constraints to each neighbor.\"\n  ;; Return nil only when the constraints lead to an impossibility\n  (let ((old-num (number-of-labelings vertex)))\n    (setf (vertex-labelings vertex) (consistent-labelings vertex))\n    (unless (impossible-vertex-p vertex)\n      (when (< (number-of-labelings vertex) old-num)\n        (every #'propagate-constraints (vertex-neighbors vertex)))\n      t)))\n\n(defun consistent-labelings (vertex)\n  \"Return the set of labelings that are consistent with neighbors.\"\n  (let ((neighbor-labels\n          (mapcar #'(lambda (neighbor) (labels-for neighbor vertex))\n                  (vertex-neighbors vertex))))\n    ;; Eliminate labelings that don't have all lines consistent\n    ;; with the corresponding line's label from the neighbor.\n    ;; Account for the L-R mismatch with reverse-label.\n    (find-all-if\n      #'(lambda (labeling)\n          (every #'member (mapcar #'reverse-label labeling)\n                 neighbor-labels))\n      (vertex-labelings vertex))))\n\n(defun search-solutions (diagram)\n  \"Try all labelings for one ambiguous vertex, and propagate.\"\n  ;; If there is no ambiguous vertex, return the diagram.\n  ;; If there is one, make copies of the diagram trying each of\n  ;; the possible labelings.  Propagate constraints and append\n  ;; all the solutions together.\n  (let ((v (find-if #'ambiguous-vertex-p\n                    (diagram-vertexes diagram))))\n    (if (null v)\n        (list diagram)\n        (mapcan\n          #'(lambda (v-labeling)\n              (let* ((diagram2 (make-copy-diagram diagram))\n                     (v2 (find-vertex (vertex-name v) diagram2)))\n                (setf (vertex-labelings v2) (list v-labeling))\n                (if (propagate-constraints v2)\n                    (search-solutions diagram2)\n                    nil)))\n          (vertex-labelings v)))))\n\n(defun labels-for (vertex from)\n  \"Return all the labels for the line going to vertex.\"\n  (let ((pos (position from (vertex-neighbors vertex))))\n    (mapcar #'(lambda (labeling) (nth pos labeling))\n            (vertex-labelings vertex))))\n\n(defun reverse-label (label)\n  \"Account for the fact that one vertex's right is another's left.\"\n  (case label (L 'R) (R 'L) (otherwise label)))\n\n(defun find-vertex (name diagram)\n  \"Find the vertex in the given diagram with the given name.\"\n  (find name (diagram-vertexes diagram) :key #'vertex-name))\n\n(defun print-vertex (vertex stream depth)\n  \"Print a vertex in the short form.\"\n  (declare (ignore depth))\n  (format stream \"~a/~d\" (vertex-name vertex)\n          (number-of-labelings vertex))\n  vertex)\n\n(defun show-vertex (vertex &optional (stream t))\n  \"Print a vertex in a long form, on a new line.\"\n  (format stream \"~&   ~a ~d:\" vertex (vertex-type vertex))\n  (mapc #'(lambda (neighbor labels)\n            (format stream \" ~a~a=[~{~a~}]\" (vertex-name vertex)\n                    (vertex-name neighbor) labels))\n        (vertex-neighbors vertex)\n        (matrix-transpose (vertex-labelings vertex)))\n  (values))\n\n(defun show-diagram (diagram &optional (title \"~2&Diagram:\")\n                             (stream t))\n  \"Print a diagram in a long form.  Include a title.\"\n  (format stream title)\n  (mapc #'show-vertex (diagram-vertexes diagram))\n  (let ((n (reduce #'* (mapcar #'number-of-labelings\n                               (diagram-vertexes diagram)))))\n  (when (> n 1)\n    (format stream \"~&For ~:d interpretation~:p.\" n))\n  (values)))\n\n(defun matrix-transpose (matrix)\n  \"Turn a matrix on its side.\"\n  (if matrix (apply #'mapcar #'list matrix)))\n\n(let ((diagrams (make-hash-table)))\n\n  (defun diagram (name)\n    \"Get a fresh copy of the diagram with this name.\"\n    (make-copy-diagram (gethash name diagrams)))\n\n  (defun put-diagram (name diagram)\n    \"Store a diagram under a name.\"\n    (setf (gethash name diagrams) diagram)\n    name))\n\n(defun construct-diagram (vertex-descriptors)\n  \"Build a new diagram from a set of vertex descriptor.\"\n  (let ((diagram (make-diagram)))\n    ;; Put in the vertexes\n    (setf (diagram-vertexes diagram)\n          (mapcar #'construct-vertex vertex-descriptors))\n    ;; Put in the neighbors for each vertex\n    (dolist (v-d vertex-descriptors)\n      (setf (vertex-neighbors (find-vertex (first v-d) diagram))\n            (mapcar #'(lambda (neighbor)\n                        (find-vertex neighbor diagram))\n                    (v-d-neighbors v-d))))\n    diagram))\n\n(defun construct-vertex (vertex-descriptor)\n  \"Build the vertex corresponding to the descriptor.\"\n  ;; Descriptors are like: (x L y z)\n  (make-vertex\n    :name (first vertex-descriptor)\n    :type (second vertex-descriptor)\n    :labelings (possible-labelings (second vertex-descriptor))))\n\n(defun v-d-neighbors (vertex-descriptor)\n  \"The neighboring vertex names in a vertex descriptor.\"\n  (rest (rest vertex-descriptor)))\n\n(defun make-copy-diagram (diagram)\n  \"Make a copy of a diagram, preserving connectivity.\"\n  (let* ((new (make-diagram\n                :vertexes (mapcar #'copy-vertex\n                                  (diagram-vertexes diagram)))))\n    ;; Put in the neighbors for each vertex\n    (dolist (v (diagram-vertexes new))\n      (setf (vertex-neighbors v)\n            (mapcar #'(lambda (neighbor)\n                        (find-vertex (vertex-name neighbor) new))\n                    (vertex-neighbors v))))\n    new))\n\n(defun ground (diagram vertex-a vertex-b)\n  \"Attach the line between the two vertexes to the ground.\n  That is, label the line with a -\"\n  (let* ((A (find-vertex vertex-a diagram))\n         (B (find-vertex vertex-b diagram))\n         (i (position B (vertex-neighbors A))))\n    (assert (not (null i)))\n    (setf (vertex-labelings A)\n          (find-all-if #'(lambda (l) (eq (nth i l) '-))\n                     (vertex-labelings A)))\n    diagram))\n\n(defun find-labelings (diagram)\n  \"Return a list of all consistent labelings of the diagram.\"\n  (every #'propagate-constraints (diagram-vertexes diagram))\n  (search-solutions diagram))\n\n(defmacro defdiagram (name &rest vertex-descriptors)\n  \"Define a diagram.  A copy can be gotten by (diagram name).\"\n  `(put-diagram ',name (construct-diagram\n                         (check-diagram ',vertex-descriptors))))\n\n(defun check-diagram (vertex-descriptors)\n  \"Check if the diagram description appears consistent.\"\n  (let ((errors 0))\n    (dolist (v-d vertex-descriptors)\n      ;; v-d is like: (a Y b c d)\n      (let ((A (first v-d))\n            (v-type (second v-d)))\n        ;; Check that the number of neighbors is right for\n        ;; the vertex type (and that the vertex type is legal)\n        (when (/= (length (v-d-neighbors v-d))\n                  (case v-type ((W Y T) 3) ((L) 2) (t -1)))\n          (warn \"Illegal type/neighbor combo: ~a\" v-d)\n          (incf errors))\n        ;; Check that each neighbor B is connected to\n        ;; this vertex, A, exactly once\n        (dolist (B (v-d-neighbors v-d))\n          (when (/= 1 (count-if\n                        #'(lambda (v-d2)\n                            (and (eql (first v-d2) B)\n                                 (member A (v-d-neighbors v-d2))))\n                        vertex-descriptors))\n            (warn \"Inconsistent vertex: ~a-~a\" A B)\n            (incf errors)))))\n    (when (> errors 0)\n      (error \"Inconsistent diagram.  ~d total error~:p.\"\n             errors)))\n  vertex-descriptors)\n\n"
  },
  {
    "path": "meta/metadata.xml",
    "content": "<dc:title>Paradigms of Artificial Intelligence Programming</dc:title>\n<dc:language>en-GB</dc:language>\n<dc:creator opf:file-as=\"Norvig, Peter\" opf:role=\"aut\">Peter Norvig</dc:creator>\n<dc:publisher>norvig.com</dc:publisher>\n<dc:date opf:event=\"publication\">2018-04-21</dc:date>\n<dc:rights>Copyright © 2018 Peter Norvig</dc:rights>\n"
  },
  {
    "path": "meta/stylesheet.css",
    "content": ""
  },
  {
    "path": "meta/title.txt",
    "content": "% Paradigms of Artificial Intelligence Programming\n% Peter Norvig\n"
  },
  {
    "path": "paip.asd",
    "content": "(defpackage paip\n  (:use :cl)\n  (:shadow :defconstant)\n  (:export :requires :*paip-files* :do-examples :open-pdf))\n\n(in-package :paip)\n\n(defmacro defconstant (symbol value &optional doc)\n  (declare (cl:ignore doc))\n  `(cl:defconstant ,symbol\n     (or (and (boundp ',symbol)\n              (symbol-value ',symbol))\n         ,value)))\n\n(defclass paip-source-file (asdf:cl-source-file) ())\n\n(defmethod asdf:perform :around ((o asdf:compile-op) (c paip-source-file))\n  (let ((*package* (find-package :paip)))\n    (call-next-method)))\n\n(asdf:defsystem \"paip\"\n  :default-component-class paip-source-file\n  :version \"0.1\"\n  :author \"Peter Norvig\"\n  :license \"MIT\"\n  :serial t\n  :components ((:module \"lisp\"\n                :components\n                ((:file \"auxfns\")\n                 (:file \"tutor\")\n                 (:file \"examples\")\n                 (:file \"open-pdf\"))))\n  :description \"Lisp code for the textbook \\\"Paradigms of Artificial Intelligence Programming\\\"\")\n"
  },
  {
    "path": "scripts/filter-ascii.rb",
    "content": "#!/usr/bin/env ruby\n\n# switch non-ascii characters to ascii equivalents or html entities\n\n# references:\n# https://en.wikipedia.org/wiki/List_of_XML_and_HTML_character_entity_references\n# https://dev.w3.org/html5/html-author/charref\n\n# e.g. filter-ascii.rb -n docs/chapter?.md\n\n# require 'byebug'\n\nodd_chars = []\nsubstitutions = {\n  \"—\" => \"-\", \"−\" => \"-\", \"–\" => \"-\",\n  \"“\" => '\"', \"”\" => '\"', '˜' => '\"', '″' => '\"',\n  '’' => \"'\", \"‘\" => \"'\", \"′\" => \"'\",\n  \"⇒\" => \"=>\", \"⇐\" => \"<=\",\n  \" \" => \" \", # non-breaking spaces\n  \"•\" => \"\",\n  \"…\" => \"...\",\n\n  # typos?\n  \"Κ\" => \"K\",\n  \"Ζ\" => \"Z\",\n  \"â\" => \"a\",\n  \"©\" => \"@\",\n  \"ô\" => \"o\",\n\n  # accents\n  \"à\" => \"&agrave;\",\n  \"ç\" => \"&ccedil;\",\n  \"è\" => \"&egrave;\",\n  \"é\" => \"&eacute;\",\n  \"ï\" => \"&iuml;\",\n  \"ö\" => \"&ouml;\",\n\n  # greek\n  \"∝\" => \"&alpha;\",\n  \"ε\" => \"&epsilon;\",\n  \"λ\" => \"&lambda;\", \"Λ\" => \"&Lambda;\",\n  \"π\" => \"&pi;\",\n  \"∑\" => \"&Sigma;\",\n  \"φ\" => \"&phi;\", \"ϕ\" => \"&Phi;\",\n  \"χ\" => \"&Chi;\",\n\n  # logic symbols\n  \"∃\" => \"&exist;\",\n  \"∧\" => \"&and;\",\n  \"∀\" => \"&forall;\",\n  \"¬\" => \"&not;\",\n  \"⊃\" => \"&Superset;\",\n  \"→\" => \"&rarr;\",\n  \"∨\" => \"&or;\",\n\n  # yet more symbols!\n  \"×\" => \"x\",\n  \"≡\" => \"=\", # maybe?\n  \"∫\" => \"&int;\",\n  \"≠\" => \"&ne;\",\n  \"≈\" => \"&asymp;\",\n  \"≤\" => \"&le;\",\n  \"√\" => \"&radic;\",\n  \"≫\" => \">>\", \"»\" => \">>\",\n  \"⋯\" => \"...\",\n  \"±\" => \"&plusmn;\",\n\n  # unclear, refer to book pdf\n  # \"ߣ\" => \"\", # right-to-left?\n  # î\n  # °\n  # ®\n}\n\nonly_print_non_ascii_lines = false\nif ARGV[0] == \"-n\"\n  # only print non-ascii lines\n  only_print_non_ascii_lines = true\n  ARGV.shift\nend\n\nwhile line = ARGF.gets\n  unless line.ascii_only? # /[\\u0080-\\u00ff]/\n    line.sub!('Ø̸', \"&Oslash;\") # two chars, doesn't fit below\n    line.each_char do |char|\n      unless char.ascii_only?\n        # byebug if char == \"’\"\n        subst = substitutions.fetch(char, \"!!!(char) #{char}\")\n        line.sub!(char, subst)\n        # byebug\n        # puts \"char: #{char}\"\n        unless odd_chars.include?(char)\n          odd_chars << char\n        end\n      end\n    end\n    # byebug\n    if only_print_non_ascii_lines && !line.ascii_only?\n      puts \"non-ascii line: #{line}\"\n    end\n  end # ascii only\n\n  puts line unless only_print_non_ascii_lines\nend\n\n# puts \"non-ascii odd_chars: #{odd_chars.join(\"\\t\")}\""
  },
  {
    "path": "scripts/httpd-py.sh",
    "content": "python2.6 -m SimpleHTTPServer 8000\n"
  },
  {
    "path": "scripts/httpd-rb.sh",
    "content": "ruby -run -e httpd . -p 8000\n"
  },
  {
    "path": "scripts/make-code-blocks.rb",
    "content": "#!/usr/bin/env ruby\n\nrequire 'byebug'\n\ndebug = false\n# if true, won't emit non-code lines\n\ndef code?(str)\n  return false unless str =~ /`/\n\n  # allow leading spaces\n  return false unless str.match('^( | )*`.*`$')\n\n  # let's make sure there aren't more ` in the middle\n  # return false if str[1 .. -2] =~ /`/\n\n  true\nend\n\ndef convert_code_line(str)\n  # only doing first and last\n  # `first segment` something `second segment` gets highlighted\n  # won't eat ` within code fragment\n  str.sub(/`/, '').gsub(/`$/, '')\nend\n\ndef convert_code_block(arr)\n  puts '```lisp'\n  arr.each do |line|\n    puts convert_code_line(line)\n  end\n  puts '```'\nend\n\nlines = []\n\nwarn 'reading file...'\nwhile (line = ARGF.gets)\n  lines << line.chomp\nend\n\nwarn 'parsing file...'\n\nwhile (line = lines.shift)\n  STDERR.printf '.'\n  unless code?(line)\n    puts line unless debug\n    next\n  end\n\n  code_block = [line]\n\n  while (line = lines.shift)\n    next if line == ''\n\n    if code?(line)\n      code_block << line\n    else\n      lines.unshift line\n      break\n    end\n  end\n\n  convert_code_block(code_block)\n  puts\n\nend\n\nwarn \"\\n\"\n"
  },
  {
    "path": "scripts/make-epub.sh",
    "content": "pandoc \\\n  -o PAIP-alpha.epub \\\n  meta/title.txt \\\n  docs/{frontmatter.md,about.md,preface.md,chapter?.md,chapter??.md,appendix.md,bibliography.md} \\\n  --epub-cover-image=docs/_media/paip-cover.gif \\\n  --css=meta/stylesheet.css \\\n  --epub-metadata=meta/metadata.xml \\\n  --table-of-contents\n"
  },
  {
    "path": "scripts/make-pdf-from-epub.sh",
    "content": "#!/bin/bash\n\n# dependencies: calibre\n\nebook-convert PAIP-alpha.epub PAIP-alpha-calibre.pdf -v\n\n# this emits dozens of warnings for missing links\n"
  },
  {
    "path": "scripts/markdown-to-text.sh",
    "content": "#!/bin/bash\n\n# turning the markdown into plaintext, for OCR comparisons\n# results: sentence per line, for nicer diffs\n\nOUTPUT=ocr/PAIP.txt\necho > $OUTPUT\nfor i in frontmatter.md preface.md $(seq -f chapter%g.md 1 25) appendix.md bibliography.md; do\n  echo \"converting $i...\"\n  pandoc - --wrap=preserve -t plain \\\n    < docs/$i >> $OUTPUT\n  echo \"---\" >> $OUTPUT\ndone\n"
  },
  {
    "path": "scripts/one-offs/add-page-anchors.rb",
    "content": "#!/usr/bin/env ruby\n\nin_path = \"PAIP.txt\"\nout_path = \"PAIP.txt.markers\"\n\nchapter = 0\nin_file = File.open(in_path, \"r\").read\nout_file = File.open(out_path, \"w\")\npage_num = -9 # experimentally determined...\n\nin_file.each_line do |line|\n  line.chomp!\n  out_file.puts line\n  if line.match(/\\f/)\n    if page_num >= 3\n      out_file.print \"<a id='page-#{page_num}'></a>\"\n    end\n    page_num += 1\n    # skipping pages. these are removed section headers.\n    page_num = 109 if page_num == 107\n    page_num = 265 if page_num == 262\n    page_num = 509 if page_num == 507\n    page_num = 753 if page_num == 751\n  end\nend\n"
  },
  {
    "path": "scripts/one-offs/linkify_page_numbers.rb",
    "content": "#!/usr/bin/env ruby\n\nrequire \"byebug\"\n\nin_path = \"PAIP.txt\"\nout_path = \"PAIP.txt.linkify\"\n\ndef parse_chapter_file(line)\n  chapter_match = line.match(/^## (.+)$/)\n\n  return nil unless chapter_match\n\n  chapter = chapter_match[1].downcase\n  chapter.gsub!(\" \", \"\")\n  chapter\nend\n\npage_to_chapters = {}\nchapter = 0\nin_file = File.open(in_path, \"r\").read\nout_file = File.open(out_path, \"w\")\n\n# index the pages within the chapters\nin_file.each_line do |line|\n  line.chomp!\n  if parse_chapter_file(line)\n    chapter = parse_chapter_file(line)\n    next\n  end\n\n  page_id = line.match(/(<a id='page-(.+?)'><\\/a>)/)\n  if page_id\n    page = page_id[2]\n    page_to_chapters[page] = chapter\n    next\n  end\nend\n\n# add links to page references\nin_file.each_line do |line|\n  line = line.chomp\n  page_match = line.match(/page (\\d+)/i)\n  if page_match\n    # not checking if already linked yet...\n    num = page_match[1]\n    chap = page_to_chapters[num]\n    line.gsub!(/page #{num}/, \"[page #{num}](#{chap}.md#page-#{num})\")\n  end\n  out_file.puts line\nend"
  },
  {
    "path": "scripts/prepare-for-merge.rb",
    "content": "#!/usr/bin/env ruby\n\nrequire \"byebug\"\nchap_path = ARGV.first || \"docs/chapter10.md\"\nout_path = \"#{chap_path}.merge\"\n\nchap_file = File.open(chap_path, \"r\")\nout_file = File.open(out_path, \"w\")\n\nuntil chap_file.eof?\n  line = chap_file.readline\n  line.gsub!(/ {docsify-ignore}$/, \"\")\n  line.gsub!(/^#/, \"##\") # promote section to header\n  out_file.puts \"\\f\" if line.match(/<a id=.page-/)\n  out_file.puts line\nend\n\n\n# copy text file, up to given chapter\n\n# merge in chapter\n\n# copy rest of text file\n\n# while line = chap_file.readline\n#   line.chomp!\n#   line.gsub!(/^#/, \"##\")\n#   # byebug\n#   out_file.puts line\n# end"
  },
  {
    "path": "scripts/split-chapters-markdown.rb",
    "content": "#!/usr/bin/env ruby\n\n# require \"byebug\"\n\nin_path = \"PAIP-safari.md\"\nout_path = \"docs\"\n\nin_file = File.open(in_path, \"r\").read\nout_file = \"\"\n\nin_file.each_line do |line|\n  line.chomp!\n\n  chapter_match = line.match(/^# (.+)$/)\n  if chapter_match\n    chapter = chapter_match[1].downcase\n    unless chapter =~ /cl.sure/\n      chapter.gsub!(\" \", \"\")\n      line.gsub!(/^##/, \"#\") # promote sections a level\n      out_file = File.open(\"#{out_path}/#{chapter}.md\", \"w\")\n    end\n  end\n\n  if line.match(/\\f/)\n    next # eat the formfeed\n  end\n\n  # eat anything after the page number marker\n  page_id = line.match(/(<a id='page-.+?'><\\/a>)/)\n  if page_id\n    # byebug\n    out_file.puts page_id[1]\n    next\n  end\n\n  out_file.puts line\nend\n\n"
  },
  {
    "path": "scripts/split-chapters.rb",
    "content": "#!/usr/bin/env ruby\n\n# require \"byebug\"\nin_path = \"PAIP.txt\"\nout_path = \"docs\"\n\nin_file = File.open(in_path, \"r\").read\nout_file = \"\"\n\nin_file.each_line do |line|\n  line.chomp!\n\n  chapter_match = line.match(/^## (.+)$/)\n  if chapter_match\n    chapter = chapter_match[1].downcase\n    chapter.gsub!(\" \", \"\")\n    line.gsub!(/^##/, \"#\") # promote sections a level\n    out_file = File.open(\"#{out_path}/#{chapter}.md\", \"w\")\n    out_file.puts \"#{line} {docsify-ignore}\"\n    next\n  end\n\n  if line.match(/\\f/)\n    next # eat the formfeed\n  end\n\n  # eat anything after the page number marker\n  page_id = line.match(/(<a id='page-.+?'><\\/a>)/)\n  if page_id\n    # byebug\n    out_file.puts page_id[1]\n    next\n  end\n\n  out_file.puts line\nend\n\n"
  }
]