├── .gitignore ├── LICENSE ├── README.md └── nqthm-1992 ├── README ├── THIS.DIR ├── basis.lisp ├── code-1-a.lisp ├── code-b-d.lisp ├── code-e-m.lisp ├── code-n-r.lisp ├── code-s-z.lisp ├── defn-sk.lisp ├── doc ├── README ├── ap-copyright-permission.text ├── logic-reference.doc └── nq.el ├── events.lisp ├── examples ├── README ├── TAGS ├── basic │ ├── alternating.events │ ├── async18.events │ ├── binomial.events │ ├── controller.events │ ├── fibsums.events │ ├── fortran.events │ ├── fs-examples.events │ ├── gauss.events │ ├── new-gauss.events │ ├── parser.events │ ├── peter.events │ ├── pr.events │ ├── proveall.events │ ├── quant.events │ ├── rsa.events │ ├── small-machine.events │ ├── tic-tac-toe.events │ ├── tmi.events │ ├── unsolv.events │ ├── wilson.events │ └── ztak.events ├── bevier │ └── kit.events ├── bronstein │ ├── README │ ├── acc_CSXA00.events │ ├── bcd.events │ ├── bcdS.events │ ├── bcdSbi.events │ ├── bibo_exp.events │ ├── corrSL.events │ ├── corr_CIXA00.events │ ├── corr_CSXA00.events │ ├── counter.events │ ├── counterR.events │ ├── countstut.events │ ├── funacc.events │ ├── handrec.events │ ├── macc.events │ ├── mlp.events │ ├── multadd.events │ ├── pplfadd.events │ ├── pplfun3.events │ ├── pplinc3.events │ ├── ppltcpu.events │ ├── ppltcpuM.events │ ├── prod0_CSXA00.events │ ├── sadder.events │ ├── serial.events │ ├── srccpu.events │ └── theta.events ├── cowles │ ├── intro-eg.events │ └── shell.events ├── dir.lisp ├── driver ├── driver-header.lisp ├── driver-sk.lisp ├── driver.lisp ├── flatau │ ├── README │ ├── app-c-d-e.events │ └── app-f.events ├── fm9001-piton │ ├── README │ ├── big-add.events │ ├── fm9001-replay.events │ ├── fm9001 │ │ ├── CHIP.NET │ │ ├── FM9001.announcement │ │ ├── LICENSE │ │ ├── README │ │ ├── TAGS │ │ ├── alu-interpretation.events │ │ ├── alu-specs.events │ │ ├── approx.events │ │ ├── asm-fm9001.events │ │ ├── bags.events │ │ ├── chip.events │ │ ├── compressed-netlist.events │ │ ├── control-modules.events │ │ ├── control.events │ │ ├── control.lisp │ │ ├── core-alu.events │ │ ├── disable.lisp │ │ ├── do-events-recursive.lisp │ │ ├── do-files.lisp │ │ ├── dual-eval-spec.events │ │ ├── dual-eval.events │ │ ├── dual-port-ram.events │ │ ├── example-v-add.events │ │ ├── examples.events │ │ ├── expand-fm9001.events │ │ ├── expand-fm9001.lisp │ │ ├── expand.lisp │ │ ├── extend-immediate.events │ │ ├── f-functions.events │ │ ├── fast-zero.events │ │ ├── files-wo-proof.csh │ │ ├── final-reset.events │ │ ├── flag-interpretation.events │ │ ├── flags.events │ │ ├── fm9001-hardware.events │ │ ├── fm9001-memory.events │ │ ├── fm9001-spec.events │ │ ├── hard-specs.events │ │ ├── high-level-spec.events │ │ ├── indices.events │ │ ├── integers.events │ │ ├── intro-overview.ps │ │ ├── intro.events │ │ ├── list-rewrites.events │ │ ├── macros.lisp │ │ ├── math-disable.events │ │ ├── math-enable.events │ │ ├── memory.events │ │ ├── monotonicity-macros.lisp │ │ ├── more-alu-interpretation.events │ │ ├── naturals.events │ │ ├── pad-vectors.events │ │ ├── pg-theory.events │ │ ├── post-alu.events │ │ ├── pre-alu.events │ │ ├── predicate-help.events │ │ ├── predicate-simple.events │ │ ├── predicate.events │ │ ├── predicate.tests │ │ ├── primitives.events │ │ ├── primitives.lisp │ │ ├── primp-database.lisp │ │ ├── proofs.events │ │ ├── purify.lisp │ │ ├── reg.events │ │ ├── regfile.events │ │ ├── rtl-level-spec.events │ │ ├── store-resultp.events │ │ ├── sysdef.lisp │ │ ├── sysload.lisp │ │ ├── t-or-nor.events │ │ ├── translate.events │ │ ├── translate.lisp │ │ ├── tree-number.events │ │ ├── tv-alu-help.events │ │ ├── tv-dec-pass.events │ │ ├── tv-if.events │ │ ├── unbound.events │ │ ├── v-equal.events │ │ ├── v-inc4.events │ │ ├── value.events │ │ ├── vector-macros.lisp │ │ ├── vector-module.events │ │ └── well-formed-fm9001.events │ ├── nim-piton.events │ └── piton.events ├── fortran-vcg │ ├── README │ ├── all.lsp │ ├── fortran-vcg.lsp │ ├── fortran.events │ ├── fsrch.events │ ├── fsrch.f │ ├── fsrch.lsp │ ├── isqrt.events │ ├── isqrt.f │ ├── isqrt.lsp │ ├── makefile │ ├── mjrty.events │ ├── mjrty.f │ └── mjrty.lsp ├── hunt │ └── fm8501.events ├── kaufmann │ ├── expr-compiler.events │ ├── foldr.events │ ├── generalize-all.events │ ├── koenig.events │ ├── locking.events │ ├── mergesort-demo.events │ ├── note-100.events │ ├── partial.events │ ├── permutationp-subbagp.events │ ├── ramsey.events │ ├── rotate.events │ ├── rpn.events │ └── shuffle.events ├── kunen │ ├── ack.events │ ├── induct.events │ ├── new-prime.events │ └── paris-harrington.events ├── numbers │ ├── arithmetic-geometric-mean.events │ ├── bags.events │ ├── extras.events │ ├── fib2.events │ ├── integers.events │ ├── naturals.events │ ├── nim.events │ ├── scheduler.events │ └── tossing.events ├── shankar │ ├── church-rosser.events │ ├── goedel.events │ └── tautology.events ├── subramanian │ ├── mutilated-checkerboard.events │ └── mutilated-checkerboard.ps ├── talcott │ ├── README │ ├── mutex-atomic.events │ └── mutex-molecular.events ├── young │ └── train.events └── yu │ ├── README │ ├── amax.events │ ├── asm.events │ ├── bsearch.events │ ├── cstring.events │ ├── fixnum-gcd.events │ ├── fmax.events │ ├── gcd.events │ ├── gcd3.events │ ├── group.events │ ├── isqrt-ada.events │ ├── isqrt.events │ ├── log2.events │ ├── mc20-0.events │ ├── mc20-1.aux │ ├── mc20-1.dvi │ ├── mc20-1.events │ ├── mc20-1.idx │ ├── mc20-1.ilg │ ├── mc20-1.ind │ ├── mc20-1.nqtex │ ├── mc20-1.ps │ ├── mc20-1.tex │ ├── mc20-1.toc │ ├── mc20-2.events │ ├── memchr.events │ ├── memcmp.events │ ├── memcpy.events │ ├── memmove.events │ ├── memset.events │ ├── mjrty.events │ ├── qsort.events │ ├── strcat.events │ ├── strchr.events │ ├── strcmp.events │ ├── strcoll.events │ ├── strcpy.events │ ├── strcspn.events │ ├── strlen.events │ ├── strncat.events │ ├── strncmp.events │ ├── strncpy.events │ ├── strpbrk.events │ ├── strrchr.events │ ├── strspn.events │ ├── strstr.events │ ├── strtok.events │ ├── strxfrm.events │ ├── switch.events │ └── zero.events ├── genfact.lisp ├── gnu-general-public-license.text ├── infix.lisp ├── io.lisp ├── make ├── README ├── compile.lisp ├── save.lisp ├── small-tester.lisp └── tiny-tester.lisp ├── makefile ├── mcl-nqthm-startup.lisp ├── nqthm-public-software-license.doc ├── nqthm-public-software-license.ps ├── nqthm.lisp ├── ppr.lisp ├── sinfix ├── README ├── akcl-patch.lisp ├── latex-init.lisp ├── latex-theory.lisp ├── scribe-init.lisp ├── scribe-theory.lisp ├── sinfix.lisp └── testlog.summary └── sloop.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.fas 3 | *.lib 4 | -------------------------------------------------------------------------------- /nqthm-1992/THIS.DIR: -------------------------------------------------------------------------------- 1 | README Introduction 2 | THIS.DIR Brief explanations of files 3 | basis.lisp An Nqthm-1992 source file 4 | code-1-a.lisp An Nqthm-1992 source file 5 | code-b-d.lisp An Nqthm-1992 source file 6 | code-e-m.lisp An Nqthm-1992 source file 7 | code-n-r.lisp An Nqthm-1992 source file 8 | code-s-z.lisp An Nqthm-1992 source file 9 | defn-sk.lisp Kaufmann's skolemizer 10 | doc A subdirectory with documentation 11 | events.lisp An Nqthm-1992 source file 12 | examples Subdirectory with the example files 13 | genfact.lisp An Nqthm-1992 source file 14 | gnu-general-public-license.text Gnu license 15 | infix.lisp A conventional notation pretty printer for Nqthm 16 | io.lisp An Nqthm-1992 source file 17 | make A directory for building an Nqthm-1992 save image 18 | make.nqthm-1992.tar A csh source file to make a tar file 19 | makefile A Unix makefile for building Nqthm-1992 20 | mcl-nqthm-startup.lisp A startup file for use with MCL on a Macintosh 21 | nqthm-public-software-license.doc The Nqthm-1992 license 22 | nqthm-public-software-license.ps Postscript form of above 23 | nqthm.lisp An Nqthm-1992 source file 24 | ppr.lisp An Nqthm-1992 source file 25 | sinfix A Scribe/TeX version of infix 26 | sloop.lisp Schelter's loop, used by Nqthm-1992 27 | 28 | -------------------------------------------------------------------------------- /nqthm-1992/doc/README: -------------------------------------------------------------------------------- 1 | The documentation for Nqthm-1992 consists of the book `A Computational Logic 2 | Handbook' by Robert S. Boyer and J Strother Moore, second edition, Academic 3 | Press, 1998, ISBN 0-12-122955-6. 4 | 5 | Permission from Academic Press to distribute Chapters 4 and 12, the formal 6 | logic and the reference guide, in electronic form may be found in the file 7 | `ap-copyright-permission.text'. 8 | 9 | The file `logic-reference.doc' contains a text version of chapters 4 and 12. 10 | In principle, these two chapters explain all that one needs to know to use 11 | Nqthm-1992 -- both the details of logic in which theorems are being proved 12 | and the commands one can use. In practice, however, a reading of the 13 | entirety of `A Computational Logic Handbook,' second edition, is strongly 14 | recommended because of the many examples of and hints for effective use of 15 | Nqthm that are provided. 16 | 17 | In the file nq.el is a Gnu Emacs utility for searching the file 18 | logic-reference.doc. 19 | -------------------------------------------------------------------------------- /nqthm-1992/doc/ap-copyright-permission.text: -------------------------------------------------------------------------------- 1 | Here is a record of our permission to distribute three chapters of A 2 | COMPUTATIONAL LOGIC HANDBOOK. It is a copy of a letter which is on 3 | file at Computational Logic, from Academic Press to Boyer and Moore. 4 | 5 | Academic Press, Inc. 6 | (Harcourt Brace Jovanovich, Publishers) 7 | Orlando, Florida 32887 8 | Telephone: 407-345-4100 9 | September 23, 1992 10 | 11 | Dr. Robert S. Boyer 12 | Dr. J Strother Moore 13 | Computational Logic Incorporated 14 | 1717 West Sixth Street 15 | Suite 290 16 | Austin, TX 78703-4776 17 | 18 | RE: Chapters 3, 4, and 12 in A COMPUTATIONAL LOGIC HANDBOOK by 19 | Robert S. Boyer and J Strother Moore 20 | 21 | Dear Drs. Boyer and Moore: 22 | 23 | This is in response to your July 27, 1992 letter regarding permission 24 | to reproduce and distribute your revised versions of the above 25 | material. We are willing to grant permission to reproduce these 26 | three revised chapters, in hard copy and in electronic format, on the 27 | following conditions: 28 | 29 | 1) that compete credit is given to our book, including the following 30 | notice: 31 | 32 | Chapters 3, 4, and 12 have been revised and reprinted by 33 | permission of the publisher from A COMPUTATIONAL LOGIC HANDBOOK by 34 | Robert S. Boyer and J Strother Moore 35 | Copyright (c) 1988 by Academic Press, Inc. 36 | 37 | 2) that the material to be used is not credited or acknowledged to 38 | sources other than Academic Press. 39 | 40 | 3) that the following order information for our book be included in 41 | all copies of the revised chapters and in any electronic format containing 42 | the revised chapters: 43 | 44 | A COMPUTATIONAL LOGIC HANDBOOK by Robert S. Boyer and J Strother 45 | Moore is available for purchase directly from Academic Press, at 46 | a price of $54.50, by phoning 1-800-321-5068, FAX: 1-800-874-6418, 47 | or by writing to: 48 | 49 | Academic Press Books 50 | Customer Service Department 51 | Orlando, FL 32887 52 | 53 | Our permission is for the three indicated chapters only, and does not 54 | extend to any other portion of the book. 55 | 56 | Sincerely, 57 | 58 | 59 | Martha Strassberger 60 | Manager, Rights and Permissions 61 | -------------------------------------------------------------------------------- /nqthm-1992/doc/nq.el: -------------------------------------------------------------------------------- 1 | ; This file, doc/nq.el, contains the definition of a Gnu Emacs utility for 2 | ; finding documentation on Nqthm-1992 topics in the file logic-reference.doc. 3 | ; To use nq.el, first edit, below, the definition of the variable 4 | ; nqthm-doc-file so that it is the name of the logic-reference.doc file at your 5 | ; site. Then, load nq.el into your Emacs. For convenience, you may want to 6 | ; place the line 7 | 8 | ; (load ".../doc/nq.el") 9 | 10 | ; in your .emacs file, where ... is the name of the nqthm-1992 directory at 11 | ; your site. 12 | 13 | ; The Gnu Emacs command 14 | 15 | ; M-X nq 16 | 17 | ; will find the file logic-reference.doc in a buffer and search for an entry on 18 | ; . Given a null topic, the nq command will continue searching for the 19 | ; previous topic. is a regular expression. A topic name need not be 20 | ; spelled out completely. nq's search strategy is very simple minded, but 21 | ; perhaps better than nothing. 22 | 23 | ; The variable nqthm-doc-file below should be edited to be the full name of the 24 | ; nqthm-1992/doc/logic-refernce.doc file at your site. 25 | (defvar nqthm-doc-file "/slocal/src/nqthm-1992/doc/logic-reference.doc") 26 | 27 | ; The previous pattern. 28 | (defvar last-nqthm-search-key "") 29 | 30 | (defun nq (word) 31 | "Search the Nqthm-1992 documentation for an entry about WORD, a regexp. 32 | If WORD is empty, continue searching for the previous pattern." 33 | (interactive "sTopic (regexp): ") 34 | (find-file nqthm-doc-file) 35 | (cond ((equal word "") 36 | (setq word last-nqthm-search-key) 37 | (forward-line 3)) 38 | (t (setq last-nqthm-search-key word) 39 | (goto-char (point-min)))) 40 | (let ((str 41 | (format 42 | (concat 43 | ;; We examine (1) titles of numbered sections, 44 | "^[0-9][0-9.]*. %s\\|" 45 | ;; (2) axiomatic definitions, 46 | "^Defining Axiom .*\n(%s\\|" 47 | ;; (3) functions in shell invocations, 48 | "^Shell Definition.[^.]* %s") 49 | word word word))) 50 | (or (re-search-forward str nil t) 51 | ;; and (4), anywhere at all, as a last resort. 52 | (re-search-forward (format "%s" word))) 53 | (goto-char (match-beginning 0)) 54 | (recenter 0))) 55 | 56 | -------------------------------------------------------------------------------- /nqthm-1992/examples/README: -------------------------------------------------------------------------------- 1 | This is the `README' file for the `examples' subdirectory of Nqthm-1992, a 2 | collection of subdirectories of over one hundred event files, which together 3 | contain thousands of theorems. This file also reflects the result of 4 | installing the additional Nqthm examples that were distributed in 1995. 5 | 6 | No file on this directory `examples', nor on any of its subdirectories, is 7 | necessary for the compilation, installation, or execution of Nqthm-1992. 8 | 9 | In the subdirectories such as basic, bevier, bronstein, cowles, flatau, 10 | fm9001-piton, fortran-vcg, hunt, kaufmann, kunen numbers, shankar, talcott, 11 | subramanian, young, and yu are the *.events files, the actual example files. 12 | 13 | There are a variety of ways to replay these examples. Please note that to 14 | replay all these examples is a data processing activity requiring nontrivial 15 | time and space resources -- perhaps as much as three hundred megabytes of disk 16 | space, one hundred megabytes of virtual memory, and, on a fast workstation of 17 | 1997, 9 hours of cpu time. See further warnings about resources in the file 18 | `driver.lisp'. 19 | 20 | Alternative 1. From within a Common Lisp into which the compiled files for 21 | Nqthm-1992 have been loaded, simply invoke, say, (prove-file-out "ex"), to 22 | check an example file named, say, `ex.events'. Before invoking prove-file-out, 23 | one must indicate the directory of the file `ex.events', either (1) by using 24 | some operating-system-specific or Common-Lisp-implementation-specific command 25 | such as `cd' or (2) by setting *DEFAULT-NQTHM-PATH* to some suitable pathname 26 | string, e.g. "/local/src/nqthm-1992/examples/basic/". Obviously, the choice of 27 | the directory name depends upon where the Nqthm-1992 examples are located at 28 | your site. If the checking is successful, a file `ex.proved' will be created. 29 | If unsuccessful, `ex.proved' will not be created, but a file `ex.proofs' may 30 | contain an error message and, in all likelihood, files named `ex.STARTED' or 31 | `ex.fail' will be created. Because some example files start with instructions 32 | to call `note-lib' to load information dumped after checking other example 33 | files, the order in which examples are done is important. An example file that 34 | starts with a `boot-strap' does not depend on another file. The drawback to 35 | running the examples in this way, via explicit calls to prove-file-out, is that 36 | it is tedious to do each by hand, since there are over a hundred. The 37 | remaining alternatives listed below automate the invocation of prove-file on 38 | each of the examples. However, these other alternatives necessarily involve 39 | operating-system-specific and Common-Lisp-implementation-specific code that 40 | will not work for some systems. 41 | 42 | Alternative 2. Load the file `driver.lisp' into a Common Lisp containing a 43 | compiled Nqthm-1992. See that file for further directions; in particular it is 44 | necessary to set up certain directory variables; the file `dir.lisp' contains 45 | typical example settings of variables that point to directories for use when 46 | running `driver.lisp'. There are two drawbacks to this `driver.lisp' 47 | alternative. First, because `driver.lisp' contains instructions for switching 48 | between the various example directories, and because we know of no method to do 49 | this in general in all Common Lisps, this method will fail for any operating 50 | system in which subdirectory components of file names are not separated by a 51 | single character, e.g., the character "/" in Unix. If a single character is 52 | not so used in your operating system, you will find it necessary to edit 53 | suitably the definition of DRIVER-PROVE-FILE-OUT in the file `driver.lisp'. 54 | Second, some of the examples are so large that they will not execute for want 55 | of sufficient heap in the default configurations of some Common Lisps. 56 | 57 | Alternative 3. Invoke either the command `make giant-test' or else the command 58 | `make giant-test-alt' at the Unix csh level while connected to the directory 59 | above this, i.e., nqthm-1992. Do this after successfully running the command 60 | `make LISP=xxx', where xxx is the the command to run your LISP. This works for 61 | AKCL, Allegro, CMU, and Lucid Common Lisps. The difference between giant-test 62 | and giant-test-alt is that the former does all of the tests in a single Lisp 63 | process whereas the latter does each test in a different process. 64 | 65 | DEFN-SK. In the spirit of `driver.lisp', the file `driver-sk.lisp' can be 66 | loaded into Nqthm-1992 to check the three example files that use defn-sk, Matt 67 | Kaufmann's Skolemizer, which we distribute with Nqthm-1992. 68 | 69 | Historical note. The Nqthm-1987 events that used to be in the single file 70 | `basic.events', as documented in `A Computational Logic Handbook,' first 71 | edition, may now be found in the subdirectories `basic' and `shankar'. The 72 | events file `fm8501.events' may be found in the subdirectory `hunt'. The 73 | events file `goedel.events' may be found in the subdirectory `shankar'. 74 | 75 | 76 | List of Files on this Directory 77 | 78 | README Introduction 79 | README-for-1995-examples Introduction to additional examples 80 | basic A Miscellany of Examples 81 | bevier The KIT work of Bill Bevier 82 | bronstein Events from Alex Bronstein 83 | cowles Some examples by John Cowles 84 | dir.lisp Definition of some directory variables 85 | driver A Unix csh driver for running the examples 86 | driver-header.lisp A file used to help make the file driver.lisp 87 | driver-sk.lisp For running the defn-sk examples 88 | driver.lisp For running the examples under any CL 89 | flatau Events from Art Flatau 90 | fm9001-piton Events for part of the Clinc Stack 91 | fortran-vcg Examples of FORTRAN verification, vcg style 92 | hunt Hunt's FM8501 93 | kaufmann Some examples by Matt Kaufmann 94 | kunen Some examples by Ken Kunen 95 | numbers Many arithmetic examples 96 | shankar Church-Rosser, Goedel's Incompleteness, etc. 97 | subramanian Events from Sakthi Subramanian 98 | talcott Some examples by C. Talcott and M. Nagayama 99 | young Events from Bill Young 100 | yu Events from Yuan Yu 101 | 102 | -------------------------------------------------------------------------------- /nqthm-1992/examples/basic/binomial.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Robert S. Boyer and J Strother Moore. All Rights 4 | Reserved. 5 | 6 | This script is hereby placed in the public domain, and therefore unlimited 7 | editing and redistribution is permitted. 8 | 9 | NO WARRANTY 10 | 11 | Robert S. Boyer and J Strother Moore PROVIDE ABSOLUTELY NO WARRANTY. THE 12 | EVENT SCRIPT IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS 13 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF 14 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO 15 | THE QUALITY AND PERFORMANCE OF THE SCRIPT IS WITH YOU. SHOULD THE SCRIPT 16 | PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR 17 | CORRECTION. 18 | 19 | IN NO EVENT WILL Robert S. Boyer or J Strother Moore BE LIABLE TO YOU FOR ANY 20 | DAMAGES, ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR 21 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT 22 | (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE 23 | OR LOSSES SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE 24 | POSSIBILITY OF SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 25 | 26 | |# 27 | 28 | (NOTE-LIB "proveall" T) 29 | (COMPILE-UNCOMPILED-DEFNS "tmp") 30 | (DEFN BC (N M) 31 | (IF (ZEROP M) 1 32 | (IF (LESSP N M) 0 33 | (PLUS (BC (SUB1 N) M) (BC (SUB1 N) (SUB1 M)))))) 34 | (DISABLE EVAL$) 35 | (PROVE-LEMMA FOR-APPEND-SUM (REWRITE) 36 | (EQUAL (FOR X (APPEND A B) TEST 'SUM BODY ALIST) 37 | (PLUS (FOR X A TEST 'SUM BODY ALIST) 38 | (FOR X B TEST 'SUM BODY ALIST)))) 39 | (PROVE-LEMMA BC-X-X1 (REWRITE) (EQUAL (BC X (ADD1 X)) 0)) 40 | (PROVE-LEMMA BC-X-X (REWRITE) (EQUAL (BC X X) 1)) 41 | (PROVE-LEMMA FROM-TO-OPENS-AT-BTM (REWRITE) 42 | (EQUAL (FROM-TO 0 B) (CONS 0 (FROM-TO 1 B)))) 43 | (PROVE-LEMMA MEMBER-FROM-TO (REWRITE) 44 | (EQUAL (MEMBER I (FROM-TO A B)) 45 | (AND (NUMBERP I) 46 | (NOT (LESSP I A)) 47 | (NOT (LESSP B I)))) 48 | ((INDUCT (FROM-TO A B)))) 49 | (PROVE-LEMMA FOR-SUM-PLUS (REWRITE) 50 | (EQUAL (FOR I RANGE TEST 'SUM (LIST (QUOTE PLUS) A B) ALIST) 51 | (PLUS (FOR I RANGE TEST 'SUM A ALIST) 52 | (FOR I RANGE TEST 'SUM B ALIST))) 53 | ((ENABLE EVAL$))) 54 | (PROVE-LEMMA TIMES-PLUS-DISTRIBUTIVITY-AGAIN (REWRITE) 55 | (EQUAL (TIMES (PLUS A B) C) 56 | (PLUS (TIMES A C) (TIMES B C)))) 57 | (PROVE-LEMMA DIFFERENCE-SUB1-2 (REWRITE) 58 | (IMPLIES (AND (NOT (ZEROP I)) 59 | (NOT (LESSP X I))) 60 | (EQUAL (DIFFERENCE X (SUB1 I)) 61 | (ADD1 (DIFFERENCE X I))))) 62 | (PROVE-LEMMA OUT-WITH-THE-FACTORS (REWRITE) 63 | (IMPLIES (AND (NLISTP ONE) 64 | (NOT (EQUAL ONE VAR))) 65 | (EQUAL (FOR VAR RANGE CONDITION (QUOTE SUM) 66 | (LIST (QUOTE TIMES) ONE TWO) 67 | ALIST) 68 | (TIMES (EVAL$ (TRUE) ONE ALIST) 69 | (FOR VAR RANGE CONDITION (QUOTE SUM) TWO 70 | ALIST)))) 71 | ((ENABLE EVAL$))) 72 | (PROVE-LEMMA LESSP-1 (REWRITE) 73 | (EQUAL (LESSP I 1) (ZEROP I))) 74 | (PROVE-LEMMA LESSP-CROCK1 (REWRITE) 75 | (IMPLIES (NOT (ZEROP I)) 76 | (EQUAL (LESSP X (SUB1 I)) 77 | (AND (LESSP X I) 78 | (NOT (EQUAL (FIX X) (SUB1 I))))))) 79 | (PROVE-LEMMA ZERO-SUM (REWRITE) 80 | (EQUAL (FOR I L COND 'SUM ''0 ALIST) 0) 81 | ((ENABLE EVAL$))) 82 | (PROVE-LEMMA SHIFT-INDICIAL-UP-CROCK (REWRITE) 83 | (IMPLIES (NOT (ZEROP N)) 84 | (EQUAL (FOR I IN (FROM-TO 1 N) SUM 85 | (TIMES (EXP A I) 86 | (TIMES (BC X (SUB1 I)) 87 | (EXP B (DIFFERENCE X I))))) 88 | (FOR I IN (FROM-TO 0 (SUB1 N)) SUM 89 | (TIMES (EXP A (ADD1 I)) 90 | (TIMES (BC X I) 91 | (EXP B (DIFFERENCE X (ADD1 I))))))))) 92 | (PROVE-LEMMA GOAL1 (REWRITE) 93 | (IMPLIES 94 | (AND (NUMBERP X) 95 | (NOT (EQUAL X 0)) 96 | (NOT (EQUAL 1 X)) 97 | (NOT (EQUAL (SUB1 X) 0))) 98 | (EQUAL 99 | (TIMES A 100 | (FOR I IN 101 | (FROM-TO 1 (SUB1 X)) 102 | SUM 103 | (TIMES (BC X I) 104 | (TIMES (EXP A I) 105 | (EXP B (DIFFERENCE X I)))))) 106 | (TIMES A 107 | (TIMES B 108 | (FOR I IN 109 | (FROM-TO 1 (SUB1 X)) 110 | SUM 111 | (TIMES (BC X I) 112 | (TIMES (EXP A I) 113 | (EXP B 114 | (DIFFERENCE (SUB1 X) I)))))))))) 115 | (PROVE-LEMMA NEWTON (REWRITE) 116 | (EQUAL (EXP (PLUS A B) N) 117 | (FOR I IN (FROM-TO 0 N) SUM 118 | (TIMES (BC N I) 119 | (EXP A I) 120 | (EXP B (DIFFERENCE N I))))) 121 | ((INDUCT (EXP A N)))) 122 | -------------------------------------------------------------------------------- /nqthm-1992/examples/bronstein/bibo_exp.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Alex Bronstein and Carolyn Talcott. All Rights 4 | Reserved. 5 | 6 | You may copy and distribute verbatim copies of this Nqthm-1992 event script as 7 | you receive it, in any medium, including embedding it verbatim in derivative 8 | works, provided that you conspicuously and appropriately publish on each copy 9 | a valid copyright notice "Copyright (C) 1994 by Alex Bronstein and Carolyn 10 | Talcott. All Rights Reserved." 11 | 12 | NO WARRANTY 13 | 14 | Alex Bronstein and Carolyn Talcott PROVIDE ABSOLUTELY NO WARRANTY. THE EVENT 15 | SCRIPT IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR 16 | IMPLIED, INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF 17 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO 18 | THE QUALITY AND PERFORMANCE OF THE SCRIPT IS WITH YOU. SHOULD THE SCRIPT 19 | PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR 20 | CORRECTION. 21 | 22 | IN NO EVENT WILL Alex Bronstein or Carolyn Talcott BE LIABLE TO YOU FOR ANY 23 | DAMAGES, ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR 24 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT 25 | (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE 26 | OR LOSSES SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE 27 | POSSIBILITY OF SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 28 | 29 | |# 30 | 31 | (note-lib "mlp" t) 32 | 33 | ;;; bibo_exp.bm 34 | ;;; 35 | ;;; Experiments with type conversions, standard commutative squares, to 36 | ;;; get a feel for these issues. Some of these theorems may turn out 37 | ;;; useful in the future, in which case they should end up in Brain, 38 | ;;; probably in th_types. 39 | ;;; 40 | ;;; Clearly, no sugar involved. 41 | ;;; 42 | ;;; Name convention: "isa" means "is almost", i.e. up to type conversion. 43 | 44 | ; (setq bibo_exp '( 45 | 46 | ; comb_bor.bm: Binary Or combinational element 47 | ; U7-DONE 48 | 49 | (defn bor (u v) 50 | (if (and (equal u 0) (equal v 0)) 51 | 0 52 | 1)) 53 | 54 | ; Everything below generated by: (bmcomb 'bor '() '(x y)) 55 | 56 | (DEFN S-BOR (X Y) 57 | (IF (EMPTY X) (E) (A (S-BOR (P X) (P Y)) (BOR (L X) (L Y))))) 58 | 59 | ;; A2-Begin-S-BOR 60 | 61 | (PROVE-LEMMA A2-EMPTY-S-BOR (REWRITE) 62 | (EQUAL (EMPTY (S-BOR X Y)) (EMPTY X)) ((DISABLE BOR))) 63 | 64 | (PROVE-LEMMA A2-E-S-BOR (REWRITE) 65 | (EQUAL (EQUAL (S-BOR X Y) (E)) (EMPTY X)) 66 | ((DISABLE S-BOR A2-EMPTY-S-BOR) (ENABLE EMPTY) 67 | (USE (A2-EMPTY-S-BOR)))) 68 | 69 | (PROVE-LEMMA A2-LP-S-BOR (REWRITE) (EQUAL (LEN (S-BOR X Y)) (LEN X)) 70 | ((DISABLE BOR) (ENABLE LEN))) 71 | 72 | (PROVE-LEMMA A2-LPE-S-BOR (REWRITE) (EQLEN (S-BOR X Y) X) 73 | ((ENABLE EQLEN-IS-EQUAL-LEN) (DISABLE LEN S-BOR))) 74 | 75 | (PROVE-LEMMA A2-IC-S-BOR (REWRITE) 76 | (IMPLIES (EQUAL (LEN X) (LEN Y)) 77 | (EQUAL (S-BOR (I C_X X) (I C_Y Y)) 78 | (I (BOR C_X C_Y) (S-BOR X Y)))) 79 | ((ENABLE I LEN) (DISABLE STR-A-I BOR))) 80 | 81 | (PROVE-LEMMA A2-LC-S-BOR (REWRITE) 82 | (IMPLIES (NOT (EMPTY X)) (EQUAL (L (S-BOR X Y)) (BOR (L X) (L Y)))) 83 | ((DISABLE BOR) (EXPAND (S-BOR X Y)))) 84 | 85 | (PROVE-LEMMA A2-PC-S-BOR (REWRITE) 86 | (EQUAL (P (S-BOR X Y)) (S-BOR (P X) (P Y))) ((DISABLE BOR))) 87 | 88 | (PROVE-LEMMA A2-HC-S-BOR (REWRITE) 89 | (IMPLIES (AND (NOT (EMPTY X)) (EQUAL (LEN X) (LEN Y))) 90 | (EQUAL (H (S-BOR X Y)) (BOR (H X) (H Y)))) 91 | ((DISABLE BOR S-BOR) (ENABLE H LEN) (INDUCT (S-BOR X Y)))) 92 | 93 | (PROVE-LEMMA A2-BC-S-BOR (REWRITE) 94 | (IMPLIES (EQUAL (LEN X) (LEN Y)) 95 | (EQUAL (B (S-BOR X Y)) (S-BOR (B X) (B Y)))) 96 | ((DISABLE BOR) (ENABLE B LEN) (INDUCT (S-BOR X Y)))) 97 | 98 | (PROVE-LEMMA A2-BNC-S-BOR (REWRITE) 99 | (IMPLIES (EQUAL (LEN X) (LEN Y)) 100 | (EQUAL (BN N (S-BOR X Y)) (S-BOR (BN N X) (BN N Y)))) 101 | ((DISABLE BOR S-BOR))) 102 | 103 | ;; A2-End-S-BOR 104 | 105 | ; eof:comb_bor.bm 106 | 107 | 108 | ; BOR-ISA-OR is trivially proved (straight rewrites) and useless because 109 | ; it refers to non-recursive head: bibo ; and in fact it does not trigger 110 | ; in the next theorem. 111 | 112 | (prove-lemma bor-isa-or (rewrite) 113 | (equal (bibo (bor (bobi u) (bobi v))) 114 | (or u v)) 115 | ) 116 | 117 | ; SBOR-ISA-SOR requires induction, and difficulty depends on hypothesis: 118 | ; - when no eqlen hyp is given, requires 16 cases, and non-trivial rewriting 119 | ; for the non-eqlen cases. Time: 41s 120 | ; - with: (equal (len x) (len y)), reduces to 5 cases and 7s, same induction. 121 | ; - with: (eqlen x y), gets better induction scheme, 4 cases and 8s. 122 | ; of course, we keep the theorem in its most general form. 123 | 124 | (prove-lemma sbor-isa-sor (rewrite) 125 | (equal (s-bibo (s-bor (s-bobi x) (s-bobi y))) 126 | (s-or x y)) 127 | ) 128 | 129 | ; some trivial type-checking experiments: 130 | 131 | (prove-lemma bor-0 () 132 | (implies (bitp v) ; necessary of course. 133 | (equal (bor 0 v) 134 | v) 135 | ) 136 | ) 137 | 138 | ; eof: bibo_exp.bm 139 | ;)) 140 | 141 | -------------------------------------------------------------------------------- /nqthm-1992/examples/bronstein/theta.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Alex Bronstein and Carolyn Talcott. All Rights 4 | Reserved. 5 | 6 | You may copy and distribute verbatim copies of this Nqthm-1992 event script as 7 | you receive it, in any medium, including embedding it verbatim in derivative 8 | works, provided that you conspicuously and appropriately publish on each copy 9 | a valid copyright notice "Copyright (C) 1994 by Alex Bronstein and Carolyn 10 | Talcott. All Rights Reserved." 11 | 12 | NO WARRANTY 13 | 14 | Alex Bronstein and Carolyn Talcott PROVIDE ABSOLUTELY NO WARRANTY. THE EVENT 15 | SCRIPT IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR 16 | IMPLIED, INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF 17 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO 18 | THE QUALITY AND PERFORMANCE OF THE SCRIPT IS WITH YOU. SHOULD THE SCRIPT 19 | PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR 20 | CORRECTION. 21 | 22 | IN NO EVENT WILL Alex Bronstein or Carolyn Talcott BE LIABLE TO YOU FOR ANY 23 | DAMAGES, ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR 24 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT 25 | (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE 26 | OR LOSSES SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE 27 | POSSIBILITY OF SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 28 | 29 | |# 30 | 31 | (note-lib "mlp" t) 32 | 33 | ;(setq theta '( 34 | 35 | ; theta.bm 36 | ; This is a 2nd order circuit constructor, derived from all the "Accumulator" 37 | ; examples, as well as the simple counter example. Basically, it arises in 38 | ; a case where the SPEC is easily expressible: as the iteration of "last-char" 39 | ; function which can be expressed only using the input string (x). So in other 40 | ; words, we have a string to char function "last-char" which defines the 41 | ; circuit, for example: the sum of all inputs, the length of input, etc... 42 | ; and we just build the corresponding string function in a "standard" fashion. 43 | ; This standard fashion is the THETA operator. 44 | ; This file just attempts to abstract the construction, and the correctness 45 | ; proof that goes with it, to facilitate future instantiations. 46 | ; 47 | ; Clearly, there is no sugar involved. 48 | ; 49 | ; Standard hints necessary for a PROVE-LEMMA have been removed in the 50 | ; corresponding ADD-AXIOM. 51 | 52 | ;;; DEFINITION OF CIRCUIT: 53 | 54 | (dcl sysd-theta (line x)) 55 | 56 | ;sysd-stringp is normally deduced by BM. 57 | (add-axiom sysd-stringp (rewrite) 58 | (stringp (sysd-theta line x))) 59 | 60 | ;;; SPEC definition: 61 | 62 | (dcl spec-theta-lastchar (x)) 63 | 64 | ; this is the standard extension from last-char-fun to MLP-string-fun. 65 | (defn spec-theta (x) 66 | (if (empty x) 67 | (e) 68 | (A (spec-theta (p x)) 69 | (spec-theta-lastchar x)))) 70 | 71 | ;;; PROOF of equivalence with spec: 72 | 73 | ;;; 2nd order instantiations for circuits: 74 | ;; theta-begin 75 | (add-axiom A2-EMPTY-theta (rewrite) 76 | (equal (empty (sysd-theta line x)) 77 | (empty x)) 78 | ) 79 | 80 | (add-axiom A2-E-theta (rewrite) 81 | (equal (equal (sysd-theta line x) (e)) 82 | (empty x)) 83 | ) 84 | 85 | (add-axiom A2-LP-theta (rewrite) 86 | (equal (len (sysd-theta line x)) 87 | (len x)) 88 | ) 89 | 90 | (add-axiom A2-LPE-theta (rewrite) 91 | (eqlen (sysd-theta line x) x) 92 | ) 93 | 94 | (add-axiom A2-PC-theta (rewrite) 95 | (implies (not (empty x)) 96 | (equal (p (sysd-theta line x)) 97 | (sysd-theta line (p x)) )) 98 | ) 99 | ;; theta-end 100 | 101 | ;;; Circuit CORRECTNESS: 102 | 103 | ; Theta-correct-ax is a "predicative correctness statement",i.e. what we would 104 | ; do if we didn't have functional equality as a specification method, but 105 | ; instead used a purely axiomatic approach. It matches the intuitive view 106 | ; of just looking at the last char. 107 | 108 | (add-axiom theta-correct-ax (rewrite) 109 | (implies (not (empty x)) 110 | (equal (l (sysd-theta 'Ytheta x)) 111 | (spec-theta-lastchar x))) 112 | ; ((expand (sysd-theta 'Ytheta x)) 113 | ; (enable STR-l-I2) ; to get case disjunction BEFORE equality hyp is used.. 114 | ; ) 115 | ) 116 | 117 | ; To go to a functional equality once we have the "last" (ax) statement is 118 | ; a trivial induction, if we start out with an P-L split which is unnatural 119 | ; for BM, so we force it w/ a USE hint of A-p-l-split 120 | 121 | (prove-lemma A-p-l-split () ; USE hints only. 122 | (implies (not (empty x)) 123 | (equal (sysd-theta 'Ytheta x) 124 | (A (p (sysd-theta 'Ytheta x)) 125 | (l (sysd-theta 'Ytheta x)) ))) 126 | ((disable theta-correct-ax a2-pc-theta) 127 | ) 128 | ) 129 | 130 | ; Interestingly: A-P-L needs to be disabled for theta-correct to go through. 131 | ; yet in more specific cases such as macc, or funacc, it is not needed, and 132 | ; in fact just makes a very minor time improvement. 133 | 134 | (prove-lemma theta-correct (rewrite) 135 | (equal (sysd-theta 'Ytheta x) 136 | (spec-theta x)) 137 | ((induct (induct-P x)) 138 | (use (A-p-l-split)) 139 | (disable A-P-L spec-theta-lastchar sysd-theta empty) 140 | ) 141 | ) 142 | 143 | ; eof: theta.bm 144 | ;)) 145 | -------------------------------------------------------------------------------- /nqthm-1992/examples/cowles/intro-eg.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by John Cowles. All Rights Reserved. 4 | 5 | This script is hereby placed in the public domain, and therefore unlimited 6 | editing and redistribution is permitted. 7 | 8 | NO WARRANTY 9 | 10 | John Cowles PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT IS PROVIDED "AS 11 | IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT 12 | NOT LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 13 | PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 14 | SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU ASSUME THE COST OF 15 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16 | 17 | IN NO EVENT WILL John Cowles BE LIABLE TO YOU FOR ANY DAMAGES, ANY LOST 18 | PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES 19 | ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT NOT 20 | LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED 21 | BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF SUCH 22 | DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 23 | 24 | |# 25 | 26 | (BOOT-STRAP NQTHM) 27 | 28 | ; A brief introduction to the 29 | ; Boyer-Moore Theorem Prover 30 | 31 | ; by 32 | ; John R. Cowles 33 | 34 | 35 | ; The theorem prover is a computer program, written in Common Lisp and 36 | ; about one million characters long, under continuous development since 37 | ; 1971 by B.S. Boyer and J S. Moore. The purpose of the program is to 38 | ; mechanize a mathematical logic suitable for the study of computation. 39 | 40 | ; Some data types such as the nonnegative integers and the Boolean truth 41 | ; values are built into the prover. The user may add new recursively 42 | ; defined data types and recursively defined functions on such data 43 | ; types as well as prove theorems. The prover specializes in induction 44 | ; proofs. 45 | 46 | ; The prover uses the prefix syntax of Lisp. For example, the prover 47 | ; uses (PLUS x y) where others might use PLUS( x,y ) or x + y. 48 | 49 | ; As an example, the prover is given the task of proving the following. 50 | 51 | ; The SUM, from k=0 to n, of k*k! 52 | ; equals 53 | ; (n+1)! - 1. 54 | 55 | ; First the theorem prover is initialized and arrangements are made to 56 | ; record the proof as well as other useful information in files by the 57 | ; command (BOOT-STRAP NQTHM) executed at the start of this file. 58 | 59 | ; Recursively define a function that computes n!. 60 | 61 | (DEFN FACT ( N ) 62 | (IF (ZEROP N) 63 | 1 64 | (TIMES N (FACT (SUB1 N))) ) ) 65 | 66 | ; Recursively define a function, called SUM, that computes the 67 | ; sum on the left side of the equation given above. 68 | 69 | (DEFN SUM ( N ) 70 | (IF (ZEROP N) 71 | 0 72 | (PLUS (SUM (SUB1 N)) 73 | (TIMES N (FACT N)) ) ) ) 74 | 75 | ; The formal argument of each of these functions is N. The functions 76 | ; IF, ZEROP, TIMES, SUB1, PLUS, FACT, and SUM give the 77 | ; following results when y and z are nonnegative integers. 78 | 79 | ; (IF x y z) returns y if x <> false 80 | ; z if x = false 81 | 82 | ; (ZEROP y) returns true if y = 0 83 | ; false if y <> 0 84 | 85 | ; (TIMES y z) returns y * z 86 | 87 | ; (SUB1 y) returns y - 1 if y > 0 88 | ; 0 if y = 0 89 | 90 | ; (PLUS y z) returns y + z 91 | 92 | ; (FACT y) returns y! 93 | 94 | ; (SUM y) returns the SUM, from k=0 to y, of k*k! 95 | 96 | ; Before the prover will accept these proposed recursive definitions for 97 | ; the functions, FACT and SUM, the recursion must be proved to 98 | ; terminate. That is, the prover verifies that functions actually exist 99 | ; that satisfy the proposed definitions. 100 | 101 | ; Next the prover is asked to prove the following trivial algebraic 102 | ; modification of the theorem originally suggested above. 103 | 104 | ; The SUM, from k=0 to n, of k*k! 105 | ; plus 1 106 | ; 107 | ; equals 108 | ; 109 | ; (n+1)!. 110 | 111 | ; The results produced by the functions EQUAL and ADD1 are given below. 112 | 113 | ; (EQUAL x y) returns true if x = y 114 | ; false if x <> y 115 | 116 | ; (ADD1 y) returns y + 1 117 | 118 | 119 | (PROVE-LEMMA SUM+1=FACT 120 | NIL 121 | (EQUAL (ADD1 (SUM N)) 122 | (FACT (ADD1 N)) ) ) 123 | 124 | ; After some simplification, the prover decides to use induction in the 125 | ; proof of this lemma. 126 | 127 | ; Now the prover is asked to prove the original version of the theorem. 128 | ; The prover is informed that the theorem just proved is a useful hint. 129 | 130 | (PROVE-LEMMA SUM=FACT-1 131 | NIL 132 | (EQUAL (SUM N) 133 | (SUB1 (FACT (ADD1 N))) ) 134 | ; Hint: 135 | ( (USE (SUM+1=FACT ( N N))) ) ) 136 | 137 | ; With the hint, the prover has no trouble completing the proof. 138 | 139 | ; The previous two lemmas together produce a proof by induction which 140 | ; should be easy to follow by a person new to the theorem prover. 141 | ; However, the hint is not needed by the prover to complete the proof of 142 | ; the original theorem. Let's start over and this time let the prover 143 | ; work directly on the last lemma without first proving the first lemma. 144 | 145 | (UBT SUM+1=FACT) 146 | 147 | (PROVE-LEMMA SUM=FACT-1 148 | NIL 149 | (EQUAL (SUM N) 150 | (SUB1 (FACT (ADD1 N))) ) 151 | ; No hint this time! 152 | ) 153 | 154 | ; This produces a mechanical proof that is much longer and no doubt more 155 | ; mysterious to a new user of the prover. It is also more interesting. 156 | ; There is an induction inside an induction, some use of elimination, 157 | ; and also some generalization. The details of the theorem prover, 158 | ; including induction, elimination, and generalization, are explained in: 159 | ; R.S. Boyer and J S. Moore, A Computational Logic Handbook. Academic 160 | ; Press, San Diego, 1988. 161 | 162 | 163 | -------------------------------------------------------------------------------- /nqthm-1992/examples/dir.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | This file is in no way necessary for the correct operation of Nqthm-1992 but 4 | merely serves as a convenience for the user wishing to automate the process of 5 | running the more than one hundred Nqthm-1992 example files. 6 | 7 | Unlike any of the other files distributed with Nqthm-1992, it is expected that 8 | a user may well need to edit this file in order to indicate the directories 9 | where Nqthm files are located. In particular, the user may need to change the 10 | three DEFPARAMETER forms below. 11 | 12 | Nqthm-1992 works for a variety of Common Lisps and operating systems. The 13 | Nqthm-1992 code is Lisp implementation and operating system independent. 14 | However, the organization of the more than one hundred Nqthm-1992 example files 15 | into subdirectories has necessitated code for identifying subdirectories, which 16 | code may introduce Lisp, operating system, and site specific information. See 17 | the file `driver.lisp' for further details. 18 | 19 | The following three Lisp variable settings identify directory names and may 20 | need to be different at different sites, especially at non-Unix sites. The 21 | particular settings below are relevant for a Unix process whose `connected' 22 | directory is an `examples' directory that (1) contains the subdirectory `yu' 23 | and that (2) has the Nqthm-1992 source directory as its superior. On some 24 | operating systems, such as the Macintosh native operating system, we recommend 25 | that full, absolute pathnames be used below instead of Unix-style relative 26 | pathnames. 27 | 28 | |# 29 | 30 | (SETQ *THM-SUPPRESS-DISCLAIMER-FLG* T) 31 | 32 | (FORMAT *STANDARD-OUTPUT* "~%Loading dir.lisp.") 33 | 34 | (IN-PACKAGE "USER") 35 | 36 | ; It is important that the strings end in the character that separates 37 | ; subdirectory components, e.g., / on Unix, > on Symbolics, and : on 38 | ; Macintosh. 39 | 40 | (LET ((*PRINT-PRETTY* T) 41 | (FORM '(PROGN 42 | 43 | ; The examples subdirectory directory, for use in driver.lisp. 44 | 45 | (DEFPARAMETER *NQTHM-EXAMPLES-DIR* "./") 46 | 47 | ; The directory where defn-sk and the Nqthm-1992 sources are located, for use 48 | ; in driver-sk.lisp. 49 | 50 | (DEFPARAMETER *NQTHM-SOURCE-DIR* "../") 51 | 52 | ; The directory where the defn-sk examples are, for use in driver-sk.lisp. 53 | 54 | (DEFPARAMETER *NQTHM-YU-DIR* "./yu/") 55 | 56 | (DEFPARAMETER *NQTHM-YOUNG-DIR* "./young/")))) 57 | 58 | (FORMAT *STANDARD-OUTPUT* 59 | "~%Evaluating this form: ~%") 60 | (PRINT FORM) 61 | (EVAL FORM)) 62 | 63 | (FORMAT *STANDARD-OUTPUT* "~%Finished loading dir.lisp.") 64 | 65 | (FORCE-OUTPUT *STANDARD-OUTPUT*) 66 | -------------------------------------------------------------------------------- /nqthm-1992/examples/flatau/README: -------------------------------------------------------------------------------- 1 | The files in this directory are the work of A. Flatau of Computational 2 | Logic, Inc. They contain work found in Appendicies C, D, E, and F of 3 | 4 | @PhDThesis(Flatau-92, 5 | key="Flatau", 6 | author="A. Flatau", 7 | title="A Verified Implementation of an Applicative 8 | Language with Dynamic Storage Allocation", 9 | school="University of Texas", 10 | year="1992", 11 | Note="Also available through Computational Logic, Inc., 12 | Suite 290, 1717 West Sixth Street, Austin, TX 78703.") 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/README: -------------------------------------------------------------------------------- 1 | In this directory `fm9001-piton' are the source files for the basic 2 | components of `Clinc stack', a hierarchy of computing systems implemented 3 | upon one another in a rigorously verified manner. The basic components are 4 | the FM9001 microprocessor, the Piton compiler, and some example programs that 5 | exercise the microprocessor and compiler. The source files include not only 6 | the implementation details of the systems but also the Nqthm-checked proof 7 | scripts. 8 | 9 | 1. The input file `fm9001-replay.events' (work of Bishop Brock and Warren 10 | Hunt, with contributions from Matt Kaufmann) was produced mechanically from the 11 | original FM9001 Nqthm work, which may be found in its entirety in the 12 | subdirectory `fm9001'. Execution of the form (library-to-events "fm9001") in 13 | the file `fm9001/sysdef.lisp' produced the file `fm9001-replay.events'. 14 | 15 | Note of explanation: the FM9001 work was not originally written as a 16 | collection of ordinary *.event files, but rather included a number of 17 | Common Lisp programs to help create the desired Nqthm events. The 18 | virtue of the file `fm9001-replay.events' is that it can be processed 19 | by the Nqthm-1992 function `prove-file', like all the other Nqthm-1992 20 | example event files. 21 | 22 | 2. The file `piton.events' (work of J Moore) contains the definition 23 | and the proof of correctness of the Piton assembler/compiler. Piton 24 | targets the FM9001 microprocessor, and so builds upon the file 25 | `fm9001.events'. 26 | 27 | 3. The file `big-add.events' (work of J Moore) is an example 28 | correctness proof of a program written in Piton. This example builds 29 | on the file `piton.events'. 30 | 31 | 4. The file `nim-piton.events' (work of Matt Wilding) is the proof of the 32 | correctness of a Nim-playing program written in Piton. It also builds 33 | on `piton.events'. 34 | 35 | Other components of the Clinc stack built on Piton may be found in: 36 | 37 | 1. The Micro-Gypsy work of Young in the Pc-Nqthm-1992 distribution. 38 | See the directory `examples/mg' in the Pc-Nqthm-1992 distribution. 39 | 40 | 2. The work of Flatau in the Nqthm-1992 distribution. See the 41 | directory `examples/flatau' in the Nqthm-1992 distribution. 42 | 43 | It is a pity that we have not yet connected these works to the FM9001 44 | and Piton work in this directory in a smooth, mechanical way. 45 | Currently, the works of Flatau and Young each start with a private 46 | definition of Piton which `we believe' is equivalent to the one given 47 | on this directory. 48 | 49 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/FM9001.announcement: -------------------------------------------------------------------------------- 1 | The FM9001 Microprocessor: 2 | Its Formal Specification and 3 | Mechanical Correctness Proof 4 | 5 | We are releasing the mechanically checked proof scripts for the FM9001 6 | microprocessor. The FM9001 is a general-purpose 32-bit microprocessor 7 | which has been implemented as a CMOS ASIC. The proof being released 8 | rigorously connects the expression of the FM9001 as a netlist with the 9 | characterization of the FM9001 at the machine-code programmer's level. 10 | (The FM9001 is the foundation of the `CLI Stack', which also includes 11 | several verified compilers and applications all running on the FM9001. 12 | Other parts of the `CLI Stack' are separately released.) 13 | 14 | To obtain information about the FM9001 microprocessor and proof, 15 | please examine the URL http://www.cli.com/hardware/fm9001.html 16 | 17 | To obtain the FM9001 system, connect to Internet site ftp.cli.com by 18 | anonymous ftp, giving your email address as the password, `get' the 19 | file /pub/fm9001/README and follow the instructions therein. Or get 20 | the URL ftp://ftp.cli.com/pub/fm9001/README via your WWW browser. 21 | 22 | Bishop C. Brock and Warren A. Hunt, Jr. 23 | brock@cli.com hunt@cli.com 24 | Spring 1995 25 | 26 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/LICENSE: -------------------------------------------------------------------------------- 1 | FM9001 PUBLIC SOFTWARE LICENSE 2 | Computational Logic, Inc. 3 | 1717 West Sixth, Suite 290 4 | Austin, Texas 78703-4776 5 | 6 | Please read this license carefully before using the FM9001 Software. By using 7 | the FM9001 Software, you are agreeing to be bound by the terms of this 8 | license. If you do not agree to the terms of this license, promptly return the 9 | FM9001 Software to the place where you obtained it. 10 | 11 | The FM9001 Software was developed by Computational Logic, Inc.(CLI). You own 12 | the disk or other medium on which the FM9001 Software is recorded, but CLI 13 | retains title to the FM9001 Software. The purposes of this license are to 14 | identify the FM9001 Software and to make the FM9001 Software, including its 15 | source code, freely available. This license allows you to use, copy, 16 | distribute and modify the FM9001 Software, on the condition that you comply 17 | with all the Copying Policies set out below. 18 | 19 | COPYING POLICIES 20 | 21 | 1. You may copy and distribute verbatim copies of the FM9001 Software as you 22 | receive it, in any medium, including embedding it verbatim in derivative 23 | works, provided that you a) conspicuously and appropriately publish on each 24 | copy a valid copyright notice "Copyright (C) 1990-1994 by Computational Logic, 25 | Inc. All Rights Reserved.", b) keep intact on all files the notices that refer 26 | to this License Agreement and to the absence of any warranty, and c) give all 27 | recipients of the FM9001 Software a copy of this License Agreement along with 28 | the program. 29 | 30 | 2. You may modify your copy or copies of the FM9001 Software or any portion of 31 | it, and copy and distribute such modifications provided you tell recipients 32 | that what they have is a modification by your organization of the CLI version 33 | of the FM9001 Software. 34 | 35 | 3. You may incorporate parts of the FM9001 Software into other programs 36 | provided that you acknowledge Computational Logic Inc. in the program 37 | documentation. 38 | 39 | CLI also requests, but does not require, that any improvements or extensions 40 | to the FM9001 Software be returned to one of the addresses below, so that they 41 | may be shared with other FM9001 users. The FM9001 Software, including its 42 | source, can be obtained by contacting one of these addresses. 43 | 44 | Software-Request or Software-Request@CLI.COM 45 | Computational Logic Inc. 46 | 1717 West Sixth, Suite 290 47 | Austin, TX 78703-4776 48 | 49 | NO WARRANTY 50 | 51 | BECAUSE THE FM9001 SOFTWARE IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY 52 | NO WARRANTY. THE SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, 53 | EITHER EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED 54 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 55 | ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. 56 | SHOULD THE FM9001 SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL 57 | NECESSARY SERVICING, REPAIR OR CORRECTION. 58 | 59 | IN NO EVENT WILL COMPUTATIONAL LOGIC INC. BE LIABLE TO YOU FOR ANY DAMAGES, 60 | ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL 61 | DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE FM9001 SOFTWARE 62 | (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE 63 | OR LOSSES SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE 64 | POSSIBILITY OF SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 65 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/bags.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | (BOOT-STRAP NQTHM) 6 | 7 | (DEFN DELETE (X L) 8 | (IF (LISTP L) 9 | (IF (EQUAL X (CAR L)) 10 | (CDR L) 11 | (CONS (CAR L) (DELETE X (CDR L)))) 12 | L)) 13 | 14 | (DEFN BAGDIFF (X Y) 15 | (IF (LISTP Y) 16 | (IF (MEMBER (CAR Y) X) 17 | (BAGDIFF (DELETE (CAR Y) X) (CDR Y)) 18 | (BAGDIFF X (CDR Y))) 19 | X)) 20 | 21 | (DEFN BAGINT (X Y) 22 | (IF (LISTP X) 23 | (IF (MEMBER (CAR X) Y) 24 | (CONS (CAR X) 25 | (BAGINT (CDR X) (DELETE (CAR X) Y))) 26 | (BAGINT (CDR X) Y)) 27 | NIL)) 28 | 29 | (DEFN OCCURRENCES 30 | (X L) 31 | (IF (LISTP L) 32 | (IF (EQUAL X (CAR L)) 33 | (ADD1 (OCCURRENCES X (CDR L))) 34 | (OCCURRENCES X (CDR L))) 35 | 0)) 36 | 37 | (DEFN SUBBAGP (X Y) 38 | (IF (LISTP X) 39 | (IF (MEMBER (CAR X) Y) 40 | (SUBBAGP (CDR X) (DELETE (CAR X) Y)) 41 | F) 42 | T)) 43 | 44 | (LEMMA LISTP-DELETE (REWRITE) 45 | (EQUAL (LISTP (DELETE X L)) 46 | (IF (LISTP L) 47 | (OR (NOT (EQUAL X (CAR L))) 48 | (LISTP (CDR L))) 49 | F)) 50 | ((ENABLE DELETE) 51 | (INDUCT (DELETE X L)))) 52 | 53 | (disable listp-delete) 54 | 55 | (LEMMA DELETE-NON-MEMBER (REWRITE) 56 | (IMPLIES (NOT (MEMBER X Y)) 57 | (EQUAL (DELETE X Y) Y)) 58 | ((ENABLE DELETE))) 59 | 60 | (LEMMA DELETE-DELETE (REWRITE) 61 | (EQUAL (DELETE Y (DELETE X Z)) 62 | (DELETE X (DELETE Y Z))) 63 | ((ENABLE DELETE DELETE-NON-MEMBER))) 64 | 65 | (lemma equal-occurrences-zero (rewrite) 66 | (equal (equal (occurrences x l) 0) 67 | (not (member x l))) 68 | ((enable occurrences))) 69 | 70 | (LEMMA MEMBER-NON-LIST (REWRITE) 71 | (IMPLIES (NOT (LISTP L)) 72 | (NOT (MEMBER X L)))) 73 | 74 | (lemma member-delete (rewrite) 75 | (equal (member x (delete y l)) 76 | (if (member x l) 77 | (if (equal x y) 78 | (lessp 1 (occurrences x l)) 79 | t) 80 | f)) 81 | ((enable delete occurrences))) 82 | 83 | 84 | (LEMMA MEMBER-DELETE-IMPLIES-MEMBERSHIP (REWRITE) 85 | (IMPLIES (MEMBER X (DELETE Y L)) 86 | (MEMBER X L)) 87 | ((ENABLE DELETE))) 88 | 89 | (LEMMA OCCURRENCES-DELETE (REWRITE) 90 | (EQUAL (OCCURRENCES X (DELETE Y L)) 91 | (IF (EQUAL X Y) 92 | (IF (MEMBER X L) 93 | (SUB1 (OCCURRENCES X L)) 94 | 0) 95 | (OCCURRENCES X L))) 96 | ((ENABLE OCCURRENCES DELETE EQUAL-OCCURRENCES-ZERO))) 97 | 98 | (LEMMA MEMBER-BAGDIFF (REWRITE) 99 | (EQUAL (MEMBER X (BAGDIFF A B)) 100 | (LESSP (OCCURRENCES X B) 101 | (OCCURRENCES X A))) 102 | ((ENABLE BAGDIFF OCCURRENCES EQUAL-OCCURRENCES-ZERO 103 | OCCURRENCES-DELETE))) 104 | 105 | (lemma bagdiff-delete (rewrite) 106 | (equal (bagdiff (delete e x) y) 107 | (delete e (bagdiff x y))) 108 | ((enable BAGDIFF DELETE 109 | DELETE-DELETE 110 | DELETE-NON-MEMBER 111 | MEMBER-BAGDIFF 112 | MEMBER-DELETE 113 | OCCURRENCES-DELETE))) 114 | 115 | 116 | (LEMMA SUBBAGP-DELETE (REWRITE) 117 | (IMPLIES (SUBBAGP X (DELETE U Y)) 118 | (SUBBAGP X Y)) 119 | ((ENABLE DELETE SUBBAGP DELETE-DELETE 120 | MEMBER-DELETE-IMPLIES-MEMBERSHIP))) 121 | 122 | (LEMMA SUBBAGP-CDR1 (REWRITE) 123 | (IMPLIES (SUBBAGP X Y) 124 | (SUBBAGP (CDR X) Y)) 125 | ((ENABLE SUBBAGP SUBBAGP-DELETE))) 126 | 127 | (LEMMA SUBBAGP-CDR2 (REWRITE) 128 | (IMPLIES (SUBBAGP X (CDR Y)) 129 | (SUBBAGP X Y)) 130 | ((ENABLE DELETE SUBBAGP DELETE-NON-MEMBER SUBBAGP-CDR1))) 131 | 132 | (LEMMA SUBBAGP-BAGINT1 (REWRITE) 133 | (SUBBAGP (BAGINT X Y) X) 134 | ((ENABLE DELETE SUBBAGP BAGINT SUBBAGP-CDR2))) 135 | 136 | (LEMMA SUBBAGP-BAGINT2 (REWRITE) 137 | (SUBBAGP (BAGINT X Y) Y) 138 | ((ENABLE SUBBAGP BAGINT SUBBAGP-CDR2))) 139 | 140 | (prove-lemma occurrences-bagint 141 | (rewrite) 142 | (equal (occurrences x (bagint a b)) 143 | (if (lessp (occurrences x a) 144 | (occurrences x b)) 145 | (occurrences x a) 146 | (occurrences x b))) 147 | ((enable occurrences bagint equal-occurrences-zero 148 | occurrences-delete))) 149 | 150 | (prove-lemma occurrences-bagdiff 151 | (rewrite) 152 | (equal (occurrences x (bagdiff a b)) 153 | (difference (occurrences x a) 154 | (occurrences x b))) 155 | ((enable occurrences bagdiff equal-occurrences-zero 156 | occurrences-delete))) 157 | 158 | (prove-lemma member-bagint 159 | (rewrite) 160 | (equal (member x (bagint a b)) 161 | (and (member x a) (member x b))) 162 | ((enable bagint member-delete))) 163 | 164 | (deftheory bags 165 | (occurrences-bagint 166 | bagdiff-delete 167 | occurrences-bagdiff 168 | member-bagint 169 | member-bagdiff 170 | subbagp-bagint2 171 | subbagp-bagint1 172 | subbagp-cdr2 173 | subbagp-cdr1 174 | subbagp-delete)) 175 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/do-events-recursive.lisp: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | (in-package "USER") 6 | 7 | (defun do-events-recursive (ev) 8 | (let (undone-events) 9 | (do-events ev))) 10 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/do-files.lisp: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | (in-package "USER") 6 | 7 | (defun safe-cadr (x) 8 | (and (consp x) 9 | (consp (cdr x)) 10 | (cadr x))) 11 | 12 | (defun library-filename (filename) 13 | (let ((pathname (pathname filename))) 14 | (namestring (make-pathname :host (pathname-host pathname) 15 | :device (pathname-device pathname) 16 | :directory (pathname-directory pathname) 17 | :name (pathname-name pathname))))) 18 | 19 | (defun make-lib-conditional (filename save? compile?) 20 | ; Do a MAKE-LIB and compile the resulting .lisp file depending on 21 | ; the value of the flags SAVE? and COMPILE? 22 | (cond (save? (make-lib filename) 23 | (cond (compile? 24 | (proclaim-nqthm-file filename) 25 | (compile-file 26 | (extend-file-name filename 27 | file-extension-lisp))))))) 28 | 29 | (defun do-files (infiles &optional (save nil) (compile nil)) 30 | ;; This does a sequence of files, stopping the first time a failed 31 | ;; event is encountered. If the flag SAVE is set, a library is saved 32 | ;; at the end of each file. If the flag SAVE is set and the flag COMPILE 33 | ;; is set, then the saved lisp file is compiled. 34 | (if (every #'probe-file infiles) 35 | (iterate for infile in infiles 36 | do (cond ((do-file infile) 37 | (make-lib-conditional (library-filename infile) 38 | save compile)) 39 | (t (make-lib-conditional (library-filename infile) 40 | save compile) 41 | (return nil))) 42 | finally (return t)) 43 | (format t "~%*** File ~a not found. ***" 44 | (some (function (lambda (x) (and (not (probe-file x)) x))) 45 | infiles)))) 46 | 47 | (DEFUN DO-FILE (INFILE &optional start-name) 48 | 49 | ;; patched so that one can specify the event at which one wants to begin 50 | 51 | ; This function executes each of the event commands in the file INFILE. 52 | ; The events are top level forms in the file. It prints 53 | ; each event form to PROVE-FILE and then executes it, accumulating the total 54 | ; event times and printing the event names to the terminal if the output is 55 | ; going elsewhere. It aborts if some event causes an error or fails. It 56 | ; prints the system configuration and the accumulated times at the end of 57 | ; PROVE-FILE. It returns T if all events succeeded and NIL if some failed. 58 | 59 | (WITH-OPEN-FILE (INSTREAM (EXTEND-FILE-NAME INFILE NIL) 60 | :DIRECTION :INPUT 61 | :IF-DOES-NOT-EXIST :ERROR) 62 | (LET (ANS FORM) 63 | (PROG NIL 64 | 65 | (when start-name 66 | (loop (setq form (READ INSTREAM NIL A-VERY-RARE-CONS)) 67 | (COND ((EQ FORM A-VERY-RARE-CONS) 68 | (RETURN T))) 69 | (when (eq (safe-cadr form) start-name) 70 | (go run-form)))) 71 | LOOP 72 | (SETQ FORM (READ INSTREAM NIL A-VERY-RARE-CONS)) 73 | run-form 74 | 75 | (COND ((EQ FORM A-VERY-RARE-CONS) 76 | (RETURN T))) 77 | 78 | ; Print out the event form to PROVE-FILE and, if PROVE-FILE is not the 79 | ; terminal, print the name to the terminal 80 | 81 | (ITERPRIN 1 PROVE-FILE) 82 | (IPRINC EVENT-SEPARATOR-STRING PROVE-FILE) 83 | (ITERPRIN 2 PROVE-FILE) 84 | (PPRIND FORM 0 0 PROVE-FILE) 85 | (ITERPRI PROVE-FILE) 86 | (COND ((NOT (EQ PROVE-FILE NIL)) 87 | (IPRINC (safe-CADR FORM) NIL))) 88 | 89 | ; Evaluate the event form 90 | 91 | (SETQ ANS (ERROR1-SET (EVAL FORM))) 92 | (COND ((NULL ANS) 93 | 94 | ; A SOFT ERROR1 occurred during the evaluation. Perhaps we should 95 | ; let the user edit the form, but we have no standard editor in the 96 | ; system. 97 | 98 | (RETURN NIL))) 99 | 100 | ; Recover the actual value from the CONS produced by the ERROR1-SET 101 | ; protection 102 | 103 | (SETQ ANS (CAR ANS)) 104 | 105 | ; Print the answer to PROVE-FILE and, if PROVE-FILE is not the terminal, 106 | ; print a comma or the failure message, as appropriate, to the terminal 107 | ; to indicate completion of the event. 108 | 109 | (ITERPRI PROVE-FILE) 110 | (IPRINC ANS PROVE-FILE) 111 | (COND ((NOT (EQ PROVE-FILE NIL)) 112 | (COND ((EQ ANS NIL) 113 | (ITERPRI NIL) 114 | (IPRINC FAILURE-MSG NIL) 115 | (ITERPRI NIL)) 116 | (T (IPRINC (QUOTE |,|) NIL) 117 | (COND ((< (OUR-LINEL NIL NIL) 118 | (IPOSITION NIL NIL NIL)) 119 | (ITERPRI NIL))))))) 120 | 121 | ; Exit if the command failed. 122 | 123 | (COND ((EQ ANS NIL) (RETURN NIL))) 124 | 125 | ; Otherwise, continue looping. 126 | 127 | (GO LOOP))))) 128 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/dual-port-ram.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; DUAL-PORT-RAM.EVENTS 8 | ;;; 9 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 10 | ;;; 11 | ;;; This file contains a model of a dual-port ram: 12 | ;;; 13 | ;;; (DUAL-PORT-RAM-VALUE bits address-lines args state) 14 | ;;; 15 | ;;; returns the RAM output, i.e., the contents of the memory addressed by the 16 | ;;; read-adress port. 17 | ;;; 18 | ;;; (DUAL-PORT-RAM-STATE bits address-lines args state) 19 | ;;; 20 | ;;; updates the state of the RAM. 21 | ;;; 22 | ;;; The ARGS are assumed to be structured as follows: 23 | ;;; 24 | ;;; 0..(ADDRESS-LINES - 1) -- A (read port) address. 25 | ;;; ADDRESS-LINES..(2*ADDRESS-LINES - 1) -- B (write port) address. 26 | ;;; (2*ADDRESS-LINES) -- WEN, active low. 27 | ;;; remainder -- DATA lines. 28 | ;;; 29 | ;;; WARNING -- This is a sequential model of what is essentially a 30 | ;;; level-sensitive device. Note that this state-holding device has no clock 31 | ;;; input. Spikes on WEN, or changes on B-ADDRESS while WEN is active may 32 | ;;; cause unanticipated changes in the memory state of the real device. 33 | ;;; 34 | ;;; The dual-port RAM used in the register file of the FM9001 is surrounded 35 | ;;; by sequential logic that ensures that setup and hold constraints are met. 36 | ;;; See the file "regfile.events". 37 | 38 | (defn dual-port-ram-value (bits address-lines args state) 39 | (let ((a-address (subrange args 0 (sub1 address-lines))) 40 | (b-address (subrange args address-lines 41 | (sub1 (times 2 address-lines)))) 42 | (wen (nth (times 2 address-lines) args))) 43 | ;; If the read address is unknown, or the device is potentially write 44 | ;; enabled and there is a potential write at the read address, then read 45 | ;; out X's. Otherwise, read out the vector from the STATE. 46 | (if (or (not (bvp a-address)) 47 | (and (not (equal wen t)) 48 | (or (not (bvp b-address)) 49 | (equal a-address b-address)))) 50 | (make-list bits (x)) 51 | (let ((val (read-mem a-address state))) 52 | (if (and (properp val) 53 | (equal (length val) bits)) 54 | val 55 | ;; Return an unknown proper list of the right length if we don't read 56 | ;; a proper list of the right length. 57 | (make-list bits (x))))))) 58 | 59 | (defn dual-port-ram-state (bits address-lines args state) 60 | (let ((b-address (subrange args address-lines 61 | (sub1 (times 2 address-lines)))) 62 | (wen (nth (times 2 address-lines) args)) 63 | ;; Use SUBRANGE instead of RESTN so that we are guaranteed 64 | ;; that this argument has the right length and is a PROPERP. 65 | ;; Note that we use bits below rather than (length args) 66 | ;; in order to ensure that data has the right length. 67 | (data 68 | (subrange args 69 | (add1 (times 2 address-lines)) 70 | (plus (times 2 address-lines) bits)))) 71 | ;; If WEN is solidly high, do nothing. 72 | (if (equal wen t) 73 | state 74 | ;; There is a potential write. If the address is unknown, wipe out the 75 | ;; state. 76 | (if (not (bvp b-address)) 77 | (constant-ram state (make-list bits (x))) 78 | ;; If WEN is solidly low, update the state with data, otherwise X out 79 | ;; the addressed entry. 80 | (if (equal wen f) 81 | (write-mem b-address state data) 82 | (write-mem b-address state (make-list bits (x)))))))) 83 | 84 | ;;; LEMMAS 85 | 86 | (prove-lemma properp-length-dual-port-ram-value (rewrite) 87 | (and 88 | (properp (dual-port-ram-value bits address-lines args state)) 89 | (equal (length (dual-port-ram-value bits address-lines args state)) 90 | (fix bits)))) 91 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/examples.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; EXAMPLES.EVENTS 8 | ;;; 9 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 10 | 11 | ;;; FULL-ADDER example. 12 | 13 | (defn half-adder* () 14 | '(half-adder 15 | (a b) 16 | (sum carry) 17 | ((g0 (sum) b-xor (a b)) 18 | (g1 (carry) b-and (a b))) 19 | nil)) 20 | 21 | (module-netlist half-adder*) 22 | (module-predicate half-adder*) 23 | 24 | (prove-lemma half-adder$value (rewrite) 25 | (implies 26 | (half-adder& netlist) 27 | (equal (dual-eval 0 'half-adder (list a b) state netlist) 28 | (list (f-xor a b) 29 | (f-and a b)))) 30 | ;;Hint 31 | ((enable half-adder& b-xor$value b-and$value))) 32 | 33 | (disable half-adder$value) 34 | 35 | (defn full-adder* () 36 | '(full-adder 37 | (a b c) 38 | (sum carry) 39 | ((t0 (sum1 carry1) half-adder (a b)) 40 | (t1 (sum carry2) half-adder (sum1 c)) 41 | (t2 (carry) b-or (carry1 carry2))) 42 | nil)) 43 | 44 | (module-netlist full-adder*) 45 | (module-predicate full-adder*) 46 | 47 | (defn f$full-adder (a b c) 48 | (list (f-xor (f-xor a b) c) 49 | (f-or (f-and a b) 50 | (f-and (f-xor a b) c)))) 51 | 52 | (prove-lemma full-adder$value (rewrite) 53 | (implies 54 | (full-adder& netlist) 55 | (equal (dual-eval 0 'FULL-ADDER (list a b c) state netlist) 56 | (f$full-adder a b c))) 57 | ;;Hint 58 | ((enable full-adder& half-adder$value b-or$value))) 59 | 60 | (defn full-adder (a b c) 61 | (list (b-xor3 a b c) 62 | (b-or (b-and a (b-or b c)) 63 | (b-and b c)))) 64 | 65 | (prove-lemma f$full-adder=full-adder (rewrite) 66 | (implies 67 | (and (boolp a) (boolp b) (boolp c)) 68 | (equal (f$full-adder a b c) 69 | (full-adder a b c)))) 70 | 71 | ;;; M1/M2 example. 72 | 73 | (defn m1* () 74 | '(m1 75 | (clk en sel d q) 76 | (q) 77 | ((mux (b) b-if (sel d q)) 78 | (latch (a an) fd1 (b clk)) 79 | (tbuf (q) t-buf (en a))) 80 | latch)) 81 | 82 | (module-netlist m1*) 83 | (module-predicate m1*) 84 | 85 | (prove-lemma m1$value (rewrite) 86 | (implies 87 | (m1& netlist) 88 | (equal (dual-eval 0 'M1 (list clk en sel d q) state netlist) 89 | (list (ft-buf en state)))) 90 | ;;Hint 91 | ((enable m1& b-if$value fd1$value t-buf$value ft-buf f-buf))) 92 | 93 | (disable m1$value) 94 | 95 | (prove-lemma m1$state (rewrite) 96 | (implies 97 | (m1& netlist) 98 | (equal (dual-eval 2 'M1 (list clk en sel d q) state netlist) 99 | (f-if sel d q))) 100 | ;;Hint 101 | ((enable m1& b-if$value fd1$value fd1$state t-buf$value f-if ft-buf f-buf))) 102 | 103 | (disable m1$state) 104 | 105 | (defn m2* () 106 | '(m2 107 | (clk en0 en1 sel0 sel1 d0 d1) 108 | (q) 109 | ((occ0 (q0) m1 (clk en0 sel0 d0 q)) 110 | (occ1 (q1) m1 (clk en1 sel1 d1 q)) 111 | (wire (q) t-wire (q0 q1))) 112 | (occ0 occ1))) 113 | 114 | (module-netlist m2*) 115 | (module-predicate m2*) 116 | 117 | (prove-lemma m2$value (rewrite) 118 | (implies 119 | (m2& netlist) 120 | (equal (dual-eval 0 'M2 121 | (list clk en0 en1 sel0 sel1 d0 d1) state netlist) 122 | (list (ft-wire (ft-buf en0 (car state)) 123 | (ft-buf en1 (cadr state)))))) 124 | ;;Hint 125 | ((enable m2& m1$value m1$state t-wire$value))) 126 | 127 | (disable m2$value) 128 | 129 | (prove-lemma m2$state (rewrite) 130 | (implies 131 | (m2& netlist) 132 | (equal (dual-eval 2 'M2 133 | (list clk en0 en1 sel0 sel1 d0 d1) state netlist) 134 | (let ((q (ft-wire (ft-buf en0 (car state)) 135 | (ft-buf en1 (cadr state))))) 136 | (list (f-if sel0 d0 q) (f-if sel1 d1 q))))) 137 | ;;Hint 138 | ((enable m2& m1$value m1$state t-wire$value))) 139 | 140 | (disable m2$state) 141 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/expand.lisp: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; EXPAND.LISP 8 | ;;; 9 | ;;; EXPAND is a way to use the NQTHM rewriter to rewrite terms, for example 10 | ;;; to provide the right hand side of complicated lemmas. 11 | ;;; 12 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 13 | 14 | (in-package "USER") 15 | 16 | (defun expand (form &optional (hyps '(true)) hints) 17 | (chk-init) 18 | (let ((dummy-var (gentemp)) 19 | term clauses answer last-literal lhs rhs expansion) 20 | ;; Check the term and hints. 21 | (setf term (translate-and-chk `(IMPLIES ,hyps (EQUAL ,form ,dummy-var)))) 22 | (match! (chk-acceptable-hints hints) 23 | (list hints)) 24 | (unless (iterate for hint in hints 25 | always (member (car hint) 26 | '(enable disable enable-theory disable-theory 27 | no-built-in-arith expand hands-off))) 28 | (error "The only allowable hints are ENABLE, DISABLE, ENABLE-THEORY, ~ 29 | DISABLE-THEORY, NO-BUILT-IN-ARITH and HANDS-OFF.")) 30 | ;; We now simplify. 31 | (unwind-protect 32 | (progn 33 | (setf term (apply-hints hints term)) 34 | (setf clauses (preprocess term)) 35 | (unless (equal (length clauses) 1) 36 | (error "Clausification of the original input ~ 37 | returned multiple clauses. ~%~s" clauses)) 38 | (setup form clauses abbreviations-used) 39 | (simplify-clause-maximally (car clauses)) 40 | (when (and (not (equal (length process-clauses) 1)) 41 | (not (iterate for (clause . rest) on process-clauses 42 | when (consp rest) 43 | always (equal (car (last clause)) 44 | (car (last (car rest))))))) 45 | (format t 46 | "Simplification returned multiple (~d) ~ 47 | unequivalent clauses.~%" (length process-clauses)) 48 | (iterate for clause in process-clauses 49 | do (progn (pprint (prettyify-clause clause)) (terpri))) 50 | (error "Too many clauses.")) 51 | (setf answer (car process-clauses)) 52 | (setf last-literal (car (last answer))) 53 | (unless (and (match last-literal (equal lhs rhs)) 54 | (or (progn (setf expansion lhs) 55 | (eq rhs dummy-var)) 56 | (progn (setf expansion rhs) 57 | (eq lhs dummy-var)))) 58 | (error "The resulting clause does not have the expected form :~ 59 | ~%~s" (prettyify-clause answer))) 60 | (untranslate expansion)) 61 | (iterate for x in hint-variable-alist 62 | do (set (cadr x) (cadddr x)))))) 63 | 64 | (defmacro expand-lemma (name type hyps term &optional hints) 65 | (let ((expansion (expand term hyps hints))) 66 | (print `(PROVE-LEMMA ,name ,type 67 | ,(if (null hyps) 68 | `(EQUAL ,term ,expansion) 69 | `(IMPLIES 70 | ,hyps 71 | (EQUAL ,term ,expansion))) 72 | ,hints)))) 73 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/extend-immediate.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; EXTEND-IMMEDIATE.EVENTS 8 | ;;; 9 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 10 | 11 | ;;; This module selects either a 32-bit value, or a 32-bit value produced by 12 | ;;; sign-extending a 9-bit value into 32 bits. 13 | 14 | (module-generator 15 | (extend-immediate*) 16 | 'extend-immediate 17 | (cons 'select-immediate (append #i(immediate 0 9) #i(reg-data 0 32))) 18 | #i(z 0 32) 19 | (list 20 | (list 'buffer 21 | '(sign-bit) 22 | 'b-buf-pwr 23 | (list #i(immediate 8))) 24 | (list 'mux 25 | #i(z 0 32) 26 | #i(tv-if (tree-number (make-tree 32))) 27 | (cons 'select-immediate 28 | (append (append #i(immediate 0 9) 29 | (make-list 23 'sign-bit)) 30 | #i(reg-data 0 32))))) 31 | nil) 32 | 33 | (disable *1*extend-immediate*) 34 | 35 | (defn extend-immediate& (netlist) 36 | (and (equal (lookup-module 'extend-immediate netlist) 37 | (extend-immediate*)) 38 | (let ((netlist (delete-module 'extend-immediate netlist))) 39 | (and (b-buf-pwr& netlist) 40 | (tv-if& netlist (make-tree 32)))))) 41 | 42 | (disable extend-immediate&) 43 | 44 | (defn extend-immediate$netlist () 45 | (cons (extend-immediate*) 46 | (union (b-buf-pwr$netlist) 47 | (tv-if$netlist (make-tree 32))))) 48 | 49 | (prove-lemma check-extend-immediate$netlist () 50 | (extend-immediate& (extend-immediate$netlist)) 51 | ;;Hint 52 | ((expand (extend-immediate*)))) 53 | 54 | (defn f$extend-immediate (select-immediate immediate reg-data) 55 | (fv-if select-immediate 56 | (append immediate 57 | (if (boolp (nth 8 immediate)) 58 | (make-list 23 (nth 8 immediate)) 59 | (make-list 23 (x)))) 60 | reg-data)) 61 | 62 | (disable f$extend-immediate) 63 | 64 | (prove-lemma properp-length-f$extend-immediate (rewrite) 65 | (and (properp (f$extend-immediate select-immediate immediate reg-bus)) 66 | (implies 67 | (equal (length immediate) 9) 68 | (equal (length (f$extend-immediate select-immediate immediate reg-bus)) 69 | 32))) 70 | ;;Hint 71 | ((enable f$extend-immediate))) 72 | 73 | (prove-lemma f$extend-immediate=extend-immediate (rewrite) 74 | (implies 75 | (and (bvp immediate) (equal (length immediate) 9) 76 | (bvp reg-data) (equal (length reg-data) 32) 77 | (boolp select-immediate)) 78 | (equal (f$extend-immediate select-immediate immediate reg-data) 79 | (if* select-immediate 80 | (sign-extend immediate 32) 81 | reg-data))) 82 | ;;Hint 83 | ((enable f$extend-immediate sign-extend-as-append if*) 84 | (disable associativity-of-append 85 | make-list *1*make-list 86 | indices *1*indices open-indices 87 | make-tree *1*make-tree))) 88 | 89 | (prove-lemma extend-immediate$value (rewrite) 90 | (implies 91 | (and (extend-immediate& netlist) 92 | (properp immediate) (equal (length immediate) 9) 93 | (properp reg-data) (equal (length reg-data) 32)) 94 | (equal (dual-eval 0 'extend-immediate 95 | (cons select-immediate (append immediate reg-data)) 96 | state netlist) 97 | (f$extend-immediate select-immediate immediate reg-data))) 98 | ;;Hint 99 | ((enable f$extend-immediate extend-immediate& extend-immediate*$destructure 100 | b-buf-pwr$value tv-if$value) 101 | (disable associativity-of-append 102 | make-list *1*make-list 103 | indices *1*indices open-indices 104 | make-tree *1*make-tree))) 105 | 106 | (disable extend-immediate$value) 107 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/fast-zero.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 6 | ;;; 7 | ;;; FAST-ZERO 8 | ;;; 9 | ;;; A zero detector optimized for quick detection of the last 2 bits of the 10 | ;;; input vector. It should save a few nanoseconds in the FM9001. 11 | ;;; 12 | ;;; LSI Logic timing analysis of the final design showed that this "fast" 13 | ;;; zero-detector was about the same as simple, fully-balanced zero-detectors 14 | ;;; defined in "t-or-nor.events". 15 | ;;; 16 | ;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17 | 18 | (defn f$fast-zero (v) 19 | (f-nor3 (tr-or-nor (firstn (sub1 (sub1 (length v))) v) 20 | f 21 | (make-tree (sub1 (sub1 (length v))))) 22 | (nth (sub1 (sub1 (length v))) v) 23 | (nth (sub1 (length v)) v))) 24 | 25 | (disable f$fast-zero) 26 | 27 | (prove-lemma f$fast-zero=tr-or-nor () 28 | (implies 29 | (and (properp v) 30 | (geq (length v) 3)) 31 | (equal (f$fast-zero v) 32 | (tr-or-nor v t (cons (make-tree (sub1 (sub1 (length v)))) 33 | (cons 0 0))))) 34 | ;;Hint 35 | ((enable f$fast-zero tr-or-nor f-nor3 f-nor nth-restn cdr-restn) 36 | (disable-theory f-gates))) 37 | 38 | (prove-lemma f$fast-zero=v-zerop (rewrite) 39 | (implies 40 | (and (bvp v) 41 | (geq (length v) 3)) 42 | (equal (f$fast-zero v) 43 | (v-zerop v))) 44 | ;;Hint 45 | ((use (f$fast-zero=tr-or-nor)) 46 | (enable tree-size))) 47 | 48 | ;;; Hardware 49 | 50 | (module-generator 51 | (fast-zero* n) 52 | #i(fast-zero n) 53 | #i(a 0 n) 54 | '(z) 55 | (list 56 | (list 'front '(zfront) #i(t-or (tree-number (make-tree (sub1 (sub1 n))))) 57 | (firstn (sub1 (sub1 n)) #i(a 0 n))) 58 | (list 'result '(z) 'b-nor3 59 | (list 'zfront #i(a (sub1 (sub1 n))) #i(a (sub1 n))))) 60 | nil) 61 | 62 | (defn fast-zero& (netlist n) 63 | (and (equal (lookup-module #i(fast-zero n) netlist) (fast-zero* n)) 64 | (let ((netlist (delete-module #i(fast-zero n) netlist))) 65 | (and (t-or-nor& netlist (make-tree (sub1 (sub1 n))) f) 66 | (b-nor3& netlist))))) 67 | 68 | (disable fast-zero&) 69 | 70 | (defn fast-zero$netlist (n) 71 | (cons (fast-zero* n) 72 | (union (t-or-nor$netlist (make-tree (sub1 (sub1 n))) f) 73 | (b-nor3$netlist)))) 74 | 75 | (prove-lemma check-fast-zero$netlist () 76 | (fast-zero& (fast-zero$netlist 5) 5)) 77 | 78 | (prove-lemma fast-zero$value (rewrite) 79 | (implies 80 | (and (fast-zero& netlist n) 81 | (properp v) 82 | (equal (length v) n) 83 | (geq n 3)) 84 | (equal (dual-eval 0 #i(fast-zero n) v state netlist) 85 | (list (f$fast-zero v)))) 86 | ;;Hint 87 | ((enable fast-zero& f$fast-zero fast-zero*$destructure t-or-nor$value 88 | b-nor3$value) 89 | (disable open-indices) 90 | (disable-theory f-gates))) 91 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/files-wo-proof.csh: -------------------------------------------------------------------------------- 1 | tar -cvf files-wo-proof.tar \ 2 | "LICENSE" \ 3 | "README" \ 4 | "FM9001.announcement" \ 5 | "TAGS" \ 6 | "intro-overview.ps" \ 7 | "files-wo-proof.csh" \ 8 | "sysdef.lisp" \ 9 | "sysload.lisp" \ 10 | "do-files.lisp" \ 11 | "do-events-recursive.lisp" \ 12 | "disable.lisp" \ 13 | "macros.lisp" \ 14 | "expand.lisp" \ 15 | "vector-macros.lisp" \ 16 | "primp-database.lisp" \ 17 | "primitives.lisp" \ 18 | "control.lisp" \ 19 | "expand-fm9001.lisp" \ 20 | "monotonicity-macros.lisp" \ 21 | "translate.lisp" \ 22 | "purify.lisp" \ 23 | "bags.events" \ 24 | "naturals.events" \ 25 | "integers.events" \ 26 | "math-disable.events" \ 27 | "intro.events" \ 28 | "list-rewrites.events" \ 29 | "indices.events" \ 30 | "hard-specs.events" \ 31 | "value.events" \ 32 | "memory.events" \ 33 | "dual-port-ram.events" \ 34 | "fm9001-memory.events" \ 35 | "tree-number.events" \ 36 | "f-functions.events" \ 37 | "dual-eval.events" \ 38 | "predicate-help.events" \ 39 | "predicate-simple.events" \ 40 | "predicate.events" \ 41 | "primitives.events" \ 42 | "unbound.events" \ 43 | "vector-module.events" \ 44 | "translate.events" \ 45 | "examples.events" \ 46 | "example-v-add.events" \ 47 | "pg-theory.events" \ 48 | "tv-if.events" \ 49 | "t-or-nor.events" \ 50 | "fast-zero.events" \ 51 | "v-equal.events" \ 52 | "v-inc4.events" \ 53 | "tv-dec-pass.events" \ 54 | "reg.events" \ 55 | "alu-specs.events" \ 56 | "pre-alu.events" \ 57 | "tv-alu-help.events" \ 58 | "post-alu.events" \ 59 | "core-alu.events" \ 60 | "fm9001-spec.events" \ 61 | "asm-fm9001.events" \ 62 | "store-resultp.events" \ 63 | "control-modules.events" \ 64 | "control.events" \ 65 | "regfile.events" \ 66 | "flags.events" \ 67 | "extend-immediate.events" \ 68 | "pad-vectors.events" \ 69 | "fm9001-hardware.events" \ 70 | "chip.events" \ 71 | "expand-fm9001.events" \ 72 | "proofs.events" \ 73 | "approx.events" \ 74 | "final-reset.events" \ 75 | "well-formed-fm9001.events" \ 76 | "math-enable.events" \ 77 | "alu-interpretation.events" \ 78 | "flag-interpretation.events" \ 79 | "more-alu-interpretation.events" \ 80 | "high-level-spec.events" \ 81 | "rtl-level-spec.events" \ 82 | "dual-eval-spec.events" \ 83 | "compressed-netlist.events" \ 84 | "predicate.tests"\ 85 | "CHIP.NET" 86 | 87 | cp files-wo-proof.tar fm9001.tar 88 | gzip -f fm9001.tar 89 | 90 | mv files-wo-proof.tar fm9001.tar 91 | compress -f fm9001.tar 92 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/indices.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; INDICES.EVENTS -- Index name generators, and lemmas. 8 | ;;; 9 | ;;; The shell INDEX is used for indexed names in our DUAL-EVAL netlists, where 10 | ;;; we expect the I-NAME of the INDEX to be a LITATOM, and the I-NUM to be the 11 | ;;; index (a number). We chose to use a paired name, rather than a naming 12 | ;;; convention (e.g., G_0, G_1 ...) to represent indexed names because it is 13 | ;;; much easier to reason about paired names. 14 | ;;; 15 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 16 | 17 | (add-shell index nil indexp 18 | ((i-name (one-of numberp litatom) zero) 19 | (i-num (one-of numberp) zero))) 20 | 21 | (defn lnfix (x) 22 | (if (or (numberp x) (litatom x)) 23 | x 24 | 0)) 25 | 26 | 27 | ;;; INDICES -- A list of N indexed names. 28 | 29 | (defn indices (name from n) 30 | (if (zerop n) 31 | nil 32 | (cons (index name from) 33 | (indices name (add1 from) (sub1 n))))) 34 | 35 | (disable indices) 36 | 37 | (prove-lemma indices-zerop (rewrite) 38 | (implies 39 | (zerop n) 40 | (equal (indices name from n) 41 | nil)) 42 | ;;Hint 43 | ((enable indices))) 44 | 45 | (prove-lemma open-indices (rewrite) 46 | (implies 47 | (not (zerop n)) 48 | (equal (indices name from n) 49 | (cons (index name from) 50 | (indices name (add1 from) (sub1 n))))) 51 | ;;Hint 52 | ((enable indices))) 53 | 54 | ;;; INDICES-AS-APPEND is an alternate way to look at the structure of the 55 | ;;; indices. 56 | 57 | (prove-lemma indices-as-append (rewrite) 58 | (implies 59 | (not (zerop n)) 60 | (equal (indices name from n) 61 | (append (indices name from (sub1 n)) 62 | (list (index name (plus (sub1 n) from)))))) 63 | ;;Hint 64 | ((enable indices))) 65 | 66 | (disable indices-as-append) 67 | 68 | (prove-lemma length-indices (rewrite) 69 | (equal (length (indices name from n)) 70 | (fix n)) 71 | ;;Hint 72 | ((enable length indices))) 73 | 74 | (prove-lemma listp-indices (rewrite) 75 | (equal (listp (indices name from n)) 76 | (not (zerop n))) 77 | ;;Hint 78 | ((enable indices))) 79 | 80 | (prove-lemma properp-indices (rewrite) 81 | (properp (indices name from n)) 82 | ;;Hint 83 | ((enable properp indices))) 84 | 85 | (prove-lemma member-indices (rewrite) 86 | (equal (member x (indices name from n)) 87 | (and (not (zerop n)) 88 | (indexp x) 89 | (equal (i-name x) (lnfix name)) 90 | (leq from (i-num x)) 91 | (lessp (i-num x) (plus from n)))) 92 | ;;Hint 93 | ((enable member indices lessp))) 94 | 95 | (prove-lemma disjoint-indices-different-names (rewrite) 96 | (implies 97 | (not (equal (lnfix name1) (lnfix name2))) 98 | (disjoint (indices name1 from1 n1) (indices name2 from2 n2))) 99 | ;;Hint 100 | ((enable disjoint indices))) 101 | 102 | (prove-lemma no-duplicates-in-indices (rewrite) 103 | (not (duplicates? (indices name from n))) 104 | ;;Hint 105 | ((enable duplicates? indices))) 106 | 107 | ;;; For some reason, OPEN-INDICES interferes with these proofs. 108 | 109 | (prove-lemma position-name-indices (rewrite) 110 | (implies 111 | (member index (indices name from n)) 112 | (equal (position index (indices name from n)) 113 | (difference (i-num index) from))) 114 | ;;Hint 115 | ((induct (indices name from n)) 116 | (enable position indices) 117 | (disable open-indices))) 118 | 119 | (prove-lemma nth-indices (rewrite) 120 | (implies 121 | (lessp n m) 122 | (equal (nth n (indices name from m)) 123 | (index name (plus n from)))) 124 | ;;Hint 125 | ((enable nth indices))) 126 | 127 | (disable nth-indices) 128 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/list-rewrites.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; LIST-REWRITES.EVENTS 8 | ;;; 9 | ;;; For some events, the NQTHM elimination heuristics are too slow or 10 | ;;; limited to do the job, so we need these helper lemmas. 11 | ;;; 12 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 13 | 14 | (prove-lemma list-rewrite-4 (rewrite) 15 | (implies 16 | (and (properp a) 17 | (equal (length a) 4)) 18 | (equal (list (car a) (cadr a) (caddr a) (cadddr a)) 19 | a)) 20 | ;;Hint 21 | ((enable equal-length-add1))) 22 | 23 | (disable list-rewrite-4) 24 | 25 | ;;; Not strictly necessary, but sometimes I get bored waiting for the prover 26 | ;;; to get around to doing an elim. 27 | 28 | (prove-lemma list-elim-4 (rewrite) 29 | (equal (equal l (list a b c d)) 30 | (and (equal (car l) a) 31 | (equal (cadr l) b) 32 | (equal (caddr l) c) 33 | (equal (cadddr l) d) 34 | (equal (cddddr l) nil)))) 35 | 36 | (disable list-elim-4) 37 | 38 | ;;; LIST-AS-COLLECTED-NTH 39 | ;;; 40 | ;;; What can I say about this bit of proof hackery? Along with OPEN-NTH, 41 | ;;; PROPERP-AS-NULL-NTHCDR, and OUR-CAR-CDR-ELIM, a quick and dirty way 42 | ;;; to rewrite PROPERP lists as (LIST (CAR L) (CADR L) .... (CADD....DR L)). 43 | ;;; Useful, since with long lists you may run out of ELIM variables and 44 | ;;; experience the dreaded SET-DIFF-N crash. 45 | 46 | (defn list-as-collected-nth (l length n) 47 | (if (zerop length) 48 | nil 49 | (cons (nth n l) 50 | (list-as-collected-nth l (sub1 length) (add1 n))))) 51 | 52 | (disable list-as-collected-nth) 53 | 54 | (prove-lemma open-list-as-collected-nth (rewrite) 55 | (and 56 | (implies 57 | (zerop length) 58 | (equal (list-as-collected-nth l length n) 59 | nil)) 60 | (implies 61 | (not (zerop length)) 62 | (equal (list-as-collected-nth l length n) 63 | (cons (nth n l) 64 | (list-as-collected-nth l (sub1 length) (add1 n)))))) 65 | ;;Hint 66 | ((enable list-as-collected-nth))) 67 | 68 | (prove-lemma equal-length-4-as-collected-nth () 69 | (implies 70 | (and (equal (length l) 4) 71 | (properp l)) 72 | (equal l (list-as-collected-nth l 4 0))) 73 | ;;Hint 74 | ((enable open-nth properp-as-null-nthcdr our-car-cdr-elim) 75 | (disable car-cdr-elim))) 76 | 77 | 78 | (prove-lemma equal-length-32-as-collected-nth () 79 | (implies 80 | (and (equal (length l) 32) 81 | (properp l)) 82 | (equal l (list-as-collected-nth l 32 0))) 83 | ;;Hint 84 | ((enable open-nth properp-as-null-nthcdr our-car-cdr-elim) 85 | (disable car-cdr-elim))) 86 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/math-disable.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | 6 | ;;; This file is to disable everything prior to this point. 7 | ;;; The purpose of this is to make sure that the previous 8 | ;;; events do not interfere with the events that follow. 9 | 10 | 11 | (disable-back-to ground-zero math-theory) 12 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/math-enable.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; MATH-ENABLE.EVENTS 8 | ;;; 9 | ;;; 10 | ;;; This file is to enable the sets, naturals, and integers 11 | ;;; libraries that were previously disabled. 12 | ;;; 13 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 14 | 15 | (better-disable-back-to b-knownp) 16 | 17 | (enable-theory math-theory) 18 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/primitives.lisp: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; PRIMITIVES.LISP 8 | ;;; 9 | ;;; Functions and macros to automate the creation of DUAL-EVAL lemmas for the 10 | ;;; primitives. 11 | ;;; 12 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 13 | 14 | (in-package "USER") 15 | 16 | ;;; Primitive result and new-state lemma macros. 17 | 18 | (defun primitive-result (name inputs results states) 19 | (let* ((name& (unstring name "&")) 20 | (args (if inputs `(LIST ,@inputs) 'NIL)) 21 | (state (cond 22 | ((null states) 'STATE) 23 | ((atom states) states) 24 | (t `(LIST ,@states)))) 25 | (value-lemma (unstring name "$VALUE")) 26 | (netlist (unstring name "$NETLIST"))) 27 | 28 | `(PROGN 29 | 30 | (DEFN ,name& (NETLIST) T) 31 | 32 | (DISABLE ,name&) 33 | 34 | (DEFN ,netlist () NIL) 35 | 36 | (PROVE-LEMMA ,value-lemma (REWRITE) 37 | (IMPLIES 38 | (,name& NETLIST) 39 | (EQUAL (DUAL-EVAL 0 ',name ,args ,state NETLIST) 40 | ,results)) 41 | ;;Hint 42 | ((ENABLE ,name& PRIMP DUAL-APPLY-VALUE) 43 | (EXPAND (DUAL-EVAL 0 ',name ,args ,state NETLIST)))) 44 | 45 | (DISABLE ,value-lemma)))) 46 | 47 | (defun primitive-state (name inputs new-states states) 48 | (let* ((args (if inputs `(LIST ,@inputs) 'NIL)) 49 | (state (cond 50 | ((null states) 'STATE) 51 | ((atom states) states) 52 | (t `(LIST ,@states)))) 53 | (name& (unstring name "&")) 54 | (state-lemma (unstring name "$STATE"))) 55 | 56 | `(PROGN 57 | 58 | (PROVE-LEMMA ,state-lemma (REWRITE) 59 | (IMPLIES 60 | (,name& NETLIST) 61 | (EQUAL (DUAL-EVAL 2 ',name ,args ,state NETLIST) 62 | ,new-states)) 63 | ;;Hint 64 | ((ENABLE ,name& PRIMP DUAL-APPLY-STATE) 65 | (EXPAND (DUAL-EVAL 2 ',name ,args ,state NETLIST)))) 66 | 67 | (DISABLE ,state-lemma)))) 68 | 69 | ;;; COMMON-LISP-PRIMP-DATABASE is defined in "primp-database.lisp". 70 | 71 | (defmacro result-and-state-lemmas () 72 | `(PROGN 73 | ,@(iterate for (name . alist) in common-lisp-primp-database 74 | collect (primitive-result name 75 | (cdr (assoc 'inputs alist)) 76 | (cdr (assoc 'results alist)) 77 | (cdr (assoc 'states alist)))) 78 | ,@(iterate for (name . alist) in common-lisp-primp-database 79 | when (member 'new-states alist :key #'car) 80 | collect (primitive-state name 81 | (cdr (assoc 'inputs alist)) 82 | (cdr (assoc 'new-states alist)) 83 | (cdr (assoc 'states alist)))))) 84 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/store-resultp.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; STORE-RESULTP.EVENTS 8 | ;;; 9 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 10 | 11 | ;;; An inverting 7-to-1 mux, with an implied F for the 8th data input. 12 | 13 | (defn store-resultp-mux (s0 s1 s2 d0 d1 d2 d3 d4 d5 d6) 14 | (let ((s0- (b-not s0)) 15 | (s1- (b-not s1)) 16 | (s2- (b-not s2))) 17 | (let ((x01 (ao2 s0- d0 s0 d1)) 18 | (x23 (ao2 s0- d2 s0 d3)) 19 | (x45 (ao2 s0- d4 s0 d5)) 20 | (x67 (b-nand s0- d6))) 21 | (let ((x0123 (ao2 s1- x01 s1 x23)) 22 | (x4567 (ao2 s1- x45 s1 x67))) 23 | (ao2 s2- x0123 s2 x4567))))) 24 | 25 | (defn-to-module store-resultp-mux) 26 | 27 | ;;; Alternate definition of store-resultp. 28 | 29 | (defn b-store-resultp (store-cc flags) 30 | (let ((s0 (car store-cc)) 31 | (s1 (cadr store-cc)) 32 | (s2 (caddr store-cc)) 33 | (s3 (cadddr store-cc)) 34 | (z (car flags)) 35 | (n (cadr flags)) 36 | (v (caddr flags)) 37 | (c (cadddr flags))) 38 | (b-xor s0 (store-resultp-mux 39 | s1 s2 s3 40 | c v n z 41 | (b-or c z) (b-xor n v) (b-or z (b-xor n v)))))) 42 | 43 | (disable b-store-resultp) 44 | 45 | (defn f$b-store-resultp (store-cc flags) 46 | (let ((s0 (car store-cc)) 47 | (s1 (cadr store-cc)) 48 | (s2 (caddr store-cc)) 49 | (s3 (cadddr store-cc)) 50 | (z (car flags)) 51 | (n (cadr flags)) 52 | (v (caddr flags)) 53 | (c (cadddr flags))) 54 | (f-xor s0 (f$store-resultp-mux 55 | s1 s2 s3 56 | c v n z 57 | (f-or c z) (f-xor n v) (f-or z (f-xor n v)))))) 58 | 59 | (disable f$b-store-resultp) 60 | 61 | (prove-lemma f$b-store-resultp=b-store-resultp (rewrite) 62 | (implies 63 | (and 64 | (bvp store-cc) (equal (length store-cc) 4) 65 | (bvp flags) (equal (length flags) 4)) 66 | (equal (f$b-store-resultp store-cc flags) 67 | (b-store-resultp store-cc flags))) 68 | ;;Hint 69 | ((enable f$b-store-resultp b-store-resultp boolp-b-gates bvp-length) 70 | (disable-theory f-gates))) 71 | 72 | (defn b-store-resultp* () 73 | '(b-store-resultp (s0 s1 s2 s3 z n v c) (result) 74 | ((g0 (cz) b-or (c z)) 75 | (g1 (nv) b-xor (n v)) 76 | (g2 (znv) b-or (z nv)) 77 | (g3 (mux) store-resultp-mux (s1 s2 s3 c v n z cz nv znv)) 78 | (g4 (result) b-xor (s0 mux))) 79 | nil)) 80 | 81 | (module-predicate b-store-resultp*) 82 | 83 | (module-netlist b-store-resultp*) 84 | 85 | ;;; Proof of equivalence. 86 | 87 | (prove-lemma b-store-resultp=store-resultp$help (rewrite) 88 | (implies 89 | (and 90 | (boolp s0) (boolp s1) (boolp s2) (boolp s3) 91 | (boolp s4) (boolp s5) (boolp s6) (boolp s7)) 92 | (equal (b-store-resultp (list s0 s1 s2 s3) (list s4 s5 s6 s7)) 93 | (store-resultp (list s0 s1 s2 s3) (list s4 s5 s6 s7)))) 94 | ;;Hint 95 | ((enable b-store-resultp store-resultp boolp))) 96 | 97 | (prove-lemma b-store-resultp=store-resultp (rewrite) 98 | (implies 99 | (and 100 | (bvp store-cc) (equal (length store-cc) 4) 101 | (bvp flags) (equal (length flags) 4)) 102 | (equal (b-store-resultp store-cc flags) 103 | (store-resultp store-cc flags))) 104 | ;;Hint 105 | ((enable bvp equal-length-add1))) 106 | 107 | (prove-lemma b-store-resultp$value (rewrite) 108 | (implies 109 | (and (b-store-resultp& netlist) 110 | (properp store-cc) (equal (length store-cc) 4) 111 | (properp store-cc) (equal (length flags) 4)) 112 | (equal (dual-eval 0 'b-store-resultp 113 | (append store-cc flags) 114 | state netlist) 115 | (list (f$b-store-resultp store-cc flags)))) 116 | ;;Hint 117 | ((enable b-store-resultp& f$b-store-resultp 118 | store-resultp-mux$value b-or$value b-xor$value 119 | equal-length-add1) 120 | (disable-theory f-gates))) 121 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/sysdef.lisp: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; SYSDEF.LISP 8 | ;;; 9 | ;;; Utilities for creating the FM9001 event libraries. 10 | ;;; 11 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 12 | 13 | (in-package "USER") 14 | 15 | ;;; This form loads all of the Common Lisp support files. This form must be 16 | ;;; evaluated before staring from a "NOTE-LIB". 17 | 18 | (progn 19 | (backquote-setting 'nqthm) 20 | 21 | ;; Akcl specific settings. The following form may be necessary depending 22 | ;; on the size of the Akcl. 23 | ;; #+akcl (setf si::*multiply-stacks* 4) 24 | ;; #+akcl (setf si::*notify-gbc* nil) 25 | ;; #+(and akcl sparc) (setq compiler::*split-files* 200000) 26 | 27 | ;; Lisp Works specific settings. 28 | ;; #+LISPWORKS (lw::extend-current-stack 1000) 29 | 30 | ;; Lucid specific settings. 31 | ;; #+Lucid (CHANGE-MEMORY-MANAGEMENT :GROWTH-LIMIT 2000) 32 | 33 | ;; Work around a bug in Allegro. This is a work around for the '(if* . t) 34 | ;; PRINT bug in Allegro CL 4.1 suggested by duane@Franz.COM, concering 35 | ;; bug report spr6115: 36 | ;; #+Allegro (SET-PPRINT-DISPATCH '(CONS (MEMBER IF*)) NIL) 37 | 38 | (setq *thm-suppress-disclaimer-flg* t) 39 | (setq reduce-term-clock 2000) 40 | ;; (setf linel-value 69) 41 | 42 | ;; Following used in DO-FILES-WITH-INTERMEDIATE-LIBS below: 43 | (load "do-files.lisp" :print t) 44 | 45 | ;; Following used in approx.events (via monotonicity-macros.lisp): 46 | (load "do-events-recursive.lisp" :print t) 47 | 48 | (load "disable.lisp" :print t) 49 | (load "macros.lisp" :print t) 50 | (load "expand.lisp" :print t) 51 | (load "vector-macros.lisp" :print t) 52 | (load "primp-database.lisp" :print t) 53 | (load "primitives.lisp" :print t) 54 | (load "control.lisp" :print t) 55 | (load "expand-fm9001.lisp" :print t) 56 | (load "monotonicity-macros.lisp" :print t) 57 | (load "translate.lisp" :print t) 58 | (load "purify.lisp" :print t)) 59 | 60 | ;;; Below we define a load sequence for the FM9001 specification and proof. 61 | ;;; This sequence creates a number of intermediate libraries. If any failures 62 | ;;; occur along the way, a library called "failed" will be created. If the 63 | ;;; run was a success, one should go back and delete the intermediate 64 | ;;; libraries since they take up a lot of space. 65 | 66 | (defmacro do-files-with-intermediate-libs (args) 67 | (if args 68 | `(IF (DO-FILES ',(caar args)) 69 | (PROGN 70 | (MAKE-LIB ,(cadar args) T) 71 | (DO-FILES-WITH-INTERMEDIATE-LIBS ,(cdr args))) 72 | (MAKE-LIB "failed")) 73 | nil)) 74 | 75 | (time 76 | (do-files-with-intermediate-libs 77 | ((("bags.events" 78 | "naturals.events" 79 | "integers.events" 80 | "math-disable.events" 81 | "intro.events" 82 | "list-rewrites.events" 83 | "indices.events" 84 | "hard-specs.events" 85 | "value.events" 86 | "memory.events" 87 | "dual-port-ram.events" 88 | "fm9001-memory.events" 89 | "tree-number.events" 90 | "f-functions.events" 91 | "dual-eval.events" 92 | "predicate-help.events" 93 | "predicate-simple.events" 94 | "predicate.events" 95 | "primitives.events" 96 | "unbound.events" 97 | "vector-module.events" 98 | "translate.events") "dual-eval") 99 | (("examples.events" 100 | "example-v-add.events" 101 | "pg-theory.events" 102 | "tv-if.events" 103 | "t-or-nor.events" 104 | "fast-zero.events" 105 | "v-equal.events" 106 | "v-inc4.events" 107 | "tv-dec-pass.events" 108 | "reg.events" 109 | "alu-specs.events" 110 | "pre-alu.events" 111 | "tv-alu-help.events" 112 | "post-alu.events" 113 | "core-alu.events" 114 | "fm9001-spec.events" 115 | "asm-fm9001.events" 116 | "store-resultp.events" 117 | "control-modules.events" 118 | "control.events" 119 | "regfile.events" 120 | "flags.events" 121 | "extend-immediate.events" 122 | "pad-vectors.events" 123 | "fm9001-hardware.events" 124 | "chip.events") "chip") 125 | (("expand-fm9001.events" 126 | "proofs.events" 127 | "approx.events" 128 | "final-reset.events" 129 | "well-formed-fm9001.events") "proofs") 130 | (("math-enable.events" 131 | "alu-interpretation.events" 132 | "flag-interpretation.events" 133 | "more-alu-interpretation.events") "fm9001")))) 134 | 135 | ;;; This form creates the "clean" version of the events. See "purify.lisp". 136 | 137 | ; (time (library-to-events "fm9001")) 138 | 139 | ;;; This form reruns the "clean" version of the events. 140 | 141 | ; (time (prove-file-out "fm9001-replay")) 142 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/sysload.lisp: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; SYSLOAD.LISP 8 | ;;; 9 | ;;; Utility file to load Common Lisp macros. 10 | ;;; 11 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 12 | 13 | (in-package "USER") 14 | 15 | ;;; This loads all of the Common Lisp support files. This form must be 16 | ;;; evaluated before staring from a "NOTE-LIB". 17 | 18 | (progn 19 | (backquote-setting 'nqthm) 20 | 21 | ;; Akcl specific settings. The following form may be necessary depending 22 | ;; on the size of the Akcl. 23 | ;; #+akcl (setf si::*multiply-stacks* 4) 24 | ;; #+akcl (setf si::*notify-gbc* nil) 25 | ;; #+(and akcl sparc) (setq compiler::*split-files* 200000) 26 | 27 | ;; Lisp Works specific settings. 28 | ;; #+LISPWORKS (lw::extend-current-stack 1000) 29 | 30 | ;; Lucid specific settings. 31 | ;; #+Lucid (CHANGE-MEMORY-MANAGEMENT :GROWTH-LIMIT 2000) 32 | 33 | ;; Work around a bug in Allegro. This is a work around for the '(if* . t) 34 | ;; PRINT bug in Allegro CL 4.1 suggested by duane@Franz.COM, concering 35 | ;; bug report spr6115: 36 | ;; #+Allegro (SET-PPRINT-DISPATCH '(CONS (MEMBER IF*)) NIL) 37 | 38 | (setq *thm-suppress-disclaimer-flg* t) 39 | (setq reduce-term-clock 2000) 40 | ;; (setf linel-value 69) 41 | 42 | ;; Following used in DO-FILES-WITH-INTERMEDIATE-LIBS below: 43 | (load "do-files.lisp" :print t) 44 | 45 | ;; Following used in approx.events (via monotonicity-macros.lisp): 46 | (load "do-events-recursive.lisp" :print t) 47 | 48 | (load "disable.lisp" :print t) 49 | (load "macros.lisp" :print t) 50 | (load "expand.lisp" :print t) 51 | (load "vector-macros.lisp" :print t) 52 | (load "primp-database.lisp" :print t) 53 | (load "primitives.lisp" :print t) 54 | (load "control.lisp" :print t) 55 | (load "expand-fm9001.lisp" :print t) 56 | (load "monotonicity-macros.lisp" :print t) 57 | (load "translate.lisp" :print t) 58 | (load "purify.lisp" :print t)) 59 | 60 | ;;; Below we define a load sequence for the FM9001 specification and proof. 61 | ;;; This sequence creates a number of intermediate libraries. If any failures 62 | ;;; occur along the way, a library called "failed" will be created. If the 63 | ;;; run was a success, one should go back and delete the intermediate 64 | ;;; libraries since they take up a lot of space. 65 | 66 | (defmacro do-files-with-intermediate-libs (args) 67 | (if args 68 | `(IF (DO-FILES ',(caar args)) 69 | (PROGN 70 | (MAKE-LIB ,(cadar args) T) 71 | (DO-FILES-WITH-INTERMEDIATE-LIBS ,(cdr args))) 72 | (MAKE-LIB "failed")) 73 | nil)) 74 | 75 | (princ " 76 | The FM9001 macros have been defined. You should next execute: 77 | 78 | (in-package \"USER\") 79 | 80 | and then you may execute any of: 81 | 82 | (note-lib \"dual-eval\" t) 83 | (note-lib \"chip\" t) 84 | (note-lib \"proofs\" t) 85 | (note-lib \"fm9001\" t) 86 | 87 | ") 88 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/translate.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; TRANSLATE.EVENTS 8 | ;;; 9 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 10 | 11 | ;;; LISP-NETLIST converts a netlist that may include INDEX shells to one where 12 | ;;; the indexed names have been collapsed into literal atoms. For example, 13 | ;;; the indexed name (INDEX 'G 0) become 'G_0. 14 | 15 | (defn rev-0 (x) 16 | (rev1 x 0)) 17 | 18 | (defn number-to-digit (number) 19 | (nth number 20 | (cdr (unpack 'a0123456789)))) 21 | 22 | (defn number-to-list1 (number) 23 | (if (zerop number) 24 | 0 25 | (cons (number-to-digit (remainder number 10)) 26 | (number-to-list1 (quotient number 10))))) 27 | 28 | (defn number-to-list (number) 29 | (if (zerop number) 30 | (cons (cadr (unpack 'a0)) 0) 31 | (rev-0 (number-to-list1 number)))) 32 | 33 | (defn lisp-netlist (netlist) 34 | (if (indexp netlist) 35 | (pack (append (unpack (i-name netlist)) 36 | (cons (cadr (unpack 'a_)) 37 | (number-to-list (i-num netlist))))) 38 | (if (nlistp netlist) 39 | netlist 40 | (cons (lisp-netlist (car netlist)) 41 | (lisp-netlist (cdr netlist)))))) 42 | 43 | 44 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 | ;;; 46 | ;;; Below are some utilities to count the number of primitives in the 47 | ;;; FM9001. COLLECT-PRIMITIVES just collects the different primitives 48 | ;;; for a particular module, X0, in NETLIST. 49 | ;;; 50 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 51 | 52 | (defn collect-primitives (flg x0 netlist) 53 | (case flg 54 | 55 | (0 (let ((fn x0)) 56 | (let ((module (lookup-module fn netlist))) 57 | (if (or (primp fn) (not module)) 58 | (list fn) 59 | (flatten-list 60 | (collect-primitives 61 | 1 (module-occurrences module) 62 | (delete-module fn netlist))))))) 63 | 64 | (1 (let ((body x0)) 65 | (if (nlistp body) 66 | nil 67 | (cons (collect-primitives 68 | 0 (occ-function (car body)) netlist) 69 | (collect-primitives 1 (cdr body) netlist))))) 70 | 71 | (otherwise f)) 72 | 73 | ((ord-lessp (cons (add1 (count netlist)) (count x0))))) 74 | 75 | (defn count-primitives (flg x0 x1 type netlist) 76 | (case flg 77 | 78 | (0 (let ((fn x0)) 79 | (if (primp fn) 80 | (if (primp-lookup fn type) 81 | (primp2 fn type) 82 | f) 83 | (let ((module (lookup-module fn netlist))) 84 | (if (listp module) 85 | (let ((m-ins (module-inputs module)) 86 | (m-outs (module-outputs module)) 87 | (m-occs (module-occurrences module))) 88 | (count-primitives 1 m-occs 0 type 89 | (delete-module fn netlist))) 90 | f))))) 91 | 92 | (1 (let ((body x0) 93 | (sum x1)) 94 | (if (nlistp body) 95 | sum 96 | (let ((occ (car body))) 97 | (let ((o-outs (occ-outputs occ)) 98 | (o-fn (occ-function occ)) 99 | (o-ins (occ-inputs occ))) 100 | (if (count-primitives 0 o-fn nil type netlist) 101 | (count-primitives 102 | 1 (cdr body) 103 | (plus sum 104 | (count-primitives 0 o-fn nil type netlist)) 105 | type 106 | netlist) 107 | f)))))) 108 | (otherwise f)) 109 | 110 | ((ord-lessp (cons (add1 (count netlist)) (count x0))))) 111 | 112 | (disable count-primitives) 113 | 114 | 115 | #| 116 | 117 | ;;; In R-LOOP, the entire FM9001, sans the I/O pads, can be generated 118 | ;;; and its primitives can be counted. 119 | 120 | (setq chip-module-net (lisp-netlist (chip-module$netlist))) 121 | (setq first-chip-module (car chip-module-net)) 122 | (setq first-chip-module-name (module-name first-chip-module)) 123 | (setq first-chip-module-inputs (module-inputs first-chip-module)) 124 | 125 | (collect-primitives 0 first-chip-module chip-module-net) 126 | 127 | (count-primitives 0 first-chip-module-name first-chip-module-inputs 128 | 'primitives chip-module-net) 129 | (count-primitives 0 first-chip-module-name first-chip-module-inputs 130 | 'gates chip-module-net) 131 | (count-primitives 0 first-chip-module-name first-chip-module-inputs 132 | 'transistors chip-module-net) 133 | 134 | 135 | ;;; print-ndl-form-to-file is in "translate.lisp". 136 | 137 | (print-ndl-form-to-file (cdr (assoc 'chip-module-net r-alist)) 138 | "chip-module.net") 139 | 140 | 141 | ;;; For the entire chip, including pads, use the following forms. 142 | 143 | (setq pads-net (lisp-netlist (chip$netlist))) 144 | 145 | (print-ndl-form-to-file (cdr (assoc 'pads-net r-alist)) 146 | "chip.net") 147 | 148 | |# 149 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/tree-number.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; TREE-NUMBER.EVENTS 8 | ;;; 9 | ;;; (TREE-NUMBER tree) returns a unique (we think) number for each 10 | ;;; equivalence class of trees with the same CONS structure. We use this 11 | ;;; to give unique, numerical indices to modules created by tree-based 12 | ;;; module generators. We never proved that TREE-NUMBER yields a unique 13 | ;;; encoding, but our netlist predicates would fail if it were ever the case 14 | ;;; that non-unique encodings were produced. 15 | ;;; 16 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 17 | ;;; 18 | ;;; This definition of TREE-NUMBER has the property that a balanced tree 19 | ;;; with N leaves has (TREE-NUMBER TREE) = N. In the binary encoding of 20 | ;;; the tree, each "full" level (whether full of CONS cells or leaves) is 21 | ;;; encoded as T. Partially empty levels are encoded by F, followed by a 22 | ;;; bit string that encodes with T and F those locations that are filled and 23 | ;;; empty respectively. 24 | 25 | (defn fix-breadth-tree-stack (stack n) 26 | (if (nlistp stack) 27 | nil 28 | (cons 29 | (append (make-list n f) (car stack)) 30 | (fix-breadth-tree-stack (cdr stack) (times 2 n))))) 31 | 32 | (defn breadth-tree (tree stack n) 33 | (if (nlistp tree) 34 | (cons (cons t (if (nlistp stack) 35 | (make-list n f) 36 | (car stack))) 37 | (fix-breadth-tree-stack (cdr stack) 2)) 38 | (cons 39 | (cons t (if (nlistp stack) 40 | (make-list n f) 41 | (car stack))) 42 | (breadth-tree (cdr tree) 43 | (breadth-tree (car tree) (cdr stack) (times 2 n)) 44 | (add1 (times 2 n)))))) 45 | 46 | (defn collect-breadth-tree (stack n) 47 | (if (nlistp stack) 48 | nil 49 | (if (equal (car stack) (make-list n t)) 50 | (cons t (collect-breadth-tree (cdr stack) (times 2 n))) 51 | (cons f (append (car stack) 52 | (collect-breadth-tree (cdr stack) (times 2 n))))))) 53 | 54 | (defn tree-number (tree) 55 | (quotient (add1 56 | (v-to-nat (collect-breadth-tree (breadth-tree tree nil 0) 1))) 57 | 2)) 58 | 59 | (disable tree-number) 60 | 61 | #| 62 | Problem: Prove that TREE-NUMBER yields a unique encoding for isomorphic trees. 63 | That is, given 64 | 65 | (defn isomorphic (x y) 66 | (if (or (nlistp x) (nlistp y)) 67 | (and (nlistp x) (nlistp y)) 68 | (and (isomorphic (car x) (car y)) 69 | (isomorphic (cdr x) (cdr y))))) 70 | 71 | then show 72 | 73 | (iff (isomorphic t1 t2) 74 | (equal (tree-number t1) 75 | (tree-number t2))). 76 | 77 | |# 78 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/unbound.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; UNBOUND.EVENTS 8 | ;;; 9 | ;;; For doing proofs of recursive module generators, it is often necessary to 10 | ;;; know that a signal name is "unbound", i.e., does not appear further in 11 | ;;; the generated body. By a "body" we mean an occurrence body, and by 12 | ;;; "bound" we mean assigned a value in the ALIST created by DUAL-EVAL with 13 | ;;; flag 1. This concept is eloquently summed up in the final two lemmas of 14 | ;;; this file. 15 | ;;; 16 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 17 | 18 | ;;; UNBOUND-IN-BODY 19 | 20 | (defn unbound-in-body (name body) 21 | (if (nlistp body) 22 | t 23 | (let ((occurrence (car body))) 24 | (let ((outputs (occ-outputs occurrence))) 25 | (and (not (member name outputs)) 26 | (unbound-in-body name (cdr body))))))) 27 | 28 | (disable unbound-in-body) 29 | 30 | (prove-lemma unbound-in-body-nlistp (rewrite) 31 | (implies 32 | (nlistp body) 33 | (unbound-in-body name body)) 34 | ;;Hint 35 | ((enable unbound-in-body))) 36 | 37 | (prove-lemma unbound-in-body-listp (rewrite) 38 | (equal (unbound-in-body name (cons occurrence rest)) 39 | (let ((outputs (occ-outputs occurrence))) 40 | (and (not (member name outputs)) 41 | (unbound-in-body name rest)))) 42 | ;;Hint 43 | ((enable unbound-in-body))) 44 | 45 | ;;; ALL-UNBOUND-IN-BODY 46 | 47 | (defn all-unbound-in-body (names body) 48 | (if (nlistp body) 49 | t 50 | (let ((occurrence (car body))) 51 | (let ((outputs (occ-outputs occurrence))) 52 | (and (disjoint names outputs) 53 | (all-unbound-in-body names (cdr body))))))) 54 | 55 | (disable all-unbound-in-body) 56 | 57 | (prove-lemma all-unbound-in-body-nlistp (rewrite) 58 | (implies 59 | (nlistp body) 60 | (all-unbound-in-body names body)) 61 | ;;Hint 62 | ((enable all-unbound-in-body))) 63 | 64 | (prove-lemma all-unbound-in-body-listp (rewrite) 65 | (equal (all-unbound-in-body names (cons occurrence rest)) 66 | (let ((outputs (occ-outputs occurrence))) 67 | (and (disjoint names outputs) 68 | (all-unbound-in-body names rest)))) 69 | ;;Hint 70 | ((enable all-unbound-in-body))) 71 | 72 | (prove-lemma all-unbound-in-body-append (rewrite) 73 | (equal (all-unbound-in-body (append names1 names2) body) 74 | (and (all-unbound-in-body names1 body) 75 | (all-unbound-in-body names2 body))) 76 | ;;Hint 77 | ((enable all-unbound-in-body append))) 78 | 79 | (prove-lemma all-unbound-in-body-cons (rewrite) 80 | (equal (all-unbound-in-body (cons name names) body) 81 | (and (unbound-in-body name body) 82 | (all-unbound-in-body names body))) 83 | ;;Hint 84 | ((enable all-unbound-in-body unbound-in-body append))) 85 | 86 | (prove-lemma all-unbound-in-body-nlistp-names (rewrite) 87 | (implies 88 | (nlistp names) 89 | (all-unbound-in-body names body)) 90 | ;;Hint 91 | ((enable all-unbound-in-body))) 92 | 93 | ;;; Lemmas 94 | 95 | (prove-lemma unbound-in-body-dual-eval-1 (rewrite) 96 | (implies 97 | (and (equal flag 1) 98 | (unbound-in-body name body)) 99 | (equal (value name (dual-eval flag body bindings state-bindings netlist)) 100 | (value name bindings))) 101 | ;;Hint 102 | ((induct (dual-eval flag body bindings state-bindings netlist)) 103 | (enable unbound-in-body))) 104 | 105 | (prove-lemma all-unbound-in-body-dual-eval-1 (rewrite) 106 | (implies 107 | (and (equal flag 1) 108 | (all-unbound-in-body names body)) 109 | (equal (collect-value 110 | names 111 | (dual-eval flag body bindings state-bindings netlist)) 112 | (collect-value names bindings))) 113 | ;;Hint 114 | ((induct (dual-eval flag body bindings state-bindings netlist)) 115 | (enable all-unbound-in-body))) 116 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/v-equal.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; V-EQUAL.EVENTS 8 | ;;; 9 | ;;; An n-bit equality circuit -- An XOR vector and a zero detector. 10 | ;;; 11 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 12 | 13 | (module-generator 14 | (v-equal* n) 15 | (index 'V-EQUAL n) 16 | (append (indices 'A 0 n) (indices 'B 0 n)) 17 | '(EQUAL) 18 | (list 19 | (list 'G0 20 | (indices 'X 0 n) 21 | (index 'V-XOR n) 22 | (append (indices 'A 0 n) (indices 'B 0 n))) 23 | (list 'G1 24 | '(EQUAL) 25 | (index 'TV-ZEROP (tree-number (make-tree n))) 26 | (indices 'X 0 n))) 27 | nil) 28 | 29 | (defn v-equal& (netlist n) 30 | (and (equal (lookup-module (index 'V-EQUAL n) netlist) 31 | (v-equal* n)) 32 | (let ((netlist (delete-module (index 'V-EQUAL n) netlist))) 33 | (and (v-xor& netlist n) 34 | (tv-zerop& netlist (make-tree n)))))) 35 | 36 | (disable v-equal&) 37 | 38 | (defn v-equal$netlist (n) 39 | (cons (v-equal* n) 40 | (union (v-xor$netlist n) 41 | (tv-zerop$netlist (make-tree n))))) 42 | 43 | (defn f$v-equal (a b) 44 | (f$tv-zerop (fv-xor a b) (make-tree (length a)))) 45 | 46 | (disable f$v-equal) 47 | 48 | (prove-lemma v-equal$value (rewrite) 49 | (implies 50 | (and (v-equal& netlist n) 51 | (not (zerop n)) 52 | (properp a) (properp b) 53 | (equal (length a) n) 54 | (equal (length b) n)) 55 | (equal (dual-eval 0 (index 'V-EQUAL n) (append a b) state netlist) 56 | (list (f$v-equal a b)))) 57 | ;;Hint 58 | ((enable v-equal& v-xor$value tv-zerop$value v-equal*$destructure 59 | f$v-equal) 60 | (disable open-indices))) 61 | 62 | (disable v-equal$value) 63 | 64 | (prove-lemma f$v-equal=equal* (rewrite) 65 | (implies 66 | (and (not (zerop (length a))) 67 | (bvp a) 68 | (bvp b) 69 | (equal (length a) (length b))) 70 | (equal (f$v-equal a b) 71 | (equal a b))) 72 | ;;Hint 73 | ((enable f$v-equal))) 74 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/v-inc4.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; V-INC4.EVENTS -- A 4-bit incrementer. 8 | ;;; 9 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 10 | 11 | (defn v-inc4 (a0 a1 a2 a3) 12 | (let ((a0n (b-not a0)) 13 | (a1n (b-not a1)) 14 | (a2n (b-not a2)) 15 | (a3n (b-not a3))) 16 | (let ((c0 a0n) 17 | (c1 (b-nor a0n a1n)) 18 | (c2 (b-nor3 a0n a1n a2n))) 19 | (list a0n 20 | (b-xor a1n c0) 21 | (b-equv a2n c1) 22 | (b-equv a3n c2))))) 23 | 24 | (defn-to-module v-inc4) 25 | 26 | (defn f$v-inc4$v (a) 27 | (let ((a0 (car a)) 28 | (a1 (cadr a)) 29 | (a2 (caddr a)) 30 | (a3 (cadddr a))) 31 | (let ((a0n (f-not a0)) 32 | (a1n (f-not a1)) 33 | (a2n (f-not a2)) 34 | (a3n (f-not a3))) 35 | (let ((c0 a0n) 36 | (c1 (f-nor a0n a1n)) 37 | (c2 (f-nor3 a0n a1n a2n))) 38 | (list a0n 39 | (f-xor a1n c0) 40 | (f-equv a2n c1) 41 | (f-equv a3n c2)))))) 42 | 43 | (disable f$v-inc4$v) 44 | 45 | (prove-lemma properp-length-f$v-inc4$v (rewrite) 46 | (and (properp (f$v-inc4$v a)) 47 | (equal (length (f$v-inc4$v a)) 4)) 48 | ;;Hint 49 | ((enable f$v-inc4$v) 50 | (disable-theory f-gates))) 51 | 52 | (prove-lemma v-inc4$value-as-v-inc (rewrite) 53 | (implies 54 | (and (v-inc4& netlist) 55 | (properp a) 56 | (equal (length a) 4)) 57 | (equal (dual-eval 0 'v-inc4 a state netlist) 58 | (f$v-inc4$v a))) 59 | ;;Hint 60 | ((enable v-inc4$value f$v-inc4 f$v-inc4$v equal-length-add1) 61 | (disable-theory f-gates))) 62 | 63 | (prove-lemma f$v-inc4$v=v-inc (rewrite) 64 | (implies 65 | (and (bvp a) 66 | (equal (length a) 4)) 67 | (equal (f$v-inc4$v a) 68 | (v-inc a))) 69 | ;;Hint 70 | ((enable f$v-inc4$v v-inc v-sum equal-length-add1 boolp-b-gates) 71 | (disable-theory f-gates))) 72 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/vector-module.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; VECTOR-MODULE.EVENTS 8 | ;;; 9 | ;;; Automatic definition and proofs for simple linear vector modules of 10 | ;;; primitives or other modules. VECTOR-MODULE is defined in 11 | ;;; "vector-macros.lisp". 12 | ;;; 13 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 14 | 15 | 16 | ;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17 | ;;; 18 | ;;; VECTOR-MODULE-INDUCTION 19 | ;;; 20 | ;;; 21 | ;;; The induction scheme for vector modules. 22 | ;;; 23 | ;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 24 | 25 | (defn vector-module-induction (body m n bindings state-bindings netlist) 26 | (if (zerop n) 27 | t 28 | (vector-module-induction 29 | (cdr body) 30 | (add1 m) 31 | (sub1 n) 32 | (dual-eval-body-bindings 1 body bindings state-bindings netlist) 33 | state-bindings 34 | netlist))) 35 | 36 | ;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 37 | ;;; 38 | ;;; V-BUF 39 | ;;; V-OR 40 | ;;; V-XOR 41 | ;;; V-PULLUP 42 | ;;; V-WIRE 43 | ;;; 44 | ;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 45 | 46 | (vector-module v-buf (g (y) b-buf (a)) ((v-threefix a)) :enable (f-buf)) 47 | 48 | (vector-module v-or (g (y) b-or (a b)) ((fv-or a b))) 49 | 50 | (vector-module v-xor (g (y) b-xor (a b)) ((fv-xor a b))) 51 | 52 | (vector-module v-pullup (g (y) pullup (a)) ((v-pullup a))) 53 | 54 | (vector-module v-wire (g (y) t-wire (a b)) ((v-wire a b))) 55 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fm9001-piton/fm9001/well-formed-fm9001.events: -------------------------------------------------------------------------------- 1 | ;;; Copyright (C) 1990-1994 Computational Logic, Inc. All Rights 2 | ;;; Reserved. See the file LICENSE in this directory for the 3 | ;;; complete license agreement. 4 | 5 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | ;;; 7 | ;;; WELL-FORMED-FM9001.EVENTS 8 | ;;; 9 | ;;; These events guarantee that the FM9001 netlists are well formed. 10 | ;;; 11 | ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 12 | 13 | ;;; We first have to compile the definitions or this proof takes 14 | ;;; too long. 15 | 16 | (compile-uncompiled-defns* "a-weird-file-name") 17 | 18 | (prove-lemma chip-well-formed () 19 | (and (equal (top-level-predicate (chip-module$netlist)) 20 | T) 21 | (equal (top-level-predicate (chip$netlist)) 22 | T)) 23 | ((disable top-level-predicate chip-module$netlist chip$netlist))) 24 | 25 | (prove-lemma chip-well-formed-after-indexed-names-removed () 26 | (and (equal (top-level-predicate (lisp-netlist (chip-module$netlist))) 27 | T) 28 | (equal (top-level-predicate (lisp-netlist (chip$netlist))) 29 | T)) 30 | ((disable top-level-predicate lisp-netlist 31 | chip-module$netlist chip$netlist))) 32 | 33 | 34 | ;; The "simple" version of the predicate does not permit tri-state 35 | ;; circuits, thus we can only check the "body" of the chip. 36 | 37 | (prove-lemma chip-well-formed-simple () 38 | (and (equal (top-level-predicate-simple (chip-module$netlist)) 39 | T) 40 | (equal (top-level-predicate-simple 41 | (lisp-netlist (chip-module$netlist))) 42 | T)) 43 | ((disable top-level-predicate chip-module$netlist))) 44 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fortran-vcg/README: -------------------------------------------------------------------------------- 1 | Three of the *.events files in this directory were generated by our Fortran 2 | verification condition generator (vcg). The algorithms, specifications, and 3 | invariants are included at the end of these *.events files. `isqrt.events' 4 | is a Newton-style integer square root algorithm. `mjrty.events' is our 5 | majority vote algorithm. `fsrch.events' is a version of our fast string 6 | algorithm. The file `fortran.events' is used both in the verification 7 | condition generation process, and in the process of proving those conditions. 8 | 9 | Also this directory is our FORTRAN verification condition generator, whose 10 | basic principles of operation are described in gory detail in our article `A 11 | Verification Condition Generator for FORTRAN' by R. S. Boyer and J S. Moore 12 | in the book `The Correctness Problem in Computer Science', eds. R. S. Boyer 13 | and J S. Moore, Academic Press, 1981. The vcg source code, in the file 14 | `fortran-vcg.lsp', is documented only by (a) the aforementioned article, (b) 15 | several pages of comments in file fortran-vcg.lsp itself, (c) this README 16 | file, and (d) the other *.lsp files on this directory, which are examples for 17 | processing by the vcg. We offer this vcg Lisp source code to the public for 18 | the curious, who may wish to see how a c. 1980 vcg works. As usual, no 19 | warranty, etc. 20 | 21 | The vcg program is written in Common Lisp, and is intended to be run from 22 | within Nqthm-1992, the Boyer-Moore prover, which we assume has already been 23 | installed. 24 | 25 | Here are the basic operating instructions for the vcg. 26 | 27 | 1. From within Nqthm-1992, one time only, while connected to this subdirectory 28 | `fortran-vcg' one should first 29 | 30 | (load "fortran-vcg.lsp") 31 | 32 | (compile-file "fortran-vcg.lsp") 33 | 34 | 2. From within Nqthm-1992, one time only, while connected to this subdirectory, 35 | one should 36 | 37 | (load "fortran.events") 38 | 39 | which will create the library file `fortran', i.e., files `fortran.lib' and 40 | `fortran.lisp', from the events in `fortran.events'. (Because fortran.events 41 | is one of the standard Nqthm-1992 example files, this library will also be 42 | created in the running of those examples.) This fortran library is used both 43 | by the vcg and as the starting point from which verification conditions (vcs) 44 | are to be proved. 45 | 46 | 3. To process particular examples with the vcg, from within Nqthm-1992, first 47 | execute, while connected to this subdirectory, 48 | 49 | (load "fortran-vcg") 50 | 51 | (note-lib "fortran") 52 | 53 | There are three example files for generating FORTRAN vcs on this directory: 54 | 55 | isqrt.lsp An integer square root function. 56 | 57 | mjrty.lsp A linear time majority voter. 58 | 59 | fsrch.lsp A fast string searching algorithm. 60 | 61 | To test the system on `fsrch.lsp', for example, one then executes 62 | 63 | (load "fsrch.lsp") 64 | 65 | (add-fsrch) 66 | 67 | The last command creates two files, fsrch.context and fsrch.vcs. The first 68 | file contains the FORTRAN code and the input and output conditions. The 69 | second file contains the verification conditions that must be proved to show 70 | that the code satisfies the input and output conditions. 71 | 72 | To check the verification conditions, proceed, within Nqthm-1992, to 73 | 74 | (load "fortran-vcg") 75 | 76 | (note-lib "fortran") 77 | 78 | (load "fsrch.vcs") 79 | 80 | (do-events vcs) 81 | 82 | If no errors or failures are reported, then the vcs will have been proved, 83 | and hence, we believe, the FORTRAN code satisfies its specification. 84 | 85 | It is *very important* to understand that the vcg generates the text of the 86 | verified FORTRAN code, not the user!! We have no FORTRAN parser!! Instead, 87 | the user provides Lisp-like input, which is quite reminiscent of the FORTRAN 88 | code to be generated, and which the vcg processes with extreme care. The vcg 89 | prints, from what the user has provided, the actual FORTRAN code, which will be 90 | found in the *.context files produced. 91 | 92 | Real tests (blush) of the verified code, with the bsd Fortran processor f77, 93 | are given in the the files *.f, which contain instructions for their own 94 | execution. The file fsrch.f illustrates the instantiation of a global 95 | parameter, ASIZE& in the file fsrch.context, with a specific value, i.e., 96 | 128. The Fortran in the *.f files was extracted from the corresponding 97 | *.context files. 98 | 99 | The resulting vcs from the three examples provided can be checked under 100 | Nqthm-1992, with the Nqthm-1992 function DO-EVENTS, but not under the more 101 | draconian function PROVE-FILE because of the presence of FORTRAN-COMMENT 102 | forms, which macro expand into axiomatic no-ops. DO-EVENTS handles the macro 103 | expansion happily, but PROVE-FILE will have none of it. See the files 104 | nqthm-1992/examples/fortran-vcg/*.events for an illustration of the simple 105 | transformation necessary to run the vcs under PROVE-FILE. It is those 106 | *.events files that are officially part of the Nqthm-1992 examples 107 | distribution. The *.lsp files we provide here are unannounced freebies for 108 | the curious. 109 | 110 | The reason we have named some files *.lsp rather than *.lisp on this 111 | directory is only to protect those files from being deleted by the "make 112 | clean-giant-examples" command, which deletes all *.lisp files from 113 | subdirectories of the examples directory. 114 | 115 | The easiest way, under unix, assuming that nqthm-1992 is in your executable 116 | path, to run this system is simply to execute, when connected to this 117 | subdirectory, 118 | 119 | make all 120 | 121 | which loads the file `all.lsp', which in turn does all the loading and 122 | compiling necessary to run the vcg and the prover on the three example files 123 | provided. 124 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fortran-vcg/all.lsp: -------------------------------------------------------------------------------- 1 | (load "fortran-vcg.lsp") 2 | (compile-file "fortran-vcg.lsp") 3 | (load "fortran-vcg") 4 | (load "fortran.events") 5 | 6 | (note-lib "fortran") 7 | (load "fsrch.lsp") 8 | (add-fsrch) 9 | (note-lib "fortran") 10 | (load "fsrch.vcs") 11 | (do-events vcs) 12 | 13 | 14 | (note-lib "fortran") 15 | (load "mjrty.lsp") 16 | (add-mjrty) 17 | (note-lib "fortran") 18 | (load "mjrty.vcs") 19 | (do-events vcs) 20 | 21 | (note-lib "fortran") 22 | (load "isqrt.lsp") 23 | (add-isqrt) 24 | (note-lib "fortran") 25 | (load "fsrch.vcs") 26 | (do-events vcs) 27 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fortran-vcg/fsrch.f: -------------------------------------------------------------------------------- 1 | C This is a test run of the fsrch routine generated by the 2 | C vcg. We search for the pattern "123" in the pattern "121236789". 3 | C Note that we have replaces the parameter ASIZE& with 128. 4 | C To run this on a bsd unix and see the answer, which is 3, you incant 5 | C % f77 fsrch.f 6 | C % a.out 7 | C % cat fort.23 8 | INTEGER DELTA1 9 | DIMENSION DELTA1(128) 10 | COMMON /BLK/DELTA1 11 | INTEGER PAT(3) 12 | INTEGER STR(10) 13 | INTEGER X 14 | PAT(1) = 1 15 | PAT(2) = 2 16 | PAT(3) = 3 17 | STR(1) = 1 18 | STR(2) = 2 19 | STR(3) = 1 20 | STR(4) = 2 21 | STR(5) = 3 22 | STR(6) = 6 23 | STR(7) = 7 24 | STR(8) = 8 25 | STR(9) = 9 26 | STR(10) = 10 27 | CALL FSRCH(PAT,STR,3,10,X) 28 | WRITE (23, 17) X 29 | 17 FORMAT (I10.10) 30 | END 31 | SUBROUTINE SETUP(A, MAXI) 32 | INTEGER DELTA1 33 | INTEGER A 34 | INTEGER MAXI 35 | INTEGER I 36 | INTEGER C 37 | DIMENSION DELTA1(128) 38 | DIMENSION A(MAXI) 39 | COMMON /BLK/DELTA1 40 | DO 50 I = 1, 128 41 | C DOJUNK PASS1 42 | DELTA1(I) = MAXI 43 | 50 CONTINUE 44 | DO 100 I = 1, MAXI 45 | C DOJUNK PASS2 46 | C = A(I) 47 | DELTA1(C) = (MAXI - I) 48 | 100 CONTINUE 49 | RETURN 50 | END 51 | SUBROUTINE FSRCH(PAT, STR, PATLEN, STRLEN, X) 52 | INTEGER DELTA1 53 | INTEGER MAX0 54 | INTEGER PATLEN 55 | INTEGER STRLEN 56 | INTEGER PAT 57 | INTEGER STR 58 | INTEGER I 59 | INTEGER J 60 | INTEGER C 61 | INTEGER NEXTI 62 | INTEGER X 63 | DIMENSION DELTA1(128) 64 | DIMENSION PAT(PATLEN) 65 | DIMENSION STR(STRLEN) 66 | COMMON /BLK/DELTA1 67 | CALL SETUP(PAT, PATLEN) 68 | I = PATLEN 69 | 200 CONTINUE 70 | C XXX INNER-TO-OUTER-HINTS 71 | CONTINUE 72 | C ASSERTION OUTER-INVRT 73 | IF ((I .GT. STRLEN)) GOTO 500 74 | J = PATLEN 75 | NEXTI = (1 + I) 76 | 300 CONTINUE 77 | C ASSERTION INNER-INVRT 78 | C = STR(I) 79 | IF ((C .NE. PAT(J))) GOTO 400 80 | IF ((J .EQ. 1)) GOTO 600 81 | J = (J - 1) 82 | I = (I - 1) 83 | C XXX INNER-TO-INNER-HINTS 84 | GOTO 300 85 | 400 I = MAX0((I + DELTA1(C)), NEXTI) 86 | GOTO 200 87 | 500 X = (STRLEN + 1) 88 | RETURN 89 | 600 CONTINUE 90 | C XXX INNER-TO-EXIT-HINTS 91 | X = I 92 | RETURN 93 | END 94 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fortran-vcg/isqrt.f: -------------------------------------------------------------------------------- 1 | C This is a test of the isqrt routine. We compute the square root of 2 | C 30. 3 | C To run this on a bsd unix and see the answer, which is 5, you incant 4 | C % f77 isqrt.f 5 | C % a.out 6 | C % cat fort.23 7 | I = ISQRT(30) 8 | WRITE (23,17) I 9 | 17 FORMAT (I10.10) 10 | END 11 | INTEGER FUNCTION ISQRT(I) 12 | INTEGER I 13 | C CALCULATE THE SQUARE ROOT OF I USING THE NEWTON METHOD. 14 | IF ((I .LT. 0)) STOP 15 | IF ((I .GT. 1)) GOTO 100 16 | ISQRT = I 17 | RETURN 18 | C ISQRT TAKES ON INCREASINGLY SMALLER VALUES AND CONVERGES TO THE SQ 19 | C UARE ROOT OF I. THE FIRST APPROXIMATION IS ONE HALF I, WHICH IS NO 20 | C T LESS THAN THE SQUARE ROOT OF I WHEN 1 IS LESS THAN I. 21 | 100 ISQRT = (I / 2) 22 | 200 CONTINUE 23 | C ASSERTION LP 24 | IF (((I / ISQRT) .GE. ISQRT)) RETURN 25 | ISQRT = ((ISQRT + (I / ISQRT)) / 2) 26 | C XXX SQ-REWRITE-OFF-AGAIN 27 | GOTO 200 28 | END 29 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fortran-vcg/isqrt.lsp: -------------------------------------------------------------------------------- 1 | (DEFVAR ISQRT-VCS) 2 | (DEFVAR ISQRT-CONTEXT) 3 | (DEFPARAMETER ISQRT-TOKENS NIL) 4 | (DEFPARAMETER ISQRT-BLOCKS NIL) 5 | (DEFPARAMETER ISQRT-XXX 6 | '((DEFN SQ (I) (TIMES I I)) 7 | (HINT ISQRT-STUFF 8 | (PROVE-LEMMA PLUS-1 (REWRITE) 9 | (EQUAL (PLUS 1 X) 10 | (ADD1 X))) 11 | (PROVE-LEMMA DIFFERENCE-2 (REWRITE) 12 | (EQUAL (DIFFERENCE (ADD1 (ADD1 X)) 13 | 2) 14 | (FIX X))) 15 | (PROVE-LEMMA QUOTIENT-BY-2 (REWRITE) 16 | (NOT (LESSP (PLUS (QUOTIENT A 2) 17 | (QUOTIENT A 2)) 18 | (SUB1 A)))) 19 | (PROVE-LEMMA 20 | MAIN-TRICK 21 | (REWRITE) 22 | (NOT (LESSP (SQ (ADD1 (QUOTIENT (PLUS J K) 2))) 23 | (PLUS (TIMES J K) 24 | J))) 25 | ((INDUCT (LESSP J K)))) 26 | (PROVE-LEMMA LESSP-REMAINDER2 (REWRITE GENERALIZE) 27 | (EQUAL (LESSP (REMAINDER X Y) 28 | Y) 29 | (NOT (ZEROP Y)))) 30 | (PROVE-LEMMA REMAINDER-QUOTIENT-ELIM (ELIM) 31 | (IMPLIES (AND (NOT (ZEROP Y)) 32 | (NUMBERP X)) 33 | (EQUAL (PLUS (REMAINDER X Y) 34 | (TIMES Y (QUOTIENT X Y))) 35 | X))) 36 | 37 | (PROVE-LEMMA SQ-ADD1-NON-ZERO (REWRITE) 38 | (NOT(EQUAL (SQ (ADD1 X)) 0))) 39 | (DISABLE SQ) 40 | (PROVE-LEMMA 41 | MAIN 42 | (REWRITE) 43 | (IMPLIES (NOT (ZEROP J)) 44 | (LESSP I (SQ (ADD1 (QUOTIENT (PLUS J (QUOTIENT I J)) 45 | 2)))))) 46 | 47 | (ENABLE SQ) 48 | (PROVE-LEMMA LESSP-TIMES-CANCELLATION-RESTATED-FOR-LINEAR 49 | (REWRITE) 50 | (IMPLIES (NOT (LESSP I J)) 51 | (NOT (LESSP (TIMES A I) 52 | (TIMES A J)))) NIL) 53 | 54 | ; (* This could be restated as an equivalence -- if B 55 | ; not equal 0 is thrown in too -- but I need it as 56 | ; a linear lemma- ) 57 | 58 | 59 | (PROVE-LEMMA MULTIPLY-THRU-BY-DIVISOR (REWRITE) 60 | (IMPLIES (LESSP A (TIMES B C)) 61 | (EQUAL (LESSP (QUOTIENT A B) 62 | C) 63 | T))) 64 | 65 | (PROVE-LEMMA TIMES-GREATERP-ZERO (REWRITE) 66 | (IMPLIES (AND (NOT (ZEROP X)) 67 | (NOT (ZEROP Y))) 68 | (LESSP 0 (TIMES X Y)))) 69 | (PROVE-LEMMA QUOTIENT-SHRINKS (REWRITE) 70 | (NOT (LESSP I (QUOTIENT I J)))) 71 | (PROVE-LEMMA QUOTIENT-SHRINKS-FAST (REWRITE) 72 | (NOT (LESSP I (TIMES 2 (QUOTIENT I 2))))) 73 | (PROVE-LEMMA QUOTIENT-BY-1 (REWRITE) 74 | (EQUAL (QUOTIENT I 1)(FIX I)))))) 75 | 76 | (DEFPARAMETER ISQRT-SUBPROGRAM (FAKE 77 | '(FUNCTION 78 | NAME ISQRT 79 | TYPE INTEGER 80 | ARGS (I) 81 | VAR-DCLS ((VAR-DCL I INTEGER NIL)) 82 | INPUT-COND (AND (NUMBERP (I STATE)) 83 | (LESSP (I STATE) 84 | (LEAST-INEXPRESSIBLE-POSITIVE-INTEGER))) 85 | RESULT (AND (ZGREATEREQP ANS 0) 86 | (NOT (LESSP (I STATE) (SQ ANS))) 87 | (LESSP (I STATE) (SQ (PLUS 1 ANS)))) 88 | CLOCKS ((I (START))) 89 | CODE 90 | ( 91 | (COMMENT CALCULATE THE SQUARE ROOT OF I USING THE NEWTON |METHOD.|) 92 | (IF-LOGICAL (ZLESSP I 0) (STOP)) 93 | (IF-LOGICAL (ZGREATERP I 1) (GOTO 100)) 94 | (ASSIGNMENT ISQRT I) 95 | (RETURN) 96 | (COMMENT 97 | ISQRT TAKES ON INCREASINGLY SMALLER VALUES AND CONVERGES 98 | TO THE SQUARE ROOT OF |I.| THE FIRST APPROXIMATION IS ONE HALF 99 | |I,| WHICH IS NOT LESS THAN THE SQUARE ROOT OF I WHEN 100 | 1 IS LESS THAN |I.|) 101 | 100 102 | (ASSIGNMENT ISQRT (ZQUOTIENT I 2)) 103 | 200 104 | (CONTINUE) 105 | (COMMENT ASSERTION LP (AND (LESSP 0 (ISQRT STATE)) 106 | (NOT (LESSP (I STATE) (TIMES 2 (ISQRT STATE)))) 107 | (NUMBERP (ISQRT STATE)) 108 | (LESSP (I STATE) 109 | (SQ (ADD1 (ISQRT STATE))))) 110 | ((ISQRT STATE))) 111 | (IF-LOGICAL (ZGREATEREQP (ZQUOTIENT I ISQRT) ISQRT) (RETURN)) 112 | (ASSIGNMENT ISQRT (ZQUOTIENT (ZPLUS ISQRT (ZQUOTIENT I ISQRT)) 113 | 2)) 114 | (COMMENT XXX SQ-REWRITE-OFF-AGAIN NIL (DISABLE SQ)) 115 | (GOTO 200))))) 116 | 117 | (DEFUN ADD-ISQRT NIL 118 | (PROG (TEMP) 119 | (SETQ TEMP (ADD-TO-CONTEXT ISQRT-TOKENS ISQRT-XXX ISQRT-BLOCKS 120 | ISQRT-SUBPROGRAM 121 | NIL)) 122 | (SETQ ISQRT-VCS (CAR TEMP)) 123 | (SETQ ISQRT-CONTEXT (CDR TEMP)) 124 | (COND ((CONSP ISQRT-VCS) 125 | (LET ((FILE (OPEN "isqrt.vcs" :direction :output))) 126 | (PRINC "(SETQ VCS '(" FILE) 127 | (TERPRI FILE) 128 | (ITERATE FOR X IN ISQRT-VCS DO 129 | (TERPRI FILE) 130 | (PPR X FILE)) 131 | (PRINC "))" FILE) 132 | (CLOSE FILE)) 133 | (PRINT-CONTEXT ISQRT-CONTEXT "isqrt.context" NIL) 134 | (RETURN (LIST (QUOTE ISQRT-VCS) 135 | (QUOTE ISQRT-CONTEXT)))) 136 | (T (RETURN FAILURE-MSG))))) 137 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fortran-vcg/makefile: -------------------------------------------------------------------------------- 1 | # 2 | all: 3 | nqthm-1992 < all.lsp > fortran.log 4 | 5 | TAGS: 6 | etags *.lsp 7 | 8 | clean: 9 | rm -f *.o *.c *.h *.data *.sbin *.lbin *.fasl *.sparcf \ 10 | *.vcs *.context TAGS fortran.log VCG-TEMP *.lib *.lisp 11 | -------------------------------------------------------------------------------- /nqthm-1992/examples/fortran-vcg/mjrty.f: -------------------------------------------------------------------------------- 1 | C This is a test of the mjrty FORTRAN program. We look for 2 | C and detect a majority in the sequence (1,2,1,5,1). 3 | C To run this on a bsd unix and see the answer, which is 1 and 1, you incant 4 | C % f77 mjrty.f 5 | C % a.out 6 | C % cat fort.23 7 | INTEGER I(5) 8 | LOGICAL BOOLE 9 | INTEGER CAND 10 | I(1) = 1 11 | I(2) = 2 12 | I(3) = 1 13 | I(4) = 5 14 | I(5) = 1 15 | CALL MJRTY(I,5,BOOLE,CAND) 16 | WRITE (23, 17) BOOLE, CAND 17 | 17 FORMAT (B, I10.10) 18 | END 19 | SUBROUTINE MJRTY(A, N, BOOLE, CAND) 20 | INTEGER N 21 | INTEGER A 22 | LOGICAL BOOLE 23 | INTEGER CAND 24 | INTEGER I 25 | INTEGER K 26 | DIMENSION A(N) 27 | K = 0 28 | C THE FOLLOWING DO IMPLEMENTS THE PAIRING PHASE. CAND IS THE CURRENT 29 | C LY LEADING CANDIDATE AND K IS THE NUMBER OF UNPAIRED VOTES FOR CAN 30 | C D. 31 | DO 100 I = 1, N 32 | C DOJUNK PHASE1-HINT 33 | IF ((K .EQ. 0)) GOTO 50 34 | IF ((CAND .EQ. A(I))) GOTO 75 35 | K = (K - 1) 36 | GOTO 100 37 | 50 CAND = A(I) 38 | K = 1 39 | C XXX PHASE1-INVRT-F-T 40 | GOTO 100 41 | 75 K = (K + 1) 42 | 100 CONTINUE 43 | IF ((K .EQ. 0)) GOTO 300 44 | BOOLE = .TRUE. 45 | IF ((K .GT. (N / 2))) RETURN 46 | C WE NOW ENTER THE COUNTING PHASE. BOOLE IS SET TO TRUE IN ANTICIPAT 47 | C ION OF FINDING CAND IN THE MAJORITY. K IS USED AS THE RUNNING TALL 48 | C Y FOR CAND. WE EXIT AS SOON AS K EXCEEDS N/2. 49 | K = 0 50 | DO 200 I = 1, N 51 | C DOJUNK PHASE2 52 | IF ((CAND .NE. A(I))) GOTO 200 53 | K = (K + 1) 54 | C XXX OUTPUT-HINT 55 | IF ((K .GT. (N / 2))) RETURN 56 | 200 CONTINUE 57 | 300 BOOLE = .FALSE. 58 | C XXX HINT-FOR-PHASE1-INVRT-T-T 59 | C XXX HINT-FOR-PHASE2-INVRT-T 60 | RETURN 61 | END 62 | -------------------------------------------------------------------------------- /nqthm-1992/examples/kaufmann/expr-compiler.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 4 | 5 | This script is hereby placed in the public domain, and therefore unlimited 6 | editing and redistribution is permitted. 7 | 8 | NO WARRANTY 9 | 10 | Computational Logic, Inc. PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT 11 | IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, 12 | INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND 13 | FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND 14 | PERFORMANCE OF THE SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU 15 | ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16 | 17 | IN NO EVENT WILL Computational Logic, Inc. BE LIABLE TO YOU FOR ANY DAMAGES, 18 | ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL 19 | DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT 20 | NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES 21 | SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF 22 | SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 23 | |# 24 | 25 | ;; Matt Kaufmann 26 | 27 | ;; From a session with Shaun Cooper, 12/9/91. Based on CLI Internal 28 | ;; Note 210 by Bill Young. 29 | 30 | (boot-strap nqthm) 31 | 32 | (defn length (x) 33 | (if (listp x) 34 | (add1 (length (cdr x))) 35 | 0)) 36 | 37 | (defn plistp (x) 38 | (if (listp x) 39 | (plistp (cdr x)) 40 | (equal x nil))) 41 | 42 | (defn exp-p (exp) 43 | (cond 44 | ((numberp exp) t) 45 | ((not (plistp exp)) f) 46 | ((equal (length exp) 3) 47 | (cond 48 | ((equal (car exp) 'plus) 49 | (and (exp-p (cadr exp)) (exp-p (caddr exp)))) 50 | ((equal (car exp) 'times) 51 | (and (exp-p (cadr exp)) (exp-p (caddr exp)))) 52 | ((equal (car exp) 'subtract) 53 | (and (exp-p (cadr exp)) (exp-p (caddr exp)))) 54 | (t f))) 55 | (t f))) 56 | 57 | (prove-lemma exp-p-opener (rewrite) 58 | (implies (not (numberp exp)) 59 | (equal (exp-p exp) 60 | (cond 61 | ((not (plistp exp)) f) 62 | ((equal (length exp) 3) 63 | (cond 64 | ((equal (car exp) 'plus) 65 | (and (exp-p (cadr exp)) (exp-p (caddr exp)))) 66 | ((equal (car exp) 'times) 67 | (and (exp-p (cadr exp)) (exp-p (caddr exp)))) 68 | ((equal (car exp) 'subtract) 69 | (and (exp-p (cadr exp)) (exp-p (caddr exp)))) 70 | (t f))) 71 | (t f))))) 72 | 73 | (defn eval-s (exp) 74 | (cond 75 | ((not (exp-p exp)) 76 | 0) 77 | ((numberp exp) exp) 78 | ((equal (car exp) 'plus) 79 | (plus (eval-s (cadr exp)) (eval-s (caddr exp)))) 80 | ((equal (car exp) 'times) 81 | (times (eval-s (cadr exp)) (eval-s (caddr exp)))) 82 | ((equal (car exp) 'subtract) 83 | (difference (eval-s (cadr exp)) (eval-s (caddr exp)))) 84 | (t 0))) 85 | 86 | (disable exp-p-opener) 87 | 88 | (defn target-inst-p (exp) 89 | (if (nlistp exp) 90 | (member exp '(add mult sub)) 91 | (and (plistp exp) 92 | (equal (length exp) 2) 93 | (equal (car exp) 'pushc) 94 | (numberp (cadr exp))))) 95 | 96 | (defn target-inst-list-p (exp) 97 | (if (listp exp) 98 | (and (target-inst-p (car exp)) 99 | (target-inst-list-p (cdr exp))) 100 | (equal exp nil))) 101 | 102 | (defn single-step (inst s) 103 | ;; inst is a target instruction 104 | (case inst 105 | (add (cons (plus (cadr s) (car s)) 106 | (cddr s))) 107 | (mult (cons (times (cadr s) (car s)) 108 | (cddr s))) 109 | (sub (cons (difference (cadr s) (car s)) 110 | (cddr s))) 111 | (otherwise (cons (cadr inst) s)))) 112 | 113 | (defn interpreter-target (inst-list s) 114 | (if (listp inst-list) 115 | (interpreter-target (cdr inst-list) (single-step (car inst-list) s)) 116 | s)) 117 | 118 | (enable exp-p-opener) 119 | 120 | (defn compile (exp) 121 | (cond 122 | ;; the first branch is needed in order to get this definition accepted 123 | ((not (exp-p exp)) 124 | nil) 125 | ((numberp exp) (list (list 'pushc exp))) 126 | ((equal (car exp) 'plus) 127 | (append (compile (cadr exp)) 128 | (append (compile (caddr exp)) 129 | (list 'add)))) 130 | ((equal (car exp) 'times) 131 | (append (compile (cadr exp)) 132 | (append (compile (caddr exp)) 133 | (list 'mult)))) 134 | ((equal (car exp) 'subtract) 135 | (append (compile (cadr exp)) 136 | (append (compile (caddr exp)) 137 | (list 'sub)))) 138 | (t nil))) 139 | 140 | (disable exp-p-opener) 141 | 142 | (prove-lemma compile-preserves-legality (rewrite) 143 | (implies (exp-p exp) 144 | (target-inst-list-p (compile exp)))) 145 | 146 | (prove-lemma interpreter-target-append (rewrite) 147 | (equal (interpreter-target (append inst-list1 inst-list2) s) 148 | (interpreter-target inst-list2 (interpreter-target inst-list1 s)))) 149 | 150 | #| first version: provides too weak of an inductive hypothesis 151 | (prove-lemma compiler-correctness (rewrite) 152 | (implies (exp-p exp) 153 | (equal (eval-s exp) 154 | (car (interpreter-target (compile exp) s))))) 155 | |# 156 | 157 | (defn compiler-correctness-induct (exp s) 158 | (if (equal (length exp) 3) 159 | (and (compiler-correctness-induct (cadr exp) s) 160 | (compiler-correctness-induct (caddr exp) 161 | (cons (eval-s (cadr exp)) s))) 162 | t)) 163 | 164 | (prove-lemma compiler-correctness-plus (rewrite) 165 | (implies (exp-p exp) 166 | (equal (interpreter-target (compile exp) s) 167 | (cons (eval-s exp) s))) 168 | ((induct (compiler-correctness-induct exp s)))) 169 | 170 | (prove-lemma compiler-correctness (rewrite) 171 | (implies (exp-p exp) 172 | (equal (eval-s exp) 173 | (car (interpreter-target (compile exp) s))))) 174 | -------------------------------------------------------------------------------- /nqthm-1992/examples/kaufmann/permutationp-subbagp.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 4 | 5 | This script is hereby placed in the public domain, and therefore unlimited 6 | editing and redistribution is permitted. 7 | 8 | NO WARRANTY 9 | 10 | Computational Logic, Inc. PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT 11 | IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, 12 | INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND 13 | FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND 14 | PERFORMANCE OF THE SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU 15 | ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16 | 17 | IN NO EVENT WILL Computational Logic, Inc. BE LIABLE TO YOU FOR ANY DAMAGES, 18 | ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL 19 | DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT 20 | NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES 21 | SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF 22 | SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 23 | |# 24 | 25 | ;; Matt Kaufmann 26 | 27 | ;; An implementation of permutationp via bags. 28 | 29 | (boot-strap nqthm) 30 | 31 | (defn remove1 (a x) 32 | (if (listp x) 33 | (if (equal (car x) a) 34 | (cdr x) 35 | (cons (car x) 36 | (remove1 a (cdr x)))) 37 | x)) 38 | 39 | (defn badguy (x y) 40 | (if (listp x) 41 | (if (member (car x) y) 42 | (badguy (cdr x) (remove1 (car x) y)) 43 | (car x)) 44 | 0)) 45 | 46 | (defn subbagp (x y) 47 | (if (listp x) 48 | (and (member (car x) y) 49 | (subbagp (cdr x) (remove1 (car x) y))) 50 | t)) 51 | 52 | (defn occur (a x) 53 | (if (listp x) 54 | (if (equal (car x) a) 55 | (add1 (occur a (cdr x))) 56 | (occur a (cdr x))) 57 | 0)) 58 | 59 | (prove-lemma member-occur (rewrite) 60 | (equal (member a x) 61 | (lessp 0 (occur a x)))) 62 | 63 | (prove-lemma occur-remove1 (rewrite) 64 | (equal (occur a (remove1 b x)) 65 | (if (equal a b) 66 | (sub1 (occur a x)) 67 | (occur a x)))) 68 | 69 | (prove-lemma subbagp-wit-lemma (rewrite) 70 | (equal (subbagp x y) 71 | (not (lessp (occur (badguy x y) y) 72 | (occur (badguy x y) x))))) 73 | 74 | (prove-lemma occur-append (rewrite) 75 | (equal (occur a (append x y)) 76 | (plus (occur a x) (occur a y)))) 77 | 78 | (prove-lemma subbagp-append (rewrite) 79 | (subbagp (append x y) (append y x))) 80 | 81 | (defn permutationp (x y) 82 | (and (subbagp x y) 83 | (subbagp y x))) 84 | 85 | (prove-lemma permutationp-append (rewrite) 86 | (permutationp (append x y) (append y x))) 87 | 88 | (prove-lemma subbagp-necc (rewrite) 89 | (implies (subbagp x y) 90 | (not (lessp (occur a y) (occur a x))))) 91 | 92 | (prove-lemma subbagp-transitive 93 | (rewrite) 94 | (implies (and (subbagp x y) (subbagp y z)) 95 | (subbagp x z)) 96 | ((use (subbagp-necc (a (badguy x z)) (y z) (x y)) 97 | (subbagp-necc (a (badguy x z)))) 98 | (disable subbagp-necc))) 99 | 100 | (prove-lemma permutationp-transitive 101 | (rewrite) 102 | (implies (and (permutationp x y) (permutationp y z)) 103 | (permutationp x z)) 104 | ((disable subbagp-wit-lemma))) -------------------------------------------------------------------------------- /nqthm-1992/examples/kaufmann/rotate.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 4 | 5 | This script is hereby placed in the public domain, and therefore unlimited 6 | editing and redistribution is permitted. 7 | 8 | NO WARRANTY 9 | 10 | Computational Logic, Inc. PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT 11 | IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, 12 | INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND 13 | FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND 14 | PERFORMANCE OF THE SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU 15 | ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16 | 17 | IN NO EVENT WILL Computational Logic, Inc. BE LIABLE TO YOU FOR ANY DAMAGES, 18 | ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL 19 | DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT 20 | NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES 21 | SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF 22 | SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 23 | |# 24 | 25 | ;; See CLI Internal Note 185 for a tutorial introduction to the 26 | ;; Boyer-Moore prove based on this example. 27 | 28 | (BOOT-STRAP NQTHM) 29 | 30 | (DEFN ROTATE (N LST) 31 | (IF (ZEROP N) 32 | LST 33 | (ROTATE (SUB1 N) 34 | (APPEND (CDR LST) (LIST (CAR LST)))))) 35 | 36 | (DEFN LENGTH (X) 37 | (IF (LISTP X) 38 | (ADD1 (LENGTH (CDR X))) 39 | 0)) 40 | 41 | (DEFN PROPERP (X) 42 | (IF (LISTP X) 43 | (PROPERP (CDR X)) 44 | (EQUAL X NIL))) 45 | 46 | (DEFN FIRSTN (N LST) 47 | (IF (ZEROP N) 48 | NIL 49 | (CONS (CAR LST) 50 | (FIRSTN (SUB1 N) (CDR LST))))) 51 | 52 | (DEFN NTHCDR (N LST) 53 | (IF (ZEROP N) 54 | LST 55 | (NTHCDR (SUB1 N) (CDR LST)))) 56 | 57 | (PROVE-LEMMA ASSOCIATIVITY-OF-APPEND (REWRITE) 58 | (EQUAL (APPEND (APPEND X Y) Z) 59 | (APPEND X (APPEND Y Z)))) 60 | 61 | (PROVE-LEMMA APPEND-NIL (REWRITE) 62 | (IMPLIES (PROPERP X) 63 | (EQUAL (APPEND X NIL) 64 | X))) 65 | 66 | (DEFN ROTATE-APPEND-INDUCTION (N LST EXTRA) 67 | (IF (OR (EQUAL N 0) (NOT (NUMBERP N))) 68 | T 69 | (IF (NLISTP LST) 70 | T 71 | (ROTATE-APPEND-INDUCTION 72 | (SUB1 N) 73 | (CDR LST) 74 | (APPEND EXTRA (LIST (CAR LST))))))) 75 | 76 | (PROVE-LEMMA PROPERP-APPEND (REWRITE) 77 | (EQUAL (PROPERP (APPEND X Y)) 78 | (PROPERP Y))) 79 | 80 | (PROVE-LEMMA ROTATE-APPEND () 81 | (IMPLIES (AND (PROPERP EXTRA) 82 | (NOT (LESSP (LENGTH LST) N))) 83 | (EQUAL (ROTATE N (APPEND LST EXTRA)) 84 | (APPEND (NTHCDR N LST) 85 | (APPEND EXTRA (FIRSTN N LST))))) 86 | ((INDUCT (ROTATE-APPEND-INDUCTION N LST EXTRA)))) 87 | 88 | (PROVE-LEMMA NTHCDR-LENGTH (REWRITE) 89 | (IMPLIES (PROPERP LST) 90 | (EQUAL (NTHCDR (LENGTH LST) LST) 91 | NIL))) 92 | 93 | (PROVE-LEMMA FIRSTN-LENGTH (REWRITE) 94 | (IMPLIES (PROPERP LST) 95 | (EQUAL (FIRSTN (LENGTH LST) LST) 96 | LST))) 97 | 98 | (PROVE-LEMMA ROTATE-LENGTH () 99 | (IMPLIES (PROPERP LST) 100 | (EQUAL (ROTATE (LENGTH LST) LST) 101 | LST)) 102 | ((USE (ROTATE-APPEND (EXTRA NIL) (N (LENGTH LST)))))) 103 | 104 | -------------------------------------------------------------------------------- /nqthm-1992/examples/kaufmann/rpn.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Matt Kaufmann, Damir Jamsek, and Computational Logic, 4 | Inc. All Rights Reserved. 5 | 6 | This script is hereby placed in the public domain, and therefore unlimited 7 | editing and redistribution is permitted. 8 | 9 | NO WARRANTY 10 | 11 | Matt Kaufmann, Damir Jamsek, and Computational Logic, Inc. PROVIDE ABSOLUTELY 12 | NO WARRANTY. THE EVENT SCRIPT IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY 13 | KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED 14 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 15 | ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SCRIPT IS WITH YOU. 16 | SHOULD THE SCRIPT PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY 17 | SERVICING, REPAIR OR CORRECTION. 18 | 19 | IN NO EVENT WILL Matt Kaufmann, Damir Jamsek, or Computational Logic, Inc. BE 20 | LIABLE TO YOU FOR ANY DAMAGES, ANY LOST PROFITS, LOST MONIES, OR OTHER 21 | SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR 22 | INABILITY TO USE THIS SCRIPT (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR 23 | DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES), EVEN IF 24 | YOU HAVE ADVISED US OF THE POSSIBILITY OF SUCH DAMAGES, OR FOR ANY CLAIM BY 25 | ANY OTHER PARTY.'' 26 | 27 | |# 28 | 29 | ;; An exercise in reverse Polish notation evaluation suggested 30 | ;; by Damir Jamsek. 31 | 32 | (boot-strap nqthm) 33 | 34 | (defn length (l) 35 | (if (listp l) 36 | (add1 (length (cdr l))) 37 | 0)) 38 | 39 | (defn op1 () '(suc)) 40 | 41 | (defn op2 () '(add mul div mod)) 42 | 43 | (defn op1-form-p (e) 44 | (and (listp e) 45 | (listp (cdr e)) 46 | (equal (cddr e) nil) 47 | (member (car e) (op1)))) 48 | 49 | (defn op2-form-p (e) 50 | (and (listp e) 51 | (listp (cdr e)) 52 | (listp (cddr e)) 53 | (equal (cdddr e) nil) 54 | (member (car e) (op2)))) 55 | 56 | (defn exp-p (e) 57 | (cond 58 | ((numberp e) t) 59 | ((op1-form-p e) 60 | (exp-p (cadr e))) 61 | ((op2-form-p e) 62 | (and (exp-p (cadr e)) 63 | (exp-p (caddr e)))) 64 | (t f))) 65 | 66 | (defn eval-exp (e) 67 | (cond 68 | ((numberp e) e) 69 | ((and (op1-form-p e) 70 | (equal (car e) 'suc)) 71 | (add1 (eval-exp (cadr e)))) 72 | ((and (op2-form-p e) 73 | (equal (car e) 'add)) 74 | (plus (eval-exp (cadr e)) 75 | (eval-exp (caddr e)))) 76 | ((and (op2-form-p e) 77 | (equal (car e) 'mul)) 78 | (times (eval-exp (cadr e)) 79 | (eval-exp (caddr e)))) 80 | ((and (op2-form-p e) 81 | (equal (car e) 'div)) 82 | (quotient (eval-exp (cadr e)) 83 | (eval-exp (caddr e)))) 84 | ((and (op2-form-p e) (equal (car e) 'mod)) 85 | (remainder (eval-exp (cadr e)) 86 | (eval-exp (caddr e)))) 87 | (t f))) 88 | 89 | 90 | (defn exp-to-rpn (e) 91 | (cond 92 | ((numberp e) 93 | (list e)) 94 | ((op1-form-p e) 95 | (append (exp-to-rpn (cadr e)) 96 | (list (car e)))) 97 | ((op2-form-p e) 98 | (append (exp-to-rpn (caddr e)) 99 | (append (exp-to-rpn (cadr e)) 100 | (list (car e))))) 101 | (t nil))) 102 | 103 | (defn eval-rpn (r s) 104 | (if (listp r) 105 | (cond 106 | ((numberp (car r)) 107 | (eval-rpn (cdr r) 108 | (cons (car r) s))) 109 | ((equal (car r) 'suc) 110 | (eval-rpn (cdr r) 111 | (cons (add1 (car s)) (cdr s)))) 112 | ((equal (car r) 'add) 113 | (eval-rpn (cdr r) 114 | (cons (plus (car s) (cadr s)) 115 | (cddr s)))) 116 | ((equal (car r) 'mul) 117 | (eval-rpn (cdr r) 118 | (cons (times (car s) (cadr s)) 119 | (cddr s)))) 120 | ((equal (car r) 'div) 121 | (eval-rpn (cdr r) 122 | (cons (quotient (car s) (cadr s)) 123 | (cddr s)))) 124 | ((equal (car r) 'mod) 125 | (eval-rpn (cdr r) 126 | (cons (remainder (car s) (cadr s)) 127 | (cddr s)))) 128 | (t (eval-rpn (cdr r) s))) 129 | s)) 130 | 131 | (prove-lemma eval-rpn-append (rewrite) 132 | (equal (eval-rpn (append r1 r2) s) 133 | (eval-rpn r2 (eval-rpn r1 s)))) 134 | 135 | (defn l1-ind (e s) 136 | (cond 137 | ((numberp e) t) 138 | ((op1-form-p e) 139 | (l1-ind (cadr e) s)) 140 | ((op2-form-p e) 141 | (and (l1-ind (caddr e) s) 142 | (l1-ind (cadr e) (cons (eval-exp (caddr e)) s)))) 143 | (t t))) 144 | 145 | (prove-lemma l1 () 146 | (implies (exp-p e) 147 | (equal (cons (eval-exp e) s) 148 | (eval-rpn (exp-to-rpn e) s))) 149 | ((induct (l1-ind e s)))) 150 | -------------------------------------------------------------------------------- /nqthm-1992/examples/kunen/ack.events: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (C) 1994 by Ken Kunen. All Rights Reserved. 3 | 4 | This script is hereby placed in the public domain, and therefore unlimited 5 | editing and redistribution is permitted. 6 | 7 | NO WARRANTY 8 | 9 | Ken Kunen PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT IS PROVIDED "AS 10 | IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT 11 | NOT LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 12 | PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 13 | SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU ASSUME THE COST OF 14 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 15 | 16 | IN NO EVENT WILL Ken Kunen BE LIABLE TO YOU FOR ANY DAMAGES, ANY LOST 17 | PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES 18 | ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT NOT 19 | LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED 20 | BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF SUCH 21 | DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 22 | |# 23 | 24 | (boot-strap nqthm) ; load basic definitions and lemmas 25 | 26 | ; From kunen@cs.wisc.edu Mon Oct 21 08:56:34 1991 27 | ; Date: Fri, 18 Oct 91 13:20:25 -0500 28 | ; From: kunen@cs.wisc.edu (Ken Kunen) 29 | ; To: boyer@CLI.COM, kaufmann@CLI.COM 30 | ; Subject: nqthm 31 | ; Cc: kunen@cs.wisc.edu 32 | ; 33 | ; The following is one of the examples I'm using in my course here 34 | ; to illustrate nqthm. In particular, note that the representation 35 | ; of a pair of numbers by an ordinal, as described on p. 42, is more 36 | ; complicated than it has to be. 37 | ; Ken 38 | ; 39 | ; ------------------------------------------------------------------------- 40 | 41 | 42 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 | ;;;;; CS761 -- SEMESTER I, 1991-92 ;;;;; 44 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 | 46 | ; nqthm contains induction on epsilon_0, so it's stronger than pure primitive 47 | ; recursive arithmetic. Presumably, it can prove Con(PA). 48 | ; LONG project -- do this 49 | 50 | ; This file -- a simple example -- use recursion on pairs to define the 51 | ; Ackermann function, which grows faster than any primitive recursive function 52 | ; see Aho-Hopcroft-Ullman, "Data Structures and Algorithms", p. 189 53 | 54 | 55 | 56 | ; Representation of a pair of numbers, (i,j), as the ordinal omega^(i+1) + j; 57 | ; This is a little simpler than the one described on Boyer-Moore p. 42. 58 | 59 | (defn rep (i j) (cons (add1 i) j)) 60 | (defn lex2 (i1 j1 i2 j2) 61 | (or 62 | (lessp i1 i2) 63 | (and (equal i1 i2) (lessp j1 j2)))) 64 | (prove-lemma rep-respects-lex (rewrite) (implies 65 | (and (numberp i1) (numberp i2) (numberp j1) (numberp j2)) 66 | (equal 67 | (lex2 i1 j1 i2 j2) 68 | (ord-lessp (rep i1 j1) (rep i2 j2))))) 69 | 70 | (defn ack (x y) 71 | (if (zerop x) 1 72 | (if (zerop y) (if (equal x 1) 2 (plus x 2)) 73 | (ack (ack (sub1 x) y) (sub1 y)) )) 74 | ( (ord-lessp (rep (fix y) (fix x))) )) ; hint 75 | ; "fix" = "cast to numberp" 76 | 77 | (prove-lemma ack-is-positive (rewrite) (equal (zerop (ack x y)) F)) 78 | 79 | (prove-lemma ack-of-1 (rewrite) ; ack(x,1) = 2x if x > 0 80 | (implies 81 | (not (zerop x)) 82 | (equal (ack x 1) (times x 2)))) 83 | 84 | (defn expt2 (x) (if (zerop x) 1 (times (expt2 (sub1 x)) 2))) 85 | 86 | (prove-lemma ack-of-2-aux1 (rewrite) (implies ;;;;;;;;;;;;;;;;;;;;;;;;;;;; 87 | (not (zerop x)) ; Table of values of ack 88 | (equal (ack x 2) (ack (ack (sub1 x) 2) 1)))) ; 89 | ; --------------------- 90 | (prove-lemma ack-of-2-aux2 (rewrite) (implies ; 3| 1 2 4 16 2^16 91 | (not (zerop x)) ; |--------------------- 92 | (equal (ack x 2) (times (ack (sub1 x) 2) 2))) ; 2| 1 2 4 8 16 93 | ( ; |--------------------- 94 | (do-not-induct T) ; 1| 1 2 4 6 8 95 | (use ; |--------------------- 96 | (ack-of-2-aux1 (x x)) ; 0| 1 2 4 5 6 97 | (ack-of-1 (x (ack (sub1 x) 2))) ) ; |_____________________ 98 | (disable ack-of-2-aux1 ack-of-1) ; 0 1 2 3 4 99 | )) ; 100 | ;;;;;;;;;;;;;;;;;;;;;;;;;; 101 | (prove-lemma ack-of-2 (rewrite) ; ack(x,2) = 2^x 102 | (equal (ack x 2) (expt2 x))) 103 | 104 | ; ack(x,3) = 2^2^2^ ...^2 (stack of x 2's, ^ assoc to right) 105 | 106 | 107 | 108 | -------------------------------------------------------------------------------- /nqthm-1992/examples/numbers/extras.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 4 | 5 | This script is hereby placed in the public domain, and therefore unlimited 6 | editing and redistribution is permitted. 7 | 8 | NO WARRANTY 9 | 10 | Computational Logic, Inc. PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT 11 | IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, 12 | INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND 13 | FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND 14 | PERFORMANCE OF THE SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU 15 | ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16 | 17 | IN NO EVENT WILL Computational Logic, Inc. BE LIABLE TO YOU FOR ANY DAMAGES, 18 | ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL 19 | DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT 20 | NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES 21 | SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF 22 | SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. 23 | |# 24 | 25 | ; Matt Wilding 26 | 27 | (note-lib "integers" T) 28 | 29 | (prove-lemma irem-itimes-igcd (rewrite) 30 | (implies 31 | (equal (irem x a) 0) 32 | (and 33 | (equal (irem x (igcd a b)) 0) 34 | (equal (irem x (igcd b a)) 0))) 35 | ((enable-theory ground-zero integer-defns naturals) 36 | (disable-theory t) 37 | (enable irem-is-my-irem my-irem igcd remainder-gcd-0))) 38 | 39 | (make-lib "extras" t) 40 | -------------------------------------------------------------------------------- /nqthm-1992/examples/talcott/README: -------------------------------------------------------------------------------- 1 | The files in this subdirectory are the work of Misao Nagayama and 2 | Carolyn Talcott. This directory contains event files for the events 3 | described in An NQTHM Mechanization of ``An Exercise in the 4 | Verification of Multi-Process Programs'' by Misao Nagayama and Carolyn 5 | Talcott, which is described in the following message. 6 | 7 | Date: Fri, 1 Nov 91 09:00:20 -0800 8 | From: Carolyn Talcott 9 | Message-Id: <9111011700.AA16816@SAIL.Stanford.EDU> 10 | To: nqthm-users@cli.com 11 | Subject: abstract 12 | Reply-To: clt@sail.stanford.edu 13 | 14 | 15 | The following report is available upon request to clt@sail.stanford.edu 16 | 17 | @techreport{nagayama-talcott-91bmp, 18 | author = {Nagayama, Misao and Talcott, Carolyn}, 19 | title = {An NQTHM Mechanization of 20 | ``An Exercise in the Verification of Multi-Process Programs''}, 21 | institution = {Computer Science Department, Stanford University}, 22 | number = {STAN-CS-91-1370}, 23 | year = 1991 24 | } 25 | Abstract: 26 | 27 | This report presents a formal verification of the local correctness of 28 | a mutex algorithm using the Boyer-Moore theorem prover. The 29 | formalization follows closely an informal proof of Manna and Pnueli. 30 | The proof method of Manna and Pnueli is to first extract from the 31 | program a set of states and induced transition system. One then 32 | proves suitable invariants There are two variants of the proof. In 33 | the first (atomic) variant, compound tests involving quantification 34 | over a finite set are viewed as atomic operations. In the second 35 | (molecular) variant, this assumption is removed, making the details of 36 | the transitions and proof somewhat more complicated. 37 | 38 | The original Manna-Pnueli proof was formulated in terms of finite 39 | sets. This led to a concise and elegant informal proof, however one 40 | that is not easy to mechanize in the Boyer-Moore logic. In the 41 | mechanized version we use a dual isomorphic representation of program 42 | states based on finite sequences. Our approach was to outline the 43 | formal proof of each invariant, making explicit the case analyses, 44 | assumptions and properties of operations used. The outline served as 45 | our guide in developing the formal proof. The resulting sequence of 46 | events follows the informal plan quite closely. The main difficulties 47 | encountered were in discovering the precise form of the lemmas and 48 | hints necessary to guide the theorem prover. 49 | 50 | The complete formal proofs (input to the Boyer-Moore prover) appear as 51 | appendices. Some comments on formalization techniques, difficulties, 52 | and alternatives are included as comments in the theorem prover input. 53 | 54 | The events are grouped in two files mutex-atomic.events for the atomic 55 | case and mutex-molecular.events for the non-atomic case. The composite files 56 | are segmented with page marks corresponding to the original files, and the 57 | contents of each `page' is describe below. 58 | 59 | ;;;;;;;;;;;;;;;;;;;;;; mutex-atomic.events ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 60 | 61 | com.ev 62 | Definitions and lemmas common to atomic and molecular cases---manipulation 63 | of finite sets and arrays, flag invariants. 64 | 65 | defn.ev 66 | Definitions of transition relation and invariants. 67 | 68 | basic.ev 69 | Properties of well-formed states are turned into rewrite rules. 70 | Several formulations of the rho! lemma 71 | are proved for use in different circumstances. 72 | Basic properties of the A-invariants are proved. 73 | 74 | ws.ev 75 | Proof that transitions preserve the well-formedness invariant Ws. 76 | 77 | lg.ev 78 | Proof that transitions preserve the flag invariant Lg. 79 | 80 | a0.ev 81 | Proof that transitions preserve Azero. 82 | 83 | a1.ev 84 | Proof that transitions preserve Aone. 85 | 86 | a2.ev 87 | Proof that transitions preserve Atwo. 88 | 89 | a3.ev 90 | Proof that transitions preserve Athree. 91 | 92 | 93 | ;;;;;;;;;;;;;;;;;;;;;; mutex-molecular.events ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 94 | 95 | com.ev 96 | Definitions and lemmas common to atomic and molecular cases---manipulation 97 | of finite sets and arrays, flag invariants. 98 | 99 | moldefn.ev 100 | Definitions of molecular transition relation and invariants. 101 | 102 | molbasic.ev 103 | More properties of finite sets. 104 | Properties of well-formed states are turned into rewrite rules. 105 | Several formulations of the molecular rho! lemma 106 | are proved for use in different circumstances. 107 | 108 | mollg.ev 109 | Proof that molecular transitions preserve the flag invariant Lg. 110 | 111 | b0.ev 112 | Proof that molecular transitions preserve Bzeroa, Bzerob. 113 | 114 | b1.ev 115 | Proof that molecular transitions preserve Bonea, Boneb, Bonec, Boned. 116 | 117 | b2.ev 118 | Proof that molecular transitions preserve Btwoa, Btwob. 119 | 120 | b3.ev 121 | Proof that molecular transitions preserve Bthreea, Bthreeb. 122 | 123 | -------------------------------------------------------------------------------- /nqthm-1992/examples/yu/README: -------------------------------------------------------------------------------- 1 | The files in this directory are the work of Yuan Yu. 2 | 3 | In the following, the notation "requires DEFN-SK" means that it is necessary to 4 | load the file defn-sk.lisp, Matt Kaufmann's skolemizer, into Nqthm, e.g., with 5 | the command (load "defn-sk.lisp"), before processing a particular file. The 6 | file defn-sk.lisp is distributed with Nqthm-1992, but it is not loaded via the 7 | standard load command (load-nqthm). 8 | 9 | group.events Theorems in group theory (requires DEFN-SK) 10 | A Journal of Automated Reasoning article about this work 11 | is cited in file. 12 | 13 | 14 | Everything below concerns mc68020 verification 15 | 16 | 17 | THE MC68020 SPECIFICATION 18 | 19 | mc20-0.events Prelude for the MC68020 specification 20 | mc20-1.events The MC68020 specification itself 21 | mc20-1.tex, .dvi The above, in Tex form 22 | (A slightly earlier version, in paper form, is 23 | available as TR 92-04 from the Computer Sciences Dept., 24 | University of Texas at Austin.) 25 | 26 | 27 | THE LEMMA LIBRARY 28 | 29 | mc20-2.events 30 | 31 | EXAMPLES 32 | 33 | amax.events (C) array maximum 34 | asm.events (C) embedded assembler 35 | bsearch.events (C) binary search 36 | switch.events (C) case statement with computed goto 37 | fixnum-gcd (Lisp) Euclid's gcd 38 | fmax.events (C) A function with a functional parameter 39 | gcd.events (C) Euclid's gcd 40 | gcd3.events (C) calling a proved subroutine 41 | isqrt-ada.events (Ada) integer square root, Newton's method 42 | isqrt.events (C) integer square root, Newton's method 43 | log2.events (C) integer log 44 | mjrty.events (C) majority vote algorithm 45 | qsort.events (C) quick sort, after K & R (requires DEFN-SK) 46 | zero.events (C) zero out an array 47 | 48 | 49 | BSD UNIX C STRING LIBRARY 50 | 51 | Verification of MC68020 machine code of 21 of the 22 C String Library functions 52 | from the Berkeley Unix C String Library, namely all the functions except 53 | strerror, which is specified to "return pointer to implementation-defined 54 | string corresponding to error n"; left out of Yu's work because of this 55 | implementation dependence. 56 | 57 | memchr.events 58 | memcmp.events 59 | memcpy.events 60 | memmove.events 61 | memset.events 62 | strcat.events 63 | strchr.events 64 | strcmp.events 65 | strcoll.events 66 | strcpy.events 67 | strcspn.events 68 | strlen.events 69 | strncat.events 70 | strncmp.events 71 | strncpy.events 72 | strpbrk.events 73 | strrchr.events 74 | strspn.events 75 | strstr.events 76 | strtok.events 77 | strxfrm.events 78 | 79 | cstring.events The proof of the second phase for all of the 80 | C string functions above (requires DEFN-SK). 81 | 82 | 83 | All of the C code in the above C string library files is covered by this 84 | copyright notice: 85 | 86 | /*- 87 | * Copyright (c) 1990 The Regents of the University of California. 88 | * All rights reserved. 89 | * 90 | * Some of the code was derived from software contributed to Berkeley by 91 | * Chris Torek and Jeffrey Mogul. 92 | # 93 | * Redistribution and use in source and binary forms are permitted 94 | * provided that: (1) source distributions retain this entire copyright 95 | * notice and comment, and (2) distributions including binaries display 96 | * the following acknowledgement: ``This product includes software 97 | * developed by the University of California, Berkeley and its contributors'' 98 | * in the documentation or other materials provided with the distribution 99 | * and in all advertising materials mentioning features or use of this 100 | * software. Neither the name of the University nor the names of its 101 | * contributors may be used to endorse or promote products derived 102 | * from this software without specific prior written permission. 103 | * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR 104 | * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 105 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. 106 | */ 107 | 108 | 109 | Permission from Yuan: 110 | 111 | From: yuan@cs.utexas.edu (Yuan Yu) 112 | Date: Thu, 29 Oct 92 21:03:01 -0600 113 | To: boyer@cli.com 114 | Subject: events files 115 | 116 | 117 | I have created a directory ~yuan/mc20/ on cs that contains all the events 118 | files in my dissertation. They have been successfully replayed. You 119 | may choose any of them to include in the nqthm-1992 release. 120 | 121 | Thanks, 122 | -Yuan 123 | 124 | -------------------------------------------------------------------------------- /nqthm-1992/examples/yu/asm.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Yuan Yu. All Rights Reserved. 4 | 5 | This script is hereby placed in the public domain, and therefore unlimited 6 | editing and redistribution is permitted. 7 | 8 | NO WARRANTY 9 | 10 | Yuan Yu PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT IS PROVIDED "AS IS" 11 | WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT NOT 12 | LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 13 | PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 14 | SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU ASSUME THE COST OF 15 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16 | 17 | IN NO EVENT WILL Yuan Yu BE LIABLE TO YOU FOR ANY DAMAGES, ANY LOST PROFITS, 18 | LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT 19 | OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT NOT LIMITED TO LOSS 20 | OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD 21 | PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF SUCH DAMAGES, OR 22 | FOR ANY CLAIM BY ANY OTHER PARTY. 23 | 24 | |# 25 | 26 | ; Proof of the Correctness of a FOO Function 27 | (note-lib "mc20-2" t) 28 | #| 29 | Here is a trivial example to illustrate our ability to handle embedded 30 | assembler in a high level language. 31 | 32 | foo returns either a or b depending on the memory value at location 10000. 33 | 34 | int foo (int a, int b) 35 | { 36 | asm("tstl 10000:w "); 37 | asm("beq l1 "); 38 | asm("movl a6@(12), d0 "); 39 | asm("jmp end "); 40 | asm("l1: movl a6@(8), d0 "); 41 | asm("end: nop "); 42 | } 43 | 44 | The MC68020 assembly code of the above C function on SUN-3 is given as 45 | follows. This binary is generated by "gcc -O". 46 | 47 | 0x243a : linkw fp,#0 48 | 0x243e : tstl @#0x2710 49 | 0x2442 : beq 0x244e 50 | 0x2446 : movel fp@(12),d0 51 | 0x244a : jmp 0x2452 52 | 0x244e : movel fp@(8),d0 53 | 0x2452 : nop 54 | 0x2454 : unlk fp 55 | 0x2456 : rts 56 | 57 | The machine code of the above program is: 58 | 59 | : 0x4e56 0x0000 0x4ab8 0x2710 0x6700 0x000a 0x202e 0x000c 60 | : 0x4efa 0x0006 0x202e 0x0008 0x4e71 0x4e5e 0x4e75 61 | 62 | '(78 86 0 0 74 184 39 16 63 | 103 0 0 10 32 46 0 12 64 | 78 250 0 6 32 46 0 8 65 | 78 113 78 94 78 117) 66 | |# 67 | 68 | ; in the logic, the above program is defined by (foo-code). 69 | (defn foo-code () 70 | '(78 86 0 0 74 184 39 16 71 | 103 0 0 10 32 46 0 12 72 | 78 250 0 6 32 46 0 8 73 | 78 113 78 94 78 117)) 74 | 75 | ; the Nqthm counterpart of foo. 76 | (defn foo (a b x) (if (equal x 0) a b)) 77 | 78 | ; the computation time of the program. 79 | (defn foo-t (x) (if (equal x 0) 7 8)) 80 | 81 | ; the preconditions of the initial state. 82 | (defn foo-statep (s a b) 83 | (and (equal (mc-status s) 'running) 84 | (evenp (mc-pc s)) 85 | (rom-addrp (mc-pc s) (mc-mem s) 30) 86 | (mcode-addrp (mc-pc s) (mc-mem s) (foo-code)) 87 | (ram-addrp (sub 32 4 (read-sp s)) (mc-mem s) 16) 88 | (ram-addrp 10000 (mc-mem s) 4) 89 | (disjoint 10000 4 (sub 32 4 (read-sp s)) 16) 90 | (equal a (iread-mem (add 32 (read-sp s) 4) (mc-mem s) 4)) 91 | (equal b (iread-mem (add 32 (read-sp s) 8) (mc-mem s) 4)))) 92 | 93 | ; from the initial state to exit: s --> exit. 94 | (prove-lemma foo-correctness (rewrite) 95 | (let ((x (iread-mem 10000 (mc-mem s) 4))) 96 | (implies (foo-statep s a b) 97 | (and (equal (mc-status (stepn s (foo-t x))) 'running) 98 | (equal (mc-pc (stepn s (foo-t x))) (rts-addr s)) 99 | (equal (read-rn 32 14 (mc-rfile (stepn s (foo-t x)))) 100 | (read-rn 32 14 (mc-rfile s))) 101 | (equal (read-rn 32 15 (mc-rfile (stepn s (foo-t x)))) 102 | (add 32 (read-an 32 7 s) 4)) 103 | (implies 104 | (d2-7a2-5p rn) 105 | (equal (read-rn oplen rn (mc-rfile (stepn s (foo-t x)))) 106 | (read-rn oplen rn (mc-rfile s)))) 107 | (implies 108 | (disjoint x k (sub 32 4 (read-sp s)) 16) 109 | (equal (read-mem x (mc-mem (stepn s (foo-t x))) k) 110 | (read-mem x (mc-mem s) k))) 111 | (equal (iread-dn 32 0 (stepn s (foo-t x))) 112 | (foo a b x)))))) -------------------------------------------------------------------------------- /nqthm-1992/examples/yu/mc20-1.aux: -------------------------------------------------------------------------------- 1 | \relax 2 | \citation{Boyer-Yu-91} 3 | \citation{m20} 4 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1}Introduction}{1}} 5 | \citation{BM-88} 6 | \citation{Boyer-Yu-91} 7 | \citation{m20} 8 | \citation{BM-88} 9 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {2}A Few Basic Functions}{2}} 10 | \citation{BM-88} 11 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3}Start Up}{3}} 12 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {4}Some Constants}{3}} 13 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {5}Bit Vector Arithmetic}{6}} 14 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {6}Integer Arithmetic}{9}} 15 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {7}Binary Trees for Memory}{12}} 16 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {8}Operands from Memory}{16}} 17 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {9}Storing the Result}{19}} 18 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {10}Retrieving the Operand According to Oplen}{22}} 19 | \citation{m:stack} 20 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {11}Effective Address Calculation}{23}} 21 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {12}The Individual Instructions}{33}} 22 | \citation{m20} 23 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {13}Stepi and Stepn}{102}} 24 | \newlabel{stepn}{{13}{102}} 25 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {14}Auxiliary Functions}{102}} 26 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {15}An Example of Simulation}{104}} 27 | \newlabel{example}{{15}{104}} 28 | \citation{Boyer-Yu-91} 29 | \citation{m:stack} 30 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {16}Acknowledgements}{106}} 31 | \citation{BM-88} 32 | \citation{BM-88} 33 | \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {17}Syntax Summary}{107}} 34 | \newlabel{syntax}{{17}{107}} 35 | \bibcite{m:stack}{1} 36 | \bibcite{BM-88}{2} 37 | \bibcite{Boyer-Yu-91}{3} 38 | \bibcite{m20}{4} 39 | \@writefile{toc}{\string\contentsline\space {section}{Index}{110}} 40 | -------------------------------------------------------------------------------- /nqthm-1992/examples/yu/mc20-1.dvi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/nqthm/aeafa016e424e9fba968a48bf7dab45ab96a3020/nqthm-1992/examples/yu/mc20-1.dvi -------------------------------------------------------------------------------- /nqthm-1992/examples/yu/mc20-1.ilg: -------------------------------------------------------------------------------- 1 | This is makeindex, portable version 2.4 [20-Mar-88]. 2 | Scanning input file mc20-1.idx........done (4854 entries accepted, 0 rejected). 3 | Sorting entries................................................done (67366 comparisons). 4 | Generating output file mc20-1.ind......done (684 lines written, 0 warnings). 5 | Output written in mc20-1.ind. 6 | Transcript written in mc20-1.ilg. 7 | -------------------------------------------------------------------------------- /nqthm-1992/examples/yu/mc20-1.toc: -------------------------------------------------------------------------------- 1 | \contentsline {section}{\numberline {1}Introduction}{1} 2 | \contentsline {section}{\numberline {2}A Few Basic Functions}{2} 3 | \contentsline {section}{\numberline {3}Start Up}{3} 4 | \contentsline {section}{\numberline {4}Some Constants}{3} 5 | \contentsline {section}{\numberline {5}Bit Vector Arithmetic}{6} 6 | \contentsline {section}{\numberline {6}Integer Arithmetic}{9} 7 | \contentsline {section}{\numberline {7}Binary Trees for Memory}{12} 8 | \contentsline {section}{\numberline {8}Operands from Memory}{16} 9 | \contentsline {section}{\numberline {9}Storing the Result}{19} 10 | \contentsline {section}{\numberline {10}Retrieving the Operand According to Oplen}{22} 11 | \contentsline {section}{\numberline {11}Effective Address Calculation}{23} 12 | \contentsline {section}{\numberline {12}The Individual Instructions}{33} 13 | \contentsline {section}{\numberline {13}Stepi and Stepn}{102} 14 | \contentsline {section}{\numberline {14}Auxiliary Functions}{102} 15 | \contentsline {section}{\numberline {15}An Example of Simulation}{104} 16 | \contentsline {section}{\numberline {16}Acknowledgements}{106} 17 | \contentsline {section}{\numberline {17}Syntax Summary}{107} 18 | \contentsline {section}{Index}{110} 19 | -------------------------------------------------------------------------------- /nqthm-1992/examples/yu/switch.events: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Copyright (C) 1994 by Yuan Yu. All Rights Reserved. 4 | 5 | This script is hereby placed in the public domain, and therefore unlimited 6 | editing and redistribution is permitted. 7 | 8 | NO WARRANTY 9 | 10 | Yuan Yu PROVIDES ABSOLUTELY NO WARRANTY. THE EVENT SCRIPT IS PROVIDED "AS IS" 11 | WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT NOT 12 | LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 13 | PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 14 | SCRIPT IS WITH YOU. SHOULD THE SCRIPT PROVE DEFECTIVE, YOU ASSUME THE COST OF 15 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16 | 17 | IN NO EVENT WILL Yuan Yu BE LIABLE TO YOU FOR ANY DAMAGES, ANY LOST PROFITS, 18 | LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT 19 | OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT NOT LIMITED TO LOSS 20 | OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD 21 | PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF SUCH DAMAGES, OR 22 | FOR ANY CLAIM BY ANY OTHER PARTY. 23 | 24 | |# 25 | 26 | ; Case study: Switch Statement 27 | (note-lib "mc20-2" t) 28 | #| 29 | 30 | The purpose of this trivial C function here is to study the switch construct 31 | in C. 32 | 33 | int foo(int n) 34 | { 35 | int i; 36 | 37 | switch(n) { 38 | case 0: i = 0; break; 39 | case 1: i = 1; break; 40 | case 2: i = 4; break; 41 | case 3: i = 9; break; 42 | case 4: i = 16; break; 43 | default: i = n; break; 44 | }; 45 | return i; 46 | } 47 | 48 | Here is the MC68020 assembly code of the above function. The code is 49 | generated by gcc with optimization option. 50 | 51 | 0x23b2 : linkw a6,#0 52 | 0x23b6 : movel a6@(8),d0 53 | 0x23ba : movel #4,d1 54 | 0x23bc : cmpl d1,d0 55 | 0x23be : bhi 0x23e4 56 | 0x23c0 : movew 0x23c8[d0.l*2],d1 57 | 0x23c4 : jmp 0x23c8[d1.w] 58 | 0x23c8 : orb #14,a2 59 | 0x23cc : orb #22,a2@ 60 | 0x23d0 : orb #-128,a2@+ 61 | 0x23d4 : bra 0x23e4 62 | 0x23d6 : movel #1,d0 63 | 0x23d8 : bra 0x23e4 64 | 0x23da : movel #4,d0 65 | 0x23dc : bra 0x23e4 66 | 0x23de : movel #9,d0 67 | 0x23e0 : bra 0x23e4 68 | 0x23e2 : movel #16,d0 69 | 0x23e4 : unlk a6 70 | 0x23e6 : rts 71 | 72 | The machine code of the above program is: 73 | 74 | : 0x4e56 0x0000 0x202e 0x0008 0x7204 0xb081 0x6224 0x323b 75 | : 0x0a06 0x4efb 0x1002 0x000a 0x000e 0x0012 0x0016 0x001a 76 | : 0x4280 0x600e 0x7001 0x600a 0x7004 0x6006 0x7009 0x6002 77 | : 0x7010 0x4e5e 0x4e75 78 | 79 | '(78 86 0 0 32 46 0 8 80 | 114 4 176 129 98 36 50 59 81 | 10 6 78 251 16 2 0 10 82 | 0 14 0 18 0 22 0 26 83 | 66 128 96 14 112 1 96 10 84 | 112 4 96 6 112 9 96 2 85 | 112 16 78 94 78 117) 86 | |# 87 | 88 | ; in the logic, the above program is specified as (foo-code). 89 | (defn foo-code () 90 | '(78 86 0 0 32 46 0 8 91 | 114 4 176 129 98 36 50 59 92 | 10 6 78 251 16 2 0 10 93 | 0 14 0 18 0 22 0 26 94 | 66 128 96 14 112 1 96 10 95 | 112 4 96 6 112 9 96 2 96 | 112 16 78 94 78 117)) 97 | 98 | (defn foo (n) 99 | (if (between-ileq 0 n 4) 100 | (times n n) 101 | n)) 102 | 103 | (defn foo-t (n) 104 | (if (or (equal n 0) 105 | (equal n 1) 106 | (equal n 2) 107 | (equal n 3)) 108 | 11 109 | (if (equal n 4) 110 | 10 111 | 7))) 112 | 113 | (defn foo-statep (s n) 114 | (and (equal (mc-status s) 'running) 115 | (evenp (mc-pc s)) 116 | (rom-addrp (mc-pc s) (mc-mem s) 54) 117 | (mcode-addrp (mc-pc s) (mc-mem s) (foo-code)) 118 | (ram-addrp (sub 32 4 (read-sp s)) (mc-mem s) 12) 119 | (disjoint (mc-pc s) 54 (sub 32 4 (read-sp s)) 12) 120 | (equal n (iread-mem (add 32 (read-sp s) 4) (mc-mem s) 4)))) 121 | 122 | (defn foo-snp (s sn n oplen rn x k) 123 | (and (equal (mc-status sn) 'running) 124 | (equal (mc-pc sn) (rts-addr s)) 125 | (equal (iread-dn 32 0 sn) (foo n)) 126 | (equal (read-rn 32 14 (mc-rfile sn)) 127 | (read-rn 32 14 (mc-rfile s))) 128 | (equal (read-rn 32 15 (mc-rfile sn)) 129 | (add 32 (read-an 32 7 s) 4)) 130 | (equal (read-rn oplen rn (mc-rfile sn)) 131 | (read-rn oplen rn (mc-rfile s))) 132 | (equal (read-mem x (mc-mem sn) k) 133 | (read-mem x (mc-mem s) k)))) 134 | 135 | (prove-lemma foo-s-sn () 136 | (implies (and (foo-statep s n) 137 | (d2-7a2-5p rn) 138 | (disjoint x k (sub 32 4 (read-sp s)) 12)) 139 | (foo-snp s (stepn s (foo-t n)) n oplen rn x k))) 140 | 141 | (prove-lemma foo-correctness (rewrite) 142 | (let ((sn (stepn s (foo-t n)))) 143 | (implies (foo-statep s n) 144 | (and (equal (mc-status sn) 'running) 145 | (equal (mc-pc sn) (rts-addr s)) 146 | (equal (read-rn 32 14 (mc-rfile sn)) 147 | (read-rn 32 14 (mc-rfile s))) 148 | (equal (read-rn 32 15 (mc-rfile sn)) 149 | (add 32 (read-an 32 7 s) 4)) 150 | (implies (d2-7a2-5p rn) 151 | (equal (read-rn oplen rn (mc-rfile sn)) 152 | (read-rn oplen rn (mc-rfile s)))) 153 | (implies (disjoint x k (sub 32 4 (read-sp s)) 12) 154 | (equal (read-mem x (mc-mem sn) k) 155 | (read-mem x (mc-mem s) k))) 156 | (equal (iread-dn 32 0 sn) (foo n))))) 157 | ((use (foo-s-sn (rn 3) (x (mc-pc s)) (k 1)) 158 | (foo-s-sn (x (mc-pc s)) (k 1)) 159 | (foo-s-sn (rn 3))) 160 | (disable foo-t foo))) 161 | 162 | -------------------------------------------------------------------------------- /nqthm-1992/make/README: -------------------------------------------------------------------------------- 1 | This directory contains Lisp code that is used only to help build Nqthm-1992 2 | under Unix via the `make' command. It is not only possible but even easy to 3 | install Nqthm-1992 without using the `make' command or anything on this 4 | directory. 5 | 6 | Unlike the sources for Nqthm-1992, the code here is Common Lisp implementation 7 | dependent. Why do we write any Common Lisp implementation dependent code at 8 | all? Example answers are that the Common Lisp specification does not say how 9 | to (a) save an executable image, (b) `work around' bugs or deliberate errors in 10 | Common Lisp implementations, (d) get the fastest compilation settings for a 11 | particular Lisp, (e) suppress irrelevant compiler warnings, (f) request more 12 | heap than comes by default, (g) arrange for the evaluation of a form at the 13 | start of a user interrupt, (h) arrange to suppress optional compiler commentary 14 | of emense proportions, or (i) suppress unwanted garbage collection or function 15 | redefinition messages. 16 | 17 | It should be recognized that although there is perhaps some justification for 18 | writing implementation dependent code, it is not unlikely that this code will 19 | break in future releases of the Lisps for which it was intended. If this code 20 | does not work for you, you are advised not to use the `make' command to build 21 | Nqthm-1992 command, but instead to use the simpler instructions for Nqthm-1992 22 | installation found in the main README file. 23 | -------------------------------------------------------------------------------- /nqthm-1992/make/compile.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 3 | 4 | Copying of this file is authorized to those who have read and agreed with the 5 | terms in the "Nqthm-1992 GENERAL PUBLIC SOFTWARE LICENSE" at the beginning of 6 | the Nqthm file "basis.lisp". 7 | 8 | |# 9 | 10 | ; This file is not necessary for building Nqthm-1992, but is provided 11 | ; as a mere convenience to users who wish to build Nqthm-1992 under 12 | ; Unix. See the file ../makefile. Unlike the sources for Nqthm-1992, 13 | ; this file contains Common Lisp implementation dependent commands for 14 | ; fixing bugs and improving performance. 15 | 16 | ; It is important for practical use of Nqthm-1992 that optimization be 17 | ; set for high speed execution. Certainly, any optimization settings 18 | ; are ok. 19 | 20 | (PROGN 21 | 22 | ; Optimize for speed. We skirt a bug in the CMU Lisp 16(e) compiler 23 | ; when compiling sloop.lisp by using SPACE = 1, which is what the 24 | ; CMU folks recommend anyway. 25 | 26 | (PROCLAIM (QUOTE (OPTIMIZE (SAFETY 0) 27 | (SPACE #+CMU 1 #-CMU 0) 28 | (SPEED 3) 29 | #+Allegro (DEBUG 0) 30 | #+(OR CMU Lucid) (COMPILATION-SPEED 0) 31 | #+CMU (EXTENSIONS:INHIBIT-WARNINGS 3)))) 32 | 33 | ; We now prevent some false assumptions about fixnums in Allegro. We use 34 | ; this obscure EVAL/READ-FROM-STRING approach because the AKCL reader 35 | ; barfs on #+(VERSION>= ...). 36 | 37 | #+Allegro 38 | (EVAL (READ-FROM-STRING " 39 | (SETQ COMPILER::DECLARED-FIXNUMS-REMAIN-FIXNUMS-SWITCH 40 | #'(LAMBDA (X Y Z #+(VERSION>= 4 1) D) NIL)) ")) 41 | 42 | ; Silence the GC. 43 | 44 | #+Lucid 45 | (SETQ *GC-SILENCE* T) 46 | #+CMU 47 | (SETQ *GC-VERBOSE* NIL) 48 | 49 | ; Suppress some compiler noise. 50 | 51 | #+AKCL 52 | (PROGN 53 | (SETQ COMPILER:*COMPILE-VERBOSE* NIL) 54 | (SETQ COMPILER:*SUPPRESS-COMPILER-NOTES* T)) 55 | 56 | #+Lucid 57 | (PROGN (SETQ *STYLE-WARNINGS* NIL) 58 | (SETQ *REDEFINITION-ACTION* NIL) 59 | (SETQ *RECORD-SOURCE-FILES* NIL) 60 | (SETQ *WARN-IF-NO-IN-PACKAGE* NIL)) 61 | 62 | #+Allegro 63 | (SETQ *RECORD-SOURCE-FILE-INFO* NIL) 64 | 65 | (LOAD "nqthm.lisp") 66 | 67 | ) 68 | 69 | (IN-PACKAGE "USER") 70 | 71 | (PROGN 72 | 73 | ; This function gets referenced before it is defined or proclaimed in the 74 | ; normal course of Nqthm-1992 compilation. We proclaim it here only to avoid a 75 | ; compiler warning. 76 | 77 | (PROCLAIM '(FUNCTION *1*SUBRP (T) T)) 78 | 79 | (COMPILE-NQTHM) 80 | (LOAD-NQTHM) 81 | (LET ((*THM-SUPPRESS-DISCLAIMER-FLG* T)) 82 | (BOOT-STRAP THM)) 83 | (WITH-OPEN-FILE 84 | (FILE "make/compile-success" 85 | :DIRECTION :OUTPUT 86 | :IF-EXISTS :RENAME-AND-DELETE) 87 | (PRINT "COMPILE-NQTHM is done." FILE))) 88 | 89 | ; Some Lisps quit gracefully when reading end of file, some don't. 90 | 91 | #+CMU 92 | (QUIT) 93 | #+Allegro 94 | (EXIT) 95 | -------------------------------------------------------------------------------- /nqthm-1992/make/small-tester.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 3 | 4 | Copying of this file is authorized to those who have read and agreed with the 5 | terms in the "Nqthm-1992 GENERAL PUBLIC SOFTWARE LICENSE" at the beginning of 6 | the Nqthm file "basis.lisp". 7 | 8 | |# 9 | 10 | (SETQ *THM-SUPPRESS-DISCLAIMER-FLG* T) 11 | 12 | (COND ((PROVE-FILE-OUT "proveall") 13 | (FORMAT *STANDARD-OUTPUT* 14 | " 15 | ============================================================================= 16 | | | 17 | | It looks like the small test worked. | 18 | | | 19 | ============================================================================= 20 | 21 | "))) 22 | 23 | ; Some Lisps quit when reading end of file, some don't. 24 | #+CMU 25 | (QUIT) 26 | #+Allegro 27 | (EXIT) 28 | 29 | 30 | -------------------------------------------------------------------------------- /nqthm-1992/make/tiny-tester.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 3 | 4 | Copying of this file is authorized to those who have read and agreed with the 5 | terms in the "Nqthm-1992 GENERAL PUBLIC SOFTWARE LICENSE" at the beginning of 6 | the Nqthm file "basis.lisp". 7 | 8 | |# 9 | 10 | #+AKCL 11 | (COND 12 | ((< SI::*LISP-MAXPAGES* 32768) 13 | (FORMAT *STANDARD-OUTPUT* 14 | " 15 | 16 | WARNING: We suspect, after examing the AKCL variable SI::*LISP-MAXPAGES*, 17 | that you may not have enough space to complete all of the examples, especially 18 | those in the examples directory `fm9001-piton'. Consider rebuilding ACKL with 19 | more heap, by rebuilding after redefining MAXPAGE thus in the file h/bsd.h: 20 | 21 | #define MAXPAGE (16384*2) 22 | 23 | This warning may be ignored unless you plan to try some of the very largest 24 | examples. 25 | "))) 26 | 27 | (SETQ *THM-SUPPRESS-DISCLAIMER-FLG* T) 28 | 29 | (BOOT-STRAP) 30 | 31 | (ASSOC-OF-APP) 32 | 33 | (MAKE-LIB "tiny-test" T) 34 | 35 | (COND ((NOTE-LIB "tiny-test" T) 36 | (PRINC " 37 | 38 | ============================================================================= 39 | | | 40 | | It looks like compilation, saving, and very simple testing of Nqthm-1992 | 41 | | worked OK. | 42 | | | 43 | | Consider copying the executable file `nqthm-1992' to a bin directory. | 44 | | | 45 | ============================================================================= 46 | 47 | ") "Success.")) 48 | 49 | ; Some Lisps quit when reading end of file, some don't. 50 | #+CMU 51 | (QUIT) 52 | #+Allegro 53 | (EXIT) 54 | -------------------------------------------------------------------------------- /nqthm-1992/makefile: -------------------------------------------------------------------------------- 1 | # Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 2 | 3 | # Copying of this file is authorized to those who have read and agreed with the 4 | # terms in the "Nqthm-1992 GENERAL PUBLIC SOFTWARE LICENSE" at the beginning of 5 | # the Nqthm file "basis.lisp". 6 | 7 | # This file is a Unix makefile for compiling Nqthm-1992, building a save image, 8 | # and running some examples. If this makefile does not work for you, you are 9 | # advised not to use the `make' command to build Nqthm-1992, but instead to use 10 | # the simple, manual instructions for Nqthm-1992 installation found in the 11 | # `README' file. This file is not necessary for building Nqthm-1992, but is 12 | # provided as a convenience to users who wish to build Nqthm-1992 under Unix. 13 | # To build an executable Nqthm-1992 image, invoke 14 | 15 | # % make LISP=xxx 16 | 17 | # where xxx is the command for running your Common Lisp. xxx defaults to 18 | # `lisp'. Currently, this save-image-build process works only for AKCL, Lucid, 19 | # Allegro, and CMU Lisp. For other Lisps, it will be necessary to edit files 20 | # in the ./make/ subdirectory, in particular to add the appropriate command to 21 | # save an image, in the file ./make/save.lisp. 22 | 23 | # As a result of this make, a very small, executable file named `nqthm-1992' 24 | # will be created on this directory. This small file `points' to a large save 25 | # file, which is also created by the make. After the make has completed, the 26 | # file `nqthm-1992' may optionally be copied with `cp' (not moved, with `mv') 27 | # to a bin directory, e.g., with the command 28 | 29 | # % cp nqthm-1992 /usr/local/bin 30 | 31 | # The choice of bin directory varies a lot from site to site, and the copying 32 | # may even require special privileges, so we do not try to automate it. There 33 | # is absolutely no necessity of copying the above file anywhere -- putting it 34 | # on a bin path does nothing besides give users the convenience of not having 35 | # to precede `nqthm-1992' with some directory pathname to start it up. 36 | 37 | # As a secondary result of the make command above, a very short little test 38 | # will be run. If a `looks ok' message gets printed at the end of the make, 39 | # then the compilation and saving probably went ok. 40 | 41 | # Once the first make has succeeded, a somewhat longer test can be invoked via 42 | 43 | # % make small-test 44 | 45 | # which will run the file ./examples/basic/proveall.events, and if successful, 46 | # create the files ./examples/proveall.proofs and ./examples/proveall.proved, 47 | # and print out a message indicating that this small test worked. You can 48 | # monitor progress with `ls -lt examples/basic/proveall.proofs'. 49 | 50 | # A large set of tests, generating about 150 megabytes of files, and possibly 51 | # requiring cpu days to complete, can be invoked via 52 | 53 | # % make giant-test 54 | 55 | # Before running this form, read the file `examples/README'. You can monitor 56 | # progress with the command `ls -lt examples/*/* | head'. 57 | 58 | # The same set of tests can also be invoked via 59 | 60 | # % make giant-test-alt 61 | 62 | # which differs from giant-test mainly in that each test is performed in a 63 | # separate process. 64 | 65 | # To build a TAGS file for use with Gnu Emacs, invoke 66 | 67 | # % make TAGS 68 | 69 | # To remove files created by building under AKCL, Lucid, Allegro, and CMU 70 | # Common Lisps, invoke 71 | 72 | # % make clean 73 | 74 | # To remove files created by running the giant test, invoke 75 | 76 | # % make clean-giant-examples 77 | 78 | # `make clean-giant-examples' should be executed before trying the giant 79 | # examples afresh, if they have ever been tried before at your site; otherwise 80 | # the make will resume where it was last aborted or failed. This resumption 81 | # feature is a real feature, not a bug: running the giant tests takes so long 82 | # that there is a palpable chance that something external like a power failure 83 | # or a network crash will occur during execution, so resumption is a common 84 | # necessity. 85 | 86 | LISP=lisp 87 | 88 | SOURCES=nqthm.lisp basis.lisp events.lisp genfact.lisp code-1-a.lisp \ 89 | code-b-d.lisp code-e-m.lisp code-n-r.lisp code-s-z.lisp io.lisp ppr.lisp 90 | 91 | all: nqthm-1992 make/tiny-test.lisp 92 | 93 | 94 | make/compile-success: ${SOURCES} 95 | ${LISP} < make/compile.lisp 96 | 97 | 98 | nqthm-1992 saved_nqthm-1992: make/compile-success 99 | # We pass the Lisp command name and the current directory to Lisp via the file 100 | # nqthm-1992-tmp. The file nqthm-1992-tmp will then be written by Lisp to 101 | # contain an appropriate command with which to start up the saved image file. 102 | echo '"'${LISP}'" "'`pwd`'"' > nqthm-1992-tmp 103 | ${LISP} < make/save.lisp 104 | mv nqthm-1992-tmp nqthm-1992 105 | chmod a+x nqthm-1992 106 | 107 | 108 | make/tiny-test.lisp: nqthm-1992 109 | cd make; ../nqthm-1992 < tiny-tester.lisp 110 | 111 | 112 | small-test: nqthm-1992 113 | cd examples/basic; ../../nqthm-1992 < ../../make/small-tester.lisp 114 | 115 | 116 | giant-test: nqthm-1992 117 | cd examples; cat dir.lisp driver.lisp driver-sk.lisp | ../nqthm-1992 118 | 119 | 120 | giant-test-alt: nqthm-1992 121 | cd examples; csh driver 122 | 123 | 124 | TAGS: ${SOURCES} 125 | etags ${SOURCES} 126 | 127 | 128 | clean: 129 | rm -f make/compile-success nqthm-1992 TAGS 130 | rm -f *.o *.c *.h *.data *.sbin *.lbin *.fasl *.sparcf \ 131 | make/tiny-test.* *saved_nqthm-1992 make/tmp.* *.log 132 | 133 | 134 | clean-giant-examples: 135 | cd ./examples ; rm -f */*.lisp */*.lib */*.trans */*.err */*.log \ 136 | */*.proofs* */*.proved */*.STARTED */tmp.* */*.fail \ 137 | */*.o */*.fasl */*.lbin */*.sbin */*.sparcf \ 138 | */*.data */*.c */*.h */[0123456789]* 139 | -------------------------------------------------------------------------------- /nqthm-1992/mcl-nqthm-startup.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (C) 1994 by Computational Logic, Inc. All Rights Reserved. 3 | 4 | Copying of this file is authorized to those who have read and agreed with the 5 | terms in the "Nqthm-1992 GENERAL PUBLIC SOFTWARE LICENSE" at the beginning of 6 | the Nqthm file "basis.lisp". 7 | 8 | |# 9 | 10 | ; A start-up file for using Nqthm-1992 on a Mac under Mac Common Lisp 2.0. 11 | 12 | (in-package "COMMON-LISP-USER") 13 | 14 | ; This file belongs in the Nqthm-1992 directory. After starting up MCL, load 15 | ; this file via the EVAL window, and as a result, nqthm.lisp will be loaded, 16 | ; *default-nqthm-path* will be set to this directory, and the command cd will 17 | ; be defined to connect back to this directory. Also, optimizations will be 18 | ; set for maximum speed. 19 | 20 | ; This file should not be compiled. 21 | 22 | (let ((temp (choose-file-default-directory))) 23 | (format t "~%Loading nqthm.lisp.~%") 24 | (load (format nil "~anqthm.lisp" temp)) 25 | (format t "~%Finished loading nqthm.lisp~%") 26 | (format t "~%Setting *default-nqthm-path* to ~a.~%" 27 | (set (intern "*DEFAULT-NQTHM-PATH*" "USER") 28 | (namestring temp)))) 29 | 30 | ; We eval the next form only to avoid getting an error report when we load this 31 | ; file into FRED. This is the file that creates the USER package. 32 | 33 | (format t "~%Proclaiming to optimize for maximum speed.~%") 34 | 35 | (proclaim '(optimize (speed 3) (safety 0) (space 0))) 36 | 37 | (defun user::cd (&optional (x user::*default-nqthm-path*)) 38 | (set-mac-default-directory x)) 39 | 40 | (format t "~%Now execute (IN-PACKAGE \"USER\"), then (COMPILE-NQTHM) ~ 41 | or (LOAD-NQTHM).~%") -------------------------------------------------------------------------------- /nqthm-1992/nqthm-public-software-license.doc: -------------------------------------------------------------------------------- 1 | Nqthm-1992 GENERAL PUBLIC SOFTWARE LICENSE 2 | Computational Logic, Inc. 3 | 1717 West Sixth, Suite 290 4 | Austin, Texas 78703-4776 5 | 6 | Please read this license carefully before using the Nqthm-1992 Software. By 7 | using the Nqthm-1992 Software, you are agreeing to be bound by the terms of 8 | this license. If you do not agree to the terms of this license, promptly return 9 | the Nqthm-1992 Software to the place where you obtained it. 10 | 11 | The Nqthm-1992 Software was developed by Computational Logic, Inc.(CLI). You 12 | own the disk or other medium on which the Nqthm-1992 Software is recorded, but 13 | CLI retains title to the Nqthm-1992 Software. The purposes of this license are 14 | to identify the Nqthm-1992 Software and to make the Nqthm-1992 Software, 15 | including its source code, freely available. This license allows you to use, 16 | copy, distribute and modify the Nqthm-1992 Software, on the condition that you 17 | comply with all the Copying Policies set out below. 18 | 19 | COPYING POLICIES 20 | 21 | 1. You may copy and distribute verbatim copies of the Nqthm-1992 Software as 22 | you receive it, in any medium, including embedding it verbatim in derivative 23 | works, provided that you a) conspicuously and appropriately publish on each 24 | copy a valid copyright notice "Copyright (C) 1989-1994 by Robert S. Boyer, J 25 | Strother Moore, and Computational Logic, Inc. All Rights Reserved.", b) keep 26 | intact on all files the notices that refer to this License Agreement and to the 27 | absence of any warranty, and c) give all recipients of the Nqthm-1992 Software 28 | a copy of this License Agreement along with the program. 29 | 30 | 2. You may modify your copy or copies of the Nqthm-1992 Software or any portion 31 | of it, and copy and distribute such modifications provided you tell recipients 32 | that what they have is a modification by your organization of the CLI version 33 | of the Nqthm-1992 Software. 34 | 35 | 3. You may incorporate parts of the Nqthm-1992 Software into other programs 36 | provided that you 37 | 38 | a) acknowledge Computational Logic, Inc. in the program documentation, and 39 | 40 | b) send a copy of a user's manual for the program to 41 | 42 | Software-Request or Software-Request@CLI.COM 43 | Computational Logic, Inc. 44 | 1717 West Sixth, Suite 290 45 | Austin, TX 78703-4776 46 | 47 | CLI also requests, but does not require, that any improvements or extensions to 48 | the Nqthm-1992 Software be returned to one of these addresses, so that they may 49 | be shared with other Nqthm-1992 users. The Nqthm-1992 Software, including its 50 | source, can be obtained by contacting one of the above addresses. 51 | 52 | NO WARRANTY 53 | 54 | BECAUSE THE Nqthm-1992 SOFTWARE IS LICENSED FREE OF CHARGE, WE PROVIDE 55 | ABSOLUTELY NO WARRANTY. THE SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF 56 | ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED 57 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE 58 | RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 59 | Nqthm-1992 SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY 60 | SERVICING, REPAIR OR CORRECTION. 61 | 62 | IN NO EVENT WILL ROBERT S. BOYER, J STROTHER MOORE, OR COMPUTATIONAL LOGIC, 63 | INC. BE LIABLE TO YOU FOR ANY DAMAGES, ANY LOST PROFITS, LOST MONIES, OR OTHER 64 | SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR 65 | INABILITY TO USE THE Nqthm-1992 SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF 66 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES), 67 | EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF SUCH DAMAGES, OR FOR ANY 68 | CLAIM BY ANY OTHER PARTY. 69 | -------------------------------------------------------------------------------- /nqthm-1992/sinfix/README: -------------------------------------------------------------------------------- 1 | Copyright (C) 1994 Computational Logic, Inc. All Rights Reserved. 2 | 3 | Copying of this file is authorized to those who have read and 4 | agreed with the terms in the "Nqthm-1992 GENERAL PUBLIC SOFTWARE 5 | LICENSE" at the beginning of the Nqthm file "basis.lisp". 6 | 7 | NQTHM Version 1992 8 | 9 | Comments, bugs, suggestions to: 10 | 11 | Michael K. Smith 12 | Computational Logic Inc. 13 | 1717 W 6th, Suite 290 14 | Austin, TX 78703-4776 15 | 16 | Fax : (512) 322-0656 17 | Email: mksmith@cli.com 18 | 19 | -------------------------------------------------------------------------- 20 | INSTALLATION 21 | 22 | The files required are: 23 | 24 | sinfix.lisp 25 | latex-init.lisp 26 | latex-theory.lisp 27 | scribe-init.lisp 28 | scribe-theory.lisp 29 | akcl-patch.lisp *** 30 | 31 | *** With AKCL version 1.615 (and earlier, presumably), a patch file 32 | must be loaded before the -init files can be compiled. Sinfix.lisp 33 | makes this load conditional on a feature check for akcl. 34 | 35 | #+akcl (load-base "akcl-patch.lisp") 36 | 37 | LOAD-BASE looks for the file in the *infix-directory* directory. See 38 | below. 39 | 40 | For decent speed, sinfix and the -init files should be compiled. 41 | With AKCL that means producing the files: 42 | 43 | sinfix.o 44 | latex-init.o 45 | scribe-init.o 46 | 47 | After compiling Nqthm, connect to the directory in which the sinfix 48 | sources reside, start up Nqthm, compile sinfix.lisp, load sinfix.o 49 | and then compile the *-init.lisp files. Starting out in the directory 50 | in which sinfix resides causes *infix-directory* to get set properly. 51 | 52 | By default, sinfix expects the scribe-theory and latex-theory files to 53 | be in *infix-directory*. And they in turn expect their corresponding 54 | -init files to be there also. This is the directory in which you 55 | should compile sinfix.lisp (the value of (probe-file "./") at compile 56 | time). If you want to put these files elsewhere or want to compile 57 | the system from some other directory, edit sinfix.lisp before 58 | compiling it for your system. Find and change: 59 | 60 | (defparameter *infix-directory* #.(namestring (probe-file "./"))) 61 | 62 | It is the first defparameter in the file. The `#.' causes the 63 | (namestring (probe-file ..)) to be evaluated at compile time. The 64 | resulting value gets assigned at load time. 65 | 66 | Other -theory files may reside in *infix-directory* or in the `current 67 | directory' (defined to be the directory returned by (probe-file "./") 68 | at execution time). The current directory is checked first. 69 | 70 | 71 | -------------------------------------------------------------------------- 72 | USE 73 | 74 | The simple way to run this program is to connect to the directory 75 | containing your .events files, start up nqthm-1992, and load sinfix.o. 76 | 77 | The basic call is then 78 | 79 | (infix-file :mode ) 80 | 81 | where is the name (without type) of a .events file and, in the 82 | simplest case, is one of "scribe" or "latex". For example: 83 | 84 | (infix-file "clock" :mode "scribe") 85 | 86 | See the documentation in sinfix.lisp for information on user 87 | parameterization and extension of modes. In particular, see the 88 | section `SETTINGS THAT MAY BE MODIFIED IN MODE-THEORY.LISP'. 89 | 90 | Just as a note, if you have an events file, say clock.events, and 91 | create a corresponding theory file, clock-theory.lisp, then you can 92 | use the even simpler invocation: 93 | 94 | (infix-file "clock") 95 | 96 | 97 | -------------------------------------------------------------------------- 98 | TESTING 99 | 100 | SinFix has been tested in both Scribe and LaTeX mode against the files 101 | in "/slocal/src/nqthm-1992/examples/*/*.events". 102 | 103 | Subdirectories included were: 104 | 105 | kaufmann basic kunen 106 | bevier numbers bronstein 107 | flatau shankar cowles 108 | fm9001-piton talcott fortran-vcg 109 | yu driver hunt 110 | 111 | See testlog.summary for a complete list of files tested. 112 | 113 | 114 | 115 | 116 | -------------------------------------------------------------------------------- /nqthm-1992/sinfix/akcl-patch.lisp: -------------------------------------------------------------------------------- 1 | ; Date: Sun, 22 Aug 93 14:19:25 +0200 2 | ; From: schelter@posso.ibp.fr (William Schelter) 3 | ; Apparently-To: mksmith@cli.com 4 | 5 | ; Here is a patch to fix the bug, which you found. Thanks again 6 | ; for finding this. The problem was in the way the interpreter 7 | ; was invoking the function. 8 | 9 | (in-package 'compiler) 10 | (defun vararg-p (x) 11 | (and (equal (get x 'proclaimed-return-type) t) 12 | (do ((v (get x 'proclaimed-arg-types) (cdr v))) 13 | ((null v) t) 14 | (or (consp v) (return nil)) 15 | (or (eq (car v) t) 16 | (eq (car v) '*) 17 | (return nil))))) 18 | 19 | -------------------------------------------------------------------------------- /nqthm-1992/sinfix/scribe-theory.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (C) 1994 Computational Logic, Inc. All Rights Reserved. 3 | 4 | Copying of this file is authorized to those who have read and 5 | agreed with the terms in the "Nqthm-1992 GENERAL PUBLIC SOFTWARE 6 | LICENSE" at the beginning of the Nqthm file "basis.lisp". 7 | 8 | |# 9 | 10 | ;; The init file should be compiled. 11 | (load (concatenate 'string *infix-directory* "scribe-init")) 12 | 13 | ; INFIX-OPS 14 | 15 | ; infix-ops (infix operators) should be function symbols of two or more 16 | ; arguments for which it is desired that one symbol come out between every 17 | ; adjacent pair of arguments. E.g., invoking (make-infix-op plus "+") causes 18 | ; the term (plus a b c d) to be printed as (a + b + c + d). Invoking 19 | ; (make-infix-op equal "=" "@neq") causes the term (equal x y) to be printed 20 | ; as (x = y) and it also causes the term (not (equal x y)) to be printed as 21 | ; (x @neq y). 22 | 23 | ; Thus, for example, if one introduces a new function, say join, and wants to 24 | ; print terms of the form (join x y) as (x @delta y): 25 | 26 | ; (make-infix-op join "@delta") 27 | 28 | ; from Lisp. That is all that need be done to cause infix-file to subsequently 29 | ; print `join' terms this way. 30 | 31 | ; Note that throughout the following examples, we have used two backslashes to 32 | ; get one because, in Common Lisp, backslash is a character for quoting other 33 | ; characters. 34 | 35 | ; Examples of make-infix-op. 36 | 37 | (make-infix-op equal "@eq" "@neq") 38 | (make-infix-op lessp "@lt" "@gte") 39 | (make-infix-op leq "@lte" "@gt") 40 | (make-infix-op greaterp "@gt" "@lte") 41 | (make-infix-op geq "@gte" "@lt") 42 | (make-infix-op member "@in" "@notin") 43 | 44 | (make-infix-op implies "@rightarrow") 45 | (make-infix-op iff "@iff") 46 | (make-infix-op difference "-") 47 | (make-infix-op quotient " \\ ") 48 | (make-infix-op remainder "@b{mod}") 49 | (make-infix-op union "@union") 50 | (make-infix-op plus "+") 51 | (make-infix-op times "*") 52 | (make-infix-op and "@and") 53 | (make-infix-op or "@or") 54 | 55 | 56 | ; UNARY-PREFIX-OPS, UNARY-SUFFIX-OPS, and UNARY-ABS-OPS 57 | 58 | ; Use make-unary-prefix-op and make-unary-suffix-op only for function symbols 59 | ; of one argument. The string str (or *neg-str*) will be printed before or 60 | ; after the argument. 61 | 62 | ; unary-suffix-ops should be unary function symbols. 63 | 64 | ; (make-unary-suffix-op foo x str) makes (foo x) print as (x @math{str}). 65 | 66 | ; Examples of make-unary-suffix-op. 67 | 68 | (make-unary-suffix-op sub1 " - 1") 69 | (make-unary-suffix-op numberp "@in @b{N}" "@notin @b{N}") 70 | (make-unary-suffix-op zerop "@congruent @ @t{0}") 71 | ;; (make-unary-suffix-op nlistp "@approx @b{nil}" "@not @approx @b{nil}") 72 | 73 | ; unary-prefix-ops should be unary function symbols. 74 | 75 | ; (make-unary-prefix-op foo str) makes (foo x) print as ($str$ x). 76 | 77 | ; Examples of make-unary-prefix-op. 78 | 79 | (make-unary-prefix-op add1 "1 + ") 80 | (make-unary-prefix-op minus "-") 81 | 82 | ; unary-abs-ops should be unary function symbols. 83 | 84 | ; To create syntax like that for absolute value, use (make-unary-absolute-op 85 | ; lhs-str rhs-str), where lhs-str and rhs-str are the strings to print on the 86 | ; left and right of the argument. (make-unary-abs-op foo str1 str2) makes (foo 87 | ; x) print as (str1 x str2). See the example for abs below. 88 | 89 | 90 | ; SOME POSSIBLE EXTENSIONS 91 | 92 | 93 | (defun simple-extension () 94 | 95 | ; Here are a few examples of normal mathematical notation for functions not in 96 | ; the bootstrap. Invoke this function to put these into effect. 97 | 98 | (make-unary-abs-op abs "@abs<" ">") 99 | (make-unary-suffix-op fact "@r{!}") 100 | (make-infix-op subsetp "@subset") 101 | (make-infix-op intersect "@inter")) 102 | 103 | 104 | (defun dmg-syntax () 105 | 106 | ; Here are some examples once tentatively proposed by David Goldschlag for his 107 | ; work. Invoke this function to put these into effect. 108 | 109 | ; prefix-multiple-op's should be function symbols that take as many arguments as 110 | ; make-prefix-multiple-op is given arguments. (make-prefix-multiple-op foo str1 111 | ; str2) makes (foo x y) print as ($str1$ x $str2$ y). That is, the first string 112 | ; comes first. 113 | 114 | (make-prefix-multiple-op invariant "@box(@ )" "@b{in}") 115 | (make-prefix-multiple-op eventually-stable "@lozenge@box(@ )" "@b{in}") 116 | 117 | ; infix-multiple-op's should be function symbols that take one more argument 118 | ; than make-infix-multiple-op is given arguments. (make-infix-multiple-op foo 119 | ; str1 str2) makes (foo x y z) print as (x $str1$ y $str2$ z). That is, the 120 | ; strings are placed between adjacent arguments. 121 | 122 | (make-infix-multiple-op leads-to "@pari" "@b{in}") 123 | (make-infix-multiple-op unless "@b{unless}" "@b{in}") 124 | (make-infix-multiple-op ensures "@b{ensures}" "@b{in}") 125 | (make-infix-multiple-op e-ensures "@ @b{e-ensures}@ " "@b{for}" "@b{in}") 126 | ; (make-infix-multiple-op n "\\leadsto" "{\\rm\\bf{by}}") 127 | (make-infix-multiple-op initial-condition "@b{initially@quad in}")) 128 | 129 | ; Undoing. To cause applications of a function symbol fn to be printed in the 130 | ; default way, i.e., fn(x, y), invoke (clean-up 'fn). 131 | 132 | --------------------------------------------------------------------------------